Merge pull request #3746 from PerlMonk-Athanasius/branch-for-challenge-104

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

4 files changed, 506 insertions, 0 deletions

diff --git a/challenge-104/athanasius/perl/ch-1.pl b/challenge-104/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..5c60745770
--- /dev/null
+++ b/challenge-104/athanasius/perl/ch-1.pl
@@ -0,0 +1,82 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 104
+=========================
+
+Task #1
+-------
+*FUSC Sequence*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 50 members of FUSC Sequence. Please refer to
+[ http://oeis.org/A002487 |OEIS] for more information._
+
+The sequence defined as below:
+
+ fusc(0) = 0
+ fusc(1) = 1
+ for n > 1:
+ when n is even: fusc(n) = fusc(n / 2),
+ when n is odd: fusc(n) = fusc((n-1)/2) + fusc((n+1)/2)
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+OEIS. A002487: Stern's diatomic series (or Stern-Brocot sequence):
+        a(0) = 0,
+        a(1) = 1;
+        for n > 0: a(2*n)   = a(n),
+                   a(2*n+1) = a(n) + a(n+1).
+
+ 0,  1,  1,  2, 1,  3,  2,  3, 1,  4,  3,  5, 2,  5,  3,  4, 1,  5,  4,  7,
+ 3,  8,  5,  7, 2,  7,  5,  8, 3,  7,  4,  5, 1,  6,  5,  9, 4, 11,  7, 10,
+ 3, 11,  8, 13, 5, 12,  7,  9, 2,  9,  7, 12, 5, 13,  8, 11, 3, 10,  7, 11,
+ 4,  9,  5,  6, 1,  7,  6, 11, 5, 14,  9, 13, 4, 15, 11, 18, 7, 17, 10, 13,
+ 3, 14, 11, 19, 8, 21, 13, 18, 5, 17, 12, 19
+
+Also called fusc(n) [Dijkstra].
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 104, Task #1: FUSC Sequence (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my @fusc = (0, 1);
+
+    for my $n (1 .. 25)
+    {
+        my $fusc_n = $fusc[ $n ];
+
+        $fusc[ 2 * $n     ] = $fusc_n;
+        $fusc[ 2 * $n + 1 ] = $fusc_n + $fusc[ $n + 1 ];
+    }
+
+    printf "fusc(%2d) = %2d\t", $_, $fusc[ $_ ] for 0 .. $#fusc - 1;
+    print  "\n";
+}
+
+###############################################################################
diff --git a/challenge-104/athanasius/perl/ch-2.pl b/challenge-104/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..b8289eaaf9
--- /dev/null
+++ b/challenge-104/athanasius/perl/ch-2.pl
@@ -0,0 +1,189 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 104
+=========================
+
+Task #2
+-------
+*NIM Game*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to simulate the NIM Game.
+
+It is played between 2 players. For the purpose of this task, let assume you
+play against the machine.
+
+There are 3 simple rules to follow:
+
+ a) You have 12 tokens
+ b) Each player can pick 1, 2 or 3 tokens at a time
+ c) The player who picks the last token wins the game
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+1.  Strategy
+    --------
+    All multiples of 4 tokens are losing positions, because whatever pick is
+    made, the following player can pick so as to reduce the tokens to another
+    multiple of 4. Hence, the player moving second can always force a win.
+
+    When the computer is in a losing position, it picks randomly.
+
+2.  Game play
+    ---------
+    The human player's name and (optionally) choice to move first are entered
+    on the command line:
+
+        perl ch-2.pl --name Larry --first
+
+    If no --first argument is given, the computer makes the first move.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Regexp::Common qw( number );
+
+const my $TOKENS_AT_START => 12;
+const my $USAGE =>
+"Usage:
+  perl $0 [--name=<Str>] [--first]
+
+    --name=<Str>    Player's name (1-8 chars)
+    --first         Human player moves first?\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 104, Task #2: NIM Game (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($name, $first) = parse_command_line();
+
+    printf "Hello %s, welcome to NIM. You have chosen to move %s.\n\n",
+            $name, $first ? 'first' : 'second';
+
+    my $move      = 0;
+    my $tokens    = $TOKENS_AT_START;
+    my $user_wins = 1;
+
+    printf "%d.                   Tokens at start:  %2d\n", $move, $tokens;
+
+    human_move( ++$move, \$tokens, $name ) if $first;
+
+    until ($tokens == 0)
+    {
+        computer_move( ++$move, \$tokens );
+
+        if ($tokens > 0)
+        {
+            human_move( ++$move, \$tokens, $name );
+        }
+        else
+        {
+            $user_wins = 0;
+        }
+    }
+
+    printf "\nGame over: %s wins!\n", $user_wins ? $name : 'Computer';
+}
+
+#------------------------------------------------------------------------------
+sub human_move
+#------------------------------------------------------------------------------
+{
+    my ($move, $tokens, $name) = @_;
+    my  @choices = $$tokens >= 3 ? (1, 2, 3) :
+                   $$tokens == 2 ? (1, 2)    : 1;
+    my  $done    = 0;
+
+    until ($done)
+    {
+        printf '   Enter your pick (%s): ', join ', ', @choices;
+
+        my $pick = <STDIN>;
+
+        if ($pick =~ / ^ $RE{num}{int} $ /x && 0 < $pick <= $choices[ -1 ])
+        {
+            $$tokens -= $pick;
+
+            printf "%d. %-8s picks %d. Tokens remaining: %2d\n",
+                $move, $name, $pick, $$tokens;
+
+            $done = 1;
+        }
+
+        print "   * Invalid entry, try again.\n" unless $done;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub computer_move
+#------------------------------------------------------------------------------
+{
+    my ($move, $tokens) = @_;
+    my  $pick     = ($$tokens % 4 == 0) ? (int( rand 3 ) + 1) : ($$tokens % 4);
+        $pick     =  $$tokens if $pick > $$tokens;
+        $$tokens -=  $pick;
+
+    printf "%d. Computer picks %d. Tokens remaining: %2d\n",
+            $move, $pick, $$tokens;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $name  = '';
+    my $first =  0;
+
+    GetOptions
+    (
+        'name=s' => \$name,
+        'first'  => \$first,
+
+    ) or error( "Error in command line arguments\n" );
+
+    if    (length $name == 0)
+    {
+         error( 'Name missing' );
+    }
+    elsif (length $name >  8)
+    {
+         error( 'Name too long' );
+    }
+
+    return ($name, $first);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-104/athanasius/raku/ch-1.raku b/challenge-104/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..7ebb711bc8
--- /dev/null
+++ b/challenge-104/athanasius/raku/ch-1.raku
@@ -0,0 +1,78 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 104
+=========================
+
+Task #1
+-------
+*FUSC Sequence*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 50 members of FUSC Sequence. Please refer to
+[ http://oeis.org/A002487 |OEIS] for more information._
+
+The sequence defined as below:
+
+ fusc(0) = 0
+ fusc(1) = 1
+ for n > 1:
+ when n is even: fusc(n) = fusc(n / 2),
+ when n is odd: fusc(n) = fusc((n-1)/2) + fusc((n+1)/2)
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+OEIS. A002487: Stern's diatomic series (or Stern-Brocot sequence):
+        a(0) = 0,
+        a(1) = 1;
+        for n > 0: a(2*n)   = a(n),
+                   a(2*n+1) = a(n) + a(n+1).
+
+ 0,  1,  1,  2, 1,  3,  2,  3, 1,  4,  3,  5, 2,  5,  3,  4, 1,  5,  4,  7,
+ 3,  8,  5,  7, 2,  7,  5,  8, 3,  7,  4,  5, 1,  6,  5,  9, 4, 11,  7, 10,
+ 3, 11,  8, 13, 5, 12,  7,  9, 2,  9,  7, 12, 5, 13,  8, 11, 3, 10,  7, 11,
+ 4,  9,  5,  6, 1,  7,  6, 11, 5, 14,  9, 13, 4, 15, 11, 18, 7, 17, 10, 13,
+ 3, 14, 11, 19, 8, 21, 13, 18, 5, 17, 12, 19
+
+Also called fusc(n) [Dijkstra].
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 104, Task #1: FUSC Sequence (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN()
+#==============================================================================
+{
+    my UInt @fusc = 0, 1;
+
+    for 1 .. 25 -> UInt $n
+    {
+        my UInt $fusc-n = @fusc[ $n ];
+
+        @fusc[ 2 * $n     ] = $fusc-n;
+        @fusc[ 2 * $n + 1 ] = $fusc-n + @fusc[ $n + 1 ];
+    }
+
+    "fusc(%2d) = %2d\t".printf: $_, @fusc[ $_ ] for 0 .. @fusc.end - 1;
+    ''.put;
+}
+
+##############################################################################
diff --git a/challenge-104/athanasius/raku/ch-2.raku b/challenge-104/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..17070fe63b
--- /dev/null
+++ b/challenge-104/athanasius/raku/ch-2.raku
@@ -0,0 +1,157 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 104
+=========================
+
+Task #2
+-------
+*NIM Game*
+
+Submitted by: Mohammad S Anwar
+
+Write a script to simulate the NIM Game.
+
+It is played between 2 players. For the purpose of this task, let assume you
+play against the machine.
+
+There are 3 simple rules to follow:
+
+ a) You have 12 tokens
+ b) Each player can pick 1, 2 or 3 tokens at a time
+ c) The player who picks the last token wins the game
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+1.  Strategy
+    --------
+    All multiples of 4 tokens are losing positions, because whatever pick is
+    made, the following player can pick so as to reduce the tokens to another
+    multiple of 4. Hence, the player moving second can always force a win.
+
+    When the computer is in a losing position, it picks randomly.
+
+2.  Game play
+    ---------
+    The human player's name and (optionally) choice to move first are entered
+    on the command line:
+
+        raku ch-2.raku --name=Larry --first
+
+    If no --first argument is given, the computer makes the first move.
+
+=end comment
+#==============================================================================
+
+my UInt constant TOKENS-AT-START = 12;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 104, Task #2: NIM Game (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Str:D  :$name where { 0 < $name.chars <= 8 },  #= Player's name (1-8 chars)
+    Bool:D :$first = False                         #= Human player moves first?
+)
+#==============================================================================
+{
+    "Hello %s, welcome to NIM. You have chosen to move %s.\n\n".printf:
+        $name, $first ?? 'first' !! 'second';
+
+    my UInt $move      = 0;
+    my UInt $tokens    = TOKENS-AT-START;
+    my Bool $user-wins = True;
+
+    "%d.                   Tokens at start:  %2d\n".printf: $move, $tokens;
+
+    human-move( ++$move, $tokens, $name ) if $first;
+
+    until $tokens == 0
+    {
+        computer-move( ++$move, $tokens );
+
+        if $tokens > 0
+        {
+            human-move( ++$move, $tokens, $name );
+        }
+        else
+        {
+            $user-wins = False;
+        }
+    }
+
+    "\nGame over: %s wins!\n".printf: $user-wins ?? $name !! 'Computer';
+}
+
+#------------------------------------------------------------------------------
+sub human-move( UInt:D $move, UInt:D $tokens is rw, Str:D $name )
+#------------------------------------------------------------------------------
+{
+    my UInt @choices = $tokens >= 3 ?? (1, 2, 3) !!
+                       $tokens == 2 ?? (1, 2)    !! 1;
+    my Bool $done    = False;
+
+    until $done
+    {
+        '   Enter your pick (%s): '.printf: @choices.join: ', ';
+
+        my Str $entry = $*IN.get;
+
+        if +$entry ~~ UInt
+        {
+            my UInt $pick = +$entry;
+
+            if 0 < $pick <= @choices[ *-1 ]
+            {
+                $tokens -= $pick;
+
+                "%d. %-8s picks %d. Tokens remaining: %2d\n".printf:
+                    $move, $name, $pick, $tokens;
+
+                $done = True;
+            }
+        }
+
+        '   * Invalid entry, try again.'.put unless $done;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub computer-move( UInt:D $move, UInt:D $tokens is rw )
+#------------------------------------------------------------------------------
+{
+    my UInt $pick = ($tokens % 4 == 0) ?? ((^3).pick + 1) !! ($tokens % 4);
+
+    $pick    = $tokens if $pick > $tokens;
+    $tokens -= $pick;
+
+    "%d. Computer picks %d. Tokens remaining: %2d\n".printf:
+        $move, $pick, $tokens;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################