First pass at challenge 113

3 files changed, 135 insertions, 0 deletions

diff --git a/challenge-113/james-smith/perl/Tree.pm b/challenge-113/james-smith/perl/Tree.pm
new file mode 100644
index 0000000000..de215abb46
--- /dev/null
+++ b/challenge-113/james-smith/perl/Tree.pm
@@ -0,0 +1,39 @@
+package Tree;
+
+## 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 ];
+  bless $self, $class;
+}
+
+sub add_child {
+  my( $self,$child ) = @_;
+  push @{$self}, $child;
+  return $self;
+}
+
+sub walk {
+  my( $self, $fn, $data, $t ) = @_;
+  my ($v,@sub) = @{$self};
+  $t = $fn->( $self, $data, $t );
+  $_->walk( $fn, $data, $t ) foreach @sub;
+  return;
+}
+
+sub flatten {
+  my $self = shift;
+  my ($v,@sub) = @{$self};
+  return ( $v, map { $_->flatten } @sub );
+}
+
+1;
diff --git a/challenge-113/james-smith/perl/ch-1.pl b/challenge-113/james-smith/perl/ch-1.pl
new file mode 100644
index 0000000000..40471b5419
--- /dev/null
+++ b/challenge-113/james-smith/perl/ch-1.pl
@@ -0,0 +1,43 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+
+is( represent( 25,  8), 0 );
+is( represent( 25,  7), 0 );
+is( represent( 24,  7), 1 );
+is( represent( 24,  0), 0 );
+is( represent( 10,  0), 1 );
+is( represent( 28,  8), 1 );
+is( represent( 26,  8), 1 );
+is( represent( 16,  8), 0 );
+is( represent( 441, 9), 1 );
+is( represent( 431, 9), 0 );
+done_testing();
+
+sub represent {
+  my( $n, $d ) = @_;
+  ## Get the smallest number when multipled by $d
+  ## that would have the same last digit as $m...
+  ## or undef if there is no such digit {happens
+  ## when $d is in 0,2,5 and the last digit is
+  ## not 0, even or 5/0 respectively...
+
+  my ($k) = grep { ($_*$d)%10 == $n%10 } 0..9;
+
+  ## If $k is defined we still need to check to
+  ## see if $n is large enough for $k distinct
+  ## numbers to add up to it..
+  ##
+  ## In this case
+  ##    $n >= $d + 1$d + 2$d .. ($k-1)$d
+  ## or $n >= $d$k + 10 (0 + 1 + 2 + ... $k-1);
+  ## or $n >= $d$k + 10 * $k * ($k-1)/2;
+  ##    $n >= $k ( $d + 5 * $k - 5 );
+
+  return defined $k && $n >= $k*(5*$k-5+$d) ? 1 : 0
+}
+
diff --git a/challenge-113/james-smith/perl/ch-2.pl b/challenge-113/james-smith/perl/ch-2.pl
new file mode 100644
index 0000000000..a01ade26d2
--- /dev/null
+++ b/challenge-113/james-smith/perl/ch-2.pl
@@ -0,0 +1,53 @@
+#!/usr/local/bin/perl
+
+use strict;
+
+use warnings;
+use feature qw(say);
+use Test::More;
+use lib '.';
+use Tree;
+
+my $x = Tree->new(1)->add_child(
+          Tree->new(2)->add_child(
+            Tree->new(4)->add_child( Tree->new(7) )
+          )
+        )->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 };
+$x->walk( sub { my( $node, $global, $local ) = @_;
+  if($global->{'tree'}) {
+    my $child = Tree->new( $node->[0] );
+    $local->add_child( $child );
+    return $child;
+  }
+  $global->{'tree'} = Tree->new( $node->[0] );
+  return $global->{'tree'};
+}, $clone );
+my $y = $clone->{'tree'};
+say '';
+say 'Dump $x';
+$x->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.='  '; }, $data, '  ' );
+say '';
+say 'Dump $y (clone of $x)';
+$y->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.='  '; }, $data, '  ' );
+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 );
+say '';
+say 'Dump $y (clone of $x)';
+$y->walk( sub { my( $node, $global, $local ) = @_; say $local||='', '> ', $node->[0]; return $local.='  '; }, $data, '  ' );
+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 '';
+