From 8968a5ff21e13aecd34c6a0697358cfe1fd30a4d Mon Sep 17 00:00:00 2001 From: boblied Date: Tue, 6 Oct 2020 07:26:56 -0500 Subject: Set up challenge 081 --- challenge-081/bob-lied/README | 4 +- challenge-081/bob-lied/perl/ch-1.pl | 46 ++++++++++++++++++++++ challenge-081/bob-lied/perl/ch-2.pl | 46 ++++++++++++++++++++++ .../bob-lied/perl/lib/CommonBaseString.pm | 39 ++++++++++++++++++ challenge-081/bob-lied/perl/lib/FrequencySort.pm | 39 ++++++++++++++++++ challenge-081/bob-lied/perl/t/CommonBaseString.t | 16 ++++++++ challenge-081/bob-lied/perl/t/FrequencySort.t | 16 ++++++++ challenge-081/bob-lied/perl/t/input | 13 ++++++ 8 files changed, 217 insertions(+), 2 deletions(-) create mode 100755 challenge-081/bob-lied/perl/ch-1.pl create mode 100755 challenge-081/bob-lied/perl/ch-2.pl create mode 100644 challenge-081/bob-lied/perl/lib/CommonBaseString.pm create mode 100644 challenge-081/bob-lied/perl/lib/FrequencySort.pm create mode 100644 challenge-081/bob-lied/perl/t/CommonBaseString.t create mode 100644 challenge-081/bob-lied/perl/t/FrequencySort.t create mode 100644 challenge-081/bob-lied/perl/t/input 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..3aa9ff13fe --- /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..5ed37221ff --- /dev/null +++ b/challenge-081/bob-lied/perl/ch-2.pl @@ -0,0 +1,46 @@ +#!/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 Getopt::Long; + +use lib "lib"; +use FrequencySort; + +sub Usage { "Usage: $0 args" }; + +my $Verbose = 0; +GetOptions('verbose' => \$Verbose); + +my $arg = shift; +my @list = @ARGV; + +die Usage() unless $arg; +die Usage() unless @list; + +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 new file mode 100644 index 0000000000..b67ecfa948 --- /dev/null +++ b/challenge-081/bob-lied/perl/lib/CommonBaseString.pm @@ -0,0 +1,39 @@ +# 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(); + +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/lib/FrequencySort.pm b/challenge-081/bob-lied/perl/lib/FrequencySort.pm new file mode 100644 index 0000000000..177e28ace9 --- /dev/null +++ b/challenge-081/bob-lied/perl/lib/FrequencySort.pm @@ -0,0 +1,39 @@ +# 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 new file mode 100644 index 0000000000..81d4345b76 --- /dev/null +++ b/challenge-081/bob-lied/perl/t/CommonBaseString.t @@ -0,0 +1,16 @@ +# 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 CommonBaseString; + +done_testing(); diff --git a/challenge-081/bob-lied/perl/t/FrequencySort.t b/challenge-081/bob-lied/perl/t/FrequencySort.t new file mode 100644 index 0000000000..794fd04750 --- /dev/null +++ b/challenge-081/bob-lied/perl/t/FrequencySort.t @@ -0,0 +1,16 @@ +# 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(); 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. -- cgit From d0579dfc12bbc9d3878bd2aab8525e9b3140824b Mon Sep 17 00:00:00 2001 From: boblied Date: Fri, 9 Oct 2020 15:34:05 -0500 Subject: Solutions for PWC 081 --- challenge-081/bob-lied/perl/ch-1.pl | 4 +- challenge-081/bob-lied/perl/ch-2.pl | 49 ++++++++++++++++------ .../bob-lied/perl/lib/CommonBaseString.pm | 48 +++++++++++++++++++-- challenge-081/bob-lied/perl/lib/FrequencySort.pm | 39 ----------------- challenge-081/bob-lied/perl/t/CommonBaseString.t | 12 +++++- challenge-081/bob-lied/perl/t/FrequencySort.t | 16 ------- 6 files changed, 93 insertions(+), 75 deletions(-) delete mode 100644 challenge-081/bob-lied/perl/lib/FrequencySort.pm delete mode 100644 challenge-081/bob-lied/perl/t/FrequencySort.t 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(); -- cgit