Merge pull request #12033 from PerlMonk-Athanasius/branch-for-challenge-321

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

4 files changed, 731 insertions, 0 deletions

diff --git a/challenge-321/athanasius/perl/ch-1.pl b/challenge-321/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..88f6e5855e
--- /dev/null
+++ b/challenge-321/athanasius/perl/ch-1.pl
@@ -0,0 +1,186 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 321
+=========================
+
+TASK #1
+-------
+*Distinct Average*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of numbers with even length.
+
+Write a script to return the count of distinct average. The average is calculate
+by removing the minimum and the maximum, then average of the two.
+
+Example 1
+
+  Input: @nums = (1, 2, 4, 3, 5, 6)
+  Output: 1
+
+  Step 1: Min = 1, Max = 6, Avg = 3.5
+  Step 2: Min = 2, Max = 5, Avg = 3.5
+  Step 3: Min = 3, Max = 4, Avg = 3.5
+
+  The count of distinct average is 1.
+
+Example 2
+
+  Input: @nums = (0, 2, 4, 8, 3, 5)
+  Output: 2
+
+  Step 1: Min = 0, Max = 8, Avg = 4
+  Step 2: Min = 2, Max = 5, Avg = 3.5
+  Step 3: Min = 3, Max = 4, Avg = 3.5
+
+  The count of distinct average is 2.
+
+Example 3
+
+  Input: @nums = (7, 3, 1, 0, 5, 9)
+  Output: 2
+
+  Step 1: Min = 0, Max = 9, Avg = 4.5
+  Step 2: Min = 1, Max = 7, Avg = 4
+  Step 3: Min = 3, Max = 5, Avg = 4
+
+  The count of distinct average is 2.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty, even-sized list of numbers is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+use constant DEBUG => 0;
+use if DEBUG, 'Data::Dump', qw( pp );
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<nums> ...]
+  perl $0
+
+    [<nums> ...]    A non-empty, even-sized list of numbers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 321, Task #1: Distinct Average (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        printf "Raw input: %s\n", pp( \@ARGV ) if DEBUG;
+
+        / ^ $RE{num}{real} $ /x or error( qq["$_" is not a valid real number] )
+            for @ARGV;
+
+        my @nums = map { $_ + 0 } @ARGV;                             # Normalize
+
+        scalar @nums % 2 == 0  or error( 'The input list is uneven' );
+
+        printf "Input:  \@nums = (%s)\n", join ', ', @nums;
+
+        my $count = count_distinct_avgs( \@nums );
+
+        print  "Output: $count\n";
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub count_distinct_avgs
+#-------------------------------------------------------------------------------
+{
+    my ($nums)  = @_;
+    my  @sorted = sort { $a <=> $b } @$nums;
+    my  %distinct_avgs;
+
+    while (scalar @sorted >= 2)
+    {
+        my $min = shift @sorted;
+        my $max = pop   @sorted;
+        my $avg = ($min + $max) / 2;
+
+        ++$distinct_avgs{ $avg };
+    }
+
+    printf "Distinct averages: %s\n", pp( \%distinct_avgs ) if DEBUG;
+
+    return scalar keys %distinct_avgs;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $nums_str, $expected) = split / \| /x, $line;
+
+        for ($test_name, $nums_str, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @nums  = split / \s+ /x, $nums_str;
+        my $count = count_distinct_avgs( \@nums );
+
+        is $count, $expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|1 2 4 3 5 6|1
+Example 2|0 2 4 8 3 5|2
+Example 3|7 3 1 0 5 9|2
diff --git a/challenge-321/athanasius/perl/ch-2.pl b/challenge-321/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..5ba3c6b8a6
--- /dev/null
+++ b/challenge-321/athanasius/perl/ch-2.pl
@@ -0,0 +1,189 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 321
+=========================
+
+TASK #2
+-------
+*Backspace Compare*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two strings containing zero or more #.
+
+Write a script to return true if the two given strings are same by treating # as
+backspace.
+
+Example 1
+
+  Input: $str1 = "ab#c"
+         $str2 = "ad#c"
+  Output: true
+
+  For first string,  we remove "b" as it is followed by "#".
+  For second string, we remove "d" as it is followed by "#".
+  In the end both strings became the same.
+
+Example 2
+
+  Input: $str1 = "ab##"
+         $str2 = "a#b#"
+  Output: true
+
+Example 3
+
+  Input: $str1 = "a#b"
+         $str2 = "c"
+  Output: false
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+Backspace characters are processed from left to right within a string.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. Two strings, each containing zero or more "#" characters, are entered on the
+   command-line.
+
+=cut
+#===============================================================================
+
+use v5.32;         # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [<ints> ...]
+  perl $0
+
+    [<ints> ...]    A non-empty list of unsigned integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 321, Task #2: Backspace Compare (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    my $argc = scalar @ARGV;
+
+    if    ($argc == 0)
+    {
+        run_tests();
+    }
+    elsif ($argc == 2)
+    {
+        my ($str1, $str2) = @ARGV;
+
+        print qq[Input:  \$str1 = "$str1"\n];
+        print qq[        \$str2 = "$str2"\n];
+
+        my $strings_are_equal = compare_strings( $str1, $str2 );
+
+        printf "Output: %s\n", $strings_are_equal ? 'true' : 'false';
+    }
+    else
+    {
+        error( "Expected 0 or 2 command-line arguments, found $argc" );
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub compare_strings
+#-------------------------------------------------------------------------------
+{
+    my ($str1, $str2) = @_;
+    my  $str1_nbs     = process_backspaces( $str1 );
+    my  $str2_nbs     = process_backspaces( $str2 );
+
+    return $str1_nbs eq $str2_nbs;
+}
+
+#-------------------------------------------------------------------------------
+sub process_backspaces
+#-------------------------------------------------------------------------------
+{
+    my ($str)   = @_;
+    my  @source = split //, $str;
+    my  @target;
+
+    while (@source)
+    {
+        my $next = shift @source;
+
+        if ($next eq '#')
+        {
+            pop  @target if @target;
+        }
+        else
+        {
+            push @target, $next;
+        }
+    }
+
+    return join '', @target;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $str1, $str2, $expected) = split / \| /x, $line;
+
+        for ($test_name, $str1, $str2, $expected)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my $strings_are_equal = compare_strings( $str1, $str2 );
+
+        is $strings_are_equal, $expected eq 'true', $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|ab#c|ad#c|true
+Example 2|ab##|a#b#|true
+Example 3|a#b |c   |false
diff --git a/challenge-321/athanasius/raku/ch-1.raku b/challenge-321/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..b47d17bd93
--- /dev/null
+++ b/challenge-321/athanasius/raku/ch-1.raku
@@ -0,0 +1,179 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 321
+=========================
+
+TASK #1
+-------
+*Distinct Average*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of numbers with even length.
+
+Write a script to return the count of distinct average. The average is calculate
+by removing the minimum and the maximum, then average of the two.
+
+Example 1
+
+  Input: @nums = (1, 2, 4, 3, 5, 6)
+  Output: 1
+
+  Step 1: Min = 1, Max = 6, Avg = 3.5
+  Step 2: Min = 2, Max = 5, Avg = 3.5
+  Step 3: Min = 3, Max = 4, Avg = 3.5
+
+  The count of distinct average is 1.
+
+Example 2
+
+  Input: @nums = (0, 2, 4, 8, 3, 5)
+  Output: 2
+
+  Step 1: Min = 0, Max = 8, Avg = 4
+  Step 2: Min = 2, Max = 5, Avg = 3.5
+  Step 3: Min = 3, Max = 4, Avg = 3.5
+
+  The count of distinct average is 2.
+
+Example 3
+
+  Input: @nums = (7, 3, 1, 0, 5, 9)
+  Output: 2
+
+  Step 1: Min = 0, Max = 9, Avg = 4.5
+  Step 2: Min = 1, Max = 7, Avg = 4
+  Step 3: Min = 3, Max = 5, Avg = 4
+
+  The count of distinct average is 2.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A non-empty, even-sized list of numbers is entered on the command-line.
+3. If the first list element is negative, it must preceded by "--" to indicate
+   that it is not a command-line flag.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+my Bool constant DEBUG = False;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 321, Task #1: Distinct Average (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    #| A non-empty, even-sized list of numbers
+
+    *@nums where { .elems > 0 && .elems %% 2 && .all ~~ Real:D }
+)
+#===============================================================================
+{
+    my Rat @rats = @nums.map: { .Rat };
+
+    "Raw input: %s\n".printf: @rats.raku if DEBUG;
+
+    "Input:  \@nums = (%s)\n".printf: @rats.join: ', ';
+
+    my UInt $count = count-distinct-avgs( @rats );
+
+    "Output: $count".put;
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub count-distinct-avgs( List:D[Rat:D] $nums where { .elems %% 2 } --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+    my UInt %distinct-avgs{Rat};
+    my Rat  @sorted = $nums.sort;
+
+    while @sorted.elems >= 2
+    {
+        my Rat $min = @sorted.shift;
+        my Rat $max = @sorted.pop;
+        my Rat $avg = ($min + $max) / 2;
+
+        ++%distinct-avgs{ $avg };
+    }
+
+    "Distinct averages: %s\n".printf: %distinct-avgs.raku if DEBUG;
+
+    return %distinct-avgs.keys.elems;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $nums-str, $expected) = $line.split: / \| /;
+
+        for     $test-name, $nums-str, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Rat  @nums  = $nums-str.split( / \s+ /, :skip-empty ).map: { .Rat };
+        my UInt $count = count-distinct-avgs( @nums );
+
+        is $count, $expected.Int, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+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|1 2 4 3 5 6|1
+        Example 2|0 2 4 8 3 5|2
+        Example 3|7 3 1 0 5 9|2
+        END
+}
+
+################################################################################
diff --git a/challenge-321/athanasius/raku/ch-2.raku b/challenge-321/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..a6058144fd
--- /dev/null
+++ b/challenge-321/athanasius/raku/ch-2.raku
@@ -0,0 +1,177 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 321
+=========================
+
+TASK #2
+-------
+*Backspace Compare*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two strings containing zero or more #.
+
+Write a script to return true if the two given strings are same by treating # as
+backspace.
+
+Example 1
+
+  Input: $str1 = "ab#c"
+         $str2 = "ad#c"
+  Output: true
+
+  For first string,  we remove "b" as it is followed by "#".
+  For second string, we remove "d" as it is followed by "#".
+  In the end both strings became the same.
+
+Example 2
+
+  Input: $str1 = "ab##"
+         $str2 = "a#b#"
+  Output: true
+
+Example 3
+
+  Input: $str1 = "a#b"
+         $str2 = "c"
+  Output: false
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+Backspace characters are processed from left to right within a string.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. Two strings, each containing zero or more "#" characters, are entered on the
+   command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 321, Task #2: Backspace Compare (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D $str1,                        #= First  string
+    Str:D $str2                         #= Second string
+)
+#===============================================================================
+{
+    qq[Input:  \$str1 = "$str1"].put;
+    qq[        \$str2 = "$str2"].put;
+
+    my Bool $strings-are-equal = compare-strings( $str1, $str2 );
+
+    "Output: %s\n".printf: $strings-are-equal ?? 'true' !! 'false';
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub compare-strings( Str:D $str1, Str:D $str2 --> Bool:D )
+#-------------------------------------------------------------------------------
+{
+    my Str $str1-nbs = process-backspaces( $str1 );
+    my Str $str2-nbs = process-backspaces( $str2 );
+
+    return $str1-nbs eq $str2-nbs;
+}
+
+#-------------------------------------------------------------------------------
+sub process-backspaces( Str:D $str --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str @source = $str.split: '', :skip-empty;
+    my Str @target;
+
+    while  @source
+    {
+        my Str $next = @source.shift;
+
+        if $next eq '#'
+        {
+            @target.pop if @target;
+        }
+        else
+        {
+            @target.push: $next;
+        }
+    }
+
+    return @target.join: '';
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $str1, $str2, $expected) = $line.split: / \| /;
+
+        for     $test-name, $str1, $str2, $expected
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Bool $strings-are-equal = compare-strings( $str1, $str2 );
+
+        is $strings-are-equal, $expected eq 'true', $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+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|ab#c|ad#c|true
+        Example 2|ab##|a#b#|true
+        Example 3|a#b |c   |false
+        END
+}
+
+################################################################################