aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-321/athanasius/perl/ch-1.pl186
-rw-r--r--challenge-321/athanasius/perl/ch-2.pl189
-rw-r--r--challenge-321/athanasius/raku/ch-1.raku179
-rw-r--r--challenge-321/athanasius/raku/ch-2.raku177
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
+}
+
+################################################################################
generated by cgit (git 2.34.1) at 2026-07-03 13:29:14 +0000