true Binary tree version of the code... write a dump, clone & flatten function which uses walk rather than self coded - all take a fn which allows artibrary code to used when cloning the value and dump/flattening it

2 files changed, 142 insertions, 9 deletions

diff --git a/challenge-113/james-smith/perl/BinaryTree.pm b/challenge-113/james-smith/perl/BinaryTree.pm
new file mode 100644
index 0000000000..be0b5a88c8
--- /dev/null
+++ b/challenge-113/james-smith/perl/BinaryTree.pm
@@ -0,0 +1,83 @@
+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 add_child_left {
+  my( $self,$child ) = @_;
+  $self->[1] = $child;
+  return $self;
+}
+
+sub add_child_right {
+  my( $self,$child ) = @_;
+  $self->[2] = $child;
+  return $self;
+}
+
+sub walk {
+  my( $self, $fn, $global, $local, $dir ) = @_;
+  my ($v,$l,$r) = @{$self};
+  $local = $fn->( $self, $global, $local, $dir||'' );
+  $l->walk( $fn, $global, $local, 'left' ) if defined $l;
+  $r->walk( $fn, $global, $local, 'right' ) if defined $r;
+  return;
+}
+
+sub flatten {
+  my( $self,$dump_fn ) = @_;
+  $dump_fn ||= sub { $_[0] };
+  my $arrayref = [];
+  $self->walk( sub {
+    my($node,$global) = @_;
+    push @{$global}, $dump_fn->( $node->[0] );
+  }, $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->[0]);
+    return $local .= '  ';
+  }, {}, '', '' );
+  return;
+}
+
+sub clone {
+  my( $self, $clone_fn ) = @_;
+  $clone_fn ||= sub { $_[0] };
+  my $clone = {};
+  $self->walk( sub { my( $node, $global, $local, $dir ) = @_;
+    if(exists $global->{'tree'} ) {
+      my $child = BinaryTree->new( $clone_fn->( $node->[0] ) );
+      $dir eq 'left' ? $local->add_child_left( $child ) : $local->add_child_right( $child );
+      return $child;
+    }
+    $global->{'tree'} = BinaryTree->new( $clone_fn->( $node->[0] ) );
+    return $global->{'tree'};
+  }, $clone );
+  return $clone->{'tree'};
+}
+
+1;
diff --git a/challenge-113/james-smith/perl/ch-2.pl b/challenge-113/james-smith/perl/ch-2.pl
index a01ade26d2..47c2f4c84e 100644
--- a/challenge-113/james-smith/perl/ch-2.pl
+++ b/challenge-113/james-smith/perl/ch-2.pl
@@ -7,6 +7,7 @@ use feature qw(say);
 use Test::More;
 use lib '.';
 use Tree;
+use BinaryTree;
 
 my $x = Tree->new(1)->add_child(
           Tree->new(2)->add_child(
@@ -16,33 +17,82 @@ my $x = Tree->new(1)->add_child(
           Tree->new(3)->add_child( Tree->new(5))->add_child( Tree->new(6) )
         );
 
-my $data  = { 't' => 0 };
 
 ## Clone $x into $y
-my $clone = { 'tree' => undef };
+my $clone = { 'total' => 0 };
+my $local;
+
+## Generate clone of $x, and compute the total of all the nodes...
+## These will be stored as { 'tree' => OBJECT, 'total' => INT }
+## in $global, $x->walk does a "pre-order" traversal of the tree.
+
 $x->walk( sub { my( $node, $global, $local ) = @_;
-  if($global->{'tree'}) {
+  $global->{'total'} += $node->[0];
+  if(exists $global->{'tree'}) {
     my $child = Tree->new( $node->[0] );
     $local->add_child( $child );
     return $child;
   }
   $global->{'tree'} = Tree->new( $node->[0] );
   return $global->{'tree'};
-}, $clone );
+}, $clone  );
+
 my $y = $clone->{'tree'};
 say '';
 say 'Dump $x';
-$x->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.='  '; }, $data, '  ' );
+$x->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.='  '; }, $y, '  ' );
+say '';
+say 'Dump $y (clone of $x)';
+$y->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.='  '; }, $y, '  ' );
+say '';
+say 'Now get total value and adjust each node... for $y';
+$y->walk( sub { my( $node, $global         ) = @_; $node->[0] = $global->{'total'} - $node->[0];           }, $clone );
+say '';
+say 'Dump $y (clone of $x)';
+$y->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.='  '; }, $y, '  ' );
+say '';
+
+say 'Running tests';
+is( "@{[ $x->flatten ]}", '1 2 4 7 3 5 6' );
+is( "@{[ $y->flatten ]}", '27 26 24 21 25 23 22' );
+say '';
+
+$x = BinaryTree->new(1)->add_child_left(
+          BinaryTree->new(2)->add_child_left(
+            BinaryTree->new(4)->add_child_right( BinaryTree->new(7) )
+          )
+        )->add_child_right(
+          BinaryTree->new(3)->add_child_left( BinaryTree->new(5))->add_child_right( BinaryTree->new(6) )
+        );
+
+
+## Generate clone of $x, and compute the total of all the nodes...
+## These will be stored as { 'tree' => OBJECT, 'total' => INT }
+## in $global, $x->walk does a "pre-order" traversal of the tree.
+
+## You will need to look more at BinaryTree.pm to see how all methods
+## work - clone & dump are implemented using "walk" to walk the tree
+## to save writing another tree walker!
+
+$y;
+
+
+say '';
+say 'Dump $x';
+$x->dump( sub { "[$_[0]]"; } );
 say '';
+say 'Clone $x as $y';
+$y = $x->clone;
 say 'Dump $y (clone of $x)';
-$y->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.='  '; }, $data, '  ' );
+$y->dump( sub { "[$_[0]]"; } );
 say '';
 say 'Now get total value and adjust each node... for $y';
-$y->walk( sub { my( $node, $global         ) = @_; $global->{'t'} += $node->[0];                           }, $data );
-$y->walk( sub { my( $node, $global         ) = @_; $node->[0] = $global->{'t'} - $node->[0];               }, $data );
+my $glob = { 'total' => 0 };
+$y->walk( sub { my( $node, $global ) = @_; $global->{'total'} += $node->[0];             }, $glob );
+$y->walk( sub { my( $node, $global ) = @_; $node->[0] = $global->{'total'} - $node->[0]; }, $glob );
 say '';
 say 'Dump $y (clone of $x)';
-$y->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.='  '; }, $data, '  ' );
+$y->dump( sub { "[$_[0]]"; } );
 say '';
 
 say 'Running tests';