Merge branch 'master' of https://github.com/manwar/perlweeklychallenge-club

6 files changed, 235 insertions, 2 deletions

diff --git a/challenge-081/bob-lied/README b/challenge-081/bob-lied/README
index 026576bd98..e698fa656a 100644
--- a/challenge-081/bob-lied/README
+++ b/challenge-081/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 79 by Bob Lied.
+Solutions to weekly challenge 81 by Bob Lied.
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-079/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-081/
diff --git a/challenge-081/bob-lied/perl/ch-1.pl b/challenge-081/bob-lied/perl/ch-1.pl
new file mode 100755
index 0000000000..032b1efc8d
--- /dev/null
+++ b/challenge-081/bob-lied/perl/ch-1.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Perl Weekly Challenge 081 Task #1 > Common Base String
+#=============================================================================
+# You are given 2 strings, $A and $B.
+# Write a script to find out common base strings in $A and $B.
+# A substring of a string $S is called base string if repeated concatenation
+# of the substring results in the string.
+# Example 1: Input: $A = "abcdabcd"
+#                   $B = "abcdabcdabcdabcd"
+#           Output: ("abcd", "abcdabcd")
+#
+# Example 2: Input: $A = "aaa"
+#                   $B = "aa"
+#           Output: ("a")
+
+use strict;
+use warnings;
+use v5.30;
+
+use feature qw/ signatures /;
+no warnings qw/ experimental::signatures /;
+
+use Getopt::Long;
+
+use lib "lib";
+use CommonBaseString;
+
+sub Usage { "Usage: $0 astring bstring" };
+
+my $Verbose = 0;
+GetOptions('verbose' => \$Verbose);
+
+my ($A, $B) = @ARGV;
+
+die Usage() unless $A;
+die Usage() unless $B;
+
+my $cbs = CommonBaseString->new($A, $B);
+my $result = $cbs->run();
+say "@$result";
diff --git a/challenge-081/bob-lied/perl/ch-2.pl b/challenge-081/bob-lied/perl/ch-2.pl
new file mode 100755
index 0000000000..76c3ba067d
--- /dev/null
+++ b/challenge-081/bob-lied/perl/ch-2.pl
@@ -0,0 +1,69 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Perl Weekly Challenge 081 Task #2 > Frequency Sort
+#=============================================================================
+# You are given file named input.
+# Write a script to find the frequency of all the words.
+# It should print the result as first column of each line should be the
+# frequency of the the word followed by all the words of that frequency
+# arranged in lexicographical order. Also sort the words in the ascending
+# order of frequency.
+# For the sake of this task, please ignore the following in the input file:
+#   . " ( ) , 's --
+# Keep hyphenated words and contractions, but reduce possessives to their base
+# (e.g., "award-winning" and "doesn't" are words, but "Joe's" becomes "Joe"
+
+use strict;
+use warnings;
+use v5.30;
+
+use feature qw/ signatures /;
+no warnings qw/ experimental::signatures /;
+
+use File::Slurper qw/ read_text /;
+
+
+sub Usage { "Usage: $0 filename" };
+
+my $InFile = shift;
+
+# It would be friendlier to allow stdin, but the spec says use a file.
+die Usage() unless $InFile;
+
+# 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}}
+}
+
diff --git a/challenge-081/bob-lied/perl/lib/CommonBaseString.pm b/challenge-081/bob-lied/perl/lib/CommonBaseString.pm
new file mode 100644
index 0000000000..4c6f98901c
--- /dev/null
+++ b/challenge-081/bob-lied/perl/lib/CommonBaseString.pm
@@ -0,0 +1,79 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# CommonBaseString.pm
+#=============================================================================
+# Copyright (c) 2020, Bob Lied
+#=============================================================================
+# Description:
+#=============================================================================
+
+package CommonBaseString;
+
+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(commonPrefix);
+
+sub new($class, $a, $b)
+{
+    $class = ref($class) || $class;
+    my $self = {
+        _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)
+{
+    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/t/CommonBaseString.t b/challenge-081/bob-lied/perl/t/CommonBaseString.t
new file mode 100644
index 0000000000..8c7108c572
--- /dev/null
+++ b/challenge-081/bob-lied/perl/t/CommonBaseString.t
@@ -0,0 +1,26 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#
+#===============================================================================
+# FILE: CommonBaseString.t
+# DESCRIPTION: Unit test for CommonBaseString
+#===============================================================================
+
+use strict;
+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");
+
+
+done_testing();
diff --git a/challenge-081/bob-lied/perl/t/input b/challenge-081/bob-lied/perl/t/input
new file mode 100644
index 0000000000..5905c36971
--- /dev/null
+++ b/challenge-081/bob-lied/perl/t/input
@@ -0,0 +1,13 @@
+West Side Story
+
+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.