Merge pull request #3136 from wanderdoc/master

Solutions to challenge-093 (and Happy New Year!). 

2 files changed, 205 insertions, 0 deletions

diff --git a/challenge-093/wanderdoc/perl/ch-1.pl b/challenge-093/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..dac859b5db
--- /dev/null
+++ b/challenge-093/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,79 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given set of co-ordinates @N. Write a script to count maximum points on a straight line when given co-ordinates plotted on 2-d plane.
+Example 1:
+|
+|     x
+|   x
+| x
++ _ _ _ _
+
+Input: (1,1), (2,2), (3,3)
+Output: 3
+
+Example 2:
+|
+|
+| x       x
+|   x
+| x   x
++ _ _ _ _ _
+Input: (1,1), (2,2), (3,1), (1,3), (5,3)
+Output: 3
+
+=cut
+
+use List::Util qw(min max);
+use Test::More;
+
+
+
+
+
+sub max_points
+{
+     my @coords = @_;
+
+
+     my $max = 1;
+     for my $i ( 0 .. $#coords)
+     {
+
+          my $same_place = 1;
+          my $same_y     = 1;
+          my %same_slope;
+
+
+          for my $j ( $i .. $#coords )
+          {
+               if ( $coords[$i]->[0] == $coords[$j]->[0] and 
+                    $coords[$i]->[1] == $coords[$j]->[1]
+               )
+               {
+                    $same_place++;
+               }
+
+               elsif ( $coords[$i]->[0] == $coords[$j]->[0])
+               {
+                    $same_y++;
+               }
+               else
+               {
+                    my $diff_x = $coords[$i]->[0] - $coords[$j]->[0];
+                    my $diff_y = $coords[$i]->[1] - $coords[$j]->[1];
+
+                    $same_slope{ sprintf("%3.2f", $diff_y/$diff_x) }++;
+               }
+          }
+          my $max_slopes = max(values %same_slope, 0) + 1;
+          $max = max($max, $same_place, $same_y, $max_slopes);
+     }
+     return $max;
+}
+
+is(max_points([1,1], [2,2], [3,3]), 3, 'Example 1');
+is(max_points([1,1], [2,2], [3,1], [1,3], [5,3]), 3, 'Example 2');
+done_testing();
diff --git a/challenge-093/wanderdoc/perl/ch-2.pl b/challenge-093/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..690f0dd4a7
--- /dev/null
+++ b/challenge-093/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,126 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given binary tree containing numbers 0-9 only. Write a script to sum all possible paths from root to leaf.
+Example 1: Input: 
+     1
+    /
+   2
+  / \
+ 3   4
+
+Output: 13 as sum two paths (1->2->3) and (1->2->4)
+
+
+Example 2: Input:
+     1
+    / \
+   2   3
+  /   / \
+ 4   5   6
+Output: 26 as sum three paths (1->2->4), (1->3->5) and (1->3->6)
+
+=cut
+
+use Struct::Dumb;
+use List::Util qw(sum);
+use Test::More;
+
+struct Node => [qw( val left right )] , named_constructor => 1;
+
+my @paths; # Did not succeed to put it into deeper scope. :-(
+
+# Example 1.
+{
+     my $root = create_root(1);
+     my $n2 = add_left($root, 2);
+
+
+     my $n3 = add_left($n2, 3);
+     my $n4 = add_right($n2, 4); 
+     is(sum_paths($root), 13, 'Example 1');
+}
+
+
+
+@paths = ();
+
+# Example 2.
+{
+     my $root = create_root(1);
+     my $n2 = add_left($root, 2);
+     my $n3 = add_right($root, 3);
+     my $n4 = add_left($n2, 4);
+     my $n5 = add_left($n3, 5);
+     my $n6 = add_right($n3, 6);
+
+     is(sum_paths($root), 26, 'Example 2');
+}
+done_testing();
+
+sub create_root
+{
+     my $val = $_[0];
+     my $root = Node( val => $val , left => undef, right => undef );
+
+     return $root;
+}
+
+sub add_left
+{
+     my ($parent, $val) = @_;
+     my $node = Node( val => $val , left => undef, right => undef );
+     $parent->left = $node;
+
+     return $node;
+}
+
+sub add_right
+{
+     my ($parent, $val) = @_;
+     my $node = Node( val => $val , left => undef, right => undef );
+     $parent->right = $node;
+
+     return $node;
+}
+
+
+sub sum_paths
+{
+     my $node = $_[0];
+     _collect_paths($node);
+
+     my $sum = sum(map { sum(@$_) } @paths);
+     print join(' ', "\tDEBUG: " , join('->', @$_)), $/ for @paths;
+     return $sum;
+
+}
+
+sub _collect_paths
+{
+     my $node = $_[0];
+
+     my $subpath = $_[1] ? [@{$_[1]}] : [];
+
+
+     if ( $node->val )
+     {
+          push @$subpath, $node->val;
+     }
+
+
+     if ( $node->left )
+     {
+          _collect_paths($node->left, $subpath);
+     }
+     if ( $node->right )
+     {
+          _collect_paths($node->right, $subpath);
+     }
+     if ((! defined $node->left) and (! defined $node->right))
+     {
+          push @paths, $subpath;
+     }
+}