Perl Weekly Challenge 111.
My solutions (task 1, task 2 and task 2a) to the The Weekly Challenge - 111.
Task 1: Search Matrix
Submitted by: Mohammad S Anwar
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
I misread the description at first, and thought that the rows were ordered and the first column was ordered, and didn’t realize that there is a relation between the last and first element of contiguous rows. Thus I made a a search to get the viable rows and then a search for the element within each of those. However, after reading the task again, it turns out the all of the elements are ordered from left to right and from the top to the bottom. As the matrix is fully ordered a binary search should be an efficient algorithm.
# Perl weekly challenge 111
# Task 1: Search matrix
#
# See https://wlmb.github.io/2021/05/03/PWC111/#task-1-search-matrix
use strict;
use warnings;
use v5.12;
use POSIX qw(floor);
# Input matrix from STDIN (not ARGV) as space and newline separated columns and rows.
# Assume it is ordered as stated above
my @elements= map {chomp; (split ' ')} <STDIN>; # no need for organizing in rows
say "Input: $_ Output: ", binary_search($_, @elements) foreach @ARGV;
sub binary_search { # binary search an ordered list
my $number=shift @_;
my @array=@_;
return 0 if $number<$array[0] or $number > $array[-1]; # trivial case
my $low=0;
my $high=@array; #beyond highest number
while($low<$high){
my $mid=floor(($low+$high)/2);
return 1 if $array[$mid]==$number;
return 0 if $mid==$low;
$low=$mid if $number > $array[$mid];
$high=$mid if $number < $array[$mid];
}
return 0;
}
Example:
./ch-1.pl 35 39 <<EOF
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
EOF
Results:
Input: 35 Output: 0
Input: 39 Output: 1
Other examples for testing edge cases:
./ch-1.pl 0 1 7 8 44 45 50 51 <<EOF
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
EOF
Results:
Input: 0 Output: 0
Input: 1 Output: 1
Input: 7 Output: 1
Input: 8 Output: 0
Input: 44 Output: 0
Input: 45 Output: 1
Input: 50 Output: 1
Input: 51 Output: 0
When I read it a third time, I realized that the task specifies a small 5x5 matrix, so small that maybe a linear search might have been good enough.
Task 2: Ordered Letters
Submitted by: E. Choroba
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.
I just need a dictionary and look at each word to decide if it’s letters are already sorted, and chose the longest word I find.
# Perl weekly challenge 111
# Task 2: Ordered letters
#
# See https://wlmb.github.io/2021/05/03/PWC111/#task-2-ordered-letters
use strict;
use warnings;
use v5.12;
use List::Util qw(all);
my $word='';
my $max_length=0;
foreach(<>){
chomp;
$_=lc $_;
next unless m/^\w+$/; #Only allow word letters
next unless length>$max_length;
next unless sorted($_);
$word=$_;
$max_length=length;
}
say "\nword: $word length:\t$max_length";
sub sorted {
my @chars=split '', shift;
return all {$chars[$_] le $chars[$_+1]} 0..$#chars-1;
}
I found an American-English dictionary installed in my system, so I use it as input.
./ch-2.pl /usr/share/dict/american-english
Results:
word: billowy length: 7
For curiosity, I modified the program above to look for all sorted words of a given length.
# Perl weekly challenge 111
# Task 2: Ordered letters
#
# See https://wlmb.github.io/2021/05/03/PWC111/#task-2-ordered-letters
use strict;
use warnings;
use v5.12;
use List::Util qw(all);
my $length=shift @ARGV;
foreach(<>){
chomp;
$_=lc $_;
next unless m/^\w+$/; #Only allow word letters
next unless length==$length;
next unless sorted($_);
say $_;
}
sub sorted {
my @chars=split '', shift;
return all {$chars[$_] le $chars[$_+1]} 0..$#chars-1;
}
./ch-2a.pl 7 /usr/share/dict/american-english
Results:
billowy
So, according to my dictionary, the result, billowy, is unique.
Now I look for slightly shorter words.
./ch-2a.pl 6 /usr/share/dict/american-english
Results:
abbott
bellow
deimos
abbess
abhors
accent
accept
access
accost
adders
almost
begins
bellow
billow
biopsy
cellos
chills
chilly
chimps
chinos
chintz
choosy
choppy
effort
floors
floppy
glossy
knotty
Expecting more sorted words for shorter lengths, below I just count them.
for i in `seq 7`
do
echo Length $i Number of words:\
`./ch-2a.pl $i /usr/share/dict/american-english |\
wc |awk '{print $1}'`
done
Results:
Length 1 Number of words: 52
Length 2 Number of words: 64
Length 3 Number of words: 134
Length 4 Number of words: 182
Length 5 Number of words: 101
Length 6 Number of words: 28
Length 7 Number of words: 1
So it seems there are not that many sorted words. The 52 length-1 words are all the letters in the alphabet in upper and lower case.