From 79b68d0a0fcc84a6c4e1a3a0a5a556798f630a03 Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Sun, 19 Jan 2025 23:37:08 +1000 Subject: Perl & Raku solutions to Tasks 1 & 2 for Week 304 --- challenge-304/athanasius/perl/ch-1.pl | 232 ++++++++++++++++++++++++++++++++ challenge-304/athanasius/perl/ch-2.pl | 174 ++++++++++++++++++++++++ challenge-304/athanasius/raku/ch-1.raku | 217 +++++++++++++++++++++++++++++ challenge-304/athanasius/raku/ch-2.raku | 177 ++++++++++++++++++++++++ 4 files changed, 800 insertions(+) create mode 100644 challenge-304/athanasius/perl/ch-1.pl create mode 100644 challenge-304/athanasius/perl/ch-2.pl create mode 100644 challenge-304/athanasius/raku/ch-1.raku create mode 100644 challenge-304/athanasius/raku/ch-2.raku diff --git a/challenge-304/athanasius/perl/ch-1.pl b/challenge-304/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..c5b2e160a0 --- /dev/null +++ b/challenge-304/athanasius/perl/ch-1.pl @@ -0,0 +1,232 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 304 +========================= + +TASK #1 +------- +*Arrange Binary* + +Submitted by: Mohammad Sajid Anwar + +You are given a list of binary digits (0 and 1) and a positive integer, $n. + +Write a script to return true if you can re-arrange the list by replacing at +least $n digits with 1 in the given list so that no two consecutive digits are 1 +otherwise return false. + +Example 1 + + Input: @digits = (1, 0, 0, 0, 1), $n = 1 + Output: true + + Re-arranged list: (1, 0, 1, 0, 1) + +Example 2 + + Input: @digits = (1, 0, 0, 0, 1), $n = 2 + Output: false + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2025 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Assumptions +----------- +1. Replacement: Only a 0 digit may be replaced with a 1 digit. +2. The given $n must be greater than zero. + +Discussion +---------- +In the Task description, juxtaposition of the words "re-arrange" and "replace" +creates ambiguity. Is the requirement to: + + 1. replace $n 0 digits with 1 digits, leaving them in their original places; or + 2. rearrange all the digits (after replacement) into the required sequence? + +Rather than choose between these alternatives, I have decided to solve both. For +example, an input of @digits = (1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1) and $n = 1 will +produce the following result: + + Input: @digits = (1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1), $n = 1 + Output + Can rearrange: true + Can replace: false + +which indicates that the digits CAN be re-arranged with no two consecutive 1s: + + (1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1) + +but CANNOT have no consecutive 1s if there is replacement but no rearrangement +(because there are consecutive 1s in the original list). + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. A binary string and a positive 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 => < + perl $0 + + A non-empty string of binary digits + A positive integer +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 304, Task #1: Arrange Binary (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $argc = scalar @ARGV; + + if ($argc == 0) + { + run_tests(); + } + elsif ($argc == 2) + { + my ($digits, $n) = @ARGV; + + $digits =~ / ^ [01]+ $ /x + or error( qq["$digits" is not a valid string of binary digits] ); + + $n =~ / ^ $RE{num}{int} $ /x + or error( qq["$n" is not a valid integer] ); + + $n > 0 or error( "$n is not positive" ); + + my @digits = split //, $digits; + + printf "Input: \@digits = (%s), \$n = %d\n", join( ', ', @digits ), $n; + + my ($can_rearrange, $can_replace) = arrange( \@digits, $n ); + + print "Output\n"; + printf " Can rearrange: %s\n", $can_rearrange ? 'true' : 'false'; + printf " Can replace: %s\n", $can_replace ? 'true' : 'false'; + } + else + { + error( "Expected 0 or 2 command-line arguments, found $argc" ); + } +} + +#------------------------------------------------------------------------------- +sub arrange +#------------------------------------------------------------------------------- +{ + my ($digits, $n) = @_; + + my $ones = 0; + $ones += $_ for @$digits; + my $zeros = scalar @$digits - $ones; + + my $can_rearrange = ($ones + $n) - ($zeros - $n) <= 1; + my $can_replace = $can_rearrange; + + if ($can_replace) + { + my $digit_str = join '', @$digits; + $can_replace = ($digit_str =~ / 11 /x) ? 0 : replace( $digit_str, $n ); + } + + return ($can_rearrange, $can_replace); +} + +#------------------------------------------------------------------------------- +sub replace +#------------------------------------------------------------------------------- +{ + my ($digits, $n) = @_; + + --$n if $digits =~ / ^ 0 /x; + + if ($n > 0) + { + --$n if $digits =~ / 0 $ /x; + + while ($n > 0) + { + $digits =~ s/ 000 /010/x or last; + --$n; + } + } + + return $n == 0; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $digit_str, $n, $exp_rearrange, $exp_replace) = + split / \| /x, $line; + + for ($test_name, $digit_str, $n, $exp_rearrange, $exp_replace) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @digits = split //, $digit_str; + my ($can_rearrange, $can_replace) = arrange( \@digits, $n ); + my $can_rearrange_str = $can_rearrange ? 'true' : 'false'; + my $can_replace_str = $can_replace ? 'true' : 'false'; + + is $can_rearrange_str, $exp_rearrange, "$test_name: rearrange"; + is $can_replace_str, $exp_replace, "$test_name: replace"; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|10001 |1|true |true +Example 2|10001 |2|false|false +Groups 1 |11100000011|1|true |false +Groups 2 |1000010001 |2|true |true +Groups 3 |1000001 |2|true |true diff --git a/challenge-304/athanasius/perl/ch-2.pl b/challenge-304/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..2402029e83 --- /dev/null +++ b/challenge-304/athanasius/perl/ch-2.pl @@ -0,0 +1,174 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 304 +========================= + +TASK #2 +------- +*Maximum Average* + +Submitted by: Mohammad Sajid Anwar + +You are given an array of integers, @ints and an integer, $n which is less than +or equal to total elements in the given array. + +Write a script to find the contiguous subarray whose length is the given inte- +ger, $n, and has the maximum average. It should return the average. + +Example 1 + + Input: @ints = (1, 12, -5, -6, 50, 3), $n = 4 + Output: 12.75 + + Subarray: (12, -5, -6, 50) + Average: (12 - 5 - 6 + 50) / 4 = 12.75 + +Example 2 + + Input: @ints = (5), $n = 1 + Output: 5 + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2025 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Assumption +---------- +$n is greater than zero. (If $n = 0, calculation of the average would result in +division by zero, which is undefined. If $n < 0, the "window" would have nega- +tive length, which makes no sense.) + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. A positive integer $n is entered on the command-line, followed by a non-empty + list of integers. 0 < $n <= (the number of elements in the list). + +=cut +#=============================================================================== + +use v5.32; # Enables strictures and warnings +use Const::Fast; +use Regexp::Common qw( number ); +use Test::More; + +const my $USAGE => < [ ...] + perl $0 + + A positive integer not greater than the size of ints + [ ...] A non-empty list of integers +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 304, Task #2: Maximum Average (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $argc = scalar @ARGV; + + if ($argc == 0) + { + run_tests(); + } + elsif ($argc == 1) + { + error( "Expected 0 or 2+ command-line arguments, found 1" ) + } + else + { + my ($n, @ints) = @ARGV; + + / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] ) + for $n, @ints; + + 0 < $n <= scalar @ints or error( "$n is not a valid value for n" ); + + printf "Input: \@ints = (%s)\n", join ', ', @ints; + + my $max_avg = find_max_average( \@ints, $n ); + + print "Output: $max_avg\n"; + } +} + +#------------------------------------------------------------------------------- +sub find_max_average +#------------------------------------------------------------------------------- +{ + my ($ints, $n) = @_; + my $left = 0; + my $right = $n - 1; + my $total = 0; + $total += $_ for @$ints[ $left .. $right ]; + my $max = $total; + + while ($right < $#$ints) + { + $total -= $ints->[ $left++ ]; + $total += $ints->[ ++$right ]; + $max = $total if $total > $max; + } + + return $max / $n; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $ints_str, $n, $expected) = split / \| /x, $line; + + for ($test_name, $ints_str, $n, $expected) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @ints = split / \s+ /x, $ints_str; + my $max_avg = find_max_average( \@ints, $n ); + + is $max_avg, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|1 12 -5 -6 50 3|4|12.75 +Example 2|5 |1| 5 +Repeating|1 -1 1 |3| 0.333333333333333 diff --git a/challenge-304/athanasius/raku/ch-1.raku b/challenge-304/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..1f2158c1fc --- /dev/null +++ b/challenge-304/athanasius/raku/ch-1.raku @@ -0,0 +1,217 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 304 +========================= + +TASK #1 +------- +*Arrange Binary* + +Submitted by: Mohammad Sajid Anwar + +You are given a list of binary digits (0 and 1) and a positive integer, $n. + +Write a script to return true if you can re-arrange the list by replacing at +least $n digits with 1 in the given list so that no two consecutive digits are 1 +otherwise return false. + +Example 1 + + Input: @digits = (1, 0, 0, 0, 1), $n = 1 + Output: true + + Re-arranged list: (1, 0, 1, 0, 1) + +Example 2 + + Input: @digits = (1, 0, 0, 0, 1), $n = 2 + Output: false + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2025 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Assumptions +----------- +1. Replacement: Only a 0 digit may be replaced with a 1 digit. +2. The given $n must be greater than zero. + +Discussion +---------- +In the Task description, juxtaposition of the words "re-arrange" and "replace" +creates ambiguity. Is the requirement to: + + 1. replace $n 0 digits with 1 digits, leaving them in their original places; or + 2. rearrange all the digits (after replacement) into the required sequence? + +Rather than choose between these alternatives, I have decided to solve both. For +example, an input of @digits = (1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1) and $n = 1 will +produce the following result: + + Input: @digits = (1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1), $n = 1 + Output + Can rearrange: true + Can replace: false + +which indicates that the digits CAN be re-arranged with no two consecutive 1s: + + (1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1) + +but CANNOT have no consecutive 1s if there is replacement but no rearrangement +(because there are consecutive 1s in the original list). + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. A binary string and a positive integer are entered on the command-line. + +=end comment +#=============================================================================== + +use Test; + +subset BinStr of Str where / ^ <[ 0 1 ]>+ $ /; +subset Bin of Int where 0 | 1; +subset Pos of Int where * > 0; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 304, Task #1: Arrange Binary (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + BinStr:D $digits, #= A non-empty string of binary digits + Pos:D $n #= A positive integer +) +#=============================================================================== +{ + my Bin @digits = $digits.split( '', :skip-empty ).map: { .Int }; + + "Input: \@digits = (%s), \$n = %d\n".printf: @digits.join( ', ' ), $n; + + my Bool ($can-rearrange, $can-replace) = arrange( @digits, $n ); + + 'Output'.put; + " Can rearrange: %s\n".printf: $can-rearrange ?? 'true' !! 'false'; + " Can replace: %s\n".printf: $can-replace ?? 'true' !! 'false'; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub arrange( List:D[Bin:D] $digits, Pos:D $n --> List:D[Bool:D, Bool:D] ) +#------------------------------------------------------------------------------- +{ + my UInt $ones = 0; + $ones += $_ for @$digits; + my UInt $zeros = $digits.elems - $ones; + + my Bool $can-rearrange = ($ones + $n) - ($zeros - $n) <= 1; + my Bool $can-replace = $can-rearrange; + + if $can-replace + { + my BinStr $digit-str = $digits.join: '', :skip-empty; + $can-replace = ($digit-str ~~ / 11 /) ?? False + !! replace( $digit-str, $n ); + } + + return $can-rearrange, $can-replace; +} + +#------------------------------------------------------------------------------- +sub replace( BinStr:D $digits is rw, Pos:D $n --> Bool:D ) +#------------------------------------------------------------------------------- +{ + my UInt $n-left = $n; + + --$n-left if $digits ~~ / ^ 0 /; + + if $n-left > 0 + { + --$n-left if $digits ~~ / 0 $ /; + + while $n-left > 0 + { + $digits ~~ s/ 000 /010/ or last; + --$n-left; + } + } + + return $n-left == 0; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $digit-str, $n, $exp-rearrange, $exp-replace) = + $line.split: / \| /; + + for $test-name, $digit-str, $n, $exp-rearrange, $exp-replace + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Bin @digits = $digit-str.split( '', :skip-empty ).map: { .Int }; + + my Bool ($can-rearrange, $can-replace) = arrange( @digits, $n.Int ); + + my Str $can-rearrange-str = $can-rearrange ?? 'true' !! 'false'; + my Str $can-replace-str = $can-replace ?? 'true' !! 'false'; + + is $can-rearrange-str, $exp-rearrange, "$test-name: rearrange"; + is $can-replace-str, $exp-replace, "$test-name: replace"; + } + + 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|10001 |1|true |true + Example 2|10001 |2|false|false + Groups 1 |11100000011|1|true |false + Groups 2 |1000010001 |2|true |true + Groups 3 |1000001 |2|true |true + END +} + +################################################################################ diff --git a/challenge-304/athanasius/raku/ch-2.raku b/challenge-304/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..6b197530b9 --- /dev/null +++ b/challenge-304/athanasius/raku/ch-2.raku @@ -0,0 +1,177 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 304 +========================= + +TASK #2 +------- +*Maximum Average* + +Submitted by: Mohammad Sajid Anwar + +You are given an array of integers, @ints and an integer, $n which is less than +or equal to total elements in the given array. + +Write a script to find the contiguous subarray whose length is the given inte- +ger, $n, and has the maximum average. It should return the average. + +Example 1 + + Input: @ints = (1, 12, -5, -6, 50, 3), $n = 4 + Output: 12.75 + + Subarray: (12, -5, -6, 50) + Average: (12 - 5 - 6 + 50) / 4 = 12.75 + +Example 2 + + Input: @ints = (5), $n = 1 + Output: 5 + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2025 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Assumption +---------- +$n is greater than zero. (If $n = 0, calculation of the average would result in +division by zero, which is undefined. If $n < 0, the "window" would have nega- +tive length, which makes no sense.) + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. A positive integer named n is entered on the command-line, followed by a non- + empty list of integers. 0 < n <= (the number of elements in the list). + +=end comment +#=============================================================================== + +use Test; + +subset Pos of Int where * > 0; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 304, Task #2: Maximum Average (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + Pos:D :$n, #= A positive integer not greater than the size of ints + + *@ints where { .elems > 0 && .all ~~ Int:D } #= A non-empty list of integers +) +#=============================================================================== +{ + $n <= @ints.elems or error( "\$n is too large" ); + + "Input: \@ints = (%s)\n".printf: @ints.join: ', '; + + my Rat $max-avg = find-max-average( @ints, $n ); + + "Output: $max-avg".put; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub find-max-average +( + List:D[Int:D] $ints where { .elems > 0 }, + Pos:D $n where { $n <= $ints.elems } +--> Rat:D +) +#------------------------------------------------------------------------------- +{ + my UInt $left = 0; + my UInt $right = $n - 1; + my Int $total = [+] $ints[ $left .. $right ]; + my Int $max = $total; + + while $right < $ints.end + { + $total -= $ints[ $left++ ]; + $total += $ints[ ++$right ]; + $max = $total if $total > $max; + } + + return $max / $n; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $ints-str, $n, $expected) = $line.split: / \| /; + + for $test-name, $ints-str, $n, $expected + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Int @ints = $ints-str.split( / \s+ /, :skip-empty ).map: { .Int }; + my Rat $max-avg = find-max-average( @ints, $n.Int ); + + is $max-avg, $expected.Rat, $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|1 12 -5 -6 50 3|4|12.75 + Example 2|5 |1| 5 + Repeating|1 -1 1 |3| 0.333333 + END +} + +################################################################################ -- cgit