links in blogs < & >

2 files changed, 78 insertions, 18 deletions

diff --git a/challenge-111/james-smith/perl/ch-1.pl b/challenge-111/james-smith/perl/ch-1.pl
index 927633a2c0..4e3efa32ed 100644
--- a/challenge-111/james-smith/perl/ch-1.pl
+++ b/challenge-111/james-smith/perl/ch-1.pl
@@ -87,29 +87,44 @@ my %TEST_SET = map { $_ => 0 } (my @KEYS = -10..60);
 $TEST_SET{$_} = 1 foreach map { @{$_} } @{$matrix};
 
 
+sub search_rows {
+  my($row,$val,$mat)=(0,@_);
+  return 0 if $val > $mat->[-1]->[-1];
+  $row++ while ($val > $mat->[$row]->[-1]);
+  return 1 if (    $val == $mat->[$row]->[0]
+                || $val == $mat->[$row]->[1]
+                || $val == $mat->[$row]->[2]
+                || $val == $mat->[$row]->[3]
+                || $val == $mat->[$row]->[4] );
+  return 0;
+}
+
+
 my $tests = {
-  'Search'     => sub { find_val_search (       $_, $matrix ) foreach @KEYS; },
-  'GrepGrep'   => sub { find_val_grep_grep(      $_, $matrix ) foreach @KEYS; },
-  'GrepMap'    => sub { find_val_grep_map(      $_, $matrix ) foreach @KEYS; },
-  'GrepExt'    => sub { find_val_grep_grep_ext( $_, $matrix ) foreach @KEYS; },
-  'Flatten'    => sub { flatten(                 $_, $matrix ) foreach @KEYS; },
+  'SR'     => sub { search_rows (       $_, $matrix ) foreach @KEYS; },
+#  'Search'     => sub { find_val_search (       $_, $matrix ) foreach @KEYS; },
+#  'GrepGrep'   => sub { find_val_grep_grep(      $_, $matrix ) foreach @KEYS; },
+#  'GrepMap'    => sub { find_val_grep_map(      $_, $matrix ) foreach @KEYS; },
+#  'GrepExt'    => sub { find_val_grep_grep_ext( $_, $matrix ) foreach @KEYS; },
+#  'Flatten'    => sub { flatten(                 $_, $matrix ) foreach @KEYS; },
 
   'DNF'        => sub { find_val_dnf(           $_, $matrix ) foreach @KEYS; },
   'DNFOpt'     => sub { find_val_dnf_optimal(   $_, $matrix ) foreach @KEYS; },
-  'DNFGen'     => sub { find_val_general_dnf(   $_, $matrix ) foreach @KEYS; },
-  'Binary'     => sub { find_val_binary(        $_, $matrix ) foreach @KEYS; },
-
-  'Hash'       => sub { find_val_hash(          $_, $matrix ) foreach @KEYS; },
-  'Flatten@'   => sub { flatten_array(           $_, @M      ) foreach @KEYS; },
-
-  'ListUtil'   => sub { find_val_list_util(     $_, $matrix ) foreach @KEYS; },
-  'AnyAny'     => sub { find_val_any_any(       $_, $matrix ) foreach @KEYS; },
-  'AANaive'    => sub { find_val_any_any_naive( $_, $matrix ) foreach @KEYS; },
-
-  'preHash'    => sub { find_val_hash_pre(       $_, $H      ) foreach @KEYS; },
-  'preGrep'    => sub { find_val_grep_pre(       $_, $A      ) foreach @KEYS; },
+#  'DNFGen'     => sub { find_val_general_dnf(   $_, $matrix ) foreach @KEYS; },
+#  'Binary'     => sub { find_val_binary(        $_, $matrix ) foreach @KEYS; },
+
+#  'Hash'       => sub { find_val_hash(          $_, $matrix ) foreach @KEYS; },
+#  'Flatten@'   => sub { flatten_array(           $_, @M      ) foreach @KEYS; },
+
+#  'ListUtil'   => sub { find_val_list_util(     $_, $matrix ) foreach @KEYS; },
+#  'AnyAny'     => sub { find_val_any_any(       $_, $matrix ) foreach @KEYS; },
+#  'AANaive'    => sub { find_val_any_any_naive( $_, $matrix ) foreach @KEYS; },
+#
+#  'preHash'    => sub { find_val_hash_pre(       $_, $H      ) foreach @KEYS; },
+#  'preGrep'    => sub { find_val_grep_pre(       $_, $A      ) foreach @KEYS; },
 };
 
+=cut
 is( find_val_binary( 35, $matrix ), 0 );
 is( find_val_binary( 39, $matrix ), 1 );
 is( find_val_binary( $_, $matrix ), $TEST_SET{$_} ) foreach @KEYS;
@@ -155,6 +170,7 @@ is( find_val_general_dnf( $_, $matrix ), $TEST_SET{$_} ) foreach @KEYS;
 
 
 done_testing();
+=cut
 cmpthese( $N, $tests );
 
 sub find_val_grep_grep_ext {
diff --git a/challenge-111/james-smith/perl/ch-2.pl b/challenge-111/james-smith/perl/ch-2.pl
index 2671043056..232ee7fc1f 100644
--- a/challenge-111/james-smith/perl/ch-2.pl
+++ b/challenge-111/james-smith/perl/ch-2.pl
@@ -4,6 +4,7 @@ use strict;
 
 use warnings;
 use feature qw(say);
+use Benchmark qw(timethese cmpthese);
 
 ## Ubuntu supplies a number of different dictionaries
 ## I have installed all four of the english (UK)
@@ -20,16 +21,59 @@ use feature qw(say);
 ##   insane:  654,299   427,891
 ##
 
+#foreach (1..10) {
+#say longest_u( '/usr/share/dict/british-english-small'  );
+#say longest_u( '/usr/share/dict/british-english-large'  );
+#say longest_u( '/usr/share/dict/british-english-huge'   );
+#say longest_u( '/usr/share/dict/british-english-insane' );
+#}
+#
+cmpthese( 10,{
+  's' => sub {
 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' );
-
+},
+  'u' => sub {
+say longest_u( '/usr/share/dict/british-english-small'  );
+say longest_u( '/usr/share/dict/british-english-large'  );
+say longest_u( '/usr/share/dict/british-english-huge'   );
+say longest_u( '/usr/share/dict/british-english-insane' );
+},
+});
 #say longest_no_comments( '/usr/share/dict/british-english-small'  );
 #say longest_no_comments( '/usr/share/dict/british-english-large'  );
 #say longest_no_comments( '/usr/share/dict/british-english-huge'   );
 #say longest_no_comments( '/usr/share/dict/british-english-insane' );
 
+sub longest_u {
+  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
+  && ( $max[0] <= length $_ )
+                     ## Remove words that are too short
+  && ( $_ eq join q(), sort unpack '(A)*' )
+                     ## Check the word is unchanged when the
+                     ## letters are sorted
+  && ( $max[0] == length $_
+       ? ( push @max, $_ )
+       : ( @max = (length $_, $_) )
+     )
+    ## 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.
+    ## If the word is longer than the max length (1st entry
+    ## in @max - reset max to include the new max length and
+    ## the word.
+    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 {
   open my $fh, q(<), $_[0];
   my @max = (0);