Merge pull request #5128 from PerlMonk-Athanasius/branch-for-challenge-136

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

4 files changed, 668 insertions, 0 deletions

diff --git a/challenge-136/athanasius/perl/ch-1.pl b/challenge-136/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..f76757eb3f
--- /dev/null
+++ b/challenge-136/athanasius/perl/ch-1.pl
@@ -0,0 +1,157 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 136
+=========================
+
+TASK #1
+-------
+*Two Friendly*
+
+Submitted by: Mohammad S Anwar
+
+You are given 2 positive numbers, $m and $n.
+
+Write a script to find out if the given two numbers are Two Friendly.
+
+    Two positive numbers, m and n are two friendly when gcd(m, n) = 2 ^ p where
+    p > 0. The greatest common divisor (gcd) of a set of numbers is the largest
+    positive number that divides all the numbers in the set without remainder.
+
+Example 1
+
+    Input: $m = 8, $n = 24
+    Output: 1
+
+    Reason: gcd(8,24) = 8 => 2 ^ 3
+
+Example 2
+
+    Input: $m = 26, $n = 39
+    Output: 0
+
+    Reason: gcd(26,39) = 13
+
+Example 3
+
+    Input: $m = 4, $n = 10
+    Output: 1
+
+    Reason: gcd(4,10) = 2 => 2 ^ 1
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+Include the flag "--verbose" (or just "-v") on the command line to display an
+explanation of the output.
+
+Implementation
+--------------
+Calculation of the greatest common divisor is delegated to the gcd() subroutine
+in the ntheory (aka Math::Prime::Util) module.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use ntheory        qw( gcd );
+use Regexp::Common qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 [--verbose|-v] <m> <n>
+
+    --verbose    Explain the output?
+    <m>          An integer > 0
+    <n>          An integer > 0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 136, Task #1: Two Friendly (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($verbose, $m, $n) = parse_command_line();
+
+    print "Input:  \$m = $m, \$n = $n\n";
+
+    my $friendly = 0;
+    my $reason   = 'not a power of 2';
+    my $gcd      = gcd( $m, $n );
+
+    if ($gcd == 1)
+    {
+        $reason = '2 ^ 0';
+    }
+    else
+    {
+        my $log2 = int( (log( $gcd ) / log( 2 )) + 0.5 );
+
+        if ($gcd == 2 ** $log2)
+        {
+            $friendly = 1;
+            $reason   = "2 ^ $log2";
+        }
+    }
+
+    printf "Output: %d\n", $friendly ? 1 : 0;
+
+    print "\nReason: gcd($m, $n) = $gcd which is $reason\n" if $verbose;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $verbose = 0;
+
+    GetOptions( verbose => \$verbose )
+               or error( 'Invalid command line flag' );
+
+    my $args = scalar @ARGV;
+       $args == 2
+               or error( "Expected 2 command line arguments, found $args" );
+
+    my ($m, $n) = @ARGV;
+
+    for ($m, $n)
+    {
+        / ^ $RE{num}{int} $ /x
+               or error( qq["$_" is not a valid integer] );
+
+        $_ > 0 or error( qq["$_" is not greater than zero] );
+    }
+
+    return ($verbose, $m, $n);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-136/athanasius/perl/ch-2.pl b/challenge-136/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..ed97d62121
--- /dev/null
+++ b/challenge-136/athanasius/perl/ch-2.pl
@@ -0,0 +1,213 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 136
+=========================
+
+TASK #2
+-------
+*Fibonacci Sequence*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive number $n.
+
+Write a script to find how many different sequences you can create using
+Fibonacci numbers where the sum of unique numbers in each sequence are the same
+as the given number.
+
+    Fibonacci Numbers: 1,2,3,5,8,13,21,34,55,89, …
+
+Example 1
+
+  Input:  $n = 16
+  Output: 4
+
+  Reason: There are 4 possible sequences that can be created using Fibonacci
+  numbers i.e. (3 + 13), (1 + 2 + 13), (3 + 5 + 8) and (1 + 2 + 5 + 8).
+
+Example 2
+
+  Input:  $n = 9
+  Output: 2
+
+  Reason: There are 2 possible sequences that can be created using Fibonacci
+  numbers i.e. (1 + 3 + 5) and (1 + 8).
+
+Example 3
+
+  Input:  $n = 15
+  Output: 2
+
+  Reason: There are 2 possible sequences that can be created using Fibonacci
+  numbers i.e. (2 + 5 + 8) and (2 + 13).
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+Include the flag "--verbose" (or just "-v") on the command line to display an
+explanation of the output.
+
+Algorithm
+---------
+1. Find the set F of Fibonacci numbers less than or equal to $n
+2. Calculate the power set P(F) of all subsets of F
+3. For each subset S in P(F), sum the elements of S and add S to the solution
+   set iff the sum equals $n
+
+Note: This algorithm works well for smaller values of $n, but will not scale
+well for larger values.
+
+Implementation
+--------------
+Calculation of the power set is delegated to the subsets() subroutine of module
+Algorithm::Combinatorics. See:
+    https://rosettacode.org/wiki/Power_set#Module:_Algorithm::Combinatorics
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Algorithm::Combinatorics qw( subsets );
+use Const::Fast;
+use Getopt::Long;
+use Regexp::Common           qw( number );
+
+const my $USAGE =>
+"Usage:
+  perl $0 [--verbose|-v] <n>
+
+    --verbose    Explain the output?
+    <n>          An integer > 0\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 136, Task #2: Fibonacci Sequence (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my ($verbose, $n) = parse_command_line();
+
+    print "Input:  \$n = $n\n";
+
+    my $seqs  = find_fib_seqs( $n );
+    my $count = scalar @$seqs;
+
+    print "Output: $count\n";
+
+    if ($verbose)
+    {
+        if    ($count == 0)
+        {
+            print  "\nReason: There are no possible sequences summing to $n" .
+                   "\n\tthat can be created using unique Fibonacci numbers\n";
+        }
+        elsif ($count == 1)
+        {
+            printf "\nReason: There is one possible sequence summing to %d"  .
+                   "\n\tthat can be created using unique Fibonacci numbers:" .
+                   "\n\t(%s)\n", $n, join ' + ', @{ $seqs->[ 0 ] };
+        }
+        else
+        {
+            printf "\nReason: There are %d possible sequences summing to %d" .
+                   "\n\tthat can be created using unique Fibonacci numbers:\n",
+                    $count, $n;
+
+            printf "\t(%s)\n", join ' + ', @$_ for @$seqs;
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find_fib_seqs
+#------------------------------------------------------------------------------
+{
+    my ($n)   = @_;
+    my  @seqs;
+    my  $fibs = get_fib_nums( $n );
+    my  $iter = subsets( $fibs );
+
+    while (my $p = $iter->next)
+    {
+        my $sum  = 0;
+           $sum += $_ for @$p;
+
+        push @seqs, $p if $sum == $n;
+    }
+
+    return \@seqs;
+}
+
+#------------------------------------------------------------------------------
+sub get_fib_nums
+#------------------------------------------------------------------------------
+{
+    my ($n)     = @_;
+    my  @fibs   = (1);
+    my ($x, $y) = (1, 1);
+
+    while ($fibs[ -1 ] < $n)
+    {
+        my $z = $x + $y;
+        push @fibs, $z;
+        $x = $y;
+        $y = $z;
+    }
+
+    pop @fibs if $fibs[ -1 ] > $n;
+
+    return \@fibs;
+}
+
+#------------------------------------------------------------------------------
+sub parse_command_line
+#------------------------------------------------------------------------------
+{
+    my $verbose = 0;
+
+    GetOptions( verbose => \$verbose )
+              or error( 'Invalid command line flag' );
+
+    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 a valid integer] );
+
+       $n > 0 or error( qq["$n" is not greater than zero] );
+
+    return ($verbose, $n);
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+###############################################################################
diff --git a/challenge-136/athanasius/raku/ch-1.raku b/challenge-136/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..8aed05ef23
--- /dev/null
+++ b/challenge-136/athanasius/raku/ch-1.raku
@@ -0,0 +1,122 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 136
+=========================
+
+TASK #1
+-------
+*Two Friendly*
+
+Submitted by: Mohammad S Anwar
+
+You are given 2 positive numbers, $m and $n.
+
+Write a script to find out if the given two numbers are Two Friendly.
+
+    Two positive numbers, m and n are two friendly when gcd(m, n) = 2 ^ p where
+    p > 0. The greatest common divisor (gcd) of a set of numbers is the largest
+    positive number that divides all the numbers in the set without remainder.
+
+Example 1
+
+    Input: $m = 8, $n = 24
+    Output: 1
+
+    Reason: gcd(8,24) = 8 => 2 ^ 3
+
+Example 2
+
+    Input: $m = 26, $n = 39
+    Output: 0
+
+    Reason: gcd(26,39) = 13
+
+Example 3
+
+    Input: $m = 4, $n = 10
+    Output: 1
+
+    Reason: gcd(4,10) = 2 => 2 ^ 1
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+Include the flag "--verbose" on the command line to display an explanation of
+the output.
+
+Implementation
+--------------
+Calculation of the greatest common divisor is performed by Raku's inbuilt infix
+operator "gcd".
+
+=end comment
+#==============================================================================
+
+subset Positive of Int where * > 0;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 136, Task #1: Two Friendly (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Positive:D $m,                          #= An integer > 0
+    Positive:D $n,                          #= An integer > 0
+    Bool:D    :$verbose = False             #= Explain the output?
+)
+#==============================================================================
+{
+    "Input:  \$m = $m, \$n = $n".put;
+
+    my Bool     $friendly = False;
+    my Str      $reason   = 'not a power of 2';
+    my Positive $gcd      = $m gcd $n;
+
+    if $gcd == 1
+    {
+        $reason = '2 ^ 0';
+    }
+    else
+    {
+        my Int $log2 = ($gcd.log2 + 0.5).Int;
+
+        if $gcd == 2 ** $log2
+        {
+            $friendly = True;
+            $reason   = "2 ^ $log2";
+        }
+    }
+
+    "Output: %d\n".printf: $friendly ?? 1 !! 0;
+
+    "\nReason: gcd($m, $n) = $gcd which is $reason".put if $verbose;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+##############################################################################
diff --git a/challenge-136/athanasius/raku/ch-2.raku b/challenge-136/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..653d86afe8
--- /dev/null
+++ b/challenge-136/athanasius/raku/ch-2.raku
@@ -0,0 +1,176 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 136
+=========================
+
+TASK #2
+-------
+*Fibonacci Sequence*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive number $n.
+
+Write a script to find how many different sequences you can create using
+Fibonacci numbers where the sum of unique numbers in each sequence are the same
+as the given number.
+
+    Fibonacci Numbers: 1,2,3,5,8,13,21,34,55,89, …
+
+Example 1
+
+  Input:  $n = 16
+  Output: 4
+
+  Reason: There are 4 possible sequences that can be created using Fibonacci
+  numbers i.e. (3 + 13), (1 + 2 + 13), (3 + 5 + 8) and (1 + 2 + 5 + 8).
+
+Example 2
+
+  Input:  $n = 9
+  Output: 2
+
+  Reason: There are 2 possible sequences that can be created using Fibonacci
+  numbers i.e. (1 + 3 + 5) and (1 + 8).
+
+Example 3
+
+  Input:  $n = 15
+  Output: 2
+
+  Reason: There are 2 possible sequences that can be created using Fibonacci
+  numbers i.e. (2 + 5 + 8) and (2 + 13).
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2021 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+Include the flag "--verbose" on the command line to display an explanation of
+the output.
+
+Algorithm
+---------
+1. Find the set F of Fibonacci numbers less than or equal to $n
+2. Calculate the power set P(F) of all subsets of F
+3. For each subset S in P(F), sum the elements of S and add S to the solution
+   set iff the sum equals $n
+
+Note: This algorithm works well for smaller values of $n, but will not scale
+well for larger values.
+
+Implementation
+--------------
+Calculation of the power set is performed by Raku's inbuilt combinations()
+method.
+
+=end comment
+#==============================================================================
+
+subset Pos of Int where * > 0;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 136, Task #2: Fibonacci Sequence (Raku)\n".put;
+}
+
+#==============================================================================
+sub MAIN
+(
+    Pos:D   $n,                           #= An integer > 0
+    Bool:D :$verbose = False              #= Explain the output?
+)
+#==============================================================================
+{
+    "Input:  \$n = $n".put;
+
+    my Array[Pos] @seqs  = find-fib-seqs( $n );
+    my UInt       $count = @seqs.elems;
+
+    "Output: $count".put;
+
+    if $verbose
+    {
+        if    $count == 0
+        {
+            ("\nReason: There are no possible sequences summing to $n" ~
+             "\n\tthat can be created using unique Fibonacci numbers").put;
+        }
+        elsif $count == 1
+        {
+            ("\nReason: There is one possible sequence summing to $n"  ~
+             "\n\tthat can be created using unique Fibonacci numbers:" ~
+             "\n\t(%s)\n").printf: @seqs[ 0 ].join: ' + ';
+        }
+        else
+        {
+            ("\nReason: There are $count possible sequences summing to $n" ~
+             "\n\tthat can be created using unique Fibonacci numbers:").put;
+
+             "\t(%s)\n".printf: $_.join: ' + ' for @seqs;
+        }
+    }
+}
+
+#------------------------------------------------------------------------------
+sub find-fib-seqs( Pos:D $n --> Array:D[Array:D[Pos:D]] )
+#------------------------------------------------------------------------------
+{
+    my Array[Pos] @seqs;
+    my Array[Pos] $fibs = get-fib-nums( $n );
+
+    for $fibs.combinations: 1 .. * -> List $c
+    {
+        my UInt $sum = [+] @$c;              # Sum using reduction metaoperator
+
+        @seqs.push: Array[Pos].new: @$c if $sum == $n;
+    }
+
+    return @seqs;
+}
+
+#------------------------------------------------------------------------------
+sub get-fib-nums( Pos:D $n --> Array:D[Pos:D] )
+#------------------------------------------------------------------------------
+{
+    my Pos  @fibs   =  1;
+    my Pos ($x, $y) = (1, 1);
+
+    while @fibs[ *-1 ] < $n
+    {
+        my Pos $z = $x + $y;
+
+        @fibs.push: $z;
+
+        $x = $y;
+        $y = $z;
+    }
+
+    @fibs.pop if @fibs[ *-1 ] > $n;
+
+    return @fibs;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/;
+    $usage.put;
+}
+
+##############################################################################