Merge pull request #4015 from drbaggy/master

Solutions to challenge 111

2 files changed, 164 insertions, 0 deletions

diff --git a/challenge-111/james-smith/perl/ch-1.pl b/challenge-111/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..aae397ff35
--- /dev/null
+++ b/challenge-111/james-smith/perl/ch-1.pl
@@ -0,0 +1,75 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+
+my $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 ],
+];
+
+## Create a test set - numbers from -10 to 60...
+my %TEST_SET = map { $_ => 0 } (-10..60);
+
+## Set all to 0, and then iterate through the
+## elements of the matrix and set the numbers
+## in the list to 1....
+
+$TEST_SET{$_} = 1 foreach map { @{$_} } @{$matrix};
+
+## Run the original PWC test examples...
+is( find_val( 35, $matrix ), 0 );
+is( find_val( 39, $matrix ), 1 );
+
+## Now run our full test set - from -10 to 60. This covers
+## all cases within the list and a few either side...
+
+is( find_val( $_, $matrix ), $TEST_SET{$_} )
+  foreach sort {$a<=>$b} keys %TEST_SET;
+
+done_testing();
+
+sub find_val {
+  ## Flatten the array provided into a list...
+  my( $val, $m, @list ) = ( $_[0], 0, map { @{$_} } @{$_[1]} );
+
+  ## We trim the list depending on the value of the middle point
+  ## If it matches we return 1 o/w we throw the middle value and
+  ## the other half of the list - by using splice...
+
+  ## Note rather than dividing by 2 to get the mid point of the
+  ## list we instead use the bit shift operator ">>" this
+  ## also has the effect of taking the integer value of the
+  ## result so instead of having to do int(3/2) you can just
+  ## write 3>>1 to get the whole number (1)
+
+    $list[ $m = @list >> 1 ] == $val ? ( return 1              )
+  : $list[ $m              ] >  $val ? ( splice @list, $m      )
+  :                                    ( splice @list, 0, $m+1 )
+    while @list>1;
+
+  ## We stop when we get to a list of either 0 or 1 entries.
+  ## If the list has length 0 then we return 0
+  ## If it has one element we return whether or not it is the value
+
+  return @list && $list[0] == $val ? 1 : 0;
+
+  ## The latter occurs when the true value happens at the start of
+  ## list either at initially or after one of the splices...
+}
+
+sub find_val_no_comments {
+  my( $val, $m, @list ) = ( $_[0], 0, map { @{$_} } @{$_[1]} );
+    $list[ $m = @list >> 1 ] == $val ? ( return 1              )
+  : $list[ $m              ] >  $val ? ( splice @list, $m      )
+  :                                    ( splice @list, 0, $m+1 )
+    while @list>1;
+  return @list && $list[0] == $val ? 1 : 0;
+}
+
diff --git a/challenge-111/james-smith/perl/ch-2.pl b/challenge-111/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..b5d5b05780
--- /dev/null
+++ b/challenge-111/james-smith/perl/ch-2.pl
@@ -0,0 +1,89 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+
+## Ubuntu supplies a number of different dictionaries
+## I have installed all four of the english (UK)
+## dictionaries that are available - a summary of the
+## number of words is listed below. This does include
+## a large number of real names and words containing
+## hyphen's and apostrophies
+##
+##   Name:    # words # trimmed
+##   -------  ------- ---------
+##   small:    50,790    39,781
+##   large:   166,828   113,695
+##   huge:    344,861   245,593
+##   insane:  654,299   427,891
+##
+
+say longest( '/usr/share/dict/british-english-small'  );
+say longest( '/usr/share/dict/british-english-large'  );
+say longest( '/usr/share/dict/british-english-huge'   );
+say longest( '/usr/share/dict/british-english-insane' );
+
+sub longest {
+  open my $fh, q(<), $_[0];
+  my @max = (0);
+     (chomp)         ## Remove newline character
+  && !/\W/           ## Remove words with non-alpha chars
+  && !/^[A-Z]/       ## Remove words starting with a capital
+  && ( lc $_ eq join q(), sort split //, lc $_ )
+                     ## Check the word is unchanged when the
+                     ## letters are sorted
+  && ( $max[0] < length $_
+     ? ( @max = ( length $_, $_ ) )
+    ## If the word is longer than the max length (1st entry
+    ## in @max - reset max to include the new max length and
+    ## the word.)
+     : ( ( $max[0] == length $_ ) && (push @max, $_ ) )
+     )
+    ## If the word is the same length as the maximal word
+    ## push it onto @max - so we store all the longest words
+    ## with maximum length.
+    while <$fh>;
+  return "$_[0] > @max";
+  ## Return the name of the file used, the size of the words
+  ## and a complete list of the words of that length.
+}
+
+sub longest_no_comments {
+  open my $fh, q(<), $_[0];
+  my @max = (0);
+     (chomp) && !/\W/ && !/^[A-Z]/
+  && ( lc $_ eq join q(), sort split //, lc $_ )
+  && ( $max[0] < length $_ ? ( @max = ( length $_, $_ ) ) :
+       ( ( $max[0] == length $_ ) && (push @max, $_ ) ) )
+     while <$fh>;
+  return "$_[0] > @max";
+}
+
+## Long words that you may not recognise....
+##
+## All 21 of the 6 letter words in the "small" dictionary
+## are common words.
+##
+## Two (billowy & beefily) are common in the "huge" list
+## The other two 7 letter words are:
+##
+##   chikors  - An alternative spelling of chukars - A
+##              species of partridge native to central
+##              Asia (Alectoris chukar).
+##
+##   dikkops  - (From afrikaans) A bird of the family
+##              Burhinidae. The stone curlew, thick-knee.
+##              Comes from dik-kop or thick head
+##
+## Finally the 8 letter word in the insane diction is:
+##
+##   aegilops - a genus of Eurasian and North American
+##              plants in the grass family, Poaceae.
+##              They are known generally as goat grasses.
+##              Some species are known as invasive weeds
+##              in parts of North America.
+##
+
+