solution to ch-1/2

4 files changed, 309 insertions, 0 deletions

diff --git a/challenge-129/james-smith/perl/BinaryTree.pm b/challenge-129/james-smith/perl/BinaryTree.pm
new file mode 100644
index 0000000000..1389bd8056
--- /dev/null
+++ b/challenge-129/james-smith/perl/BinaryTree.pm
@@ -0,0 +1,187 @@
+package BinaryTree;
+
+use strict;
+use warnings;
+use Data::Dumper qw(Dumper);
+use feature qw(say);
+
+## The tree is stored in an array ref
+# The first element is the value of the node
+# The remainder of the array are child sub-trees
+#
+# Methods:
+#  ->add_child( $child_tree )
+#  ->flatten                  -- flatten list to array.
+#
+
+sub new {
+  my $class = shift;
+  my $value = shift;
+  my $self = [ $value, undef, undef ];
+  bless $self, $class;
+}
+
+sub ancestors {
+  my $self = shift;
+  my $x = $self;
+  my @ancestors;
+  while($x->has_parent) {
+    push @ancestors, $x;
+    $x = $x->parent;
+  }
+  return @ancestors;
+}
+sub max_length {
+  my $self = shift;
+  my $d = 0;
+     $d = $self->left->max_length if $self->has_left;
+  return 1+$d unless $self->has_right;
+  my $t = $self->right->max_length;
+  return $t > $d ? 1+$t : 1+$d;
+}
+
+sub diameter {
+  my $self = shift;
+  my $global = { 'diameter' => 0 };
+  $self->walk( sub {
+    my $d = ($_[0]->has_left  ? $_[0]->left->max_length  : 0 ) +
+            ($_[0]->has_right ? $_[0]->right->max_length : 0 );
+    $_[1]{'diameter'} = $d if $d > $_[1]->{'diameter'};
+  }, $global );
+  return $global->{'diameter'};
+}
+
+sub value {
+  my $self = shift;
+  return $self->[0];
+}
+
+sub left {
+  my $self = shift;
+  return $self->[1];
+}
+
+sub parent {
+  my $self = shift;
+  return $self->[3];
+}
+
+sub has_parent {
+  my $self = shift;
+  return defined $self->[3];
+}
+
+sub right {
+  my $self = shift;
+  return $self->[2];
+}
+
+sub has_left {
+  my $self = shift;
+  return defined $self->[1];
+}
+
+sub has_right {
+  my $self = shift;
+  return defined $self->[2];
+}
+
+sub update {
+  my( $self, $val ) = @_;
+  $self->[0] = $val;
+  return $self;
+}
+
+sub add_child_left {
+  my( $self,$child ) = @_;
+  $self->[1] = $child;
+  $child->[3] = $self;
+  return $self;
+}
+
+sub add_child_right {
+  my( $self,$child ) = @_;
+  $self->[2] = $child;
+  $child->[3] = $self;
+  return $self;
+}
+
+## Define walk method....
+sub walk {
+  my $self = shift;
+  $self->walk_pre( @_ );
+  return;
+}
+
+##
+## Pre-order walk process node then the left and right sub-trees
+##
+
+sub walk_pre {
+  my( $self, $fn, $global, $local, $dir ) = @_;
+  $local = $fn->( $self, $global, $local, $dir||'' );
+  $self->left->walk_pre(  $fn, $global, $local, 'left'  ) if $self->has_left;
+  $self->right->walk_pre( $fn, $global, $local, 'right' ) if $self->has_right;
+  return;
+}
+
+##
+## In-order walk process left sub-tree, then the node and finally the right sub-tree
+##
+
+sub walk_in {
+  my( $self, $fn, $global, $local, $dir ) = @_;
+  $self->left->walk_in(  $fn, $global, $local, 'left'  ) if $self->has_left;
+  $local = $fn->( $self, $global, $local, $dir||'' );
+  $self->right->walk_in( $fn, $global, $local, 'right' ) if $self->has_right;
+  return;
+}
+
+##
+## Reverse-order walk process right sub-tree, then the node and finally the left sub-tree
+##
+
+sub walk_reverse {
+  my( $self, $fn, $global, $local, $dir ) = @_;
+  $self->right->walk_reverse( $fn, $global, $local, 'right' ) if $self->has_right;
+  $local = $fn->( $self, $global, $local, $dir||'' );
+  $self->left->walk_reverse(  $fn, $global, $local, 'left'  ) if $self->has_left;
+  return;
+}
+
+##
+## Post-order walk the left and right subtrees before processing the node...
+##
+
+sub walk_post {
+  my( $self, $fn, $global, $local, $dir ) = @_;
+  $self->left->walk_post(  $fn, $global, $local, 'left'  ) if $self->has_left;
+  $self->right->walk_post( $fn, $global, $local, 'right' ) if $self->has_right;
+  $local = $fn->( $self, $global, $local, $dir||'' );
+  return;
+}
+
+sub flatten {
+  my( $self,$dump_fn, $method ) = @_;
+  $dump_fn ||= sub { $_[0] };
+  $method  = $self->can( 'walk_'.($method||'pre') ) || 'walk';
+  my $arrayref = [];
+  $self->$method( sub {
+    my($node,$global) = @_;
+    push @{$global}, $dump_fn->( $node->value );
+  }, $arrayref );
+  return @{$arrayref};
+}
+
+sub dump {
+  my( $self, $dump_fn ) = @_;
+  $dump_fn ||= sub { $_[0] };
+  $self->walk( sub {
+    my( $node, $global, $local, $dir ) = @_;
+    say join '', $local||'', $dir eq 'left' ? '<' : $dir eq 'right' ? '>' : ' ', ' ', $dump_fn->($node->value);
+    return $local .= '  ';
+  }, {}, '', '' );
+  return;
+}
+
+1;
diff --git a/challenge-129/james-smith/perl/LL.pm b/challenge-129/james-smith/perl/LL.pm
new file mode 100644
index 0000000000..8d52218464
--- /dev/null
+++ b/challenge-129/james-smith/perl/LL.pm
@@ -0,0 +1,42 @@
+package LL;
+
+# The linked list object consists of 3 values;
+#  * 'val'  => the value of the node;
+#  * 'next' => the next node in the list;
+#  * 'last' => the last node in the list; {so can easily add next value}
+
+# Two methods:
+#  * ->add( $val ) => Add another value to the end of the list
+#  * ->flatten     => Flatten to array of values
+
+sub new {
+  my $class = shift;
+  my $self = { 'val' => shift, 'next' => undef };
+  $self->{'last'} = $self;
+  bless $self, $class;
+}
+
+sub next {
+  my $self = shift;
+  $self = $self->{'next'};
+}
+
+sub val {
+  my $self = shift;
+  return $self->{'val'};
+}
+sub add {
+  my( $self, $val ) =@_;
+  my $new = LL->new( $val );
+  $self->{'last'}{'next'} = $new;
+  $self->{'last'} = $new;
+  return $self;
+}
+
+sub flatten {
+  my $self = shift;
+  return $self->{'val'} unless $self->{'next'};
+  return ( $self->{'val'}, $self->{'next'}->flatten );
+}
+
+1;
diff --git a/challenge-129/james-smith/perl/ch-1.pl b/challenge-129/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..bced1d697b
--- /dev/null
+++ b/challenge-129/james-smith/perl/ch-1.pl
@@ -0,0 +1,53 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Data::Dumper qw(Dumper);
+use lib '.';
+use BinaryTree;
+
+my $node_1_6 = BinaryTree->new( 6 );
+my $node_1_5 = BinaryTree->new( 5 );
+my $node_1_4 = BinaryTree->new( 4 )->add_child_left( $node_1_5 )->add_child_right( $node_1_6 );
+my $node_1_2 = BinaryTree->new( 2 );
+
+my $tree_1 = BinaryTree->new(1)->add_child_left( $node_1_2 )
+                ->add_child_right( BinaryTree->new( 3 )->add_child_right( $node_1_4 ) );
+
+my $node_2_8 = BinaryTree->new( 8 );
+my $node_2_6 = BinaryTree->new( 6 )->add_child_left( $node_2_8 )
+                                   ->add_child_right( BinaryTree->new( 9 ) );
+my $node_2_7 = BinaryTree->new( 7 );
+
+my $tree_2 = BinaryTree->new(1)->add_child_left(
+               BinaryTree->new(2)->add_child_left(
+                 BinaryTree->new(4)->add_child_right( $node_2_6 )
+               )
+             )->add_child_right(
+               BinaryTree->new(3)->add_child_right(
+                 BinaryTree->new(5)->add_child_left( $node_2_7 )
+               )
+             );
+
+my @TESTS = (
+  [ $node_1_6, 3 ],
+  [ $node_1_5, 3 ],
+  [ $node_1_2, 1 ],
+  [ $node_1_4, 2 ],
+  [ $node_2_7, 3 ],
+  [ $node_2_8, 4 ],
+  [ $node_2_6, 3 ],
+);
+
+is( root_distance($_->[0]), $_->[1] ) foreach @TESTS;
+
+done_testing();
+
+sub root_distance {
+  scalar shift->ancestors;
+}
+
diff --git a/challenge-129/james-smith/perl/ch-2.pl b/challenge-129/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..073a26b877
--- /dev/null
+++ b/challenge-129/james-smith/perl/ch-2.pl
@@ -0,0 +1,27 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use Benchmark qw(cmpthese timethis);
+use Data::Dumper qw(Dumper);
+use lib '.';
+use LL;
+
+my $ch1 = LL->new( 1 )->add( 3 )->add( 2 );
+my $ch2 = LL->new( 3 )->add( 1 )->add( 2 );
+
+my $ch3 = LL->new( $ch1->val + $ch2->val );
+my ( $p1, $p2, $p3 ) = ( $ch1, $ch2, $ch3 );
+
+while( 1 ) {
+  $p1 = $p1->next;
+  last unless $p1;
+  $p2 = $p2->next;
+  $p3 = $p3->add( $p1->val + $p2->val );
+}
+
+say join "   ", $ch3->flatten;
+