From ef976956007697098bdfd8668f32f981fed141c7 Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Tue, 28 May 2024 23:01:30 +1000 Subject: Perl & Raku solutions to Tasks 1 & 2 for Week 271 --- challenge-271/athanasius/perl/ch-1.pl | 206 ++++++++++++++++++++++++++++++ challenge-271/athanasius/perl/ch-2.pl | 178 ++++++++++++++++++++++++++ challenge-271/athanasius/raku/ch-1.raku | 216 ++++++++++++++++++++++++++++++++ challenge-271/athanasius/raku/ch-2.raku | 162 ++++++++++++++++++++++++ 4 files changed, 762 insertions(+) create mode 100644 challenge-271/athanasius/perl/ch-1.pl create mode 100644 challenge-271/athanasius/perl/ch-2.pl create mode 100644 challenge-271/athanasius/raku/ch-1.raku create mode 100644 challenge-271/athanasius/raku/ch-2.raku 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 => < ...] + perl $0 + + [ ...] 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 = ) + { + 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 => < ...] + perl $0 + + [ ...] 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 = ) + { + 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 +} + +################################################################################ -- cgit