Merge pull request #2483 from PerlMonk-Athanasius/branch-for-challenge-081

Perl & Raku solutions to Tasks 1 & 2 of the Perl Weekly Challenge #081

6 files changed, 596 insertions, 0 deletions

diff --git a/challenge-081/athanasius/perl/WestSideStory.txt b/challenge-081/athanasius/perl/WestSideStory.txt
new file mode 100644
index 0000000000..37001629ad
--- /dev/null
+++ b/challenge-081/athanasius/perl/WestSideStory.txt
@@ -0,0 +1,3 @@
+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.
diff --git a/challenge-081/athanasius/perl/ch-1.pl b/challenge-081/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..d3e22ee5f6
--- /dev/null
+++ b/challenge-081/athanasius/perl/ch-1.pl
@@ -0,0 +1,130 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 081
+=========================
+
+Task #1
+-------
+*Common Base String*
+
+Submitted by: Mohammad S Anwar
+
+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")
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+                                       # Exports:
+use strict;
+use warnings;
+use Const::Fast;                       # const()
+use Math::Prime::Util qw( divisors );
+use Set::Scalar;                       # infix "*" (overloaded for set inter-
+                                       #             section), members(), new()
+
+const my $USAGE =>
+"Usage:
+  perl $0 <A> <B>
+
+    <A>    First string
+    <B>    Second string\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 081, Task #1: Common Base String (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($A, $B)   = parse_command_line();
+
+    # (1) Display the input
+
+    print qq[Input:\n    \$A = "$A"\n    \$B = "$B"\n\n];
+
+    # (2) Find the *lengths* of all possible base strings common to $A and $B
+
+    my $A_lengths = Set::Scalar->new( divisors(length $A) );
+    my $B_lengths = Set::Scalar->new( divisors(length $B) );
+    my @lengths   = sort { $a <=> $b } ($A_lengths * $B_lengths)->members;
+
+    # (3) Find the base strings common to $A and $B using the substring lengths
+    #     just calculated
+
+    my $A_bases   = Set::Scalar->new( find_base_strings($A, \@lengths) );
+    my $B_bases   = Set::Scalar->new( find_base_strings($B, \@lengths) );
+    my @bases     = sort +($A_bases * $B_bases)->members;
+
+    # (4) Display the common base strings
+
+    printf "Output:\n    (%s)\n", join ', ', map { qq["$_"] } @bases;
+}
+
+#------------------------------------------------------------------------------
+sub find_base_strings
+#------------------------------------------------------------------------------
+{
+    my ($string, $lengths) = @_;
+    my  $total_length      = length $string;
+    my  @base_strings;
+
+    for my $length (@$lengths)
+    {
+        my $substring  = substr $string, 0, $length;
+        my $new_string = $substring x int($total_length / $length);
+
+        push @base_strings, $substring if $new_string eq $string;
+    }
+
+    return @base_strings;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+
+    $args == 2
+        or die "ERROR: Incorrect number ($args) of command-line arguments\n" .
+               $USAGE;
+
+    return @ARGV;
+}
+
+###############################################################################
diff --git a/challenge-081/athanasius/perl/ch-2.pl b/challenge-081/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..c32157c2bb
--- /dev/null
+++ b/challenge-081/athanasius/perl/ch-2.pl
@@ -0,0 +1,174 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 081
+=========================
+
+Task #2
+-------
+*Frequency Sort*
+
+Submitted by: Mohammad S Anwar
+
+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 lexico-
+graphical order. Also sort the words in the ascending order of frequency.
+
+INPUT file
+
+ 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.
+
+NOTE
+
+For the sake of this task, please ignore the following in the input file:
+
+ . " ( ) , 's --
+
+OUTPUT
+
+ 1 But City It Jet Juliet Latino New Romeo Side Story Their Then West York
+ adaptation any anything at award-winning away become before begin best classic
+ climactic coexist control dance do doesn't end ending escalates families
+ feuding form former friend gains gangs goes happened hatred heartbreaking
+ highway hoping in know love lovers meet meeting neither no one plan planning
+ point romantic rumble run secret sends sister streets strikes terribly their
+ two under understanding until violence warring what when where white whoever
+ wins with wrong younger
+
+ 2 Bernardo Jets Riff Sharks The by it led tragedy
+
+ 3 Maria Tony a can of stop
+
+ 4 to
+
+ 9 and the
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;                       # Exports const()
+
+const my $DEFAULT_INPUT_FILE => 'WestSideStory.txt';
+const my $USAGE =>
+"Usage:
+  perl $0 [<input>]
+
+    [<input>]    Input file name\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 081, Task #2: Frequency Sort (Perl)\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    # (1) Read in and edit the input text
+
+    my $text = parse_command_line();
+
+    # The text is first edited by replacing trailing 's and _ with spaces, then
+    # any remaining apostrophes are converted to underscores. This is done
+    # because \w matches the underscore character but not the apostrophe: which
+    # makes it easy to identify "words" using the zero-width assertion \b that
+    # matches on word boundaries (\w\W and \W\w). Note: It is not necessary to
+    # remove the other non-word characters [."(),] from the text, as these are
+    # automatically excluded by the match logic of the regex.
+
+    $text =~ s{ 's \b }{ }gx;
+    $text =~ s{   _   }{ }gx;
+    $text =~ s{   '   }{_}gx;
+
+    # (2) Create a dictionary of words (keys) and their frequencies (values)
+
+    my %by_word;
+
+    for my $word ($text =~ m{ \b (\w+?) \b }gx)
+    {
+        # Once a word has been identified, its apostrophes (if any) are
+        # restored, then it is recorded in the dictionary
+
+        $word =~ s{ _ }{'}gx;
+
+        ++$by_word{ $word };
+    }
+
+    # (3) Create a reverse dictionary of frequencies (keys) and arrays of words
+    #     (values)
+
+    my %by_freq;        # Reverse dictionary: frequency => array of words
+
+    #     From perlfaq4, "How do I look up a hash element by value?"
+
+    while (my ($word, $freq) = each %by_word)
+    {
+        push $by_freq{ $freq }->@*, $word;
+    }
+
+    # (4) Output frequencies (in ascending numerical order) together with their
+    #     associated words (in ascending lexicographical order)
+
+    for my $freq (sort { $a <=> $b } keys %by_freq)
+    {
+        printf "\n%d %s\n", $freq, join ' ', sort $by_freq{ $freq }->@*;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args  = scalar @ARGV;
+    my $input = $DEFAULT_INPUT_FILE;
+
+    if    ($args == 1)
+    {
+        $input = $ARGV[0];
+    }
+    elsif ($args >  1)
+    {
+           die "ERROR: Too many ($args) command-line arguments\n$USAGE";
+    }
+
+    open(my $fh, '<', $input)
+        or die "ERROR: Cannot open file '$input' for reading\n$USAGE";
+
+    local $/;               # Slurp mode
+
+    my $text = <$fh>;
+
+    close $fh
+        or die "ERROR: Cannot close file '$input', stopped";
+
+    return $text;
+}
+
+###############################################################################
diff --git a/challenge-081/athanasius/raku/WestSideStory.txt b/challenge-081/athanasius/raku/WestSideStory.txt
new file mode 100644
index 0000000000..37001629ad
--- /dev/null
+++ b/challenge-081/athanasius/raku/WestSideStory.txt
@@ -0,0 +1,3 @@
+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.
diff --git a/challenge-081/athanasius/raku/ch-1.raku b/challenge-081/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..ec0cb43a1a
--- /dev/null
+++ b/challenge-081/athanasius/raku/ch-1.raku
@@ -0,0 +1,138 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 081
+=========================
+
+Task #1
+-------
+*Common Base String*
+
+Submitted by: Mohammad S Anwar
+
+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")
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 081, Task #1: Common Base String (Raku)\n".put;
+}
+
+##=============================================================================
+sub MAIN
+(
+    Str:D $A,                       #= First string
+    Str:D $B,                       #= Second string
+)
+##=============================================================================
+{
+    # (1) Display the input
+
+    qq[Input:\n    \$A = "$A"\n    \$B = "$B"\n].put;
+
+    # (2) Find the *lengths* of all possible base strings common to $A and $B
+
+    my UInt @common-lengths = (find-divisors($A).Set ∩
+                               find-divisors($B).Set).keys.sort;
+
+    # (3) Find the base strings common to $A and $B using the substring lengths
+    #     just calculated
+
+    my Str @common-bases =
+                (find-base-strings($A, @common-lengths).Set ∩
+                 find-base-strings($B, @common-lengths).Set).keys.sort;
+
+    # (4) Display the common base strings
+
+    "Output:\n    (%s)\n".printf: @common-bases.map( { qq["$_"] } ).join: ', ';
+}
+
+#------------------------------------------------------------------------------
+sub find-base-strings
+(
+    Str:D           $string,
+    Array:D[UInt:D] $lengths,
+--> Array:D[Str:D]
+)
+#------------------------------------------------------------------------------
+{
+    my UInt $total-length = $string.chars;
+    my Str  @base-strings;
+    
+    for @$lengths -> UInt $length
+    {
+        my Str $substring  = substr $string, 0, $length;
+        my Str $new-string = $substring x ($total-length / $length);
+
+        @base-strings.push: $substring if $new-string eq $string;
+    }
+
+    return @base-strings;
+}
+
+#------------------------------------------------------------------------------
+sub find-divisors( Str:D $string --> Seq:D[UInt:D] )
+#------------------------------------------------------------------------------
+{
+    my UInt $integer = $string.chars;
+
+    my UInt @divisors = 1, $integer;
+
+    for 2 .. $integer.sqrt.floor -> UInt $i
+    {
+        if $integer % $i == 0
+        {
+            my UInt $j = ($integer / $i).floor;
+
+            @divisors.push: $i;
+            @divisors.push: $j unless $j == $i;
+        }
+    }
+
+    return @divisors.sort;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-081/athanasius/raku/ch-2.raku b/challenge-081/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..c5d2bc7774
--- /dev/null
+++ b/challenge-081/athanasius/raku/ch-2.raku
@@ -0,0 +1,148 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 081
+=========================
+
+Task #2
+-------
+*Frequency Sort*
+
+Submitted by: Mohammad S Anwar
+
+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 lexico-
+graphical order. Also sort the words in the ascending order of frequency.
+
+INPUT file
+
+ 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.
+
+NOTE
+
+For the sake of this task, please ignore the following in the input file:
+
+ . " ( ) , 's --
+
+OUTPUT
+
+ 1 But City It Jet Juliet Latino New Romeo Side Story Their Then West York
+ adaptation any anything at award-winning away become before begin best classic
+ climactic coexist control dance do doesn't end ending escalates families
+ feuding form former friend gains gangs goes happened hatred heartbreaking
+ highway hoping in know love lovers meet meeting neither no one plan planning
+ point romantic rumble run secret sends sister streets strikes terribly their
+ two under understanding until violence warring what when where white whoever
+ wins with wrong younger
+
+ 2 Bernardo Jets Riff Sharks The by it led tragedy
+
+ 3 Maria Tony a can of stop
+
+ 4 to
+
+ 9 and the
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+my constant $DEFAULT-INPUT-FILE = 'WestSideStory.txt';
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 081, Task #2: Frequency Sort (Raku)".put;
+}
+
+##=============================================================================
+sub MAIN
+(
+    Str:D $input where *.IO.f = $DEFAULT-INPUT-FILE          #= Input file name
+)
+##=============================================================================
+{
+    # (1) Read in and edit the input text
+
+    my Str $text = $input.IO.slurp;
+
+    # The text is first edited by replacing trailing 's and _ with spaces, then
+    # any remaining apostrophes are converted to underscores. This is done
+    # because \w matches the underscore character but not the apostrophe: which
+    # makes it easy to identify "words" using the zero-width assertions « and »
+    # that match on word boundaries (\W\w and \w\W). Note: It is not necessary
+    # to remove the other non-word characters [."(),] from the text, as these
+    # are automatically excluded by the match logic of the regex below.
+
+    $text ~~ s:g/ \'s » / /;
+    $text ~~ s:g/  _    / /;
+    $text ~~ s:g/ \'    /_/;
+
+    # (2) Create a dictionary of words (keys) and their frequencies (values)
+
+    my UInt %by-word;
+
+    for $text ~~ m:g/ « (\w+?) » / -> Match $match
+    {
+        my Str $word =  $match.Str;
+
+        # Once a word has been identified, its apostrophes (if any) are
+        # restored, then it is recorded in the dictionary
+
+        $word ~~ s:g/ _ /'/;
+
+        ++%by-word{ $word };
+    }
+
+    # (3) Create a reverse dictionary of frequencies (keys) and arrays of words
+    #     (values)
+
+    my Array[Str] %by-freq;
+
+    for %by-word.kv -> Str $word, UInt $freq
+    {
+        %by-freq{ $freq }.push: $word;
+    }
+
+    # (4) Output frequencies (in ascending numerical order) together with their
+    #     associated words (in ascending lexicographical order)
+
+    for %by-freq.keys.map( { .UInt }).sort -> UInt $freq
+    {
+        "\n%d %s\n".printf: $freq, %by-freq{ $freq }.sort.join: ' ';
+    }
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+###############################################################################