Solutions for PWC 081

6 files changed, 93 insertions, 75 deletions

diff --git a/challenge-081/bob-lied/perl/ch-1.pl b/challenge-081/bob-lied/perl/ch-1.pl
index 3aa9ff13fe..032b1efc8d 100755
--- a/challenge-081/bob-lied/perl/ch-1.pl
+++ b/challenge-081/bob-lied/perl/ch-1.pl
@@ -36,11 +36,11 @@ sub Usage { "Usage: $0 astring bstring" };
 my $Verbose = 0;
 GetOptions('verbose' => \$Verbose);
 
-my (@A, @B) = @ARGV;
+my ($A, $B) = @ARGV;
 
 die Usage() unless $A;
 die Usage() unless $B;
 
 my $cbs = CommonBaseString->new($A, $B);
 my $result = $cbs->run();
-say $result;
+say "@$result";
diff --git a/challenge-081/bob-lied/perl/ch-2.pl b/challenge-081/bob-lied/perl/ch-2.pl
index 5ed37221ff..76c3ba067d 100755
--- a/challenge-081/bob-lied/perl/ch-2.pl
+++ b/challenge-081/bob-lied/perl/ch-2.pl
@@ -25,22 +25,45 @@ use v5.30;
 use feature qw/ signatures /;
 no warnings qw/ experimental::signatures /;
 
-use Getopt::Long;
+use File::Slurper qw/ read_text /;
 
-use lib "lib";
-use FrequencySort;
 
-sub Usage { "Usage: $0 args" };
+sub Usage { "Usage: $0 filename" };
 
-my $Verbose = 0;
-GetOptions('verbose' => \$Verbose);
+my $InFile = shift;
 
-my $arg = shift;
-my @list = @ARGV;
+# It would be friendlier to allow stdin, but the spec says use a file.
+die Usage() unless $InFile;
 
