DAJ 285

2 files changed, 129 insertions, 0 deletions

diff --git a/challenge-285/dave-jacoby/perl/ch-1.pl b/challenge-285/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..c5bb9d277f
--- /dev/null
+++ b/challenge-285/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ postderef say signatures state };
+
+use List::Util qw{ uniq };
+
+my @examples = (    # added a couple test entries
+
+    [ [ 'B', 'C' ], [ 'D', 'B' ], [ 'C', 'A' ] ],
+    [ [ 'A', 'Z' ] ],
+
+);
+
+for my $example (@examples) {
+    my $routes = join ', ', map { qq{[$_]} }
+        map {
+        join ',',
+            map { qq{"$_"} }
+            $_->@*
+        } $example->@*;
+    my $output = no_connection($example);
+    say <<"END";
+    Input:  \@routes = ($routes)
+    Output: "$output"
+END
+}
+
+sub no_connection ($input) {
+    my %routes;
+    map { $routes{ $_->[0] } = $_->[1] } $input->@*;
+    for my $k ( keys %routes ) {
+        no warnings;
+        if ( defined $routes{ $routes{$k} } ) {
+            my $v  = $routes{$k};
+            my $vv = $routes{$v};
+            $routes{$k} = $vv;
+            delete $routes{$v};
+        }
+    }
+    my ($k) = keys %routes;
+    return $routes{$k};
+}
diff --git a/challenge-285/dave-jacoby/perl/ch-2.pl b/challenge-285/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..bc9fd77bed
--- /dev/null
+++ b/challenge-285/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,85 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say state postderef signatures };
+
+use List::Util qw{ uniq };
+use Getopt::Long;
+
+my $change;
+my $verbose=0;
+my %done;
+GetOptions( 
+    "change=i" => \$change, 
+    "verbose" => \$verbose,
+    );
+if ( defined $change ) {
+    my @output = make_change($change);
+    my $output = scalar @output;
+    %done = ();
+    say <<"END";
+    Input:  \$amount = $change
+    Output: $output
+END
+    say join "\n\t", 'OUTPUT',@output if $verbose;
+    exit;
+}
+
+my @examples = ( 9, 15, 25, 50, 55, 99, 100, 256 );
+
+for my $example (@examples) {
+    %done = ();
+    my @output = make_change($example);
+    my $output = scalar @output;
+    say <<"END";
+    Input:  \$amount = $example
+    Output: $output
+END
+    say join "\n\t", 'OUTPUT',@output if $verbose;
+}
+
+sub make_change ( $amount, $so_far = [] ) {
+    my %change = (
+        P  => 1,
+        N  => 5,
+        D  => 10,
+        Q  => 25,
+        HD => 50,
+    );
+
+    if ( $amount < 0 ) {
+        return;
+    }
+    if ( $amount == 0 ) {
+        state $h = {};
+        my $solution = format_solution( $so_far->@* );
+        $h->{$solution} ++;
+        # say qq{$solution ($h->{$solution})} if $verbose;
+        return $solution;
+    }
+    my @output;
+    for my $c ( sort { $change{$b} <=> $change{$a} } keys %change ) {
+        no warnings 'recursion';
+        my $value = $change{$c};
+        next unless $amount >= $value;
+        my $local = [];
+        push $local->@*, $so_far->@*, $c;
+        my $format = format_solution( @$local );
+        next if $done{$format}++;
+        push @output, make_change( $amount - $value, $local );
+        @output = uniq @output;
+    }
+    return @output;
+}
+
+sub format_solution(@array) {
+    my @output;
+    for my $l (qw{ HD Q D N P }) {
+        my $c = scalar grep { $l eq $_ } @array;
+        @array = grep { $l ne $_ } @array;
+        if ( $c > 1 )  { push @output, $c . $l }
+        if ( $c == 1 ) { push @output, $l }
+    }
+    return join ' + ', @output;
+}