Merge pull request #2553 from PerlMonk-Athanasius/branch-for-challenge-082

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

4 files changed, 737 insertions, 0 deletions

diff --git a/challenge-082/athanasius/perl/ch-1.pl b/challenge-082/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..da267889a4
--- /dev/null
+++ b/challenge-082/athanasius/perl/ch-1.pl
@@ -0,0 +1,161 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 082
+=========================
+
+Task #1
+-------
+*Common Factors*
+
+Submitted by: Niels van Dijke
+
+You are given 2 positive numbers $M and $N.
+
+Write a script to list all common factors of the given numbers.
+
+Example 1:
+
+ Input:
+     $M = 12
+     $N = 18
+
+ Output:
+     (1, 2, 3, 6)
+
+ Explanation:
+     Factors of 12: 1, 2, 3, 4, 6
+     Factors of 18: 1, 2, 3, 6, 9
+
+Example 2:
+
+ Input:
+     $M = 18
+     $N = 23
+
+ Output:
+     (1)
+
+ Explanation:
+     Factors of 18: 1, 2, 3, 6, 9
+     Factors of 23: 1
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Is X a factor of X? In other words, is the "divides" relation reflexive? It is
+usually thought so -- see https://en.wikipedia.org/wiki/Divisor -- but the
+Examples in the Task description imply not. This leads to some anomalies, e.g.,
+if 17 is not a factor of 17, then the only factor common to 17 and 34 is 1 and
+17 itself is excluded.
+
+In the solution given below, it is assumed that the divides relation IS reflex-
+ive; but this can be changed by setting the constant "REFLEXIVE" to zero.
+
+=cut
+#==============================================================================
+
+                                       # Exports:
+use strict;
+use warnings;
+use Const::Fast;                       # const()
+use Math::Prime::Util qw( divisors );
+use Regexp::Common    qw( number );    # %RE{num}
+use Set::Scalar;                       # infix "*" (overloaded for set inter-
+                                       #             section), members(), new()
+use constant
+{
+    REFLEXIVE => 1,
+    VERBOSE   => 1,
+};
+
+const my $USAGE =>
+"Usage:
+  perl $0 <M> <N>
+
+    <M>    First positive integer
+    <N>    Second positive integer\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 082, Task #1: Common Factors (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($M, $N) = parse_command_line();
+
+    printf "Input:\n    \$M = %d\n    \$N = %d\n\n", $M, $N;
+
+    my $M_factors = Set::Scalar->new( divisors($M) );
+       $M_factors->delete($M)                                 unless REFLEXIVE;
+
+    my $N_factors = Set::Scalar->new( divisors($N) );
+       $N_factors->delete($N)                                 unless REFLEXIVE;
+
+    my @common = sort { $a <=> $b } ($M_factors * $N_factors)->members;
+
+    printf "Output:\n    (%s)\n", join ', ', @common;
+
+    explain($M, $N, $M_factors, $N_factors)                         if VERBOSE;
+}
+
+if (VERBOSE)
+{
+    #--------------------------------------------------------------------------
+    sub explain
+    #--------------------------------------------------------------------------
+    {
+        my ($M, $N, $M_factors, $N_factors) = @_;
+
+        my @M_factors = sort { $a <=> $b } @$M_factors;
+        my @N_factors = sort { $a <=> $b } @$N_factors;
+
+        my $w = length($M) >= length($N) ? length($M) : length($N);
+
+        print  "\nExplanation:\n";
+        printf   "    Factors of %*d: %s\n",   $w, $M, join(', ', @M_factors);
+        printf   "    Factors of %*d: %s\n\n", $w, $N, join(', ', @N_factors);
+
+        printf qq[    Note: the "is a factor of" (or "divides", or "|") ] .
+               qq[relation is here assumed\n          %sto be reflexive\n],
+               REFLEXIVE ? '' : 'NOT ';
+    }
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $args =  scalar @ARGV;
+       $args == 2 or die "ERROR: Expected 2 command-line arguments, found " .
+                         "$args\n$USAGE";
+
+    for (@ARGV)
+    {
+        / \A $RE{num}{int} \z /x
+                  or  die "ERROR: Non-integer '$_'\n$USAGE";
+
+        $_ <  0   and die "ERROR: Negative integer '$_'\n$USAGE";
+
+        $_ == 0   and die "ERROR: Zero is not a \"positive\" integer\n$USAGE";
+    }
+
+    return @ARGV;
+}
+
+###############################################################################
diff --git a/challenge-082/athanasius/perl/ch-2.pl b/challenge-082/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..5b1f6440b7
--- /dev/null
+++ b/challenge-082/athanasius/perl/ch-2.pl
@@ -0,0 +1,217 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 082
+=========================
+
+Task #2
+-------
+*Interleave String*
+
+Submitted by: Mohammad S Anwar
+
+You are given 3 strings; $A, $B and $C.
+
+Write a script to check if $C is created by interleave $A and $B.
+
+Print 1 if check is success otherwise 0.
+
+Example 1:
+
+ Input:
+     $A = "XY"
+     $B = "X"
+     $C = "XXY"
+
+ Output: 1
+
+EXPLANATION
+
+ "X" (from $B) + "XY" (from $A) = $C
+
+Example 2:
+
+ Input:
+     $A = "XXY"
+     $B = "XXZ"
+     $C = "XXXXZY"
+
+ Output: 1
+
+EXPLANATION
+
+ "XX" (from $A) + "XXZ" (from $B) + "Y" (from $A) = $C
+
+Example 3:
+
+ Input:
+     $A = "YX"
+     $B = "X"
+     $C = "XXY"
+
+ Output: 0
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Notes:
+
+1. It is assumed that strings $A and $B must be fully consumed by the inter-
+   leaving process that creates string $C
+
+2. The interleaving check is performed by sub interleave, which is recursive
+
+3. Where more than one solution is possible, only the first will be given in
+   the explanation: namely, the solution found by taking letters from $A before
+   $B where both are valid options
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;                # Exports const()
+use enum qw(A B C);
+use constant VERBOSE => 1;
+
+const my $USAGE =>
+"Usage:
+  perl $0 <A> <B> <C>
+
+    <A>    First string
+    <B>    Second string
+    <C>    Third string: can it be created by interleaving A and B?\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 082, Task #2: Interleave String (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+       $args == 3 or die "ERROR: Expected 3 command-line arguments, found " .
+                         "$args\n$USAGE";
+
+    my ($A, $B, $C) = @ARGV;
+
+    print "Input:\n";
+    print qq[    \$A = "$A"\n];
+    print qq[    \$B = "$B"\n];
+    print qq[    \$C = "$C"\n\n];
+
+    my $is_interleaved = length($C) == length($A) + length($B) ?
+                         interleave($A, $B, $C, \my @sequence) : 0;
+
+    print "Output: $is_interleaved\n";
+
+    $is_interleaved && explain($A, $B, $C, \@sequence) if VERBOSE;
+}
+
+#------------------------------------------------------------------------------
+sub interleave                                           # Recursive subroutine
+#------------------------------------------------------------------------------
+{
+    my ($A, $B, $C, $seq) = @_;
+    my  $success = 0;
+    my  @length  = map { length } $A, $B, $C;
+
+    if    ($length[A] == 0)                                       # Base case 1
+    {
+        if ($B eq $C)
+        {
+            $success = 1;
+            push @$seq, 'B'           if VERBOSE;
+        }
+    }
+    elsif ($length[B] == 0)                                       # Base case 2
+    {
+        if ($A eq $C)
+        {
+            $success = 1;
+            push @$seq, 'A'           if VERBOSE;
+        }
+    }
+    else
+    {
+        my $A0 = substr $A, 0, 1;
+        my $AA = substr $A, 1;
+        my $C0 = substr $C, 0, 1;
+        my $CC = substr $C, 1;
+
+        if ($C0 eq $A0)                                      # Recursive case 1
+        {
+            push @$seq, 'A'           if VERBOSE;
+            $success = interleave($AA, $B, $CC, $seq);
+            $success or pop @$seq     if VERBOSE;
+        }
+
+        unless ($success)
+        {
+            my $B0 = substr $B, 0, 1;
+            my $BB = substr $B, 1;
+
+            if ($C0 eq $B0)                                  # Recursive case 2
+            {
+                push @$seq, 'B'       if VERBOSE;
+                $success = interleave($A, $BB, $CC, $seq);
+                $success or pop @$seq if VERBOSE;
+            }
+        }
+    }
+
+    return $success;
+}
+
+#------------------------------------------------------------------------------
+sub explain
+#------------------------------------------------------------------------------
+{
+    my ($A,  $B,  $C, $seq) =  @_;
+    my ($ai, $bi, @A, @B  ) = (0, 0);
+
+    for my $i (0 .. $#$seq - 1)
+    {
+        if ($seq->[$i] eq 'A')
+        {
+            push @A, substr $A, $ai++, 1;
+            push @B, ' ';
+        }
+        else
+        {
+            push @A, ' ';
+            push @B, substr $B, $bi++, 1;
+        }
+    }
+
+    if ($seq->[-1] eq 'A')
+    {
+        push @A, substr $A, $ai;
+    }
+    else
+    {
+        push @B, substr $B, $bi;
+    }
+
+    print  "\nEXPLANATION\n";
+    printf   "    \$A =  %s\n", join '', @A;
+    printf   "    \$B =  %s\n", join '', @B;
+    print    "    \$C =  $C\n";
+}
+
+###############################################################################
+
diff --git a/challenge-082/athanasius/raku/ch-1.raku b/challenge-082/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..46fcbeefb8
--- /dev/null
+++ b/challenge-082/athanasius/raku/ch-1.raku
@@ -0,0 +1,145 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 082
+=========================
+
+Task #1
+-------
+*Common Factors*
+
+Submitted by: Niels van Dijke
+
+You are given 2 positive numbers $M and $N.
+
+Write a script to list all common factors of the given numbers.
+
+Example 1:
+
+ Input:
+     $M = 12
+     $N = 18
+
+ Output:
+     (1, 2, 3, 6)
+
+ Explanation:
+     Factors of 12: 1, 2, 3, 4, 6
+     Factors of 18: 1, 2, 3, 6, 9
+
+Example 2:
+
+ Input:
+     $M = 18
+     $N = 23
+
+ Output:
+     (1)
+
+ Explanation:
+     Factors of 18: 1, 2, 3, 6, 9
+     Factors of 23: 1
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Is X a factor of X? In other words, is the "divides" relation reflexive? It is
+usually thought so -- see https://en.wikipedia.org/wiki/Divisor -- but the
+Examples in the Task description imply not. This leads to some anomalies, e.g.,
+if 17 is not a factor of 17, then the only factor common to 17 and 34 is 1 and
+17 itself is excluded.
+
+In the solution given below, it is assumed that the divides relation IS reflex-
+ive; but this can be changed by setting the constant $REFLEXIVE to False.
+
+=end comment
+#==============================================================================
+
+my Bool constant $REFLEXIVE = True;
+my Bool constant $VERBOSE   = True;
+
+subset Pos of Int where * > 0;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 082, Task #1: Common Factors (Raku)\n".put;
+}
+
+##=============================================================================
+sub MAIN
+(
+    Pos:D $M,               #= First  positive integer
+    Pos:D $N,               #= Second positive integer
+)
+##=============================================================================
+{
+    "Input:\n    \$M = $M\n    \$N = $N\n".put;
+
+    my Set[Pos] $M-factors =  Set[Pos].new( find-divisors($M) );
+    my Set[Pos] $N-factors =  Set[Pos].new( find-divisors($N) );
+    my     Pos  @common    = ($M-factors ∩ $N-factors).keys.sort;
+
+    "Output:\n    (%s)\n".printf: @common.join: ', ';
+
+    explain($M, $N, $M-factors, $N-factors) if $VERBOSE;
+}
+
+#------------------------------------------------------------------------------
+sub find-divisors( Pos:D $number --> Array:D[Pos:D] )
+#------------------------------------------------------------------------------
+{
+    my Pos @divisors = 1;
+
+    for 2 .. $number.sqrt.floor -> Pos $i
+    {
+        if $number % $i == 0
+        {
+            my Pos $j = ($number / $i).floor;
+
+            @divisors.push: $i;
+            @divisors.push: $j unless $j == $i;
+        }
+    }
+
+    @divisors.push: $number.Int if $REFLEXIVE;
+
+    return @divisors;
+}
+
+#------------------------------------------------------------------------------
+sub explain( Pos:D $M, Pos:D $N, Set:D[Pos:D] $M-facts, Set:D[Pos:D] $N-facts )
+#------------------------------------------------------------------------------
+{
+    my $w = ($M.chars, $N.chars).max;
+
+    "\nExplanation:".put;
+    "    Factors of %*d: %s\n"\ .printf: $w, $M, $M-facts.keys.sort.join: ', ';
+    "    Factors of %*d: %s\n\n".printf: $w, $N, $N-facts.keys.sort.join: ', ';
+
+    (qq[    Note: the "is a factor of" (or "divides", or "|") ] ~
+     qq[relation is here assumed\n          %sto be reflexive\n]).printf:
+        $REFLEXIVE ?? '' !! 'NOT ';
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-082/athanasius/raku/ch-2.raku b/challenge-082/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..b33232fd81
--- /dev/null
+++ b/challenge-082/athanasius/raku/ch-2.raku
@@ -0,0 +1,214 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 082
+=========================
+
+Task #2
+-------
+*Interleave String*
+
+Submitted by: Mohammad S Anwar
+
+You are given 3 strings; $A, $B and $C.
+
+Write a script to check if $C is created by interleave $A and $B.
+
+Print 1 if check is success otherwise 0.
+
+Example 1:
+
+ Input:
+     $A = "XY"
+     $B = "X"
+     $C = "XXY"
+
+ Output: 1
+
+EXPLANATION
+
+ "X" (from $B) + "XY" (from $A) = $C
+
+Example 2:
+
+ Input:
+     $A = "XXY"
+     $B = "XXZ"
+     $C = "XXXXZY"
+
+ Output: 1
+
+EXPLANATION
+
+ "XX" (from $A) + "XXZ" (from $B) + "Y" (from $A) = $C
+
+Example 3:
+
+ Input:
+     $A = "YX"
+     $B = "X"
+     $C = "XXY"
+
+ Output: 0
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2020 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Notes:
+
+1. It is assumed that strings $A and $B must be fully consumed by the inter-
+   leaving process that creates string $C
+
+2. The interleaving check is performed by sub interleave, which is recursive
+
+3. Where more than one solution is possible, only the first will be given in
+   the explanation: namely, the solution found by taking letters from $A before
+   $B where both are valid options
+
+=end comment
+#==============================================================================
+
+enum < A B C >;
+
+my Bool constant $VERBOSE = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 082, Task #2: Interleave String (Raku)\n".put;
+}
+
+##=============================================================================
+sub MAIN
+(
+    Str:D $A,      #= First  string
+    Str:D $B,      #= Second string
+    Str:D $C,      #= Third  string: can it be created by interleaving A and B?
+)
+##=============================================================================
+{
+    "Input:"\           .put;
+    qq[    \$A = "$A"]\ .put;
+    qq[    \$B = "$B"]\ .put;
+    qq[    \$C = "$C"\n].put;
+
+    my Str  @sequence;
+    my Bool $is-interleaved = $C.chars == $A.chars + $B.chars   ??
+                              interleave($A, $B, $C, @sequence) !! False;
+
+    "Output: %d\n".printf: $is-interleaved ?? 1 !! 0;
+
+    $is-interleaved && explain($A, $B, $C, @sequence) if $VERBOSE;
+}
+
+#------------------------------------------------------------------------------
+sub interleave( Str:D $A, Str:D $B, Str:D $C, Array:D[Str:D] $seq --> Bool:D )
+#------------------------------------------------------------------------------
+{
+    my Bool $success = False;
+    my UInt @length  = ($A, $B, $C).map: { .chars };
+
+    if    @length[A] == 0                                         # Base case 1
+    {
+        if $B eq $C
+        {
+            $success = True;
+            $seq.push: 'B'              if $VERBOSE;
+        }
+    }
+    elsif @length[B] == 0                                         # Base case 2
+    {
+        if $A eq $C
+        {
+            $success = True;
+            $seq.push: 'A'              if $VERBOSE;
+        }
+    }
+    else
+    {
+        my Str $A0 = $A.substr: 0, 1;
+        my Str $AA = $A.substr: 1;
+        my Str $C0 = $C.substr: 0, 1;
+        my Str $CC = $C.substr: 1;
+
+        if $C0 eq $A0                                        # Recursive case 1
+        {
+            $seq.push: 'A'              if $VERBOSE;
+            $success = interleave($AA, $B, $CC, $seq);
+            $success or $seq.pop        if $VERBOSE;
+        }
+
+        unless $success
+        {
+            my $B0 = $B.substr: 0, 1;
+            my $BB = $B.substr: 1;
+
+            if $C0 eq $B0                                    # Recursive case 2
+            {
+                $seq.push: 'B'          if $VERBOSE;
+                $success = interleave($A, $BB, $CC, $seq);
+                $success or $seq.pop if $VERBOSE;
+            }
+        }
+    }
+
+    return $success;
+}
+
+#------------------------------------------------------------------------------
+sub explain( Str:D $A, Str:D $B, Str:D $C, Array:D[Str:D] $seq )
+#------------------------------------------------------------------------------
+{
+    my (UInt $ai, UInt $bi) = 0, 0;
+    my (Str  @A,  Str  @B);
+
+    for 0 .. $seq.end - 1 -> UInt $i
+    {
+        if $seq[$i] eq 'A'
+        {
+            @A.push: $A.substr: $ai++, 1;
+            @B.push: ' ';
+        }
+        else
+        {
+            push @A, ' ';
+            push @B, $B.substr: $bi++, 1;
+        }
+    }
+
+    if $seq[*-1] eq 'A'
+    {
+        @A.push: $A.substr: $ai;
+    }
+    else
+    {
+        @B.push: $B.substr: $bi;
+    }
+
+    "\nEXPLANATION"\ .put;
+    "    \$A =  %s\n".printf: @A.join: '';
+    "    \$B =  %s\n".printf: @B.join: '';
+    "    \$C =  $C"\ .put;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+###############################################################################