-die Usage() unless $arg;
-die Usage() unless @list;
+# Slurp input file into one long string.
+my $input = read_text($InFile);
+
+# Split on word separators, and convienently get rid of them.
+# That might leave some empty strings, so filter those.
+my @words = grep !/^$/, split(/\s|[\n\r."(),]/, $input);
+
+# These next two cleanups could be chained to make one pass,
+# but let's keep it readable for now.
+#
+# Phrases separated by long dashes turn into multiple words.
+@words = map { if (/--/) { split(/--/) } else { $_ } } @words;
+
+# Possessives reduce to the base noun.
+@words = map { s/'s//; $_ } @words;
+
+my %counts;
+$counts{$_}++ foreach @words;
+
+# Invert the hash to have counts as keys to lists of words.
+my %countList;
+for my $word ( keys %counts )
+{
+    push @{$countList{ $counts{$word} }}, $word;
+}
+
+# Numeric sort ascending on the counts.
+for my $n ( sort { $a <=> $b } keys %countList )
+{
+    say "$n\t", join " ", sort @{$countList{$n}}
+}
 
-my $task = FrequencySort->new();
-my $result = $task->run();
-say $result;
diff --git a/challenge-081/bob-lied/perl/lib/CommonBaseString.pm b/challenge-081/bob-lied/perl/lib/CommonBaseString.pm
index b67ecfa948..4c6f98901c 100644
--- a/challenge-081/bob-lied/perl/lib/CommonBaseString.pm
+++ b/challenge-081/bob-lied/perl/lib/CommonBaseString.pm
@@ -19,21 +19,61 @@ no warnings qw/ experimental::signatures /;
 require Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT = qw();
-our @EXPORT_OK = qw();
+our @EXPORT_OK = qw(commonPrefix);
 
-sub new($class, $name1)
+sub new($class, $a, $b)
 {
     $class = ref($class) || $class;
     my $self = {
-        _name1 => $name1,
+        _a => $a,
+        _b => $b,
     };
     bless $self, $class;
     return $self;
 }
 
+# 
+sub commonPrefix($s, $t)
+{
+    my @s1 = split("", $s);
+    my @s2 = split("", $t);
+    my $prefix = "";
+    my @possiblePrefixes = ();
+
+    while ( @s1 && @s2 && ($s = shift @s1) eq ($t = shift @s2) )
+    {
+        $prefix .= $s;
+        push @possiblePrefixes, $prefix;
+    }
+    return \@possiblePrefixes;
+}
+
 sub run($self)
 {
-    return undef;
+    my ($A, $B) = @{$self}{qw(_a _b)};
+    my ($lenA, $lenB) = ( length($A), length($B) );
+    my @thisWorks = ();
+
+    my $prefixes = commonPrefix($A, $B);
+
+    for my $prefix ( @$prefixes )
+    {
+        my $lenP = length($prefix);
+        # Only prefixes that can be repeated to the length of both strings
+        # are candidates.
+        next unless $lenA % $lenP == 0;
+        next unless $lenB % $lenP == 0;
+
+        # Number of repetitions required for each string.
+        my $repA = $lenA / $lenP;
+        my $repB = $lenB / $lenP;
+
+        my $buildsA = ( ($prefix x $repA) eq $A );
+        my $buildsB = ( ($prefix x $repB) eq $B );
+        push @thisWorks, $prefix if ( $buildsA && $buildsB );
+    }
+
+    return \@thisWorks;
 }
 
 1;
diff --git a/challenge-081/bob-lied/perl/lib/FrequencySort.pm b/challenge-081/bob-lied/perl/lib/FrequencySort.pm
deleted file mode 100644
index 177e28ace9..0000000000
--- a/challenge-081/bob-lied/perl/lib/FrequencySort.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
-#=============================================================================
-# FrequencySort.pm
-#=============================================================================
-# Copyright (c) 2020, Bob Lied
-#=============================================================================
-# Description:
-#=============================================================================
-
-package FrequencySort;
-
-use strict;
-use warnings;
-use v5.30;
-
-use feature qw/ signatures /;
-no warnings qw/ experimental::signatures /;
-
-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT = qw();
-our @EXPORT_OK = qw();
-
-sub new($class, $name1)
-{
-    $class = ref($class) || $class;
-    my $self = {
-        _name1 => $name1,
-    };
-    bless $self, $class;
-    return $self;
-}
-
-sub run($self)
-{
-    return undef;
-}
-
-1;
diff --git a/challenge-081/bob-lied/perl/t/CommonBaseString.t b/challenge-081/bob-lied/perl/t/CommonBaseString.t
index 81d4345b76..8c7108c572 100644
--- a/challenge-081/bob-lied/perl/t/CommonBaseString.t
+++ b/challenge-081/bob-lied/perl/t/CommonBaseString.t
@@ -10,7 +10,17 @@ use warnings;
 use v5.30;
 
 use Test2::V0;
+use lib "lib";
+
+use CommonBaseString qw/ commonPrefix /;
+
+is( commonPrefix("abc", "def"), [ ],           "commonPrefix length 0" );
+is( commonPrefix("aaa", "abc"), [ "a" ],       "commonPrefix length 1" );
+is( commonPrefix("aaa", "aac"), [ "a", "aa" ], "commonPrefix length 2" );
+is( commonPrefix("abab", "abababab"), [ "a", "ab", "aba", "abab" ], "commonPrefix 2 possibilities" );
+
+is( CommonBaseString->new("abcdabcd", "abcdabcdabcdabcd")->run, [ "abcd", "abcdabcd" ], "Example 1");
+is( CommonBaseString->new("aaa", "a")->run, [ "a" ], "Example 2");
 
-use CommonBaseString;
 
 done_testing();
diff --git a/challenge-081/bob-lied/perl/t/FrequencySort.t b/challenge-081/bob-lied/perl/t/FrequencySort.t
deleted file mode 100644
index 794fd04750..0000000000
--- a/challenge-081/bob-lied/perl/t/FrequencySort.t
+++ /dev/null
@@ -1,16 +0,0 @@
-# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
-#
-#===============================================================================
-# FILE: FrequencySort.t
-# DESCRIPTION: Unit test for FrequencySort
-#===============================================================================
-
-use strict;
-use warnings;
-use v5.30;
-
-use Test2::V0;
-
-use FrequencySort;
-
-done_testing();