Solutions to challenge-111

2 files changed, 147 insertions, 0 deletions

diff --git a/challenge-111/wanderdoc/perl/ch-1.pl b/challenge-111/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..d49f08a12a
--- /dev/null
+++ b/challenge-111/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,83 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+
+You are given 5x5 matrix filled with integers such that each row is sorted from left to right and the first integer of each row is greater than the last integer of the previous row. 
+
+Write a script to find a given integer in the matrix using an efficient search algorithm.
+
+Example
+
+
+Matrix: [  1,  2,  3,  5,  7 ]
+        [  9, 11, 15, 19, 20 ]
+        [ 23, 24, 25, 29, 31 ]
+        [ 32, 33, 39, 40, 42 ]
+        [ 45, 47, 48, 49, 50 ]
+
+Input: 35 Output: 0 since it is missing in the matrix
+
+Input: 39 Output: 1 as it exists in the matrix
+=cut
+
+
+
+
+my @mtr = ([  1,  2,  3,  5,  7 ],
+          [  9, 11, 15, 19, 20 ],
+          [ 23, 24, 25, 29, 31 ],
+          [ 32, 33, 39, 40, 42 ],
+          [ 45, 47, 48, 49, 50 ]);
+
+
+
+sub search
+{
+     my ($aoa, $num) = @_;
+
+
+     my $row = 0; 
+     my $col = 0;
+
+     return 1 if $aoa->[$row][$col] == $num;
+     return 0 if $aoa->[$row][$col] >  $num;
+
+     while ($aoa->[$row][$col] < $num ) 
+     {
+          $row++; 
+          $row-- and last if $row > $#$aoa;
+          return 1 if $aoa->[$row][$col] == $num;
+     }
+
+     if ( $aoa->[$row][$col] > $num )
+     {
+          while ( $aoa->[$row-1][$col] < $num )
+          {
+
+               $col++; 
+               return 0 if $col > $#{$aoa->[$row-1]};
+          }
+          return 1 if $aoa->[$row-1][$col] == $num;
+     }
+
+     else
+     {
+
+          while ( $aoa->[$row][$col] < $num )
+          {
+               $col++; 
+               return 0 if $col > $#{$aoa->[$row-1]};
+          }
+
+          return 1 if $aoa->[$row][$col] == $num;
+     }
+
+     return 0;
+}
+
+for my $i ( -10 .. 60 ) 
+{
+     print join(" => ", $i, search([@mtr], $i)), $/; 
+}
\ No newline at end of file
diff --git a/challenge-111/wanderdoc/perl/ch-2.pl b/challenge-111/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..a1f4410ae3
--- /dev/null
+++ b/challenge-111/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,64 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Given a word, you can sort its letters alphabetically (case insensitive). For example, "beekeeper" becomes "beeeeekpr" and "dictionary" becomes "acdiinorty". Write a script to find the longest English words that don't change when their letters are sorted.
+=cut
+
+
+
+
+
+
+
+
+
+
+
+use File::Basename;
+use Mojo::UserAgent;
+use URI;
+use FindBin qw($Bin);
+
+
+# Download dictionary if it was not downloaded yet.
+
+unless ( (-e "$Bin/words.txt") and (-s "$Bin/words.txt" > 5_000_000) )
+{
+     my $url = URI->new( 'https://github.com/dwyl/english-words/raw/master/words.txt' );
+     my $file = basename( $url->path );
+     my $response = Mojo::UserAgent->new->max_redirects(5)->get( $url->as_string )->res;
+     die "Error while downloading a dictionary file!$/" unless 200 == $response->code;
+     open my $fh, '>', "$Bin/$file" or die "$!";
+     print {$fh} $response->body;
+}
+
+
+
+
+
+my $max_len = 0;
+my $candidate = '';
+open my $in, "<", "$Bin/words.txt" or die "$!";
+
+LINE: while ( my $line = <$in> )
+{
+     chomp $line;
+     my $this_len = length($line);
+
+     next if $this_len < $max_len;
+     $line = lc $line;
+     
+     for my $i ( 1 .. $this_len)
+     {
+          my $substring = substr($line, 0, $i);
+          my $sorted =  join('', sort {$a cmp $b} split(//,$substring));
+          next LINE if $substring ne $sorted;
+
+     }
+     $candidate = $line;
+     $max_len = length($line);
+}
+
+print $candidate, $/;
\ No newline at end of file