Solutions for PWC 081

1 files changed, 44 insertions, 4 deletions

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;