Solution!

4 files changed, 238 insertions, 0 deletions

diff --git a/challenge-117/dave-jacoby/blog.txt b/challenge-117/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..ccb925ce8f
--- /dev/null
+++ b/challenge-117/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/06/14/trees-and-rows-perl-weekly-challenge-117.html
diff --git a/challenge-117/dave-jacoby/perl/ch-1.pl b/challenge-117/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..90675d2ae0
--- /dev/null
+++ b/challenge-117/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+
+# use generate_files.pl to create test files
+# where the missing line number is _not_ 
+# _necessarily_ the same as the file number.
+
+use strict;
+use warnings;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental };
+
+use List::Util qw{ sum };
+
+for my $file (@ARGV) {
+    next unless -f $file;
+    my $row = missing_row($file);
+    say join "\t", $row, $file;
+}
+
+sub missing_row( $file ) {
+    if ( -f $file && open my $fh, '<', $file ) {
+        my @targets = map { $_ } 0 .. 15;
+        my @x       = map { chomp $_; $_ } <$fh>;
+        close $fh;
+        for my $l (@x) { my ($d) = split /,/, $l; $targets[$d] = 0; }
+        return sum @targets;
+    }
+    return 'none';
+}
diff --git a/challenge-117/dave-jacoby/perl/ch-2.pl b/challenge-117/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..186a66c4b0
--- /dev/null
+++ b/challenge-117/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,171 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental };
+
+# 1) make the triangle
+# 2) traverse the triangle
+
+use Carp;
+use Getopt::Long;
+
+my $n = 2;
+GetOptions( 'number=i' => \$n );
+croak 'Too Small' if $n < 0;
+
+my $tree  = make_triangle($n);
+my $start = $tree->[0][0];
+my $end   = $start;
+while ( $end->right ) {
+    $end = $end->right;
+}
+traverse_tree( $start, $end );
+
+my @output;
+
+sub traverse_tree ( $node, $end, $path = '' ) {
+    return unless $node;
+    my $value = $node->value;
+    my $ev    = $end->value();
+    if ( $value eq $ev ) {
+        push @output, $path;
+    }
+    my $l = $node->left;
+    my $r = $node->right;
+    my $h = $node->horizontal;
+    my $flag =
+           defined $l
+        || defined $r
+        || defined $h ? 1 : 0;
+    traverse_tree( $h, $end, $path . 'H' ) if defined $h;
+    traverse_tree( $l, $end, $path . 'L' ) if defined $l;
+    traverse_tree( $r, $end, $path . 'R' ) if defined $r;
+}
+
+say join " ", sort { length $a <=> length $b } @output;
+
+exit;
+
+sub test_tree( $tree ) {
+    say 'VALUE';
+    for my $i ( 0 .. -1 + scalar $tree->@* ) {
+        say join ' ', map { $_->value } $tree->[$i]->@*;
+    }
+    say 'LEFT';
+    for my $i ( 0 .. -1 + scalar $tree->@* ) {
+        say join ' ',
+            map { defined $_->left ? $_->left->value : 'LLL' }
+            $tree->[$i]->@*;
+    }
+    say 'RIGHT';
+    for my $i ( 0 .. -1 + scalar $tree->@* ) {
+        say join ' ',
+            map { defined $_->right ? $_->right->value : 'RRR' }
+            $tree->[$i]->@*;
+    }
+    say 'HORIZONTAL';
+    for my $i ( 0 .. -1 + scalar $tree->@* ) {
+        say join ' ',
+            map { defined $_->horizontal ? $_->horizontal->value : 'HHH' }
+            $tree->[$i]->@*;
+    }
+}
+
+sub make_triangle( $n ) {
+    my @rows;
+
+    my $tree;
+    for my $i ( 0 .. $n ) {
+        for my $j ( 0 .. $i ) {
+            my $k = 2 * ( int( $j / 2 ) );
+            push $tree->[$i]->@*, Node->new(1);
+        }
+    }
+    for my $i ( 0 .. $n ) {
+        for my $j ( 0 .. -1 + scalar $tree->[$i]->@* ) {
+            $tree->[$i][$j]->value( join ',', $i, $j );
+        }
+    }
+
+    for my $i ( 0 .. $n ) {
+        for my $j ( 0 .. -1 + scalar $tree->[$i]->@* ) {
+            if ( defined $tree->[ $i + 1 ][$j] ) {
+                $tree->[$i][$j]->left( $tree->[ $i + 1 ][$j] );
+            }
+            if ( defined $tree->[ $i + 1 ][ $j + 1 ] ) {
+                $tree->[$i][$j]->right( $tree->[ $i + 1 ][ $j + 1 ] );
+            }
+            if ( $j < $i ) {
+                $tree->[$i][$j]->horizontal( $tree->[$i][ $j + 1 ] );
+            }
+        }
+    }
+    return $tree;
+}
+
+package Node;
+
+sub new ( $class, $value = 0 ) {
+    my $self = {};
+    $self->{value}      = $value;
+    $self->{left}       = undef;
+    $self->{right}      = undef;
+    $self->{horizontal} = 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 horizontal ( $self, $node = undef ) {
+    if ( defined $node ) {
+        $self->{horizontal} = $node;
+        $node->{parent}     = $self;
+    }
+    else {
+        return $self->{horizontal};
+    }
+}
+
+sub parent ($self ) {
+    return $self->{parent};
+}
diff --git a/challenge-117/dave-jacoby/perl/generate_files.pl b/challenge-117/dave-jacoby/perl/generate_files.pl
new file mode 100644
index 0000000000..52e7afafcd
--- /dev/null
+++ b/challenge-117/dave-jacoby/perl/generate_files.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ postderef say signatures state };
+no warnings qw{ experimental };
+
+my $translate = {
+    1  => 'One',
+    2  => 'Two',
+    3  => 'Three',
+    4  => 'Four',
+    5  => 'Five',
+    6  => 'Six',
+    7  => 'Seven',
+    8  => 'Eight',
+    9  => 'Nine',
+    10 => 'Ten',
+    11 => 'Eleven',
+    12 => 'Twelve',
+    13 => 'Thirteen',
+    14 => 'Fourteen',
+    15 => 'Fifteen',
+};
+
+my $c = 1;
+for my $i ( sort { rand 2 <=> rand 2 } 1 .. 15 ) {
+    my $filename = sprintf 'text_file_%02d.txt', $c;
+    open my $fh , '>', $filename;
+    for my $j ( sort { rand 2 <=> rand 2 } 1 .. 15 ) {
+        next if $i == $j;
+        my $w = $translate->{$j};
+        $w = int rand 2 ? $w : lc $w ;
+        say $fh qq{$j, Line $w};
+    }
+    $c++;
+}