RabbitFarm

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

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.

Solution

use v5.38;
use boolean;
use constant COST_JUICE => 5;

sub exact_change{
    my @bank;
    my $current_customer = shift;
    { 
        push @bank, $current_customer if $current_customer == COST_JUICE;
        if($current_customer > COST_JUICE){
            my $change_due = $current_customer - COST_JUICE;
            my @bank_sorted = sort {$a <=> $b} @bank;
            my @bank_reserved;
            {
                my $bill = pop @bank_sorted;
                push @bank_reserved, $bill if $change_due < $bill;
                $change_due -= $bill if $change_due >= $bill;
                redo if @bank_sorted;
            } 
            return false if $change_due != 0;
            @bank = @bank_reserved;
            push @bank, $current_customer;
        }
        $current_customer = shift; 
        redo if $current_customer;
    }
    return true;
}


MAIN:{
    say exact_change 5, 5, 5, 10, 20;
    say exact_change 5, 5, 10, 10, 20;
    say exact_change 5, 5, 5, 20;
}

Sample Run

$ perl perl/ch-1.pl 
1
0
1

Notes

Making change is easy as long as we preferentially use larger bills first. To do so all we need to do is sort any accumulated payments and then pop off the change as required by the current transaction, if possible.

Part 2

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.

Solution

use v5.38;
use boolean;
sub loop_counter{
    my @integers = @_;
    my @loops;
    do{
        my @loop;
        my $loop_found = false;
        my $start = $_;
        my $next = $integers[$start];
        push @loop, $start, $next;
        my $counter = 1;
        {
            if($next == $start){
                shift @loop;
                if(@loops == 0 || @loop == 2){
                    push @loops, \@loop;
                    my @loop;
                    $loop_found = true;
                }
                else{
                    my $loop_duplicate = false;
                    my @s0 = sort @loop;
                    do { 
                        my @s1 = sort @{$_};                        
                        $loop_duplicate = true if((@s0 == @s1) && (0 < grep {$s0[$_] == $s1[$_]} 0 .. @s0 - 1));
                    } for @loops;   
                    if(!$loop_duplicate){
                        $loop_found = true;
                        push @loops, \@loop;
                    }
                    else{
                        $counter = @integers + 1; 
                    }           
                }
            }
            else{
                $next = $integers[$next];
                push @loop, $next;   
                $counter++;     
            }
            redo unless $loop_found || $counter > @integers;
        }
    } for 0 .. @integers - 1; 
    return @loops + 0;
}

MAIN:{
    say loop_counter 4, 6, 3, 8, 15, 0, 13, 18, 7, 16, 14, 19, 17, 5, 11, 1, 12, 2, 9, 10;
    say loop_counter 0, 1, 13, 7, 6, 8, 10, 11, 2, 14, 16, 4, 12, 9, 17, 5, 3, 18, 15, 19;
    say loop_counter 9, 8, 3, 11, 5, 7, 13, 19, 12, 4, 14, 10, 18, 2, 16, 1, 0, 15, 6, 17;
}

Sample Run

$ perl perl/ch-2.pl 
3
6
1

Notes

When I first approached this problem I didn't appreciate that many loops are just cycles of each other. In those cases we need to identify if such cyclical duplicates exit. Much of the code here, then, is for examining such cases. The detection is done by comparing each loop to the existing loops, in sorted order. if there are any equivalents we know we have a duplicate.

The line shift @loop; is to remove to starting point, which is convenient to maintain up until storing in the @loops array.

References

Challenge 236