Merge pull request #8505 from PerlMonk-Athanasius/branch-for-challenge-228

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

4 files changed, 774 insertions, 0 deletions

diff --git a/challenge-228/athanasius/perl/ch-1.pl b/challenge-228/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..8eaba7d7e3
--- /dev/null
+++ b/challenge-228/athanasius/perl/ch-1.pl
@@ -0,0 +1,179 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 228
+=========================
+
+TASK #1
+-------
+*Unique Sum*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to find out the sum of unique elements in the given array.
+
+Example 1
+
+  Input: @int = (2, 1, 3, 2)
+  Output: 4
+
+  In the given array we have 2 unique elements (1, 3).
+
+Example 2
+
+  Input: @int = (1, 1, 1, 1)
+  Output: 0
+
+  In the given array no unique element found.
+
+Example 3
+
+  Input: @int = (2, 1, 3, 4)
+  Output: 10
+
+  In the given array every element is unique.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If $VERBOSE is set to a true value, the solution is followed by a list of the
+   unique elements in the array.
+
+=cut
+#===============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   =>
+"Usage:
+  perl $0 <year>
+  perl $0
+
+    <year>    A non-empty list of integers\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 228, Task #1: Unique Sum (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my  $args = scalar @ARGV;
+
+    if ($args == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @int = @ARGV;
+
+        for (@int)
+        {
+            / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+        }
+
+        printf "Input:  \@int = (%s)\n", join ', ', @int;
+
+        my ($sum, $uniq) = find_sum( \@int );
+
+        print  "Output: $sum\n";
+
+        printf "\nUnique elements: (%s)\n", join ', ', @$uniq if $VERBOSE;
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_sum
+#-------------------------------------------------------------------------------
+{
+    my ($ints) = @_;
+
+    my  %freq;
+      ++$freq{ $_ } for @$ints;
+
+    my  $sum = 0;
+    my  @uniq;
+
+    for my $n (@$ints)
+    {
+        if ($freq{ $n } == 1)
+        {
+            $sum += $n;
+            push @uniq, $n;
+        }
+    }
+
+    @uniq = sort { $a <=> $b } @uniq;
+
+    return ($sum, \@uniq);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test, $int_str, $exp_sum, $exp_uniq_str) = split / \| /x, $line;
+
+        for ($test, $int_str, $exp_sum, $exp_uniq_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my  @int         = split / \s+ /x, $int_str;
+        my  @exp_uniq    = split / \s+ /x, $exp_uniq_str;
+        my ($sum, $uniq) = find_sum( \@int );
+
+        is        $sum,   $exp_sum,  "$test: sum";
+        is_deeply $uniq, \@exp_uniq, "$test: unique";
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|2 1 3 2| 4|1 3
+Example 2|1 1 1 1| 0|
+Example 3|2 1 3 4|10|1 2 3 4
diff --git a/challenge-228/athanasius/perl/ch-2.pl b/challenge-228/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..ae632eaf0a
--- /dev/null
+++ b/challenge-228/athanasius/perl/ch-2.pl
@@ -0,0 +1,208 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 228
+=========================
+
+TASK #2
+-------
+*Empty Array*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers in which all elements are unique.
+
+Write a script to perform the following operations until the array is empty and
+return the total count of operations.
+
+    If the first element is the smallest then remove it otherwise move it to the
+    end.
+
+Example 1
+
+  Input: @int = (3, 4, 2)
+  Output: 5
+
+  Operation 1: move 3 to the end: (4, 2, 3)
+  Operation 2: move 4 to the end: (2, 3, 4)
+  Operation 3: remove element 2: (3, 4)
+  Operation 4: remove element 3: (4)
+  Operation 5: remove element 4: ()
+
+Example 2
+
+  Input: @int = (1, 2, 3)
+  Output: 3
+
+  Operation 1: remove element 1: (2, 3)
+  Operation 2: remove element 2: (3)
+  Operation 3: remove element 3: ()
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If $VERBOSE is set to a true value, the solution is followed by details of
+   the operations performed.
+
+=cut
+#===============================================================================
+
+use strict;
+use warnings;
+use Const::Fast;
+use List::Util     qw( min );
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $VERBOSE => 1;
+const my $USAGE   =>
+"Usage:
+  perl $0 [<int> ...]
+  perl $0
+
+    [<int> ...]    A non-empty list of unique integers\n";
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 228, Task #2: Empty Array (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my @int = parse_command_line();
+
+        printf "Input:  \@int = (%s)\n", join ', ', @int;
+
+        my $ops = empty_array( \@int );
+
+        printf "Output: %d\n", scalar @$ops;
+
+        if ($VERBOSE)
+        {
+            print   "\n";
+            print "$_\n" for @$ops;
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub empty_array
+#-------------------------------------------------------------------------------
+{
+    my ($int) = @_;
+    my  @ops;
+
+    for (my $count = 1; scalar @$int > 0; ++$count)
+    {
+        my $min =  min   @$int;
+        my $n   =  shift @$int;
+        my $op  = "Operation $count: ";
+
+        if ($n == $min)
+        {
+            $op .= "remove element $n";
+        }
+        else
+        {
+            push @$int, $n;
+
+            $op .= "move $n to the end";
+        }
+
+        $op .= sprintf ': (%s)', join ', ', @$int;
+
+        push @ops, $op;
+    }
+
+    return \@ops;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my %count;
+
+    for (@ARGV)
+    {
+        / ^ $RE{num}{int} $ /x
+                or error( qq["$_" is not a valid integer] );
+
+        ++$count{ $_ };
+    }
+
+    for (values %count)
+    {
+        $_ == 1 or error( 'The integers in the input list are not unique' );
+    }
+
+    return @ARGV;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $int_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $int_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @int = split / \s+ /x, $int_str;
+        my $ops = empty_array( \@int );
+
+        is scalar @$ops, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|      3 4 2| 5
+Example 2|      1 2 3| 3
+Reversed |6 5 4 3 2 1|21
+Singleton|         42| 1
+Negatives|-1 -2 -3 -4|10
diff --git a/challenge-228/athanasius/raku/ch-1.raku b/challenge-228/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..dc745d889a
--- /dev/null
+++ b/challenge-228/athanasius/raku/ch-1.raku
@@ -0,0 +1,178 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 228
+=========================
+
+TASK #1
+-------
+*Unique Sum*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers.
+
+Write a script to find out the sum of unique elements in the given array.
+
+Example 1
+
+  Input: @int = (2, 1, 3, 2)
+  Output: 4
+
+  In the given array we have 2 unique elements (1, 3).
+
+Example 2
+
+  Input: @int = (1, 1, 1, 1)
+  Output: 0
+
+  In the given array no unique element found.
+
+Example 3
+
+  Input: @int = (2, 1, 3, 4)
+  Output: 10
+
+  In the given array every element is unique.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If $VERBOSE is set to True, the solution is followed by a list of the unique
+   elements in the array.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Bool constant $VERBOSE = True;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 228, Task #1: Unique Sum (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    *@int where { .elems > 0 && * ~~ Int:D }     #= A non-empty list of integers
+)
+#===============================================================================
+{
+    "Input:  \@int = (%s)\n".printf: @int.join: ', ';
+
+    my (Int $sum, Array[Int] $uniq) = find-sum( @int );
+
+    "Output: $sum".put;
+
+    "\nUnique elements: (%s)\n".printf: @$uniq.join: ', ' if $VERBOSE;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-sum( List:D[Int:D] $ints --> List:D[Int:D, List:D[Int:D]] )
+#-------------------------------------------------------------------------------
+{
+    my %freq;
+     ++%freq{ $_ } for @$ints;
+
+    my Int $sum = 0;
+    my Int @uniq;
+
+    for @$ints -> Int $n
+    {
+        if %freq{ $n } == 1
+        {
+            $sum += $n;
+            @uniq.push: $n;
+        }
+    }
+
+    @uniq .= sort;
+
+    return $sum, @uniq;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test, $int-str, $exp-sum, $exp-uniq-str) = $line.split: / \| /;
+
+        for     $test, $int-str, $exp-sum, $exp-uniq-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @int = $int-str\    .split( / \s+ /, :skip-empty ).map: { .Int };
+        my Int @exp = $exp-uniq-str.split( / \s+ /, :skip-empty ).map: { .Int };
+
+        my (Int $sum, Array[Int] $uniq) = find-sum( @int );
+
+        is        $sum,  $exp-sum, "$test: sum";
+        is-deeply $uniq, @exp,     "$test: unique";
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+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;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1|2 1 3 2| 4|1 3
+        Example 2|1 1 1 1| 0|
+        Example 3|2 1 3 4|10|1 2 3 4
+        END
+}
+
+################################################################################
diff --git a/challenge-228/athanasius/raku/ch-2.raku b/challenge-228/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..2c1868b12a
--- /dev/null
+++ b/challenge-228/athanasius/raku/ch-2.raku
@@ -0,0 +1,209 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 228
+=========================
+
+TASK #2
+-------
+*Empty Array*
+
+Submitted by: Mohammad S Anwar
+
+You are given an array of integers in which all elements are unique.
+
+Write a script to perform the following operations until the array is empty and
+return the total count of operations.
+
+    If the first element is the smallest then remove it otherwise move it to the
+    end.
+
+Example 1
+
+  Input: @int = (3, 4, 2)
+  Output: 5
+
+  Operation 1: move 3 to the end: (4, 2, 3)
+  Operation 2: move 4 to the end: (2, 3, 4)
+  Operation 3: remove element 2: (3, 4)
+  Operation 4: remove element 3: (4)
+  Operation 5: remove element 4: ()
+
+Example 2
+
+  Input: @int = (1, 2, 3)
+  Output: 3
+
+  Operation 1: remove element 1: (2, 3)
+  Operation 2: remove element 2: (3)
+  Operation 3: remove element 3: ()
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2023 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If the first argument is negative, it must be preceded by '--' on the command
+   line.
+3. If $VERBOSE is set to True, the solution is followed by details of the opera-
+   tions performed.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Bool constant $VERBOSE = True;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 228, Task #2: Empty Array (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty list of unique integers
+
+    *@int where { .elems > 0 && .all ~~ Int:D && are-unique( @int ) }
+)
+#===============================================================================
+{
+    "Input:  \@int = (%s)\n".printf: @int.join: ', ';
+
+    my Str @ops = empty-array( @int );
+
+    "Output: %d\n".printf: @ops.elems;
+
+    if $VERBOSE
+    {
+        put();
+       .put for @ops;
+    }
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub empty-array( List:D[Int:D] $ints --> List:D[Str:D] )
+#-------------------------------------------------------------------------------
+{
+    my Int @int = @$ints;       # Make a copy
+    my Str @ops;
+
+    loop (my UInt $count = 1; @int.elems > 0; ++$count)
+    {
+        my Int $min =  @int.min;
+        my Int $n   =  @int.shift;
+        my Str $op  = "Operation $count: ";
+
+        if $n == $min
+        {
+            $op ~= "remove element $n";
+        }
+        else
+        {
+            @int.push: $n;
+
+            $op ~= "move $n to the end";
+        }
+
+        $op ~= ': (%s)'.sprintf: @int.join: ', ';
+
+        @ops.push: $op;
+    }
+
+    return @ops;
+}
+
+#-------------------------------------------------------------------------------
+sub are-unique( List:D[Int:D] $ints --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt %count{Int};
+
+    ++%count{ $_ } for @$ints;
+
+    $_ > 1 and return False for %count.values;
+
+    return True;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $int-str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $int-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int @int = $int-str.split( / \s+ /, :skip-empty ).map: { .Int };
+        my Str @ops = empty-array( @int );
+
+        is @ops.elems, $expected.Int, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+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;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1|      3 4 2| 5
+        Example 2|      1 2 3| 3
+        Reversed |6 5 4 3 2 1|21
+        Singleton|         42| 1
+        Negatives|-1 -2 -3 -4|10
+        END
+}
+
+################################################################################