links in blogs < & >

2 files changed, 93 insertions, 15 deletions

diff --git a/challenge-113/james-smith/perl/BinaryTree.pm b/challenge-113/james-smith/perl/BinaryTree.pm
index e28307765a..711dde9039 100644
--- a/challenge-113/james-smith/perl/BinaryTree.pm
+++ b/challenge-113/james-smith/perl/BinaryTree.pm
@@ -64,19 +64,67 @@ sub add_child_right {
   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||'' );
-  $self->left->walk(  $fn, $global, $local, 'left'  ) if $self->has_left;
-  $self->right->walk( $fn, $global, $local, 'right' ) if $self->has_right;
   return;
 }
 
 sub flatten {
-  my( $self,$dump_fn ) = @_;
+  my( $self,$dump_fn, $method ) = @_;
   $dump_fn ||= sub { $_[0] };
+  $method  = $self->can( 'walk_'.($method||'pre') ) || 'walk';
   my $arrayref = [];
-  $self->walk( sub {
+  $self->$method( sub {
     my($node,$global) = @_;
     push @{$global}, $dump_fn->( $node->value );
   }, $arrayref );
@@ -96,6 +144,16 @@ sub dump {
 
 sub clone {
   my( $self, $clone_fn ) = @_;
+  $self->walk_post( sub { my ($node, $global, $local, $dir ) = @_
+    my $new_node = BinaryTree->new( $clone_fn( $node->value ) );
+    $new_node->add_child_left(  $self->left->walk_post(  $node, $global ) ) if $self->has_left;
+    $new_node->add_child_right( $self->right->walk_post( $node, $global ) ) if $self->has_right;
+    return $new_node;
+  });
+  return
+}
+sub clonez {
+  my( $self, $clone_fn ) = @_;
   $clone_fn ||= sub { $_[0] };
   my $clone = {};
   $self->walk( sub { my( $node, $global, $local, $dir ) = @_;
diff --git a/challenge-113/james-smith/perl/ch-2.pl b/challenge-113/james-smith/perl/ch-2.pl
index bb453db985..cbc18d00fe 100644
--- a/challenge-113/james-smith/perl/ch-2.pl
+++ b/challenge-113/james-smith/perl/ch-2.pl
@@ -89,31 +89,51 @@ $x = BinaryTree->new(1)
 $y;
 
 say '
+========================================================================
+
+BinaryTree.pm
+=============
+
 Now using the binary specific code - with clone/dump/flatten methods
 added into the class implemented by walk
-
 ';
 
 say 'Dump $x';
 $x->dump;
 say '';
-say 'Clone $x as $y';
-$y = $x->clone;
-say 'Dump $y (clone of $x)';
-$y->dump;
-say '';
-say 'Now get total value and adjust each node... for $y';
+say 'Now get total value';
 my $glob = { 'total' => 0 };
-$y->walk( sub { my( $node, $global ) = @_; $global->{'total'} += $node->value;                 }, $glob );
-$y->walk( sub { my( $node, $global ) = @_; $node->update( $global->{'total'} - $node->value ); }, $glob );
+$x->walk( sub { my( $node, $global ) = @_; $global->{'total'} += $node->value;                 }, $glob );
+say '  TOTAL is ',$glob->{'total'};
+say '';
+## Clone x into y -> but with the value as total - value'
+say 'Clone $x as $y - and set value as "total" - value';
+$y = $x->clone( sub { $glob->{'total'} - $_[0]; } );
 say '';
 say 'Dump $y (clone of $x)';
 $y->dump;
-say '';
+say '
+------------------------------------------------------------------------
+';
 
+say "@{[ $x->flatten ]}";
+say "@{[ $y->flatten ]}";
+say '
+Dump in different orders:
+';
+say "Pre-order     @{[ $x->flatten( undef, 'pre'     ) ]}";
+say "In order      @{[ $x->flatten( undef, 'in'      ) ]}";
+say "Reverse order @{[ $x->flatten( undef, 'reverse' ) ]}";
+say "Post order    @{[ $x->flatten( undef, 'post'    ) ]}";
+say '
+------------------------------------------------------------------------
+';
 say 'Running tests';
 is( "@{[ $x->flatten ]}", '1 2 4 7 3 5 6' );
 is( "@{[ $y->flatten ]}", '27 26 24 21 25 23 22' );
 done_testing();
-say '';
+say '
+========================================================================
+
+';