Perl Weekly Challenge 236.

My solutions (task 1 and task 2 ) to the The 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

I guess that serving clients with small bills first and with larger bills later, and getting rid of large bills as fast as possible would be a reasonable strategy. The result fits a two-liner

Example 1:

perl  -E '
@i=sort {$a<=>$b} @ARGV; $s=1; for(@i){++$b{$_}; $o=$_-5; for(10,5){$o-=$_, --$b{$_}
while $o>=$_ && $b{$_}} $s&&=!$o} say "@ARGV -> ", $s?"true":"false";
' 5 5 5 10 20

Results:

5 5 5 10 20 5 -> true

Example 2:

perl  -E '
@i=sort {$a<=>$b} @ARGV; $s=1; for(@i){++$b{$_}; $o=$_-5; for(10,5){$o-=$_, --$b{$_}
while $o>=$_ && $b{$_}} $s&&=!$o} say "@ARGV -> ", $s?"true":"false";
' 5 5 10 10 20

Results:

5 5 10 10 20 -> false

Example 3:

perl  -E '
@i=sort {$a<=>$b} @ARGV; $s=1; for(@i){++$b{$_}; $o=$_-5; for(10,5){$o-=$_, --$b{$_}
while $o>=$_ && $b{$_}} $s&&=!$o} say "@ARGV -> ", $s?"true":"false";
' 5 5 5 20

Results:

5 5 5 20 -> true

Another example:

perl  -E '
@i=sort {$a<=>$b} @ARGV; $s=1; for(@i){++$b{$_}; $o=$_-5; for(10,5){$o-=$_, --$b{$_}
while($o>=$_ && $b{$_})} $s&&=!$o} say "@ARGV -> ", $s?"true":"false";
' 5 5 5 10 20

Results:

5 5 5 10 20 -> true

Notice that this example would have failed if we gave back 5 dollar bills before 10 dollar bills:

perl  -E '
@i=sort {$a<=>$b} @ARGV; $s=1; for(@i){++$b{$_}; $o=$_-5; for(5,10){$o-=$_, --$b{$_}
while($o>=$_ && $b{$_})} $s&&=!$o} say "@ARGV -> ", $s?"true":"false";
' 5 5 5 10 20

Wrong result:

5 5 5 10 20 -> false

When the 20 bill came in the program above gave two 5 bills change and then there was only a 10 bill left, which was too large. Thus, the reason for the order in the for(10,5) code.

The full code is similar.

 1  # Perl weekly challenge 236
 2  # Task 1: Exact Change
 3  #
 4  # See https://wlmb.github.io/2023/09/24/PWC236/#task-1-exact-change
 5  use v5.36;
 6  die <<~"FIN" unless @ARGV;
 7      Usage: $0 B1 [B2...]
 8      to see if you can sell $5 juice taking bills B1, B2... and giving
 9      exact change.
10      FIN
11  my  @sorted_input=sort {$a<=>$b} @ARGV;
12  my $success=1;
13  my %cash_box;
14  my $remaining_change;
15  for(@sorted_input){
16      ++$cash_box{$_};
17      $remaining_change=$_-5;
18      for(10,5){
19          $remaining_change-=$_, --$cash_box{$_}
20  	    while $remaining_change>=$_ && $cash_box{$_};
21      }
22      $success &&= !$remaining_change;
23  }
24  say "@ARGV -> ", $success?"true":"false";
25  
26  

Examples:

./ch-1.pl 5 5 5 10 20 5
./ch-1.pl 5 5 10 10 20
./ch-1.pl 5 5 5 20
./ch-1.pl 5 5 5 10 20
./ch-1.pl 20 10 5 5 5

Results:

5 5 5 10 20 5 -> true
5 5 10 10 20 -> false
5 5 5 20 -> true
5 5 5 10 20 -> true
20 10 5 5 5 -> true

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]

To solve this task, for each element of the array I try to start a loop. If I return to this element, I count a success. If I visit any element previously visited or if I find an out-of bounds index, I end this loop and search the next. This fits a one liner.

Example 1:

perl -E '
@i=@ARGV;for(0..@i-1){$s[$n=$_]++; 1 while 0<=$n<@i && !$s[$n=$i[$n]]++;  ++$c if $n==$_;} say "@ARGV -> $c";
' 4 6 3 8 15 0 13 18 7 16 14 19 17 5 11 1 12 2 9 10

Results:

4 6 3 8 15 0 13 18 7 16 14 19 17 5 11 1 12 2 9 10 -> 3

Example 2:

perl -E '
@i=@ARGV;for(0..@i-1){$s[$n=$_]++; 1 while 0<=$n<@i && !$s[$n=$i[$n]]++;  ++$c if $n==$_;} say "@ARGV -> $c";
' 0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3 18 15 19

Results:

0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3 18 15 19 -> 6

Example 3:

perl -E '
@i=@ARGV;for(0..@i-1){$s[$n=$_]++; 1 while 0<=$n<@i && !$s[$n=$i[$n]]++;  ++$c if $n==$_;} say "@ARGV -> $c";
' 9 8 3 11 5 7 13 19 12 4 14 10 18 2 16 1 0 15 6 17

Results:

9 8 3 11 5 7 13 19 12 4 14 10 18 2 16 1 0 15 6 17 -> 1

The full code is similar.

 1  # Perl weekly challenge 236
 2  # Task 2:  Array Loops
 3  #
 4  # See https://wlmb.github.io/2023/09/24/PWC236/#task-2-array-loops
 5  use v5.36;
 6  my @in=@ARGV;
 7  my @seen;
 8  my $count=0;
 9  for(0..@in-1){ #for each possible starting index
10      $seen[my $next=$_]++;
11      1 while 0<=$next <@in && !$seen[$next=$in[$next]]++;
12      ++$count if $next==$_;
13  }
14  say "@in -> $count";

Example:

./ch-2.pl 4 6 3 8 15 0 13 18 7 16 14 19 17 5 11 1 12 2 9 10
./ch-2.pl 0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3 18 15 19
./ch-2.pl 9 8 3 11 5 7 13 19 12 4 14 10 18 2 16 1 0 15 6 17

Results:

4 6 3 8 15 0 13 18 7 16 14 19 17 5 11 1 12 2 9 10 -> 3
0 1 13 7 6 8 10 11 2 14 16 4 12 9 17 5 3 18 15 19 -> 6
9 8 3 11 5 7 13 19 12 4 14 10 18 2 16 1 0 15 6 17 -> 1
Written on September 24, 2023