part II now added

3 files changed, 260 insertions, 1 deletions

diff --git a/challenge-125/james-smith/perl/BinaryTree.pm b/challenge-125/james-smith/perl/BinaryTree.pm
new file mode 100644
index 0000000000..1cbcbfc511
--- /dev/null
+++ b/challenge-125/james-smith/perl/BinaryTree.pm
@@ -0,0 +1,170 @@
+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 depth {
+  my $self = shift;
+  my $d = 0;
+     $d = $self->left->depth if $self->has_left;
+  return 1+$d unless $self->has_right;
+  my $t = $self->right->depth;
+  return $t > $d ? 1+$t : 1+$d;
+}
+
+sub diameter {
+  my $self = shift;
+  return 1 + $self->left->depth + $self->right->depth if $self->has_left && $self->has_right;
+
+  my $diameter = $self->depth; ## Case 1 has a single depth....
+  my $t = $self->has_left ? $self->left : $self->right;
+  while( $t->has_left || $t->has_right ) {
+    if( $t->has_left && $t->has_right ) {
+      my $d = 1 + $t->left->depth + $t->right->depth;
+      return $d > $diameter ? $d : $diameter;
+    }
+    $t = $t->has_left ? $t->left : $t->right;
+  }
+  return $diameter;
+}
+
+sub value {
+  my $self = shift;
+  return $self->[0];
+}
+
+sub left {
+  my $self = shift;
+  return $self->[1];
+}
+
+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;
+  return $self;
+}
+
+sub add_child_right {
+  my( $self,$child ) = @_;
+  $self->[2] = $child;
+  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-125/james-smith/perl/ch-1.pl b/challenge-125/james-smith/perl/ch-1.pl
index 7227b26068..c0bf708d10 100644
--- a/challenge-125/james-smith/perl/ch-1.pl
+++ b/challenge-125/james-smith/perl/ch-1.pl
@@ -12,7 +12,7 @@ my @TESTS = (
   [ 0, 1 ],
 );
 
-say $_,' > ', get_triples($_) foreach 1..100;
+say $_,' > ', get_triples($_) foreach 1..500;
 
 sub get_triples {
   my $n = shift;
diff --git a/challenge-125/james-smith/perl/ch-2.pl b/challenge-125/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..451047c0cb
--- /dev/null
+++ b/challenge-125/james-smith/perl/ch-2.pl
@@ -0,0 +1,89 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use lib '.';
+use BinaryTree;
+
+say '';
+
+## Node has both left and right trees - the diameter is 1 + depth of the two child trees.
+
+## 1 -> 2 -> 3
+##   |    `> 4
+##   `> 5 -> 6
+##        `> 7 -> 8 -> 9           [ depth 5 ]
+##             `> 10
+## -------------------------------
+## 9 -> 8 -> 7 -> 5 -> 1 -> 2 -> 3 [ diameter 7 ]
+
+my $x = BinaryTree->new(1)->add_child_left(
+          BinaryTree->new(2)->add_child_left( BinaryTree->new(3) )->add_child_right( BinaryTree->new(4) )
+        )->add_child_right(
+          BinaryTree->new(5)->add_child_left( BinaryTree->new(6))->add_child_right(
+            BinaryTree->new(7)->add_child_left( BinaryTree->new(8)->add_child_left(BinaryTree->new(9)) )->add_child_right(BinaryTree->new(10))
+        ));
+$x->dump;
+say sprintf 'Max depth: %d, diameter %d', $x->depth, $x->diameter;
+say '';
+## No node has 2 children - the diameter is the depth...
+
+## 1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 7 [ depth 7 ]
+## -------------------------------
+## 7 -> 6 -> 5 -> 4 -> 3 -> 2 -> 1 [ diameter 7 ]
+$x = BinaryTree->new(1)->add_child_left(
+       BinaryTree->new(2)->add_child_left(
+         BinaryTree->new(3)->add_child_right(
+           BinaryTree->new(4)->add_child_left(
+             BinaryTree->new(5)->add_child_right(
+               BinaryTree->new(6)->add_child_left(
+                 BinaryTree->new(7)
+     ))))));
+
+$x->dump;
+say sprintf 'Max depth: %d, diameter %d', $x->depth, $x->diameter;
+say '';
+## We have a node with two children - but there is a sequence of nodes
+## leading up to this node which is longer than the depth of the child trees.
+## so diameter is just depth.
+
+## 1 -> 2 -> 3 -> 4 -> 5 -> 6 [ depth 6]
+##                  `> 7 -> 8
+## --------------------------
+## 6 -> 5 -> 4 -> 3 -> 2 -> 1 [ diameter 6 ]
+$x = BinaryTree->new(1)->add_child_left(
+          BinaryTree->new(2)->add_child_left(
+            BinaryTree->new(3)->add_child_left(
+              BinaryTree->new(4)->add_child_left(
+                BinaryTree->new(5)->add_child_left( BinaryTree->new(6) )
+              )->add_child_right(
+                BinaryTree->new(7)->add_child_left( BinaryTree->new(8) )
+              )
+     )));
+
+$x->dump;
+say sprintf 'Max depth: %d, diameter %d', $x->depth, $x->diameter;
+say '';
+
+## This time both child trees have depths longer than the number of
+## ancestor nodes - so that is used to get the length...
+
+## 1 -> 2 -> 3 -> 4      [ depth 4]
+##        `> 5 -> 6
+## ---------------------
+## 6 -> 5 -> 2 -> 3 -> 4 [ diameter 5 ]
+
+$x = BinaryTree->new(1)->add_child_left(
+       BinaryTree->new(2)->add_child_left(
+         BinaryTree->new(3)->add_child_left( BinaryTree->new(4) )
+       )->add_child_right(
+         BinaryTree->new(5)->add_child_left( BinaryTree->new(6) )
+       )
+    );
+
+$x->dump;
+say sprintf 'Max depth: %d, diameter %d', $x->depth, $x->diameter;
+say '';