Merge pull request #2456 from drbaggy/master

solution to #081!

3 files changed, 71 insertions, 16 deletions

diff --git a/challenge-081/james-smith/README.md b/challenge-081/james-smith/README.md
index b1f39c934a..2a23e4ef37 100644
--- a/challenge-081/james-smith/README.md
+++ b/challenge-081/james-smith/README.md
@@ -1,18 +1,2 @@
 Solutions by James Smith.
 
-# Challenge 1 - Smallest Positive Number
-
-After testing three solutions:
-
-  * using sort
-  * using hash keys
-  * scanning with the numbers 1, 2, 3 etc
-
-it became obvious the best way of handling this is to sort the +ve numbers and them loop through them to find the first missing one (the first number which has the value in the array not equal to the 1-based index) was the quicksest...
-
-# Challenge 2 - Count candies
-
-This is a simple sweep approach applying the b) rule multiple times until the counting stops!
-
-Note you have to do this repeatedly till you find the right answer - a single pass will not return the right value {especially in more complex environments}
-
diff --git a/challenge-081/james-smith/perl/ch-1.pl b/challenge-081/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..27fdb24971
--- /dev/null
+++ b/challenge-081/james-smith/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use feature qw(say);
+
+use Test::More;
+
+## Run tests....
+
+is( "@{common_base_string( qw(abcdabcd abcdabcdabcdabcd) )}", 'abcd abcdabcd' );
+is( "@{common_base_string( qw(aaa aa) )                   }", 'a' );
+is( "@{common_base_string( 'abcd'x30, 'abcd'x12 )         }", 'abcd abcdabcd abcdabcdabcd abcdabcdabcdabcdabcdabcd' );
+is( "@{common_base_string( qw(abcd ef) )                  }", '' );
+
+done_testing;
+
+sub common_base_string {
+  my( $s, $t ) = @_;
+  my $ls = length $s; ## need lengths many times so we get them
+  my $lt = length $t;
+  return [ map { substr $s,0,$_ }
+          grep { my $x = substr $s,0,$_;
+                  !($ls % $_) &&           ## false unless length of
+                  !($lt % $_) &&           ## both strings a multiple of $_
+                  $s eq ($x x ($ls/$_)) && ## check to see if both
+                  $t eq ($x x ($lt/$_))    ## strings fit requirement!
+               }
+               1 .. ($ls<$lt?$ls:$lt) ];
+}
+
+
+
+
diff --git a/challenge-081/james-smith/perl/ch-2.pl b/challenge-081/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..bb1d5f40bc
--- /dev/null
+++ b/challenge-081/james-smith/perl/ch-2.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+my $string = q(
+The award-winning adaptation of the classic romantic tragedy "Romeo and Juliet". The feuding families become two warring New York City gangs, the white Jets led by Riff and the Latino Sharks, led by Bernardo. Their hatred escalates to a point where neither can coexist with any form of understanding. But when Riff's best friend (and former Jet) Tony and Bernardo's younger sister Maria meet at a dance, no one can do anything to stop their love. Maria and Tony begin meeting in secret, planning to run away. Then the Sharks and Jets plan a rumble under the highway--whoever wins gains control of the streets. Maria sends Tony to stop it, hoping it can end the violence. It goes terribly wrong, and before the lovers know what's happened, tragedy strikes and doesn't stop until the climactic and heartbreaking ending.
+);
+
+print_words( get_words( $string ));
+
+sub get_words {
+  my $string = shift;
+  my $words = {};
+  foreach ( grep {$_ }map { s{([."\(\),]|--|'s$)}{}msgr } $string =~ m{(\S+)}mxg ) {
+    $words->{lc $_} ||= [ $_, 0 ];
+    $words->{lc $_}[1]++;
+  }
+  return $words;
+}
+
+sub print_words {
+  my $struct = shift;
+  my @words;
+  ## Use array rather than hash as avoids one of the two sorts and
+  ## shouldn't be too sparse
+  push @{ $words[$_->[1]] }, $_->[0] foreach (values %{$struct});
+  foreach ( 0..(@words-1) ) {
+    next unless $words[$_];
+    print "$_ @{[ sort { lc $a cmp lc $b } @{$words[$_]} ]}\n";
+  }
+}
+
+
+
+