Merge pull request #4084 from PerlMonk-Athanasius/branch-for-challenge-112

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

4 files changed, 837 insertions, 0 deletions

diff --git a/challenge-112/athanasius/perl/ch-1.pl b/challenge-112/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..099dbe768e
--- /dev/null
+++ b/challenge-112/athanasius/perl/ch-1.pl
@@ -0,0 +1,199 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 112
+=========================
+
+TASK #1
+-------
+*Canonical Path*
+
+Submitted by: Mohammad S Anwar
+
+You are given a string path, starting with a slash '/'.
+
+Write a script to convert the given absolute path to the simplified canonical
+path.
+
+In a Unix-style file system:
+
+ - A period '.' refers to the current directory
+ - A double period '..' refers to the directory up a level
+ - Multiple consecutive slashes ('//') are treated as a single slash '/'
+
+The canonical path format:
+
+ - The path starts with a single slash '/'.
+ - Any two directories are separated by a single slash '/'.
+ - The path does not end with a trailing '/'.
+ - The path only contains the directories on the path from the root directory
+   to the target file or directory
+
+Example
+
+ Input: "/a/"
+ Output: "/a"
+
+ Input: "/a/b//c/"
+ Output: "/a/b/c"
+
+ Input: "/a/b/c/../.."
+ Output: "/a"
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+The script may be invoked with either one argument (a single rooted path), or
+with no arguments. In the latter case, the 3 paths given in the Example are
+used as input.
+
+Note that Windows-style backslashes are also supported as path separators.
+
+Algorithm
+---------
+Directories (and the final file, if any) are stored sequentially in an array,
+with 2 exceptions:
+
+    (1) .  (the current directory) is ignored;
+    (2) .. (the parent  directory) is "stored" by removing the most-recently
+            added directory from the array.
+
+When all directory and file entries have been processed, the canonical path is
+re-constructed from whatever entries remain in the array.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+
+const my @EXAMPLES => ('/a/', '/a/b//c/', '/a/b/c/../..');
+const my $USAGE    =>
+"Usage:
+  perl $0
+  perl $0 <path>
+
+    <path>    Absolute path beginning at root\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 112, Task #1: Canonical Path (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    if ((my $path = parse_command_line()) eq 'EXAMPLES')
+    {
+        my $first = 1;
+
+        for (@EXAMPLES)
+        {
+            print "\n" unless $first;
+
+            $first = 0;
+
+            canonical_path( $_ );
+        }
+    }
+    else
+    {
+        canonical_path( $path );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub canonical_path
+#------------------------------------------------------------------------------
+{
+    my ($path) = @_;
+
+    print qq[Input:  "$path"\n];
+
+    $path =~ s{ \\ }{/}gx;         # Convert all backslashes to forward slashes
+
+    my $valid_path = 1;
+    my @canonical_dirs;
+
+    # Note: The grep below removes all empty directories, and thereby reduces
+    #       each sequence of consecutive slashes in the path to a single slash
+
+    for my $dir (grep { /./ } split '/', $path)
+    {
+        next if $dir eq '.';                        # Current directory: ignore
+
+        if ($dir eq '..')                           # Parent directory
+        {
+            if (scalar @canonical_dirs == 0)        # Impossible case
+            {
+                $valid_path = 0;
+                last;
+            }
+            else                                    # Go one directory "up"
+            {
+                pop @canonical_dirs;
+            }
+        }
+        else                                        # Go one directory "down"
+        {
+            push @canonical_dirs, $dir;
+        }
+    }
+
+    printf "Output: %s\n",
+        $valid_path ? '"/' . join('/', @canonical_dirs) . '"'
+                    : 'INVALID PATH: The root directory has no parent';
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args = scalar @ARGV;
+    my $path;
+
+    if    ($args == 0)
+    {
+        $path = 'EXAMPLES';
+    }
+    elsif ($args == 1)
+    {
+        $path = $ARGV[ 0 ];
+
+        unless ($path =~ / ^ [\/\\] /x)
+        {
+            error( qq[Invalid input path "$path": paths must begin at root] );
+        }
+    }
+    else
+    {
+        error( "Expected 0 or 1 command line arguments, found $args" );
+    }
+
+    return $path;
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-112/athanasius/perl/ch-2.pl b/challenge-112/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..2612924857
--- /dev/null
+++ b/challenge-112/athanasius/perl/ch-2.pl
@@ -0,0 +1,234 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 112
+=========================
+
+TASK #2
+-------
+*Climb Stairs*
+
+Submitted by: Mohammad S Anwar
+
+You are given $n steps to climb
+
+Write a script to find out the distinct ways to climb to the top. You are
+allowed to climb either 1 or 2 steps at a time.
+
+Example
+
+ Input: $n = 3
+ Output: 3
+
+     Option 1: 1 step + 1 step + 1 step
+     Option 2: 1 step + 2 steps
+     Option 3: 2 steps + 1 step
+
+ Input: $n = 4
+ Output: 5
+
+     Option 1: 1 step + 1 step + 1 step + 1 step
+     Option 2: 1 step + 1 step + 2 steps
+     Option 3: 2 steps + 1 step + 1 step
+     Option 4: 1 step + 2 steps + 1 step
+     Option 5: 2 steps + 2 steps
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+It is not clear from the Task description whether the requirement is for
+
+    (1) details of all the distinct ways to climb to the top,
+or just
+    (2) the total number of these distinct ways.
+
+I have therefore provided both solutions, defaulting to (2) unless the option "--show-steps" is provided on the command line.
+
+Algorithms
+----------
+(1) The number of distinct solutions for n is simply the (n + 1)th Fibonacci
+    number. A straightforward calculation is provided for this.
+
+(2) Display of the distinct solutions is performed in 3 stages:
+
+    (a) Strings are constructed representing the possible combinations of '1'
+        and '2' digits in each solution. For example, for n = 4, the strings
+        are '1111', '112', and '22'.
+
+    (b) Each string constructed in (a) is permuted into all of its possible
+        digit arrangements. For example, the string '112' is permuted to '112',
+        '121', and '211'.
+
+    (c) Each permutation calculated in (b) is decoded and displayed as a
+        sequence of steps. For example, '211' is displayed as:
+            "Option 4: 2 steps + 1 step  + 1 step"
+
+Note that the permutations in (b) are calculated using the NextPermute() sub-
+routine from the CPAN module Algorithm::Loops.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Algorithm::Loops qw( NextPermute );
+use Const::Fast;
+use Getopt::Long;
+use Regexp::Common   qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 [--show-steps] <n>
+
+    <n>             The number of steps to climb
+    --show-steps    Display all the distinct ways to climb?\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 112, Task #2: Climb Stairs (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($n, $show_steps) = parse_command_line();
+
+    print "Input:  \$n = $n\n";
+
+    if ($show_steps)
+    {
+        show_steps( $n );
+    }
+    else
+    {
+        printf "Output: %d\n", fibonacci( $n + 1 );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub show_steps
+#------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+
+    # (a) Construct strings to represent the possible combinations of '1' and
+    #     '2' digits in a solution
+
+    my   @steps;
+    push @steps, ('1' x ($n - 2 * $_)) . ('2' x $_) for 0 .. int( $n / 2 );
+
+    # (b) Permute each string constructed in (a) into all the possible distinct
+    #     arrangements of its digits
+
+    my @options;
+
+    for my $step (@steps)
+    {
+        my @list = split '', $step;
+
+        do
+        {
+            push @options, join( '', @list );
+
+        } while (NextPermute( @list ));
+    }
+
+    # (c) Decode each permutation calculated in (b) and display it as a
+    #     sequence of steps
+
+    printf "Output: %d\n\n", scalar @options;
+
+    my $count = 0;
+    my $width = length scalar @options;
+
+    for my $option (@options)
+    {
+        printf '    Option %*d: ', $width, ++$count;
+
+        my $step = substr $option, 0, 1;
+
+        printf '%d step%s', $step, $step == 1 ? ' ' : 's';
+
+        for my $i (1 .. length( $option ) - 1)
+        {
+            $step = substr $option, $i, 1;
+
+            printf ' + %s step%s', $step, $step eq '1' ? ' ' : 's';
+        }
+
+        print "\n";
+    }
+}
+
+#------------------------------------------------------------------------------
+# Return the nth Fibonacci number:
+#         n   0, 1, 2, 3, 4, 5, 6,  7,  8,  9, 10, 11,  12, ...
+#     fib(n)  0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, ...
+#
+sub fibonacci
+#------------------------------------------------------------------------------
+{
+    my ($n) = @_;
+
+    $n >= 0 or die "Negative Fibonacci numbers are not supported\n";
+
+    return 0 if $n == 0;
+    return 1 if $n == 1 || $n == 2;
+
+    my ($p, $q) = (1, 1);
+    my  $fib;
+
+    for (1 .. $n - 2)
+    {
+        $fib = $p + $q;
+        $p   = $q;
+        $q   = $fib;
+    }
+
+    return $fib;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $show_steps;
+
+    GetOptions( 'show-steps' => \$show_steps )
+               or error( 'Invalid command line argument(s)' );
+
+    my $args = scalar @ARGV;
+       $args == 1
+               or error( "Expected 1 command line argument, found $args" );
+
+    my $n =  $ARGV[ 0 ];
+       $n =~ / ^ $RE{num}{int} $/x
+               or error( qq["$n" is not an integer] );
+       $n >  0 or error( qq["$n" is not greater than zero] );
+
+    return ($n, $show_steps);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-112/athanasius/raku/ch-1.raku b/challenge-112/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..ad39def909
--- /dev/null
+++ b/challenge-112/athanasius/raku/ch-1.raku
@@ -0,0 +1,162 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 112
+=========================
+
+TASK #1
+-------
+*Canonical Path*
+
+Submitted by: Mohammad S Anwar
+
+You are given a string path, starting with a slash '/'.
+
+Write a script to convert the given absolute path to the simplified canonical
+path.
+
+In a Unix-style file system:
+
+ - A period '.' refers to the current directory
+ - A double period '..' refers to the directory up a level
+ - Multiple consecutive slashes ('//') are treated as a single slash '/'
+
+The canonical path format:
+
+ - The path starts with a single slash '/'.
+ - Any two directories are separated by a single slash '/'.
+ - The path does not end with a trailing '/'.
+ - The path only contains the directories on the path from the root directory
+   to the target file or directory
+
+Example
+
+ Input: "/a/"
+ Output: "/a"
+
+ Input: "/a/b//c/"
+ Output: "/a/b/c"
+
+ Input: "/a/b/c/../.."
+ Output: "/a"
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+The script may be invoked with either one argument (a single rooted path), or
+with no arguments. In the latter case, the 3 paths given in the Example are
+used as input.
+
+Note that Windows-style backslashes are also supported as path separators.
+
+Algorithm
+---------
+Directories (and the final file, if any) are stored sequentially in an array,
+with 2 exceptions:
+
+    (1) .  (the current directory) is ignored;
+    (2) .. (the parent  directory) is "stored" by removing the most-recently
+            added directory from the array.
+
+When all directory and file entries have been processed, the canonical path is
+re-constructed from whatever entries remain in the array.
+
+=end comment
+#==============================================================================
+
+my constant @EXAMPLES = Array[Str].new: '/a/', '/a/b//c/', '/a/b/c/../..';
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 112, Task #1: Canonical Path (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN()
+#==============================================================================
+{
+    my Bool $first = True;
+
+    for @EXAMPLES
+    {
+        ''.put unless $first;
+
+        $first = False;
+
+        canonical-path( $_ );
+    }
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    Str:D $path where { / ^ <[ \\ / ]> / };  #= Absolute path beginning at root
+)
+#==============================================================================
+{
+    canonical-path( $path );
+}
+
+#------------------------------------------------------------------------------
+sub canonical-path( Str:D $absolute-path )
+#------------------------------------------------------------------------------
+{
+    qq[Input:  "$absolute-path"].put;
+
+    my Str  $path = $absolute-path;
+            $path ~~ s:g{ \\ } = '/';  # Convert backslashes to forward slashes
+    my Bool $valid-path        = True;
+    my Str  @canonical-dirs;
+
+    # Note: The ":skip-empty" below removes all empty directories, and thereby
+    #       reduces each sequence of consecutive slashes to a single slash
+
+    for $path.split: '/', :skip-empty -> Str $dir
+    {
+        next if $dir eq '.';                        # Current directory: ignore
+
+        if $dir eq '..'                             # Parent directory
+        {
+            if @canonical-dirs.elems == 0           # Impossible case
+            {
+                $valid-path = False;
+                last;
+            }
+            else                                    # Go one directory "up"
+            {
+                @canonical-dirs.pop;
+            }
+        }
+        else                                        # Go one directory "down"
+        {
+            @canonical-dirs.push: $dir;
+        }
+    }
+
+    "Output: %s\n".printf:
+        $valid-path ?? '"/' ~ @canonical-dirs.join( '/' ) ~ '"'
+                    !! 'INVALID PATH: The root directory has no parent';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-112/athanasius/raku/ch-2.raku b/challenge-112/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..9850509679
--- /dev/null
+++ b/challenge-112/athanasius/raku/ch-2.raku
@@ -0,0 +1,242 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 112
+=========================
+
+TASK #2
+-------
+*Climb Stairs*
+
+Submitted by: Mohammad S Anwar
+
+You are given $n steps to climb
+
+Write a script to find out the distinct ways to climb to the top. You are
+allowed to climb either 1 or 2 steps at a time.
+
+Example
+
+ Input: $n = 3
+ Output: 3
+
+     Option 1: 1 step + 1 step + 1 step
+     Option 2: 1 step + 2 steps
+     Option 3: 2 steps + 1 step
+
+ Input: $n = 4
+ Output: 5
+
+     Option 1: 1 step + 1 step + 1 step + 1 step
+     Option 2: 1 step + 1 step + 2 steps
+     Option 3: 2 steps + 1 step + 1 step
+     Option 4: 1 step + 2 steps + 1 step
+     Option 5: 2 steps + 2 steps
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+It is not clear from the Task description whether the requirement is for
+
+    (1) details of all the distinct ways to climb to the top,
+or just
+    (2) the total number of these distinct ways.
+
+I have therefore provided both solutions, defaulting to (2) unless the option "--show-steps" is provided on the command line.
+
+Algorithms
+----------
+(1) The number of distinct solutions for n is simply the (n + 1)th Fibonacci
+    number. A straightforward calculation is provided for this.
+
+(2) Display of the distinct solutions is performed in 3 stages:
+
+    (a) Strings are constructed representing the possible combinations of '1'
+        and '2' digits in each solution. For example, for n = 4, the strings
+        are '1111', '112', and '22'.
+
+    (b) Each string constructed in (a) is permuted into all of its possible
+        digit arrangements. For example, the string '112' is permuted to '112',
+        '121', and '211'.
+
+    (c) Each permutation calculated in (b) is decoded and displayed as a
+        sequence of steps. For example, '211' is displayed as:
+            "Option 4: 2 steps + 1 step  + 1 step"
+
+Note that the permutations in (b) are calculated using the algorithm from the
+NextPermute() subroutine in the CPAN module Algorithm::Loops. As that module
+produced errors when invoked with
+
+    use Algorithm::Loops:from<Perl5> <NextPermute>;
+
+I have ported the Perl code to Raku and included it as a subroutine here.
+
+=end comment
+#==============================================================================
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 112, Task #2: Climb Stairs (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    UInt:D  $n where { $n > 0 },     #= The number of steps to climb
+    Bool:D :$show-steps = False      #= Display all the distinct ways to climb?
+)
+#==============================================================================
+{
+    "Input:  \$n = $n".put;
+
+    if $show-steps
+    {
+        show-steps( $n );
+    }
+    else
+    {
+        "Output: %d\n".printf: fibonacci( $n + 1 );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub show-steps( UInt:D $n )
+#------------------------------------------------------------------------------
+{
+    # (a) Construct strings to represent the possible combinations of '1' and
+    #     '2' digits in a solution
+
+    my Str @steps;
+
+    @steps.push: ('1' x ($n - 2 * $_)) ~ ('2' x $_) for 0 .. ( $n / 2 ).floor;
+
+    # (b) Permute each string constructed in (a) into all the possible distinct
+    #     arrangements of its digits
+
+    my Str @options;
+
+    for @steps -> Str $step
+    {
+        my Array[Str] $list = Array[Str].new: $step.split: '', :skip-empty;
+
+        repeat
+        {
+            @options.push: $list.join: '';
+
+        } while NextPermute( $list );
+    }
+
+    # (c) Decode each permutation calculated in (b) and display it as a
+    #     sequence of steps
+
+    "Output: %d\n\n".printf: @options.elems;
+
+    my UInt $count = 0;
+    my UInt $width = @options.elems.Str.chars;
+
+    for @options -> Str $option
+    {
+        '    Option %*d: '.printf: $width, ++$count;
+
+        my Str $step = $option.substr: 0, 1;
+
+        '%d step%s'.printf: $step, $step == 1 ?? ' ' !! 's';
+
+        for 1 .. $option.chars - 1 -> UInt $i
+        {
+            $step = $option.substr: $i, 1;
+
+            ' + %s step%s'.printf: $step, $step eq '1' ?? ' ' !! 's';
+        }
+
+        ''.put;
+    }
+}
+
+#------------------------------------------------------------------------------
+sub NextPermute( Array:D[Str:D] $vals is rw --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    my UInt $last = $vals.end;
+
+    return False if $last < 1;
+
+    # Find last item not in reverse-sorted order:
+
+    my Int $i = $last - 1;
+           $i-- while 0 <= $i && $vals[ $i ] ge $vals[ $i + 1 ];
+
+    # If complete reverse sort, we are done!
+
+    if -1 == $i
+    {
+        # Reset to starting/sorted order:
+
+        $vals = Array[Str].new( $vals.reverse );
+
+        return False;
+    }
+
+    # Re-sort the reversely-sorted tail of the list:
+
+    $vals[ $i + 1 .. $last ] = $vals[ $i + 1 .. $last ].reverse
+        if  $vals[ $i + 1 ] gt $vals[ $last ];
+
+    # Find next item that will make us "greater":
+
+    my UInt $j = $i + 1;
+            $j++ while $vals[ $i ] ge $vals[ $j ];
+
+    # Swap:
+
+    $vals[ $i, $j ] = $vals[ $j, $i ];
+
+    return True;
+}
+
+#------------------------------------------------------------------------------
+# Return the nth Fibonacci number:
+#         n   0, 1, 2, 3, 4, 5, 6,  7,  8,  9, 10, 11,  12, ...
+#     fib(n)  0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, ...
+#
+sub fibonacci( UInt:D $n --> UInt:D )
+#------------------------------------------------------------------------------
+{
+    return 0 if $n == 0;
+    return 1 if $n == 1 || $n == 2;
+
+    my UInt ($p, $q) = 1, 1;
+    my UInt  $fib;
+
+    for 1 .. $n - 2
+    {
+        $fib = $p + $q;
+        $p   = $q;
+        $q   = $fib;
+    }
+
+    return $fib;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################