DAJ 236 no-blog

2 files changed, 118 insertions, 0 deletions

diff --git a/challenge-236/dave-jacoby/perl/ch-1.pl b/challenge-236/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..7d2163e399
--- /dev/null
+++ b/challenge-236/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,64 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::MoreUtils qw( first_index );
+use List::Util      qw( sum0 );
+
+my @examples = (
+
+    [ 5, 5, 5,  10, 20 ],
+    [ 5, 5, 10, 10, 20 ],
+    [ 5, 5, 5,  20 ],
+);
+
+for my $e (@examples) {
+    my @ints   = $e->@*;
+    my $ints   = join ', ', @ints;
+    my $output = exact_change(@ints) ? 'true' : 'false';
+    say <<~"END";
+    Input:  \@ints = ($ints)
+    Output: $output
+    END
+}
+
+sub exact_change (@transactions) {
+    my @till;
+    my $till = 0;
+T: for my $t (@transactions) {
+        my $change = $t - 5;
+        $till += 5;
+        push @till, $t;
+        if ($change) {
+            my @bills = has_change( $change, \@till, [] );
+            my $bills = sum0 @bills;
+            return 0 if $change != $bills;
+            for my $b (@bills) {
+                my $fi = first_index { $_ == $b } @till;
+                delete $till[$fi];
+                @till = grep { defined } @till;
+            }
+        }
+    }
+    return 1;
+}
+
+sub has_change ( $change, $till, $values = [] ) {
+    my @till = sort { $b <=> $a } $till->@*;    # sort big to small, big bills first
+    my $sum  = sum0 $values->@*;
+    return             if $sum > $change;   # too much change
+    return             if !scalar @till;    # not enough in till
+    return $values->@* if $sum == $change;  # exactly right
+    for my $i ( 0 .. -1 + scalar @till ) {  # 
+        my @copy = $values->@*;
+        my $v    = shift @till;
+        push @copy, $v;
+        my @out = has_change( $change, \@till, \@copy );
+        my $val = sum0 @out;
+        return @out if $val == $change;
+        push @till, $v;
+    }
+    return;
+}
diff --git a/challenge-236/dave-jacoby/perl/ch-2.pl b/challenge-236/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..5bbc57eb5c
--- /dev/null
+++ b/challenge-236/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Util qw{ uniq };
+
+my @examples = (
+
+    [ 4, 6, 3,  8, 15, 0, 13, 18, 7, 16, 14, 19, 17, 5, 11, 1, 12, 2, 9, 10 ],
+    [ 0, 1, 13, 7, 6,  8, 10, 11, 2, 14, 16, 4, 12, 9, 17, 5, 3, 18, 15, 19 ],
+    [ 9, 8, 3,  11, 5, 7, 13, 19, 12, 4, 14, 10, 18, 2, 16, 1, 0, 15, 6, 17 ],
+);
+
+for my $e (@examples) {
+    my @ints   = $e->@*;
+    my $ints   = join ', ', @ints;
+    my $output = find_loops( \@ints );
+    say <<~"END";
+    Input:  \@ints = 
+        ($ints)
+    Output: $output
+    END
+}
+
+sub find_loops ($ints) {
+    my $output = 0;
+    my %no_go;
+    for my $i ( 0 .. -1 + scalar $ints->@* ) {
+        my $v = $ints->[$i];
+        next if $no_go{$v};
+        my @loop = ($v);
+        my $loop = traverse_loop( $ints, \@loop );
+        if ( $loop == -1 ) { }
+        if ( scalar $loop->@* ) {
+            # say qq{has_loop: }. join ', ', $loop->@*;
+            map { $no_go{$_} = 1 } $loop->@*;
+            $output++;
+        }
+    }
+    return $output;
+}
+
+sub traverse_loop ( $ints, $loop ) {
+    my $first = $loop->[0];
+    my $last  = $loop->[-1];
+    my $next  = $ints->[$last];
+    if ( scalar $loop->@* > scalar $ints->@* ) { return -1 }
+    if ( $next == $first )                     { return $loop }
+    my $copy->@* = $loop->@*;
+    push $copy->@*, $next;
+    return traverse_loop( $ints, $copy );
+}