aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-271/athanasius/perl/ch-1.pl206
-rw-r--r--challenge-271/athanasius/perl/ch-2.pl178
-rw-r--r--challenge-271/athanasius/raku/ch-1.raku216
-rw-r--r--challenge-271/athanasius/raku/ch-2.raku162
4 files changed, 762 insertions, 0 deletions
diff --git a/challenge-271/athanasius/perl/ch-1.pl b/challenge-271/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..a2d4da7ce4
--- /dev/null
+++ b/challenge-271/athanasius/perl/ch-1.pl
@@ -0,0 +1,206 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 271
+=========================
+
+TASK #1
+-------
+*Maximum Ones*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a m x n binary matrix.
+
+Write a script to return the row number containing maximum ones, in case of more
+than one rows then return smallest row number.
+
+Example 1
+
+ Input: $matrix = [ [0, 1],
+ [1, 0],
+ ]
+ Output: 1
+
+ Row 1 and Row 2 have the same number of ones, so return row 1.
+
+Example 2
+
+ Input: $matrix = [ [0, 0, 0],
+ [1, 0, 1],
+ ]
+ Output: 2
+
+ Row 2 has the maximum ones, so return row 2.
+
+Example 3
+
+ Input: $matrix = [ [0, 0],
+ [1, 1],
+ [0, 0],
+ ]
+ Output: 2
+
+ Row 2 have the maximum ones, so return row 2.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The matrix is entered on the command-line as a series of non-empty, same-
+ length bit-strings, one for each matrix row.
+
+Reference
+---------
+Code for handling binary matrices adapted from the Perl solution to Week 270,
+Task #1, "Special Positions".
+
+=cut
+#===============================================================================
+
+use v5.32.1; # Enables strictures
+use warnings;
+use Const::Fast;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+ perl $0 [<matrix> ...]
+ perl $0
+
+ [<matrix> ...] A non-empty m x n binary matrix, e.g., 1100 0110 0010
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ $| = 1;
+ print "\nChallenge 271, Task #1: Maximum Ones (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+ if (scalar @ARGV == 0)
+ {
+ run_tests();
+ }
+ else
+ {
+ my $matrix = parse_matrix( \@ARGV );
+
+ printf "Input: \$matrix = [%s]\n", join ' ', $matrix->[ 0 ]->@*;
+
+ for my $row (1 .. $#$matrix)
+ {
+ printf " [%s]\n", join ' ', $matrix->[ $row ]->@*;
+ }
+
+ my $row = find_max_row( $matrix );
+
+ print "Output: $row\n";
+ }
+}
+
+#-------------------------------------------------------------------------------
+sub find_max_row
+#-------------------------------------------------------------------------------
+{
+ my ($matrix) = @_;
+ my $max_count = 0;
+ my $max_row = 0;
+
+ for my $row (0 .. $#$matrix)
+ {
+ my $count = 0;
+ $count += $_ for $matrix->[ $row ]->@*;
+
+ if ($count > $max_count)
+ {
+ $max_count = $count;
+ $max_row = $row;
+ }
+ }
+
+ return $max_row + 1; # Change from 0- to 1-based indexing
+}
+
+#-------------------------------------------------------------------------------
+sub parse_matrix
+#-------------------------------------------------------------------------------
+{
+ my ($rows) = @_;
+ my $n = length $rows->[ 0 ];
+ my @matrix;
+
+ for (@$rows)
+ {
+ / ^ [01]+ $ /x or error( qq["$_" is not a valid bitstring] );
+
+ length == $n or error( 'The input matrix is not rectangular' );
+
+ push @matrix, [ split // ];
+ }
+
+ return \@matrix;
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+ print "Running the test suite\n";
+
+ while (my $line = <DATA>)
+ {
+ chomp $line;
+
+ my ($test_name, $matrix_str, $expected) = split / \| /x, $line;
+
+ for ($test_name, $matrix_str, $expected)
+ {
+ s/ ^ \s+ //x;
+ s/ \s+ $ //x;
+ }
+
+ my @rows = split / \s+ /x, $matrix_str;
+ my $matrix = parse_matrix( \@rows );
+ my $row = find_max_row( $matrix );
+
+ is $row, $expected, $test_name;
+ }
+
+ done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+ my ($message) = @_;
+
+ die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|01 10 |1
+Example 2|000 101 |2
+Example 3|00 11 00 |2
+Singleton|0 |1
+1st of 2 |00000 11011 00100 10111 00000|2
+Last |0000 0100 1010 1011 1111 |5
diff --git a/challenge-271/athanasius/perl/ch-2.pl b/challenge-271/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..4531c2daf1
--- /dev/null
+++ b/challenge-271/athanasius/perl/ch-2.pl
@@ -0,0 +1,178 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 271
+=========================
+
+TASK #2
+-------
+*Sort by 1 bits*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are give an array of integers, @ints.
+
+Write a script to sort the integers in ascending order by the number of 1 bits
+in their binary representation. In case more than one integers have the same
+number of 1 bits then sort them in ascending order.
+
+Example 1
+
+ Input: @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8)
+ Output: (0, 1, 2, 4, 8, 3, 5, 6, 7)
+
+ 0 = 0 one bits
+ 1 = 1 one bits
+ 2 = 1 one bits
+ 4 = 1 one bits
+ 8 = 1 one bits
+ 3 = 2 one bits
+ 5 = 2 one bits
+ 6 = 2 one bits
+ 7 = 3 one bits
+
+Example 2
+
+ Input: @ints = (1024, 512, 256, 128, 64)
+ Output: (64, 128, 256, 512, 1024)
+
+ All integers in the given array have one 1-bits, so just sort them in ascend-
+ ing order.
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumption
+----------
+The integers in @int are unsigned (i.e., non-negative).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The elements of @ints are entered in sequence on the command-line.
+
+=cut
+#===============================================================================
+
+use v5.32.1; # Enables strictures
+use warnings;
+use Const::Fast;
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+ perl $0 [<ints> ...]
+ perl $0
+
+ [<ints> ...] Non-empty list of unsigned integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ $| = 1;
+ print "\nChallenge 271, Task #2: Sort by 1 bits (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+ if (scalar @ARGV == 0)
+ {
+ run_tests();
+ }
+ else
+ {
+ my @ints = @ARGV;
+
+ for (@ints)
+ {
+ / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+ $_ >= 0 or error( qq["$_" is negative] );
+ }
+
+ printf "Input: \@ints = (%s)\n", join ', ', @ints;
+
+ my $sorted = sort_by_one_bits( \@ints );
+
+ printf "Output: (%s)\n", join ', ', @$sorted;
+ }
+}
+
+#-------------------------------------------------------------------------------
+sub sort_by_one_bits
+#-------------------------------------------------------------------------------
+{
+ my ($ints) = @_;
+ my @sorted = sort {
+ count_one_bits( $a ) <=> count_one_bits( $b ) ||
+ $a <=> $b
+ } @$ints;
+
+ return \@sorted;
+}
+
+#-------------------------------------------------------------------------------
+sub count_one_bits
+#-------------------------------------------------------------------------------
+{
+ my ($decimal) = @_;
+ my $binary = sprintf '%b', $decimal;
+
+ return $binary =~ tr/1/1/; # Count the 1's
+}
+
+#-------------------------------------------------------------------------------
+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 $sorted = sort_by_one_bits( \@ints );
+ my @expected = split / \s+ /x, $expected_str;
+
+ is_deeply $sorted, \@expected, $test_name;
+ }
+
+ done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+ my ($message) = @_;
+
+ die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|0 1 2 3 4 5 6 7 8 |0 1 2 4 8 3 5 6 7
+Example 2|1024 512 256 128 64|64 128 256 512 1024
diff --git a/challenge-271/athanasius/raku/ch-1.raku b/challenge-271/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..3e1696fc58
--- /dev/null
+++ b/challenge-271/athanasius/raku/ch-1.raku
@@ -0,0 +1,216 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 271
+=========================
+
+TASK #1
+-------
+*Maximum Ones*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given a m x n binary matrix.
+
+Write a script to return the row number containing maximum ones, in case of more
+than one rows then return smallest row number.
+
+Example 1
+
+ Input: $matrix = [ [0, 1],
+ [1, 0],
+ ]
+ Output: 1
+
+ Row 1 and Row 2 have the same number of ones, so return row 1.
+
+Example 2
+
+ Input: $matrix = [ [0, 0, 0],
+ [1, 0, 1],
+ ]
+ Output: 2
+
+ Row 2 has the maximum ones, so return row 2.
+
+Example 3
+
+ Input: $matrix = [ [0, 0],
+ [1, 1],
+ [0, 0],
+ ]
+ Output: 2
+
+ Row 2 have the maximum ones, so return row 2.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The matrix is entered on the command-line as a series of non-empty, same-
+ length bit-strings, one for each matrix row.
+
+Reference
+---------
+Code for handling binary matrices adapted from the Perl solution to Week 270,
+Task #1, "Special Positions".
+
+=end comment
+#===============================================================================
+
+use Test;
+
+subset Bit of Int where 0 | 1;
+subset BitStr of Str where / ^ <[01]>+ $ /;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ "\nChallenge 271, Task #1: Maximum Ones (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+ #| A non-empty m x n binary matrix, e.g., 1100 0110 0010
+
+ *@matrix where { .elems > 0 && .all ~~ BitStr:D }
+)
+#===============================================================================
+{
+ my Array[Bit] @binary = parse-matrix( @matrix );
+
+ "Input: \$matrix = [%s]\n"\ .printf: @binary[ 0 ].join: ' ';
+
+ for 1 .. @binary.end -> UInt $row
+ {
+ " [%s]\n".printf: @binary[ $row ].join: ' ';
+ }
+
+ my UInt $row = find-max-row( @binary );
+
+ "Output: $row".put;
+}
+
+#===============================================================================
+multi sub MAIN() # No input: run the test suite
+#===============================================================================
+{
+ run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-max-row( List:D[List:D[Bit:D]] $matrix --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+ my UInt $max-count = 0;
+ my UInt $max-row = 0;
+
+ for 0 .. $matrix.end -> UInt $row
+ {
+ my UInt $count = [+] $matrix[ $row ].list;
+
+ if $count > $max-count
+ {
+ $max-count = $count;
+ $max-row = $row;
+ }
+ }
+
+ return $max-row + 1; # Change from 0- to 1-based indexing
+}
+
+#-------------------------------------------------------------------------------
+sub parse-matrix( List:D[BitStr:D] $rows --> List:D[List:D[Bit:D]] )
+#-------------------------------------------------------------------------------
+{
+ my Array[Bit] @matrix;
+ my UInt $n = $rows[ 0 ].chars;
+
+ for @$rows -> BitStr $row-str
+ {
+ $row-str.chars == $n or error( 'The input matrix is not rectangular' );
+
+ my Bit @row = $row-str.split( '', :skip-empty ).map: { .Int };
+
+ @matrix.push: @row;
+ }
+
+ return @matrix;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+ 'Running the test suite'.put;
+
+ for test-data.lines -> Str $line
+ {
+ my Str ($test-name, $matrix-str, $expected-str) = $line.split: / \| /;
+
+ for $test-name, $matrix-str, $expected-str
+ {
+ s/ ^ \s+ //;
+ s/ \s+ $ //;
+ }
+
+ my BitStr @rows = $matrix-str.split: / \s+ /, :skip-empty;
+ my Array[Bit] @matrix = parse-matrix( @rows );
+ my UInt $row = find-max-row( @matrix );
+
+ is $row, $expected-str.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|01 10 |1
+ Example 2|000 101 |2
+ Example 3|00 11 00 |2
+ Singleton|0 |1
+ 1st of 2 |00000 11011 00100 10111 00000|2
+ Last |0000 0100 1010 1011 1111 |5
+ END
+}
+
+################################################################################
diff --git a/challenge-271/athanasius/raku/ch-2.raku b/challenge-271/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..3cec5d7513
--- /dev/null
+++ b/challenge-271/athanasius/raku/ch-2.raku
@@ -0,0 +1,162 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 271
+=========================
+
+TASK #2
+-------
+*Sort by 1 bits*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are give an array of integers, @ints.
+
+Write a script to sort the integers in ascending order by the number of 1 bits
+in their binary representation. In case more than one integers have the same
+number of 1 bits then sort them in ascending order.
+
+Example 1
+
+ Input: @ints = (0, 1, 2, 3, 4, 5, 6, 7, 8)
+ Output: (0, 1, 2, 4, 8, 3, 5, 6, 7)
+
+ 0 = 0 one bits
+ 1 = 1 one bits
+ 2 = 1 one bits
+ 4 = 1 one bits
+ 8 = 1 one bits
+ 3 = 2 one bits
+ 5 = 2 one bits
+ 6 = 2 one bits
+ 7 = 3 one bits
+
+Example 2
+
+ Input: @ints = (1024, 512, 256, 128, 64)
+ Output: (64, 128, 256, 512, 1024)
+
+ All integers in the given array have one 1-bits, so just sort them in ascend-
+ ing order.
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumption
+----------
+The integers in @int are unsigned (i.e., non-negative).
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. The elements of @ints are entered in sequence on the command-line.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+ "\nChallenge 271, Task #2: Sort by 1 bits (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+ #| Non-empty list of unsigned integers
+
+ *@ints where { .elems > 0 && .all ~~ UInt:D }
+)
+#===============================================================================
+{
+ "Input: \@ints = (%s)\n".printf: @ints.join: ', ';
+
+ my UInt @sorted = sort-by-one-bits( @ints );
+
+ "Output: (%s)\n"\.printf: @sorted.join: ', ';
+}
+
+#===============================================================================
+multi sub MAIN() # No input: run the test suite
+#===============================================================================
+{
+ run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub sort-by-one-bits( List:D[UInt:D] $ints --> Seq:D[UInt:D] )
+#-------------------------------------------------------------------------------
+{
+ return $ints.sort: {
+ count-one-bits( $^a ) <=> count-one-bits( $^b ) ||
+ $^a <=> $^b
+ };
+}
+
+#-------------------------------------------------------------------------------
+sub count-one-bits( UInt:D $decimal --> UInt:D )
+#-------------------------------------------------------------------------------
+{
+ return $decimal.base( 2 ).trans( '0' => '' ).chars;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+ 'Running the test suite'.put;
+
+ for test-data.lines -> Str $line
+ {
+ my Str ($test-name, $ints-str, $expd-str) = $line.split: / \| /;
+
+ for $test-name, $ints-str, $expd-str
+ {
+ s/ ^ \s+ //;
+ s/ \s+ $ //;
+ }
+
+ my UInt @ints = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int };
+ my UInt @sorted = sort-by-one-bits( @ints );
+ my UInt @expctd = $expd-str.split( / \s+ /, :skip-empty ).map: { .Int };
+
+ is-deeply @sorted, @expctd, $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|0 1 2 3 4 5 6 7 8 |0 1 2 4 8 3 5 6 7
+ Example 2|1024 512 256 128 64|64 128 256 512 1024
+ END
+}
+
+################################################################################
generated by cgit (git 2.34.1) at 2026-07-05 00:37:48 +0000