Merge pull request #7160 from PerlMonk-Athanasius/branch-for-challenge-192

Perl & Raku solutions to Tasks 1 & 2 for Week 192

4 files changed, 880 insertions, 0 deletions

diff --git a/challenge-192/athanasius/perl/ch-1.pl b/challenge-192/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..b06b5193c3
--- /dev/null
+++ b/challenge-192/athanasius/perl/ch-1.pl
@@ -0,0 +1,171 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 192
+=========================
+
+TASK #1
+-------
+*Binary Flip*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive integer, $n.
+
+Write a script to find the binary flip.
+
+Example 1
+
+  Input: $n = 5
+  Output: 2
+
+  First find the binary equivalent of the given integer, 101.
+  Then flip the binary digits 0 -> 1 and 1 -> 0 and we get 010.
+  So Binary 010 => Decimal 2.
+
+Example 2
+
+  Input: $n = 4
+  Output: 3
+
+  Decimal 4 = Binary 100
+  Flip 0 -> 1 and 1 -> 0, we get 011.
+  Binary 011 = Decimal 3
+
+Example 3
+
+  Input: $n = 6
+  Output: 1
+
+  Decimal 6 = Binary 110
+  Flip 0 -> 1 and 1 -> 0, we get 001.
+  Binary 001 = Decimal 1
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+Assumption
+----------
+A "positive integer" is a non-negative integer (i.e., one greater than or equal
+to zero).
+
+Solution
+--------
+1. sprintf '%b' translates the integer to its corresponding binary string.
+2. The transliteration operator tr/// flips the digits in the binary string.
+3. Conversion of the flipped binary string to a decimal integer is accomplished
+   by prepending '0b' to the string and then calling Perl's oct function.
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $TST_FLDS => 3;
+const my $USAGE    =>
+"Usage:
+  perl $0 <n>
+  perl $0
+
+    <n>    A positive integer\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 192, Task #1: Binary Flip (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    my $args = scalar @ARGV;
+
+    if    ($args == 0)
+    {
+        run_tests();
+    }
+    elsif ($args == 1)
+    {
+        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 positive] );
+
+        print  "Input:  \$n = $n\n";
+        printf "Output: %d\n", binary_flip( $n );
+    }
+    else
+    {
+        error( "Expected 1 or 0 command-line arguments, found $args" );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub binary_flip
+#------------------------------------------------------------------------------
+{
+    my ($n)      = @_;
+    my  $binary  = sprintf '%b', $n;
+    my  $flipped = $binary =~ tr/01/10/r;
+
+    return oct "0b$flipped";
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $n, $expected) = split / , \s* /x, $line, $TST_FLDS;
+
+        is binary_flip( $n ), $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1,     5,   2
+Example 2,     4,   3
+Example 3,     6,   1
+Power of 2,  128, 127
+Alternating, 170,  85
+Two and one, 438,  73
diff --git a/challenge-192/athanasius/perl/ch-2.pl b/challenge-192/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..e94f830e3f
--- /dev/null
+++ b/challenge-192/athanasius/perl/ch-2.pl
@@ -0,0 +1,262 @@
+#!perl
+
+###############################################################################
+=comment
+
+Perl Weekly Challenge 192
+=========================
+
+TASK #2
+-------
+*Equal Distribution*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of integers greater than or equal to zero, @list.
+
+Write a script to distribute the number so that each members are same. If you
+succeed then print the total moves otherwise print -1.
+
+Please follow the rules (as suggested by Neils van Dijke [2022-11-21 13:00])
+
+  1) You can only move a value of '1' per move
+  2) You are only allowed to move a value of '1' to a direct neighbor/adjacent
+     cell
+
+Example 1:
+
+  Input: @list = (1, 0, 5)
+  Output: 4
+
+  Move #1: 1, 1, 4
+  (2nd cell gets 1 from the 3rd cell)
+
+  Move #2: 1, 2, 3
+  (2nd cell gets 1 from the 3rd cell)
+
+  Move #3: 2, 1, 3
+  (1st cell gets 1 from the 2nd cell)
+
+  Move #4: 2, 2, 2
+  (2nd cell gets 1 from the 3rd cell)
+
+Example 2:
+
+  Input: @list = (0, 2, 0)
+  Output: -1
+
+  It is not possible to make each same.
+
+Example 3:
+
+  Input: @list = (0, 3, 0)
+  Output: 2
+
+  Move #1: 1, 2, 0
+  (1st cell gets 1 from the 2nd cell)
+
+  Move #2: 1, 1, 1
+  (3rd cell gets 1 from the 2nd cell)
+
+=cut
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run.
+2. To show (one possible version of) the actual moves, set $VERBOSE to a true
+   value. (This has no effect on the running of the test suite.)
+
+Algorithm
+---------
+sum  := sum of all the list elements
+size := number of elements in the list
+IF sum is evenly divisible by size THEN
+    target := sum / size
+    move   := 0
+    WHILE list elements are not all equal
+        low  := index of first element less    than target
+        high := index of first element greater than target
+        # Implement one move:
+        increment the element beside element[high] on the side closest to
+            element[low]
+        decrement element[high]
+        increment move
+    ENDWHILE
+    RETURN move
+ELSE
+    RETURN -1
+ENDIF
+
+=cut
+#==============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $TST_FLDS => 3;
+const my $VERBOSE  => 1;
+const my $USAGE    =>
+"Usage:
+  perl $0 [<list> ...]
+  perl $0
+
+    [<list> ...]    A non-empty list of non-negative integers\n";
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 192, Task #2: Equal Distribution (Perl)\n\n";
+}
+
+#==============================================================================
+MAIN:
+#==============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @list = @ARGV;
+
+        for my $n (@list)
+        {
+            $n =~ / ^ $RE{num}{int} $ /x
+                    or error( qq["$n is not a valid integer] );
+
+            $n >= 0 or error( qq["$n" is negative] );
+        }
+
+        printf "Input:  \@list = (%s)\n", join ', ', @list;
+        printf "Output: %d\n", count_moves( 1, @list );
+    }
+}
+
+#------------------------------------------------------------------------------
+sub count_moves
+#------------------------------------------------------------------------------
+{
+    my ($display, @list) = @_;
+    my  $size =  scalar @list;
+    my  $move = -1;                 # Assume failure
+    my  $sum  =  0;
+        $sum +=  $_ for @list;
+
+    if ($sum % $size == 0)          # Solution is possible
+    {
+        $move = 0;
+
+        my $target = $sum / $size;
+
+        until (distribution_is_equal( $target, @list ))
+        {
+            my $low  = get_idx_low  ( $target, @list );
+            my $high = get_idx_high ( $target, @list );
+
+            ++$list[ $high + (($low < $high) ? -1 : 1) ];
+            --$list[ $high ];
+            ++$move;
+
+            printf "       Move %2d: (%s)\n", $move, join ', ', @list
+                if $VERBOSE && $display;
+        }
+    }
+
+    return $move;
+}
+
+#------------------------------------------------------------------------------
+sub distribution_is_equal
+#------------------------------------------------------------------------------
+{
+    my ($target, @list) = @_;
+
+    for my $n (@list)
+    {
+        return 0 unless $n == $target;
+    }
+
+    return 1;
+}
+
+#------------------------------------------------------------------------------
+sub get_idx_low
+#------------------------------------------------------------------------------
+{
+    my ($target, @list) = @_;
+
+    for my $i (0 .. $#list)
+    {
+        return $i if $list[ $i ] < $target;
+    }
+
+    die 'No low index found';
+}
+
+#------------------------------------------------------------------------------
+sub get_idx_high
+#------------------------------------------------------------------------------
+{
+    my ($target, @list) = @_;
+
+    for my $i (0 .. $#list)
+    {
+        return $i if $list[ $i ] > $target;
+    }
+
+    die 'No high index found';
+}
+
+#------------------------------------------------------------------------------
+sub error
+#------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+#------------------------------------------------------------------------------
+sub run_tests
+#------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my ($test_name, $in, $expected) = split / , \s* /x, $line, $TST_FLDS;
+
+        my @list = split / \s+ /x, $in;
+
+        is count_moves( 0, @list ), $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+###############################################################################
+
+__DATA__
+Example 1,     1 0 5,            4
+Example 2,     0 2 0,           -1
+Example 3,     0 3 0,            2
+Bubble left,   4 5 6  7 8 9 10, 28
+Bubble right, 10 9 8  7 6 5  4, 28
+Middle,        4 9 5 10 8 6  7,  8
+Fully centred, 1 1 1  8 1 1  1, 12
diff --git a/challenge-192/athanasius/raku/ch-1.raku b/challenge-192/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..2281bf9d59
--- /dev/null
+++ b/challenge-192/athanasius/raku/ch-1.raku
@@ -0,0 +1,168 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 192
+=========================
+
+TASK #1
+-------
+*Binary Flip*
+
+Submitted by: Mohammad S Anwar
+
+You are given a positive integer, $n.
+
+Write a script to find the binary flip.
+
+Example 1
+
+  Input: $n = 5
+  Output: 2
+
+  First find the binary equivalent of the given integer, 101.
+  Then flip the binary digits 0 -> 1 and 1 -> 0 and we get 010.
+  So Binary 010 => Decimal 2.
+
+Example 2
+
+  Input: $n = 4
+  Output: 3
+
+  Decimal 4 = Binary 100
+  Flip 0 -> 1 and 1 -> 0, we get 011.
+  Binary 011 = Decimal 3
+
+Example 3
+
+  Input: $n = 6
+  Output: 1
+
+  Decimal 6 = Binary 110
+  Flip 0 -> 1 and 1 -> 0, we get 001.
+  Binary 001 = Decimal 1
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+If no command-line arguments are given, the test suite is run.
+
+Assumption
+----------
+A "positive integer" is a non-negative integer (i.e., one greater than or equal
+to zero).
+
+Solution
+--------
+1. Raku's base() method with argument 2 translates the integer to its corres-
+   ponding binary string.
+2. The transliteration operator TR/// flips the digits in the binary string.
+3. Conversion of the flipped binary string to a decimal integer is accomplished
+   by the application of radix notation to the string: :2( $flipped ).
+
+=end comment
+#==============================================================================
+
+use Test;
+
+my UInt constant $TEST-FIELDS = 3;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 192, Task #1: Binary Flip (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    UInt:D $n                      #= A positive integer
+)
+#==============================================================================
+{
+    "Input:  \$n = $n".put;
+    "Output: %d\n".printf: binary-flip( $n );
+}
+
+#==============================================================================
+multi sub MAIN()                                 # No input: run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub binary-flip( UInt:D $n --> UInt:D )
+#------------------------------------------------------------------------------
+{
+    my Str $binary  = $n.base( 2 );
+    my Str $flipped = TR/01/10/ with $binary;
+
+    return :2( $flipped );
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $n, $expected) =
+            $line.split: / \, \s* /, $TEST-FIELDS;
+
+        is binary-flip( $n.Int ), $expected.Int, $test-name;
+    }
+
+    done-testing;
+}
+
+#------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1,     5,   2
+        Example 2,     4,   3
+        Example 3,     6,   1
+        Power of 2,  128, 127
+        Alternating, 170,  85
+        Two and one, 438,  73
+        END
+}
+
+#------------------------------------------------------------------------------
+sub error( Str:D $message )
+#------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################
diff --git a/challenge-192/athanasius/raku/ch-2.raku b/challenge-192/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..d4e19fc893
--- /dev/null
+++ b/challenge-192/athanasius/raku/ch-2.raku
@@ -0,0 +1,279 @@
+use v6d;
+
+###############################################################################
+=begin comment
+
+Perl Weekly Challenge 192
+=========================
+
+TASK #2
+-------
+*Equal Distribution*
+
+Submitted by: Mohammad S Anwar
+
+You are given a list of integers greater than or equal to zero, @list.
+
+Write a script to distribute the number so that each members are same. If you
+succeed then print the total moves otherwise print -1.
+
+Please follow the rules (as suggested by Neils van Dijke [2022-11-21 13:00])
+
+  1) You can only move a value of '1' per move
+  2) You are only allowed to move a value of '1' to a direct neighbor/adjacent
+     cell
+
+Example 1:
+
+  Input: @list = (1, 0, 5)
+  Output: 4
+
+  Move #1: 1, 1, 4
+  (2nd cell gets 1 from the 3rd cell)
+
+  Move #2: 1, 2, 3
+  (2nd cell gets 1 from the 3rd cell)
+
+  Move #3: 2, 1, 3
+  (1st cell gets 1 from the 2nd cell)
+
+  Move #4: 2, 2, 2
+  (2nd cell gets 1 from the 3rd cell)
+
+Example 2:
+
+  Input: @list = (0, 2, 0)
+  Output: -1
+
+  It is not possible to make each same.
+
+Example 3:
+
+  Input: @list = (0, 3, 0)
+  Output: 2
+
+  Move #1: 1, 2, 0
+  (1st cell gets 1 from the 2nd cell)
+
+  Move #2: 1, 1, 1
+  (3rd cell gets 1 from the 2nd cell)
+
+=end comment
+###############################################################################
+
+#--------------------------------------#
+# Copyright © 2022 PerlMonk Athanasius #
+#--------------------------------------#
+
+#==============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run.
+2. To show (one possible version of) the actual moves, set $VERBOSE to True.
+   (This has no effect on the running of the test suite.)
+
+Algorithm
+---------
+sum  := sum of all the list elements
+size := number of elements in the list
+IF sum is evenly divisible by size THEN
+    target := sum / size
+    move   := 0
+    WHILE list elements are not all equal
+        low  := index of first element less    than target
+        high := index of first element greater than target
+        # Implement one move:
+        increment the element beside element[high] on the side closest to
+            element[low]
+        decrement element[high]
+        increment move
+    ENDWHILE
+    RETURN move
+ELSE
+    RETURN -1
+ENDIF
+
+=end comment
+#==============================================================================
+
+use Test;
+
+my UInt constant $TST-FLDS = 3;
+my Bool constant $VERBOSE  = True;
+
+#------------------------------------------------------------------------------
+BEGIN
+#------------------------------------------------------------------------------
+{
+    "\nChallenge 191, Task #2: Equal Distribution (Raku)\n".put;
+}
+
+#==============================================================================
+multi sub MAIN
+(
+    #| A non-empty list of non-negative integers
+
+    *@list where { .elems > 0 && .all ~~ UInt:D } 
+)
+#==============================================================================
+{
+    "Input:  \@list = (%s)\n".printf: @list.join: ', ';
+
+    "Output: %d\n".printf: count-moves( True, @list );
+}
+
+#==============================================================================
+multi sub MAIN()                                           # Run the test suite
+#==============================================================================
+{
+    run-tests();
+}
+
+#------------------------------------------------------------------------------
+sub count-moves
+(
+    Bool:D $display,
+          *@list where { .elems > 0 && .all ~~ UInt:D }
+--> Int:D
+)
+#------------------------------------------------------------------------------
+{
+    my UInt $size = @list.elems;
+    my Int  $move = -1;                 # Assume failure
+    my UInt $sum  = [+] @list;
+
+    if $sum %% $size                    # Solution is possible
+    {
+        $move = 0;
+
+        my UInt $target = ($sum / $size).Int;
+
+        until distribution-is-equal( $target, @list )
+        {
+            my UInt $low  = get-idx-low\( $target, @list );
+            my UInt $high = get-idx-high( $target, @list );
+
+            ++@list[ $high + (($low < $high) ?? -1 !! 1) ];
+            --@list[ $high ];
+            ++$move;
+
+            if $VERBOSE && $display
+            {
+                "       Move %2d: (%s)\n".printf: $move, join ', ', @list;
+            }
+        }
+    }
+
+    return $move;
+}
+
+#------------------------------------------------------------------------------
+sub distribution-is-equal
+(
+    UInt:D $target,
+          *@list where { .elems > 0 && .all ~~ UInt:D }
+--> Bool:D
+)
+#------------------------------------------------------------------------------
+{
+    for @list -> UInt $n
+    {
+        return False unless $n == $target;
+    }
+
+    return True;
+}
+
+#------------------------------------------------------------------------------
+sub get-idx-low
+(
+    UInt:D $target,
+          *@list where { .elems > 0 && .all ~~ UInt:D }
+--> UInt:D
+)
+#------------------------------------------------------------------------------
+{
+    for 0 .. @list.end -> UInt $i
+    {
+        return $i if @list[ $i ] < $target;
+    }
+
+    die 'No low index found';
+}
+
+#------------------------------------------------------------------------------
+sub get-idx-high
+(
+    UInt:D $target,
+          *@list where { .elems > 0 && .all ~~ UInt:D }
+--> UInt:D
+)
+#------------------------------------------------------------------------------
+{
+    for 0 .. @list.end -> UInt $i
+    {
+        return $i if @list[ $i ] > $target;
+    }
+
+    die 'No high index found';
+}
+
+#------------------------------------------------------------------------------
+sub run-tests()
+#------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $in, $expected) =
+            $line.split: / \, \s* /, $TST-FLDS, :skip-empty;
+
+        my UInt @list = $in.split( / \s+ /, :skip-empty ).map: { .Int };
+
+        is count-moves( False, @list ), $expected.Int, $test-name;
+    }
+
+    done-testing;
+}
+
+#------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1,     1 0 5,            4
+        Example 2,     0 2 0,           -1
+        Example 3,     0 3 0,            2
+        Bubble left,   4 5 6  7 8 9 10, 28
+        Bubble right, 10 9 8  7 6 5  4, 28
+        Middle,        4 9 5 10 8 6  7,  8
+        Fully centred, 1 1 1  8 1 1  1, 12
+        END
+}
+
+#------------------------------------------------------------------------------
+sub error( Str:D $message )
+#------------------------------------------------------------------------------
+{
+    "ERROR: $message".put;
+
+    USAGE();
+
+    exit 0;
+}
+
+#------------------------------------------------------------------------------
+sub USAGE()
+#------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+###############################################################################