diff options
| author | Mohammad Sajid Anwar <mohammad.anwar@yahoo.com> | 2024-07-28 21:43:08 +0100 |
|---|---|---|
| committer | Mohammad Sajid Anwar <mohammad.anwar@yahoo.com> | 2024-07-28 21:43:08 +0100 |
| commit | 3012f4d3d9802643573ff4cae49ef4bdafbbf63f (patch) | |
| tree | f195cd846ba0f8fdbb9ba1fa8817a9b44460e986 /challenge-279 | |
| parent | 1c07f8683d7e19731bbb2cade44f72fe19b27a4a (diff) | |
| download | perlweeklychallenge-club-3012f4d3d9802643573ff4cae49ef4bdafbbf63f.tar.gz perlweeklychallenge-club-3012f4d3d9802643573ff4cae49ef4bdafbbf63f.tar.bz2 perlweeklychallenge-club-3012f4d3d9802643573ff4cae49ef4bdafbbf63f.zip | |
- Added solutions by Wanderdoc.
Diffstat (limited to 'challenge-279')
| -rwxr-xr-x | challenge-279/wanderdoc/perl/ch-1.pl | 43 | ||||
| -rwxr-xr-x | challenge-279/wanderdoc/perl/ch-2.pl | 82 |
2 files changed, 125 insertions, 0 deletions
diff --git a/challenge-279/wanderdoc/perl/ch-1.pl b/challenge-279/wanderdoc/perl/ch-1.pl new file mode 100755 index 0000000000..207e297afa --- /dev/null +++ b/challenge-279/wanderdoc/perl/ch-1.pl @@ -0,0 +1,43 @@ +#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given two arrays, @letters and @weights.
+
+Write a script to sort the givem array @letters based on the @weights..
+Example 1
+
+Input: @letters = ('R', 'E', 'P', 'L')
+ @weights = (3, 2, 1, 4)
+Output: PERL
+
+Example 2
+
+Input: @letters = ('A', 'U', 'R', 'K')
+ @weights = (2, 4, 1, 3)
+Output: RAKU
+
+Example 3
+
+Input: @letters = ('O', 'H', 'Y', 'N', 'P', 'T')
+ @weights = (5, 4, 2, 6, 1, 3)
+Output: PYTHON
+=cut
+
+use Test2::V0;
+is(sort_letters([('R', 'E', 'P', 'L')], [(3, 2, 1, 4)]), 'PERL', 'Example 1');
+is(sort_letters([('A', 'U', 'R', 'K')], [(2, 4, 1, 3)]), 'RAKU', 'Example 2');
+is(sort_letters([('O', 'H', 'Y', 'N', 'P', 'T')], [(5, 4, 2, 6, 1, 3)]), 'PYTHON', 'Example 3');
+done_testing();
+
+sub sort_letters
+{
+ my ($aref_ltr, $aref_num) = @_;
+ my %hash;
+ for my $idx ( 0 .. $#$aref_num )
+ {
+ $hash{ $aref_num->[$idx] } = $aref_ltr->[$idx];
+ }
+ return join('', @hash{ sort {$a <=> $b} keys %hash });
+}
\ No newline at end of file diff --git a/challenge-279/wanderdoc/perl/ch-2.pl b/challenge-279/wanderdoc/perl/ch-2.pl new file mode 100755 index 0000000000..6e04fdd7bc --- /dev/null +++ b/challenge-279/wanderdoc/perl/ch-2.pl @@ -0,0 +1,82 @@ +#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given a string, $str.
+
+Write a script to split the given string into two containing exactly same number of vowels and return true if you can otherwise false.
+Example 1
+
+Input: $str = "perl"
+Output: false
+
+Example 2
+
+Input: $str = "book"
+Output: true
+
+Two possible strings "bo" and "ok" containing exactly one vowel each.
+
+Example 3
+
+Input: $str = "goodmorning""
+Output: true
+
+Two possible strings "good" and "morning" containing two vowels each.
+=cut
+
+use constant { true => 1, false => 0};
+use Test2::V0;
+
+is(splits_on_vowels('perl'), false, 'Example 1');
+is(splits_on_vowels('book'), true, 'Example 2');
+is(splits_on_vowels('goodmorning'), true, 'Example 3');
+is(actually_split_on_vowels('perl'), false, 'Example 1A');
+is(actually_split_on_vowels('book'), true, 'Example 2A');
+is(actually_split_on_vowels('goodmorning'), true, 'Example 3A');
+
+done_testing();
+
+
+
+
+sub splits_on_vowels
+{
+ my $string = $_[0];
+ my $re_vowels = qr/[aeiouy]/i;
+ my $count = () = $string =~ /$re_vowels/g;
+ return ($count == 0 or $count % 2 == 1) ? false : true;
+}
+
+
+
+sub actually_split_on_vowels
+{
+ my $string = $_[0];
+ my $re_vowels = qr/[aeiouy]/i;
+
+ if ( length($string) == 1)
+ {
+ return false;
+ }
+ elsif ( length($string) == 2 )
+ {
+ return
+ (substr($string, 0, 1) =~ /$re_vowels/
+ and substr($string, -1, 1) =~ /$re_vowels/) ? true : false;
+ }
+ else
+ {
+ for my $idx ( 1 .. length($string) - 1 )
+ {
+ my $count_1 = () = substr($string, 0, $idx) =~ /$re_vowels/g;
+ my $count_2 = () = substr($string, $idx) =~ /$re_vowels/g;
+ if ( $count_1 == $count_2 )
+ {
+ return true;
+ }
+ }
+ }
+ return false;
+}
\ No newline at end of file |