From 3012f4d3d9802643573ff4cae49ef4bdafbbf63f Mon Sep 17 00:00:00 2001
From: Mohammad Sajid Anwar <mohammad.anwar@yahoo.com>
Date: Sun, 28 Jul 2024 21:43:08 +0100
Subject: - Added solutions by Wanderdoc.

---
 challenge-279/wanderdoc/perl/ch-1.pl | 43 +++++++++++++++++++
 challenge-279/wanderdoc/perl/ch-2.pl | 82 ++++++++++++++++++++++++++++++++++++
 2 files changed, 125 insertions(+)
 create mode 100755 challenge-279/wanderdoc/perl/ch-1.pl
 create mode 100755 challenge-279/wanderdoc/perl/ch-2.pl

(limited to 'challenge-279')

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
-- 
cgit