From 2c49a2a347c5071c1cdf34d938874b7cfd4f2a51 Mon Sep 17 00:00:00 2001
From: wanderdoc <wanderdoc@googlemail.com>
Date: Sun, 9 May 2021 16:02:20 +0200
Subject: Solutions to challenge-111

---
 challenge-111/wanderdoc/perl/ch-1.pl | 83 ++++++++++++++++++++++++++++++++++++
 challenge-111/wanderdoc/perl/ch-2.pl | 64 +++++++++++++++++++++++++++
 2 files changed, 147 insertions(+)
 create mode 100644 challenge-111/wanderdoc/perl/ch-1.pl
 create mode 100644 challenge-111/wanderdoc/perl/ch-2.pl

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