aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad Sajid Anwar <Mohammad.Anwar@yahoo.com>2025-05-25 20:56:43 +0100
committerGitHub <noreply@github.com>2025-05-25 20:56:43 +0100
commite9e7db9cb75a06cfc1a32eb63476a95ea2490694 (patch)
tree50cdc1e7271b9593244f8d3b6ce38f0bee810c2f
parent2d8fc729ab08c9841689ac21c18ad555edd80013 (diff)
parent10a35727344d92a0f6d986047da671e0845de2ec (diff)
downloadperlweeklychallenge-club-e9e7db9cb75a06cfc1a32eb63476a95ea2490694.tar.gz
perlweeklychallenge-club-e9e7db9cb75a06cfc1a32eb63476a95ea2490694.tar.bz2
perlweeklychallenge-club-e9e7db9cb75a06cfc1a32eb63476a95ea2490694.zip
Merge pull request #12077 from PerlMonk-Athanasius/branch-for-challenge-322
Perl & Raku solutions to Tasks 1 & 2 for Week 322
-rw-r--r--challenge-322/athanasius/perl/ch-1.pl164
-rw-r--r--challenge-322/athanasius/perl/ch-2.pl165
-rw-r--r--challenge-322/athanasius/raku/ch-1.raku150
-rw-r--r--challenge-322/athanasius/raku/ch-2.raku158
4 files changed, 637 insertions, 0 deletions
diff --git a/challenge-322/athanasius/perl/ch-1.pl b/challenge-322/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..1762d7700b
--- /dev/null
+++ b/challenge-322/athanasius/perl/ch-1.pl
@@ -0,0 +1,164 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 322
+=========================
+
+TASK #1
+-------
+*String Format*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string and a positive integer.
+
+Write a script to format the string, removing any dashes, in groups of size
+given by the integer. The first group can be smaller than the integer but should
+have at least one character. Groups should be separated by dashes.
+
+Example 1
+
+ Input: $str = "ABC-D-E-F", $i = 3
+ Output: "ABC-DEF"
+
+Example 2
+
+ Input: $str = "A-BC-D-E", $i = 2
+ Output: "A-BC-DE"
+
+Example 3
+
+ Input: $str = "-A-B-CD-E", $i = 4
+ Output: "A-BCDE"
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2025 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. A string, and a positive (non-zero) integer, are entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32; # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+ perl $0 <str> <i>
+ perl $0
+
+ <str> A string
+ <i> A positive (non-zero) integer
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ $| = 1;
+ print "\nChallenge 322, Task #1: String Format (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+ my $argc = scalar @ARGV;
+
+ if ($argc == 0)
+ {
+ run_tests();
+ }
+ elsif ($argc == 2)
+ {
+ my ($str, $i) = @ARGV;
+
+ $i =~ / ^ $RE{num}{int} $ /x
+ or error( qq["$i" is not a valid integer] );
+
+ $i > 0 or error( "$i is not positive" );
+
+ print qq[Input: \$str = "$str", \$i = $i\n];
+
+ my $grouped = format_string( $str, $i );
+
+ print qq[Output: "$grouped"\n];
+ }
+ else
+ {
+ error( "Expected 0 or 2 command-line arguments, found $argc" );
+ }
+}
+
+#-------------------------------------------------------------------------------
+sub format_string
+#-------------------------------------------------------------------------------
+{
+ my ($str, $i) = @_;
+ my $bare = $str =~ s/ \- //grx;
+ my @groups;
+
+ while ($bare =~ s/ ( .{1,$i} ) $ //x)
+ {
+ unshift @groups, $1;
+ }
+
+ return join '-', @groups;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+ print "Running the test suite\n";
+
+ while (my $line = <DATA>)
+ {
+ chomp $line;
+
+ my ($test_name, $str, $i, $expected) = split / \| /x, $line;
+
+ for ($test_name, $str, $i, $expected)
+ {
+ s/ ^ \s+ //x;
+ s/ \s+ $ //x;
+ }
+
+ my $grouped = format_string( $str, $i );
+
+ is $grouped, $expected, $test_name;
+ }
+
+ done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+ my ($message) = @_;
+
+ die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|ABC-D-E-F|3|ABC-DEF
+Example 2|A-BC-D-E |2|A-BC-DE
+Example 3|-A-B-CD-E|4|A-BCDE
diff --git a/challenge-322/athanasius/perl/ch-2.pl b/challenge-322/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..b3d5cc38d4
--- /dev/null
+++ b/challenge-322/athanasius/perl/ch-2.pl
@@ -0,0 +1,165 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 322
+=========================
+
+TASK #2
+-------
+*Rank Array*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers.
+
+Write a script to return an array of the ranks of each element: the lowest value
+has rank 1, next lowest rank 2, etc. If two elements are the same then they
+share the same rank.
+
+Example 1
+
+ Input: @ints = (55, 22, 44, 33)
+ Output: (4, 1, 3, 2)
+
+Example 2
+
+ Input: @ints = (10, 10, 10)
+ Output: (1, 1, 1)
+
+Example 3
+
+ Input: @ints = (5, 1, 1, 4, 3)
+ Output: (4, 1, 1, 3, 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 list of integers is entered on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32; # Enables strictures
+use warnings;
+use Const::Fast;
+use List::Util qw( uniqint );
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+ perl $0 [<ints> ...]
+ perl $0
+
+ [<ints> ...] A non-empty list of integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ $| = 1;
+ print "\nChallenge 322, Task #2: Rank Array (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+ if (scalar @ARGV == 0)
+ {
+ run_tests();
+ }
+ else
+ {
+ my @ints = @ARGV;
+
+ / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] )
+ for @ints;
+
+ printf "Input: \@ints = (%s)\n", join ', ', @ints;
+
+ my $ranks = find_ranks( \@ints );
+
+ printf "Output: (%s)\n", join ', ', @$ranks;
+ }
+}
+
+#-------------------------------------------------------------------------------
+sub find_ranks
+#-------------------------------------------------------------------------------
+{
+ my ($ints) = @_;
+ my @sorted = uniqint sort { $a <=> $b } @$ints;
+ my %rank;
+
+ for my $i (0 .. $#sorted)
+ {
+ $rank{ $sorted[ $i ] } = $i + 1;
+ }
+
+ my @ranks;
+
+ for my $i (0 .. $#$ints)
+ {
+ push @ranks, $rank{ $ints->[ $i ] };
+ }
+
+ return \@ranks;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+ print "Running the test suite\n";
+
+ while (my $line = <DATA>)
+ {
+ chomp $line;
+
+ my ($test_name, $ints_str, $expected_str) = split / \| /x, $line;
+
+ for ($test_name, $ints_str, $expected_str)
+ {
+ s/ ^ \s+ //x;
+ s/ \s+ $ //x;
+ }
+
+ my @ints = split / \s+ /x, $ints_str;
+ my $ranks = find_ranks( \@ints );
+ my @expected = split / \s+ /x, $expected_str;
+
+ is_deeply $ranks, \@expected, $test_name;
+ }
+
+ done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+ my ($message) = @_;
+
+ die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|55 22 44 33 |4 1 3 2
+Example 2|10 10 10 |1 1 1
+Example 3| 5 1 1 4 3|4 1 1 3 2
diff --git a/challenge-322/athanasius/raku/ch-1.raku b/challenge-322/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..bf6b70a776
--- /dev/null
+++ b/challenge-322/athanasius/raku/ch-1.raku
@@ -0,0 +1,150 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 322
+=========================
+
+TASK #1
+-------
+*String Format*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a string and a positive integer.
+
+Write a script to format the string, removing any dashes, in groups of size
+given by the integer. The first group can be smaller than the integer but should
+have at least one character. Groups should be separated by dashes.
+
+Example 1
+
+ Input: $str = "ABC-D-E-F", $i = 3
+ Output: "ABC-DEF"
+
+Example 2
+
+ Input: $str = "A-BC-D-E", $i = 2
+ Output: "A-BC-DE"
+
+Example 3
+
+ Input: $str = "-A-B-CD-E", $i = 4
+ Output: "A-BCDE"
+
+=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 string, and a positive (non-zero) integer, are entered on the command-line.
+3. If the string begins with a hyphen, it must be preceded by "--" to indicate
+ that it is not a command-line flag.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Pos of Int where * > 0;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ "\nChallenge 322, Task #1: String Format (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+ Str:D $str, #= A string
+ Pos:D $i #= A positive (non-zero) integer
+)
+#===============================================================================
+{
+ qq[Input: \$str = "$str", \$i = $i].put;
+
+ my $grouped = format-string( $str, $i );
+
+ qq[Output: "$grouped"].put;
+}
+
+#===============================================================================
+multi sub MAIN() # No input: run the test suite
+#===============================================================================
+{
+ run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub format-string( Str:D $str, Pos:D $i --> Str:D )
+#-------------------------------------------------------------------------------
+{
+ my Str $bare = S:g/ \- // given $str;
+ my Str @groups;
+
+ while $bare ~~ s/ (. ** {1 .. $i}) $ //
+ {
+ @groups.unshift: ~$0;
+ }
+
+ return @groups.join: '-';
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+ 'Running the test suite'.put;
+
+ for test-data.lines -> Str $line
+ {
+ my Str ($test-name, $str, $i-str, $expected) = $line.split: / \| /;
+
+ for $test-name, $str, $i-str, $expected
+ {
+ s/ ^ \s+ //;
+ s/ \s+ $ //;
+ }
+
+ my $grouped = format-string( $str, $i-str.Int );
+
+ is $grouped, $expected, $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|ABC-D-E-F|3|ABC-DEF
+ Example 2|A-BC-D-E |2|A-BC-DE
+ Example 3|-A-B-CD-E|4|A-BCDE
+ END
+}
+
+################################################################################
diff --git a/challenge-322/athanasius/raku/ch-2.raku b/challenge-322/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..2c94004a51
--- /dev/null
+++ b/challenge-322/athanasius/raku/ch-2.raku
@@ -0,0 +1,158 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 322
+=========================
+
+TASK #2
+-------
+*Rank Array*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers.
+
+Write a script to return an array of the ranks of each element: the lowest value
+has rank 1, next lowest rank 2, etc. If two elements are the same then they
+share the same rank.
+
+Example 1
+
+ Input: @ints = (55, 22, 44, 33)
+ Output: (4, 1, 3, 2)
+
+Example 2
+
+ Input: @ints = (10, 10, 10)
+ Output: (1, 1, 1)
+
+Example 3
+
+ Input: @ints = (5, 1, 1, 4, 3)
+ Output: (4, 1, 1, 3, 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 list of integers 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;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ "\nChallenge 322, Task #2: Rank Array (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+ #| A non-empty list of integers
+
+ *@ints where { .elems > 0 && .all ~~ Int:D }
+)
+#===============================================================================
+{
+ "Input: \@ints = (%s)\n".printf: @ints\.join: ', ';
+
+ my UInt @ranks = find-ranks( @ints );
+
+ "Output: (%s)\n".printf: @ranks.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN() # No input: run the test suite
+#===============================================================================
+{
+ run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-ranks( List:D[Int:D] $ints --> List:D[UInt:D] )
+#-------------------------------------------------------------------------------
+{
+ my Int @sorted = $ints.sort.squish.map: { .Int };
+ my UInt %rank{Int};
+
+ for 0 .. @sorted.end -> UInt $i
+ {
+ %rank{ @sorted[ $i ] } = $i + 1;
+ }
+
+ my UInt @ranks;
+
+ for 0 .. $ints.end -> UInt $i
+ {
+ @ranks.push: %rank{ +$ints[ $i ] };
+ }
+
+ return @ranks;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+ 'Running the test suite'.put;
+
+ for test-data.lines -> Str $line
+ {
+ my Str ($test-name, $int-str, $exp-str) = $line.split: / \| /;
+
+ for $test-name, $int-str, $exp-str
+ {
+ s/ ^ \s+ //;
+ s/ \s+ $ //;
+ }
+
+ my Int @ints = $int-str.split( / \s+ /, :skip-empty ).map: { .Int };
+ my UInt @ranks = find-ranks( @ints );
+ my UInt @expectd = $exp-str.split( / \s+ /, :skip-empty ).map: { .Int };
+
+ is-deeply @ranks, @expectd, $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|55 22 44 33 |4 1 3 2
+ Example 2|10 10 10 |1 1 1
+ Example 3| 5 1 1 4 3|4 1 1 3 2
+ END
+}
+
+################################################################################