Merge pull request #1617 from wanderdoc/master

Solutions to challenge 057.

2 files changed, 189 insertions, 0 deletions

diff --git a/challenge-057/wanderdoc/perl/ch-1.pl b/challenge-057/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..c9e37b06f7
--- /dev/null
+++ b/challenge-057/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,66 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given Binary Tree like below:
+
+          1
+        /   \
+       2     3
+      / \   / \
+     4   5 6   7
+
+Write a script to invert and return like below:
+
+          1
+        /   \
+       3     2
+      / \   / \
+     7   6 5   4
+
+It would be nice if you could print the Binary Tree as shown above.
+=cut
+
+use Tree::DAG_Node;
+
+my $root = Tree::DAG_Node->new;
+$root->name(1);
+$root->new_daughter->name($_) for (2 .. 3);
+
+my @names = (45, 67);
+my $count = 0;
+
+for my $node ($root->daughters) 
+{
+    for my $digit (split(//, $names[$count++])) 
+    {
+        $node->new_daughter->name($digit);
+
+
+    }
+}
+
+
+print map "$_\n", @{$root->draw_ascii_tree};
+print $/;
+
+invert($root);
+
+print map "$_\n", @{$root->draw_ascii_tree};
+# This is built-in in the module, so all credit goes to the author.
+print $/;
+# A slight modification:
+print  map { s/   /  /g; s/^\s+$//g; $_; }
+     map {s/\-/ /g; s/[|]//g; s/[<>]/ /g;
+     "$_$/";}  @{$root->draw_ascii_tree};
+
+
+sub invert 
+{
+     my $node = shift;
+     my @daughters = $node->daughters;
+     @daughters = reverse @daughters;
+     $node->set_daughters(@daughters);
+     invert($_) for $node->daughters;
+}
\ No newline at end of file
diff --git a/challenge-057/wanderdoc/perl/ch-2.pl b/challenge-057/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..4a1781d4b4
--- /dev/null
+++ b/challenge-057/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,123 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+Write a script to find the Shortest Unique Prefix to represent each word in the given list. Prefixes need not be of same length.
+List
+    [ "alphabet", "book", "carpet", "cadmium", "cadeau", "alpine" ]
+Expected Output
+    [ "alph", "b", "car", "cadm", "cade", "alpi" ]
+=cut
+
+
+
+
+
+##### Solution with hash.
+
+my @words = ("alphabet", "book", "carpet", "cadmium", "cadeau", "alpine"); 
+my %strings;
+for my $w ( @words )
+{
+     for my $idx ( 1 .. length($w) )
+     {
+          $strings{ substr($w, 0, $idx) }++;
+
+     }
+}
+my @output;
+for my $w ( @words )
+{
+     my @cand = grep $w =~ /^$_/, keys %strings;
+     if ( @cand )
+     {
+          my @suff = sort {length($a)<=> length($b)} grep $strings{$_} == 1, @cand;
+          push @output, $suff[0]; # print $suff[0], $/;
+     }
+}
+
+
+print join(", ", @output), $/;
+
+##### Solution with Tree as Trie.
+
+print "#" x 25, $/;
+use Tree::DAG_Node;
+
+my $root = Tree::DAG_Node->new({name => 'root', attributes => {f => 0} });
+
+my $node = $root;
+my @output_2;
+for my $w ( @words )
+{
+     my @arr = split(//,$w);
+     for my $idx ( 0 .. $#arr ) # $letter ( @arr )
+     {
+          if ( $node->mother and $node->mother->name eq 'root' 
+
+               and $node->name eq $arr[$idx] and 0 == $idx)
+          {
+               $node->attributes->{f}++;
+          }
+          else
+          {
+               my ($ed) = grep $_->name eq $arr[$idx], $node->daughters;
+
+
+               if ( $ed )
+               {
+                    $ed->attributes->{f}++;
+                    $node = $ed;
+               }
+
+
+
+               else
+               {
+                    my $daughter = $node->new_daughter({name => $arr[$idx], attributes => {f => 1}});
+                    $node = $daughter;
+               }
+          }
+     }
+     $node = $root;
+}
+
+# print map "$_\n", @{$root->draw_ascii_tree};
+
+sub suffixes
+{
+     my $root = $_[0];
+     my @d = $root->daughters;
+     for my $dt ( @d )
+     {
+
+          my @leaves = $dt->leaves_under;
+
+          for my $leaf ( @leaves )
+          {
+               my $node = $leaf;
+               my $suff;
+
+               while ( 1 == $node->mother->attributes->{f} )
+               {
+
+                    $node = $node->mother;
+
+               }
+               while ( 0 < $node->mother->attributes->{f} )
+               {
+                    $suff .= $node->name;
+                    $node = $node->mother;
+               }
+
+               $suff .= $node->name;
+
+               $suff = reverse $suff;
+               push @output_2, $suff; # print $suff, $/;
+          }
+     }
+}
+
+suffixes($root);
+print join(", ", @output_2), $/;
\ No newline at end of file