Challenge-236 - "Exact Change" and "Count Loops"

Exact Change - use a simple algorithm to manage the wallet.
The problem description makes it seem like there might be a need
to recursively try multiple solutions, but in practice this is
not necessary.

Count Loops - I originally implemented this using a destructive
approach with a hash, but in my benchmarks this was slow and also
non-determinisitc, and making it deterministic would make it slower.
Using an array based approach seems like it would be worse, but
in practice, with randomly generated input data a pure array
approach was faster. *Shrug*

2 files changed, 130 insertions, 0 deletions

diff --git a/challenge-236/demerphq/perl/ch-1.pl b/challenge-236/demerphq/perl/ch-1.pl
new file mode 100644
index 0000000000..c2f939de46
--- /dev/null
+++ b/challenge-236/demerphq/perl/ch-1.pl
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+
+# You are asked to sell juice each costs $5. You are given an array of
+# notes. 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.
+#
+# NOTE: At first blush it might seem like we have to recursively handle
+#       $20 notes, as there may be two possible solutions, 10 + 5 or 5 +
+#       5 + 5. HOWEVER, it turns out that the 10 + 5 solution is always
+#       "correct" in this situation. With the current rules there are no
+#       situations where "saving" the $10 for later would help us
+#       complete a transaction, but there are situations where "saving"
+#       the $5 notes would help us complete a transaction. If there were
+#       other prices involved, or other denominations then the situation
+#       would be different.
+
+sub exact_change {
+    my ($notes) = @_;
+    my %wallet = ( 5 => 0, 10 => 0, 20 => 0 );
+
+    foreach my $bill (@$notes) {
+        die "Bad bill '$bill'" unless exists $wallet{$bill};
+        if ( $bill == 20 ) {
+            if ($wallet{10} and $wallet{5}) {
+                $wallet{10}--;
+                $wallet{5}--;
+            }
+            elsif ($wallet{5} >= 3) {
+                $wallet{5} -= 3;
+            }
+            else {
+                return 0;
+            }
+        }
+        elsif ( $bill == 10 ) {
+            $wallet{5}--
+                or return 0;
+        }
+        $wallet{$bill}++;
+    }
+    return 1;
+}
+
+use Test::More;
+foreach my $tuple (
+    [1,[5,5,5,10,20]],
+    [0,[5,5,10,10,20]],
+    [1,[5,5,5,20]],
+    [1,[5,5,5,5,10,20,10]],
+) {
+    my ($want, $notes)= @$tuple;
+    my $got = exact_change($notes);
+    is($got, $want, "exact_change(@$notes) == $want");
+}
+done_testing();
diff --git a/challenge-236/demerphq/perl/ch-2.pl b/challenge-236/demerphq/perl/ch-2.pl
new file mode 100644
index 0000000000..0707049027
--- /dev/null
+++ b/challenge-236/demerphq/perl/ch-2.pl
@@ -0,0 +1,70 @@
+use strict;
+use warnings;
+
+# 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.
+
+sub compute_index_loops {
+    my ($array) = @_;
+
+    # This implementation is deterministic, and is fast. It looks like
+    # it could scan @$array one less time than it contains loops,
+    # whereas an implementation using a hash might avoid this exact
+    # scan, but in practice it is about twice as fast as a hash based
+    # implementation. Yes this suprised me! For one thing, if the
+    # indexes are fairly shuffled then on average it will only have to
+    # inspect 1/2 of the indexes it contains. For another, looping over
+    # a few thousand elements is fast, so unless the array is very large
+    # and there are a huge number of loops this code is reasonably fast.
+
+    my @seen;
+    my @loops = [];
+    my $this = 0;
+    my $count = 0;
+    do {
+        while (!$seen[$this]++) {
+            $count++; # for sanity checking.
+            push @{$loops[-1]}, $this;
+            $this = $array->[$this];
+        }
+        $this = undef;
+        for my $i (0 .. $#$array) {
+            if (!$seen[$i]) {
+                $this = $i;
+                push @loops,[];
+                last;
+            }
+        }
+    } while defined $this;
+    if ($count != @$array) {
+        die "Duplicate index in array ($count,", 0+@$array,")\n";
+    }
+    pop @loops unless @{$loops[-1]};
+    return \@loops;
+}
+
+sub count_loops {
+    my $loops = compute_index_loops(@_);
+    return 0+@$loops;
+}
+
+use Test::More;
+foreach my $tuple (
+    [3,[(4,6,3,8,15,0,13,18,7,16,14,19,17,5,11,1,12,2,9,10)]],
+    [6,[(0,1,13,7,6,8,10,11,2,14,16,4,12,9,17,5,3,18,15,19)]],
+    [1,[(9,8,3,11,5,7,13,19,12,4,14,10,18,2,16,1,0,15,6,17)]],
+){
+    my ($want, $array) = @$tuple;
+    my $loops = compute_index_loops($array);
+    if ($ENV{VERBOSE}) {
+        print "Input: @$array\n";
+        printf "  %2d: %s\n", $_+1, join ", ", @{$loops->[$_]} for 0..$#$loops;
+    }
+    is(0+@$loops,$want,"Want $want from @$array");
+}
+done_testing;