diff options
| author | Mohammad Sajid Anwar <Mohammad.Anwar@yahoo.com> | 2023-09-30 10:28:10 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2023-09-30 10:28:10 +0100 |
| commit | 8dbe2c2050f57666a4a8260b35d766a8d23613e6 (patch) | |
| tree | 7435e29b28fa0e7a96c6bd02e15c5cab3874baca | |
| parent | bd2c857a5cd67254eb283c51489ac1c88eb339f1 (diff) | |
| parent | 6496b947f2b9bd7f9df46aacec0ac7f859870a7b (diff) | |
| download | perlweeklychallenge-club-8dbe2c2050f57666a4a8260b35d766a8d23613e6.tar.gz perlweeklychallenge-club-8dbe2c2050f57666a4a8260b35d766a8d23613e6.tar.bz2 perlweeklychallenge-club-8dbe2c2050f57666a4a8260b35d766a8d23613e6.zip | |
Merge pull request #8779 from PerlMonk-Athanasius/branch-for-challenge-236
Perl & Raku solutions to Tasks 1 & 2 for Week 236
| -rw-r--r-- | challenge-236/athanasius/perl/ch-1.pl | 204 | ||||
| -rw-r--r-- | challenge-236/athanasius/perl/ch-2.pl | 249 | ||||
| -rw-r--r-- | challenge-236/athanasius/raku/ch-1.raku | 197 | ||||
| -rw-r--r-- | challenge-236/athanasius/raku/ch-2.raku | 234 |
4 files changed, 884 insertions, 0 deletions
diff --git a/challenge-236/athanasius/perl/ch-1.pl b/challenge-236/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..39c862f198 --- /dev/null +++ b/challenge-236/athanasius/perl/ch-1.pl @@ -0,0 +1,204 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 236 +========================= + +TASK #1 +------- +*Exact Change* + +Submitted by: Mohammad S Anwar + +You are asked to sell juice each costs $5. You are given an array of bills. You +can only sell ONE juice to each customer but make sure you return exact change +back. You only have $5, $10 and $20 notes. You do not have any change in hand at +first. + +Write a script to find out if it is possible to sell to each customers with +correct change. + +Example 1 + + Input: @bills = (5, 5, 5, 10, 20) + Output: true + + From the first 3 customers, we collect three $5 bills in order. + From the fourth customer, we collect a $10 bill and give back a $5. + From the fifth customer, we give a $10 bill and a $5 bill. + Since all customers got correct change, we output true. + +Example 2 + + Input: @bills = (5, 5, 10, 10, 20) + Output: false + + From the first two customers in order, we collect two $5 bills. + For the next two customers in order, we collect a $10 bill and give back a $5 + bill. + For the last customer, we can not give the change of $15 back because we only + have two $10 bills. + Since not every customer received the correct change, the answer is false. + +Example 3 + + Input: @bills = (5, 5, 5, 20) + Output: true + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +=cut +#=============================================================================== + +use v5.32.1; +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); +use Test::More; + +const my $USAGE => +"Usage: + perl $0 [<bills> ...] + perl $0 + + [<bills> ...] A list of bills: \$5, \$10, and \$20 only\n"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 236, Task #1: Exact Change (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my $bills = parse_command_line(); + + printf "Input: \@bills = (%s)\n", join ', ', @$bills; + + my $can_give_change = give_change( $bills ); + + printf "Output: %s\n", $can_give_change ? 'True' : 'False'; + } +} + +#------------------------------------------------------------------------------- +sub give_change +#------------------------------------------------------------------------------- +{ + my ($bills) = @_; + my %cash_in_hand = (5 => 0, 10 => 0, 20 => 0); + + for my $bill (@$bills) + { + ++$cash_in_hand{ $bill }; + + if ($bill == 10) # $5 change due + { + return 0 if $cash_in_hand{ 5 } == 0; + + --$cash_in_hand{ 5 }; + } + elsif ($bill == 20) # $15 change due + { + if ($cash_in_hand{ 10 } >= 1 && + $cash_in_hand{ 5 } >= 1) + { + --$cash_in_hand{ 10 }; + --$cash_in_hand{ 5 }; + } + elsif ($cash_in_hand{ 5 } >= 3) + { + $cash_in_hand{ 5 } -= 3; + } + else + { + return 0; + } + } + } + + return 1; +} + +#------------------------------------------------------------------------------- +sub parse_command_line +#------------------------------------------------------------------------------- +{ + for (@ARGV) + { + / ^ $RE{num}{int} $ /x + or error( qq["$_" is not a valid integer] ); + + $_ == 5 || $_ == 10 || $_ == 20 + or error( qq["$_" is not a valid note denomination]); + } + + return \@ARGV; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = <DATA>) + { + chomp $line; + + my ($test_name, $bills_str, $expected) = split / \| /x, $line; + + for ($test_name, $bills_str, $expected) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @bills = split / \s+ /x, $bills_str; + my $can_give_change = give_change( \@bills ) ? 'True' : 'False'; + + is $can_give_change, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|5 5 5 10 20|True +Example 2|5 5 10 10 20|False +Example 3|5 5 5 20 |True diff --git a/challenge-236/athanasius/perl/ch-2.pl b/challenge-236/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..cc033fbbe3 --- /dev/null +++ b/challenge-236/athanasius/perl/ch-2.pl @@ -0,0 +1,249 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 236 +========================= + +TASK #2 +------- +*Array Loops* + +Submitted by: Mark Anderson + +You are given an array of unique integers. + +Write a script to determine how many loops are in the given array. + + To determine a loop: Start at an index and take the number at array[index] + and then proceed to that index and continue this until you end up at the + starting index. + +Example 1 + + Input: @ints = (4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10) + Output: 3 + + To determine the 1st loop, start at index 0, the number at that index is 4, + proceed to index 4, the number at that index is 15, proceed to index 15 and so + on until you're back at index 0. + + Loops are as below: + [4 15 1 6 13 5 0] + [3 8 7 18 9 16 12 17 2] + [14 11 19 10] + +Example 2 + + Input: @ints = (0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3,18,15,19) + Output: 6 + + Loops are as below: + [0] + [1] + [13 9 14 17 18 15 5 8 2] + [7 11 4 6 10 16 3] + [12] + [19] + +Example 3 + + Input: @ints = (9,8,3,11,5,7,13,19,12,4,14,10,18,2,16,1,0,15,6,17) + Output: 1 + + Loop is as below: + [9 4 5 7 19 17 15 1 8 12 18 6 13 2 3 11 10 14 16 0] + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Assumption +---------- +The contents of the input array are the valid indices for that array (in any +order). Therefore: +1. The minimum array value is 0. +2. For an array of n elements, the maximum array value is (n - 1). +3. Since the array values are unique, each valid index is included in the input + array exactly once. + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. If VERBOSE is set to a true value (the default), the output is followed by + details of the loops found. + +=cut +#=============================================================================== + +use v5.32.1; +use warnings; +use Const::Fast; +use List::Util qw( max min uniqint ); +use Regexp::Common qw( number ); +use Test::More; + +const my $FALSE => 0; +const my $TRUE => 1; +const my $VERBOSE => $TRUE; +const my $USAGE => +"Usage: + perl $0 [<ints> ...] + perl $0 + + [<ints> ...] A non-empty list of all valid array indices in any order\n"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 236, Task #2: Array Loops (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my $ints = parse_command_line(); + + printf "Input: \@ints = (%s)\n", join ',', @$ints; + + my $loops = find_loops( $ints ); + my $count = scalar @$loops; + + print "Output: $count\n"; + + if ($VERBOSE) + { + printf "\nLoop%s as below:\n", $count == 1 ? ' is' : 's are'; + printf "[%s]\n", join ' ', @$_ for @$loops; + } + } +} + +#------------------------------------------------------------------------------- +sub find_loops +#------------------------------------------------------------------------------- +{ + my ($ints) = @_; + my @loops; + my @found = ($FALSE) x scalar @$ints; + + for my $i (0 .. $#$ints) + { + next if $found[ $i ]; + + my $start = $ints->[ $i ]; + my @loop = $start; + my $last = $start; + my $next = -1; + + $found[ $start ] = 1; + + while ($TRUE) + { + $next = $ints->[ $last ]; + + last if $next == $start; + + push @loop, $next; + + $found[ $next ] = $TRUE; + + $last = $next; + } + + push @loops, [ @loop ]; + } + + return \@loops; +} + +#------------------------------------------------------------------------------- +sub parse_command_line +#------------------------------------------------------------------------------- +{ + / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] ) + for @ARGV; + + my $min = min @ARGV; + my $max = max @ARGV; + + $min == 0 or error( qq[Minimum is "$min", should be 0] ); + $max == $#ARGV or error( qq[Maximum is "$max", should be $#ARGV] ); + + scalar @ARGV == scalar uniqint @ARGV + or error( qq[Duplicate found] ); + + return \@ARGV; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = <DATA>) + { + chomp $line; + + my ($test_name, $ints_str) = split / \| /x, $line; + + $line = <DATA>; + + my @exp_strs = split / \| /x, $line; + + for ($test_name, $ints_str, @exp_strs) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @ints = split / \s+ /x, $ints_str; + my $loops = find_loops( \@ints ); + my @expected; + + for my $exp_str (@exp_strs) + { + push @expected, [ split / \s+ /x, $exp_str ]; + } + + is_deeply $loops, \@expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|4 6 3 8 15 0 13 18 7 16 14 19 17 5 11 1 12 2 9 10 + 4 15 1 6 13 5 0| 3 8 7 18 9 16 12 17 2|14 11 19 10 +Example 2|0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3 18 15 19 + 0| 1|13 9 14 17 18 15 5 8 2| 7 11 4 6 10 16 3|12|19 +Example 3|9 8 3 11 5 7 13 19 12 4 14 10 18 2 16 1 0 15 6 17 + 9 4 5 7 19 17 15 1 8 12 18 6 13 2 3 11 10 14 16 0 diff --git a/challenge-236/athanasius/raku/ch-1.raku b/challenge-236/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..1a5a2365ac --- /dev/null +++ b/challenge-236/athanasius/raku/ch-1.raku @@ -0,0 +1,197 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 236 +========================= + +TASK #1 +------- +*Exact Change* + +Submitted by: Mohammad S Anwar + +You are asked to sell juice each costs $5. You are given an array of bills. You +can only sell ONE juice to each customer but make sure you return exact change +back. You only have $5, $10 and $20 notes. You do not have any change in hand at +first. + +Write a script to find out if it is possible to sell to each customers with +correct change. + +Example 1 + + Input: @bills = (5, 5, 5, 10, 20) + Output: true + + From the first 3 customers, we collect three $5 bills in order. + From the fourth customer, we collect a $10 bill and give back a $5. + From the fifth customer, we give a $10 bill and a $5 bill. + Since all customers got correct change, we output true. + +Example 2 + + Input: @bills = (5, 5, 10, 10, 20) + Output: false + + From the first two customers in order, we collect two $5 bills. + For the next two customers in order, we collect a $10 bill and give back a $5 + bill. + For the last customer, we can not give the change of $15 back because we only + have two $10 bills. + Since not every customer received the correct change, the answer is false. + +Example 3 + + Input: @bills = (5, 5, 5, 20) + Output: true + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +=end comment +#=============================================================================== + +use Test; + +subset Bill of Int where * ~~ 5 | 10 | 20; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 236, Task #1: Exact Change (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + #| A list of bills: $5, $10, and $20 only + + *@bills where { .elems > 0 && .all ~~ Bill:D } +) +#=============================================================================== +{ + "Input: \@bills = (%s)\n".printf: @bills.join: ', '; + + my Bool $can-give-change = give-change( @bills ); + + "Output: %s\n".printf: $can-give-change ?? 'True' !! 'False'; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub give-change( List:D[Bill:D] $bills --> Bool:D ) +#------------------------------------------------------------------------------- +{ + my UInt %cash-in-hand{Bill} = 5 => 0, 10 => 0, 20 => 0; + + for @$bills -> Bill $bill + { + ++%cash-in-hand{ $bill.Int }; + + if $bill == 10 # $5 change due + { + return False if %cash-in-hand{ 5 } == 0; + + --%cash-in-hand{ 5 }; + } + elsif $bill == 20 # $15 change due + { + if %cash-in-hand{ 10 } >= 1 && + %cash-in-hand{ 5 } >= 1 + { + --%cash-in-hand{ 10 }; + --%cash-in-hand{ 5 }; + } + elsif %cash-in-hand{ 5 } >= 3 + { + %cash-in-hand{ 5 } -= 3; + } + else + { + return False; + } + } + } + + return True; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $bills-str, $expected) = $line.split: / \| /; + + for $test-name, $bills-str, $expected + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Bill @bills = $bills-str.split( / \s+ / ).map: { .Int }; + my Str $can-give-change = give-change( @bills ) ?? 'True' !! 'False'; + + is $can-give-change, $expected, $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|5 5 5 10 20|True + Example 2|5 5 10 10 20|False + Example 3|5 5 5 20 |True + END +} + +################################################################################ diff --git a/challenge-236/athanasius/raku/ch-2.raku b/challenge-236/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..a5c201b395 --- /dev/null +++ b/challenge-236/athanasius/raku/ch-2.raku @@ -0,0 +1,234 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 236 +========================= + +TASK #2 +------- +*Array Loops* + +Submitted by: Mark Anderson + +You are given an array of unique integers. + +Write a script to determine how many loops are in the given array. + + To determine a loop: Start at an index and take the number at array[index] + and then proceed to that index and continue this until you end up at the + starting index. + +Example 1 + + Input: @ints = (4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10) + Output: 3 + + To determine the 1st loop, start at index 0, the number at that index is 4, + proceed to index 4, the number at that index is 15, proceed to index 15 and so + on until you're back at index 0. + + Loops are as below: + [4 15 1 6 13 5 0] + [3 8 7 18 9 16 12 17 2] + [14 11 19 10] + +Example 2 + + Input: @ints = (0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3,18,15,19) + Output: 6 + + Loops are as below: + [0] + [1] + [13 9 14 17 18 15 5 8 2] + [7 11 4 6 10 16 3] + [12] + [19] + +Example 3 + + Input: @ints = (9,8,3,11,5,7,13,19,12,4,14,10,18,2,16,1,0,15,6,17) + Output: 1 + + Loop is as below: + [9 4 5 7 19 17 15 1 8 12 18 6 13 2 3 11 10 14 16 0] + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Assumption +---------- +The contents of the input array are the valid indices for that array (in any +order). Therefore: +1. The minimum array value is 0. +2. For an array of n elements, the maximum array value is (n - 1). +3. Since the array values are unique, each valid index is included in the input + array exactly once. + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. If VERBOSE is set to True (the default), the output is followed by details of + the loops found. + +=end comment +#=============================================================================== + +use Test; + +my Bool constant VERBOSE = True; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 236, Task #2: Array Loops (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + #| A non-empty list of all valid array indices in any order + + *@ints where { .elems > 0 && .all ~~ UInt:D && + .min == 0 && .max == .end && .elems == .unique.elems } +) +#=============================================================================== +{ + "Input: \@ints = (%s)\n".printf: @ints.join: ','; + + my Array[UInt] @loops = find-loops( @ints ); + my UInt $count = @loops.elems; + + "Output: $count".put; + + if VERBOSE + { + "\nLoop%s as below:\n".printf: $count == 1 ?? ' is' !! 's are'; + "[%s]\n"\ .printf: .join: ' ' for @loops; + } +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub find-loops( List:D[UInt:D] $ints --> List:D[List:D[UInt:D]] ) +#------------------------------------------------------------------------------- +{ + my Array[UInt] @loops; + my Bool @found = False xx $ints.elems; + + for 0 .. $ints.end -> UInt $i + { + next if @found[ $i ]; + + my UInt $start = $ints[ $i ]; + @found[ $start ] = True; + my UInt @loop = $start; + my UInt $last = $start; + my Int $next = -1; + + loop + { + $next = $ints[ $last ]; + + last if $next == $start; + + @loop.push: $next; + @found[ $next ] = True; + $last = $next; + } + + @loops.push: @loop; + } + + return @loops; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $ints-str, @exp-strs) = $line.split: / \| /; + + for $test-name, $ints-str, |@exp-strs + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my UInt @ints = $ints-str.split( / \s+ / ).map: { .Int }; + my Array[UInt] @loops = find-loops( @ints ); + my Array[UInt] @expected; + + for @exp-strs -> Str $exp-str + { + @expected.push: + Array[UInt].new: $exp-str.split( / \s+ / ).map: { .Int }; + } + + is-deeply @loops, @expected, $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 ) +#------------------------------------------------------------------------------- +{ + my Str $data =q:to/END/; + Example 1|4 6 3 8 15 0 13 18 7 16 14 19 17 5 11 1 12 2 9 10 \ + |4 15 1 6 13 5 0| 3 8 7 18 9 16 12 17 2|14 11 19 10 + Example 2|0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3 18 15 19 \ + |0| 1|13 9 14 17 18 15 5 8 2| 7 11 4 6 10 16 3|12|19 + Example 3|9 8 3 11 5 7 13 19 12 4 14 10 18 2 16 1 0 15 6 17 \ + |9 4 5 7 19 17 15 1 8 12 18 6 13 2 3 11 10 14 16 0 + END + + $data ~~ s:g/ \\ \n //; + + return $data; +} + +################################################################################ |
