An Unrelated Blog Title, but ...

3 files changed, 177 insertions, 0 deletions

diff --git a/challenge-151/dave-jacoby/blog.txt b/challenge-151/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..b54afc3fad
--- /dev/null
+++ b/challenge-151/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2022/02/07/dr-metropolis-and-his-amazing-maniac-machine-the-weekly-challenge-151.html
diff --git a/challenge-151/dave-jacoby/perl/ch-1.pl b/challenge-151/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..a8f09e7582
--- /dev/null
+++ b/challenge-151/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,127 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+my @input;
+push @input, '1 | 2 3 | 4 5';
+push @input, '1 | 2 3 | 4 * * 5 | * 6';
+push @input, '1 | 3 5 | 7 9 11';
+push @input, '1 | 2 | 3 | 4 | 5 6 | * * 7 | * * * * 8';
+push @input, '1 | 2 | 3 | 4 | 5 6 | * * 7 | * * * * * * 8';
+push @input, '1 | 2 | 3 | 4 | 5 | 6 | 7 | 8';
+
+for my $i (@input) {
+    my $depth = make_tree($i);
+    say <<"END";
+    Input:  '$i'
+    Output: $depth
+END
+}
+
+sub make_tree( $input ) {
+    my @rows;
+    my $e = 0;
+
+    my @input = split m{\s*\|\s*}, $input;    # basis for all the rows
+    my %nodes =
+        map { $_ => Node->new($_) }
+        grep { /\d+/ } split m{\D}, $input;    # create all the nodes
+
+    # here's where the tree is made
+    for my $r (@input) {
+        my $w   = -1 + 2**$e;
+        my @i   = split /\s+/, $r;
+        my @row = map { $i[$_] || '*' } 0 .. $w;
+        push @rows, \@row;
+        for my $n ( 0 .. $w ) {
+            my $val  = $row[$n];
+            my $node = $nodes{$val};
+            my $lr   = $n % 2;
+            my $p    = ' ';
+            my $u    = ' ';
+            if ( $e > 0 ) { $u = int( $n / 2 ); $p = $rows[ $e - 1 ][$u]; }
+            my $parent = $nodes{$p};
+            if ( defined $node && defined $parent ) {
+                my $v = $node->value;
+                if   ($lr) { $nodes{$p}->left( $nodes{$v} ); }
+                else       { $nodes{$p}->right( $nodes{$v} ); }
+            }
+        }
+        $e++;
+    }
+
+    my @o =                         # REMEMBER, READ THIS BACK TO FRONT
+        sort { $a <=> $b }          # sort low to high
+        map  { 1 + node_depth($_) } # 1 + node_depth = number of nodes involved 
+        grep { ! $_->is_root }      # each node is not a root
+        grep { $_->is_leaf }        # each node is a leaf
+        map  { $nodes{$_} }         # turn it into nodes
+        keys %nodes;                # the keys to the nodes
+    return $o[0]; # and we pull the first one, which should be 
+}
+
+sub node_depth ( $node ) {
+    my $d = 0;
+    while ( !$node->is_root ) {
+        $d++;
+        $node = $node->parent;
+    }
+    return $d;
+}
+
+package Node;
+
+sub new ( $class, $value = 0 ) {
+    my $self = {};
+    $self->{value}  = $value;
+    $self->{left}   = undef;
+    $self->{right}  = undef;
+    $self->{parent} = undef;
+    return bless $self, $class;
+}
+
+sub value ( $self, $value = undef ) {
+    if ( defined $value ) {
+        $self->{value} = $value;
+    }
+    else {
+        return $self->{value};
+    }
+}
+
+sub is_root ( $self ) {
+    return defined $self->{parent} ? 0 : 1;
+}
+
+sub is_leaf ( $self ) {
+    return ( !defined $self->{left} && !defined $self->{right} )
+        ? 1
+        : 0;
+}
+
+sub left ( $self, $node = undef ) {
+    if ( defined $node ) {
+        $self->{left}   = $node;
+        $node->{parent} = $self;
+    }
+    else {
+        return $self->{left};
+    }
+}
+
+sub right ( $self, $node = undef ) {
+    if ( defined $node ) {
+        $self->{right}  = $node;
+        $node->{parent} = $self;
+    }
+    else {
+        return $self->{right};
+    }
+}
+
+sub parent ($self ) {
+    return $self->{parent};
+}
diff --git a/challenge-151/dave-jacoby/perl/ch-2.pl b/challenge-151/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..d2d40f0928
--- /dev/null
+++ b/challenge-151/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+use List::Util qw{ sum0 };
+
+my @blocks;
+push @blocks, [ 2, 4, 5 ];
+push @blocks, [ 4, 2, 3, 6, 5, 3 ];
+push @blocks, [ 6, 7, 0, 1, 1, 5, 0, 2, 0, 4 ];
+
+for my $block (@blocks) {
+    my ( $value, $list ) = plan_robberies($block);
+}
+
+sub plan_robberies( $block ) {
+    my $b = join ', ', @$block;
+    my @x = _plan($block);
+    say <<"END";
+        Input:  ($b)
+        Output: $x[0][0]
+                $x[0][1]
+END
+}
+
+sub _plan ( $block, $index = 0, $list = '' ) {
+    my @output;
+    if ( !defined $block->[$index] ) {
+        my $sum = _score( $block, $list );
+        return [ $sum, $list ];
+    }
+
+    # don't include this value
+    push @output, _plan( $block, $index + 1, $list );
+
+    # include this value
+    push @output,
+        _plan( $block, $index + 2, join ', ', grep { /\d/ } $list, $index );
+
+    @output = sort { $b->[0] <=> $a->[0] } @output;
+    return @output;
+}
+
+sub _score ( $block, $list ) {
+    return sum0 map { $block->[$_] } grep { /\d/ } split /\D+/, $list;
+}