changes

2 files changed, 40 insertions, 16 deletions

diff --git a/challenge-111/james-smith/perl/ch-1.pl b/challenge-111/james-smith/perl/ch-1.pl
index 4635c73bbc..e1908ecfbd 100644
--- a/challenge-111/james-smith/perl/ch-1.pl
+++ b/challenge-111/james-smith/perl/ch-1.pl
@@ -89,10 +89,13 @@ is( find_val_grep_map( 35, $matrix ), 0 );
 is( find_val_grep_map( 39, $matrix ), 1 );
 is( find_val_dnf(      35, $matrix ), 0 );
 is( find_val_dnf(      39, $matrix ), 1 );
+is( find_val_dnf_x(      35, $matrix ), 0 );
+is( find_val_dnf_x(      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_dnf_x(    $_, $matrix ), $TEST_SET{$_} ) foreach @KEYS;
 is( find_val_dnf(      $_, $matrix ), $TEST_SET{$_} ) foreach @KEYS;
 is( find_val_search(   $_, $matrix ), $TEST_SET{$_} ) foreach @KEYS;
 is( find_val_map_grep( $_, $matrix ), $TEST_SET{$_} ) foreach @KEYS;
@@ -100,7 +103,8 @@ is( find_val_grep_map( $_, $matrix ), $TEST_SET{$_} ) foreach @KEYS;
 
 done_testing();
 
-cmpthese(10_000, {
+cmpthese(100_000, {
+  q(X)             => sub { find_val_dnf_x(    $_, $matrix ) foreach @KEYS; },
   q(Don't flatten) => sub { find_val_dnf(      $_, $matrix ) foreach @KEYS; },
   'Flatten'        => sub { flatten(           $_, $matrix ) foreach @KEYS; },
   'Search'         => sub { find_val_search(   $_, $matrix ) foreach @KEYS; },
@@ -117,6 +121,20 @@ sub find_val_dnf {
            : ( $v < $m->[4][0] ? 3 : 4                       )
          ]};
 }
+sub find_val_dnf_x {
+  my($v,$m) = @_;
+  my $t;
+  return $v < $m->[0][0] || $v > $m->[4][4]
+       ? 0
+       : ( $t = $m->[ $v < $m->[3][0]
+           ? ( $v < $m->[1][0] ? 0 : $v < $m->[2][0] ? 1 : 2 )
+           : ( $v < $m->[4][0] ? 3 : 4                       )
+         ] ) &&
+         ( return $v == $t->[2] ? 1 :
+                  $v < $t->[2] ?
+                  (( $v == $t->[0] || $v == $t->[1] ) ? 1 : 0) :
+                  (( $v == $t->[4] || $v == $t->[3] ) ? 1 : 0) );
+}
 
 sub flatten {
   my @list = map { @{$_} } @{$_[1]};
diff --git a/challenge-111/james-smith/perl/ch-2.pl b/challenge-111/james-smith/perl/ch-2.pl
index b5d5b05780..d840048986 100644
--- a/challenge-111/james-smith/perl/ch-2.pl
+++ b/challenge-111/james-smith/perl/ch-2.pl
@@ -25,25 +25,32 @@ say longest( '/usr/share/dict/british-english-large'  );
 say longest( '/usr/share/dict/british-english-huge'   );
 say longest( '/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 {
   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 $_ )
+  #&& !/\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 split //, $_ )
                      ## 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, $_ ) )
+  && ( $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
@@ -52,13 +59,12 @@ sub longest {
 
 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, $_ ) ) )
+  my @m = (0);
+     (chomp)&&!/[^a-z]/&&($m[0]<=length$_)
+  &&($_ eq join q(),sort split//,$_)
+  &&($m[0]==length$_?(push@m,$_):(@m=(length$_,$_)))
      while <$fh>;
-  return "$_[0] > @max";
+  return "$_[0] > @m";
 }
 
 ## Long words that you may not recognise....