Merge pull request #7158 from jacoby/master

DAJ Challenge 192

2 files changed, 104 insertions, 0 deletions

diff --git a/challenge-192/dave-jacoby/perl/ch-1.pl b/challenge-192/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..dcb5e395ea
--- /dev/null
+++ b/challenge-192/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ fc say postderef signatures state };
+
+my @input = 1 .. 20;
+
+for my $i (@input) {
+    my $output = binary_flip($i);
+    say <<"END";
+        Input:  \$s = $i
+        Output: $output
+END
+}
+
+sub binary_flip ( $input ) {
+    my $pos = sprintf '%b', $input;
+    my $neg = '';
+    for my $i ( 0 .. -1 + length $pos ) {
+        my $p = substr( $pos, $i, 1 );
+        my $n = $p == 1 ? 0 : 1;
+        substr( $neg, $i, 1 ) = $n;
+    }
+    my $flip = bin2dec($neg);
+    # say join " ", $input, $pos, '', $neg, $flip;
+    return $flip;
+}
+
+# Perl Cookbook
+sub bin2dec {
+    return unpack( "N", pack( "B32", substr( "0" x 32 . shift, -32 ) ) );
+}
diff --git a/challenge-192/dave-jacoby/perl/ch-2.pl b/challenge-192/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..fd5c07500a
--- /dev/null
+++ b/challenge-192/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Util qw{ min sum };
+
+my @input = ( [ 1, 1, 1 ], [ 1, 0, 5 ], [ 0, 2, 0 ], [ 0, 3, 0 ], );
+
+for my $input (@input) {
+    my $list   = join ', ', $input->@*;
+    my $output = equal_distrib($input);
+    say <<"END";
+    Input:  \@list = ($list)
+    Output: $output
+END
+}
+
+sub equal_distrib ( $list, $level = 0, $steps = {} ) {
+    my @output;
+
+    # possible?
+    my $sum = sum $list->@*;
+    my $spaces = scalar $list->@*;
+    return -1 unless 0 == $sum % $spaces;
+
+    # test
+    my $c = 0;
+    for my $i ( 0 .. -1 + scalar $list->@* ) {
+        $c++ if $list->[$i] == $list->[0];
+    }
+    return $level if $c == scalar $list->@*;
+
+    # recurse
+    for my $i ( 0 .. -2 + scalar $list->@* ) {
+        for my $j ( 0 .. 1 ) {
+            my $step = join ',', $list->@*;
+            my %hash = $steps->%*;
+            return if $hash{$step}++;
+
+            if ($j) {    # move a digit up if possible
+                my @copy = $list->@*;
+                if ( $copy[$i] > 0 ) {
+                    $copy[$i]--;
+                    $copy[ $i + 1 ]++;
+                    my $out = equal_distrib( \@copy, $level + 1, \%hash );
+
+                    # say join ' ', '>', @copy, $out || 'BLANK';
+                    if ( defined $out ) {
+                        push @output, $out if $out > 0;
+                    }
+                }
+            }
+            else {    # move a digit down if possible
+                my @copy = $list->@*;
+                if ( $copy[ $i + 1 ] > 0 ) {
+                    $copy[$i]++;
+                    $copy[ $i + 1 ]--;
+                    my $out = equal_distrib( \@copy, $level + 1, \%hash );
+
+                    # say join ' ', '<', @copy, $out || 'BLANK';
+                    if ( defined $out ) {
+                        push @output, $out if $out > 0;
+                    }
+                }
+            }
+        }
+    }
+    return min @output;
+}