Merge pull request #1794 from PerlMonk-Athanasius/branch-for-challenge-063

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

4 files changed, 407 insertions, 0 deletions

diff --git a/challenge-063/athanasius/perl/ch-1.pl b/challenge-063/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..4c71ad7301
--- /dev/null
+++ b/challenge-063/athanasius/perl/ch-1.pl
@@ -0,0 +1,101 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 063
+=========================
+
+Task #1
+-------
+*Last Word*
+
+*Submitted by: Mohammad S Anwar*
+*Reviewed by: Ryan Thompson*
+
+Define sub last_word($string, $regexp) that returns the last word matching
+$regexp found in the given string, or undef if the string does not contain a
+word matching $regexp.
+
+For this challenge, a "word" is defined as any character sequence consisting of
+non-whitespace characters (\S) only. That means punctuation and other symbols
+are part of the word.
+
+The $regexp is a regular expression. Take care that the regexp can only match
+individual words! See the *Examples* for one way this can break if you are not
+careful.
+
+*Examples*
+
+ last_word('  hello world',                qr/[ea]l/);      # 'hello'
+ last_word("Don't match too much, Chet!",  qr/ch.t/i);      # 'Chet!'
+ last_word("spaces in regexp won't match", qr/in re/);      #  undef
+ last_word( join(' ', 1..1e6),             qr/^(3.*?){3}/); # '399933'
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my @TESTS =>
+         (
+             [ '  hello world',                qr/[ea]l/,      'hello'  ],
+             [ "Don't match too much, Chet!",  qr/ch.t/i,      'Chet!'  ],
+             [ "spaces in regexp won't match", qr/in re/,       undef   ],
+             [  join(' ', 1 .. 1e6),           qr/^(3.*?){3}/, '399933' ],
+             [ 'I like ripe pies',             qr/i/i,         'pies'   ],
+         );
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 063, Task #1: Last Word (Perl)\n\n";
+
+    for my $test (@TESTS)
+    {
+        my ($string, $regexp, $expected) = @$test;
+
+        is
+        (
+            last_word( $string, $regexp ),
+            $expected,
+            defined $expected ? "Match '$expected'" : 'No match'
+        );
+    }
+
+    done_testing( scalar @TESTS );
+}
+
+#-------------------------------------------------------------------------------
+sub last_word
+#-------------------------------------------------------------------------------
+{
+    my ($string, $regexp) = @_;
+
+    my @words = split / \s+ /x, $string;
+
+    for my $word (reverse @words)
+    {
+        return $word if $word =~ $regexp;
+    }
+
+    return;
+}
+
+################################################################################
diff --git a/challenge-063/athanasius/perl/ch-2.pl b/challenge-063/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..e4f4a75b7b
--- /dev/null
+++ b/challenge-063/athanasius/perl/ch-2.pl
@@ -0,0 +1,117 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 063
+=========================
+
+Task #2
+-------
+*Rotate String*
+
+*Submitted by: Mohammad S Anwar*
+*Reviewed by: Ryan Thompson*
+
+Given a word made up of an arbitrary number of x and y characters, that word can
+be rotated as follows: For the _i_th rotation (starting at _i_ = 1), _i_ %
+length(_word_) characters are moved from the front of the string to the end.
+Thus, for the string xyxx, the initial (_i_ = 1) % 4 = 1 character (x) is moved
+to the end, forming yxxx. On the second rotation, (_i_ = 2) % 4 = 2 characters
+(yx) are moved to the end, forming xxyx, and so on. See below for a complete
+example.
+
+Your task is to write a function that takes a string of xs and ys and returns
+the minimum non-zero number of rotations required to obtain the original string.
+You may show the individual rotations if you wish, but that is not required.
+
+*Example*
+
+Input: $word = 'xyxx';
+
+ ▪ *Rotation 1:* you get yxxx by moving x to the end.
+ ▪ *Rotation 2:* you get xxyx by moving yx to the end.
+ ▪ *Rotation 3:* you get xxxy by moving xxy to the end.
+ ▪ *Rotation 4:* you get xxxy by moving nothing as 4 % length(xyxx) == 0.
+ ▪ *Rotation 5:* you get xxyx by moving x to the end.
+ ▪ *Rotation 6:* you get yxxx by moving xx to the end.
+ ▪ *Rotation 7:* you get xyxx by moving yxxx to the end which is same as the
+                 given word.
+
+Output: 7
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+
+const my $USAGE => "Usage:\n  perl $0 [--show] <word>\n\n"            .
+                   "    <word>    string of 'x' and 'y' characters\n" .
+                   "    --show    display individual rotations\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    print "Challenge 063, Task #2: Rotate String (Perl)\n\n";
+
+    my $show = 0;
+
+    GetOptions('show' => \$show) or die "\n" . $USAGE;
+    scalar @ARGV == 1            or die        $USAGE;
+
+    my $word = $ARGV[0];
+
+    warn "WARNING: Invalid character '$1' found in word '$word'\n\n"
+        if $word =~ / ([^xy]) /x;
+
+    my $count = find_rotations($word, $show);
+
+    print "Minimum rotations for '$word': $count\n";
+}
+
+#-------------------------------------------------------------------------------
+sub find_rotations
+#-------------------------------------------------------------------------------
+{
+    my ($word, $show) = @_;
+    my  $length       = length    $word;
+    my  @chars        = split //, $word;
+    my  $rotation     = 0;
+    my  $rotd_word    = $word;
+
+    printf "Rotation %d: %s\n", $rotation, $rotd_word if $show;
+
+    do
+    {
+        my   @chars_to_move;
+        push @chars_to_move, shift @chars for 1 .. ++$rotation % $length;
+        push @chars, @chars_to_move;
+
+        $rotd_word = join '', @chars;
+
+        printf "Rotation %d: %s\n", $rotation, $rotd_word if $show;
+
+    } until ($rotd_word eq $word);
+
+    print "\n" if $show;
+
+    return $rotation;
+}
+
+################################################################################
diff --git a/challenge-063/athanasius/raku/ch-1.raku b/challenge-063/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..628461a305
--- /dev/null
+++ b/challenge-063/athanasius/raku/ch-1.raku
@@ -0,0 +1,89 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 063
+=========================
+
+Task #1
+-------
+*Last Word*
+
+*Submitted by: Mohammad S Anwar*
+*Reviewed by: Ryan Thompson*
+
+Define sub last_word($string, $regexp) that returns the last word matching
+$regexp found in the given string, or undef if the string does not contain a
+word matching $regexp.
+
+For this challenge, a "word" is defined as any character sequence consisting of
+non-whitespace characters (\S) only. That means punctuation and other symbols
+are part of the word.
+
+The $regexp is a regular expression. Take care that the regexp can only match
+individual words! See the *Examples* for one way this can break if you are not
+careful.
+
+*Examples*
+
+ last_word('  hello world',                qr/[ea]l/);      # 'hello'
+ last_word("Don't match too much, Chet!",  qr/ch.t/i);      # 'Chet!'
+ last_word("spaces in regexp won't match", qr/in re/);      #  undef
+ last_word( join(' ', 1..1e6),             qr/^(3.*?){3}/); # '399933'
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+use Test;
+
+subset Test-Type of Array where [Str, Regex, Str];
+
+my constant TESTS = Array[ Test-Type ].new:
+            [ '  hello world',                rx/ <[ea]> l/,        'hello'  ],
+            [ "Don't match too much, Chet!",  rx:i/ ch.t /,         'Chet!'  ],
+            [ "spaces in regexp won't match", rx:s/in re/,          ''       ],
+            [ (1 .. 1e6).join(' '),           rx/ ^ (3 .*?) ** 3 /, '399933' ],
+            [ 'I like ripe pies',             rx:i/ i /,            'pies'   ];
+
+#-------------------------------------------------------------------------------
+BEGIN ''.put;
+#-------------------------------------------------------------------------------
+
+#===============================================================================
+sub MAIN()
+#===============================================================================
+{
+    "Challenge 063, Task #1: Last Word (Raku)\n".put;
+
+    plan TESTS.elems;
+
+    for  TESTS -> Test-Type $test
+    {
+        my (Str $string, Regex $regexp, Str $expected) = $test;
+
+        is last_word( $string, $regexp ),
+           $expected,
+           $expected.chars ?? "Match '$expected'" !! 'No match';
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub last_word( Str:D $string, Regex:D $regexp, --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str @words = $string.split: / \s+ /;
+
+    for @words.reverse -> Str $word
+    {
+        return $word if $word ~~ $regexp;
+    }
+
+    return '';
+}
+
+################################################################################
diff --git a/challenge-063/athanasius/raku/ch-2.raku b/challenge-063/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..219e1fcf4a
--- /dev/null
+++ b/challenge-063/athanasius/raku/ch-2.raku
@@ -0,0 +1,100 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 063
+=========================
+
+Task #2
+-------
+*Rotate String*
+
+*Submitted by: Mohammad S Anwar*
+*Reviewed by: Ryan Thompson*
+
+Given a word made up of an arbitrary number of x and y characters, that word can
+be rotated as follows: For the _i_th rotation (starting at _i_ = 1), _i_ %
+length(_word_) characters are moved from the front of the string to the end.
+Thus, for the string xyxx, the initial (_i_ = 1) % 4 = 1 character (x) is moved
+to the end, forming yxxx. On the second rotation, (_i_ = 2) % 4 = 2 characters
+(yx) are moved to the end, forming xxyx, and so on. See below for a complete
+example.
+
+Your task is to write a function that takes a string of xs and ys and returns
+the minimum non-zero number of rotations required to obtain the original string.
+You may show the individual rotations if you wish, but that is not required.
+
+*Example*
+
+Input: $word = 'xyxx';
+
+ ▪ *Rotation 1:* you get yxxx by moving x to the end.
+ ▪ *Rotation 2:* you get xxyx by moving yx to the end.
+ ▪ *Rotation 3:* you get xxxy by moving xxy to the end.
+ ▪ *Rotation 4:* you get xxxy by moving nothing as 4 % length(xyxx) == 0.
+ ▪ *Rotation 5:* you get xxyx by moving x to the end.
+ ▪ *Rotation 6:* you get yxxx by moving xx to the end.
+ ▪ *Rotation 7:* you get xyxx by moving yxxx to the end which is same as the
+                 given word.
+
+Output: 7
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#-------------------------------------------------------------------------------
+BEGIN ''.put;
+#-------------------------------------------------------------------------------
+
+#===============================================================================
+sub MAIN
+(
+    Str:D   $word,                           #= string of 'x' and 'y' characters
+    Bool:D :$show = False,                   #= display individual rotations
+)
+#===============================================================================
+{
+    "Challenge 063, Task #2: Rotate String (Raku)\n".put;
+
+    "WARNING: Invalid character '$0' found in word '$word'\n".note
+        if $word ~~ / ( <-[xy]> ) /;
+
+    my UInt $count = find-rotations($word, $show);
+
+    "Minimum rotations for '$word': $count".put;
+}
+
+#-------------------------------------------------------------------------------
+sub find-rotations( Str:D $word, Bool:D $show --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt $length    = $word.chars;
+    my Str  @chars     = $word.split: '', :skip-empty;
+    my UInt $rotation  = 0;
+    my Str  $rotd-word = $word;
+
+    "Rotation $rotation: $rotd-word".put if $show;
+
+    repeat until $rotd-word eq $word
+    {
+        my Str @chars-to-move;
+               @chars-to-move.push: @chars.shift for 1 .. ++$rotation % $length;
+
+        @chars.append: @chars-to-move;
+
+        $rotd-word = @chars.join: '';
+
+        "Rotation $rotation: $rotd-word".put if $show;
+    }
+
+    ''.put if $show;
+
+    return $rotation;
+}
+
+################################################################################