6 files changed, 147 insertions, 0 deletions
diff --git a/challenge-057/paulo-custodio/Makefile b/challenge-057/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-057/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-057/paulo-custodio/README b/challenge-057/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-057/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-057/paulo-custodio/perl/ch-1.pl b/challenge-057/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..f5c3745be8
--- /dev/null
+++ b/challenge-057/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,94 @@
+#!/usr/bin/env perl
+
+# Challenge 057
+#
+# TASK #1 › Invert Tree
+# You are given a full binary tree of any height, similar to the one below:
+#
+#
+#
+# Write a script to invert the tree, by mirroring the children of every node,
+# from left to right. The expected output from the tree above would be:
+#
+#
+#
+# The input can be any sensible machine-readable binary tree format of your
+# choosing, and the output should be the same format.
+#
+# BONUS
+# In addition to the above, you may wish to pretty-print your binary tree in a
+# human readable text-based format similar to the following:
+#
+#        1
+#       /  \
+#      3    2
+#     / \  / \
+#    7   6 5  4
+
+use Modern::Perl;
+
+# tree object
+{
+    package Tree;
+    use Object::Tiny::RW qw( value left right );
+}
+
+my $tree = parse_tree();
+invert_tree($tree);
+dump_tree($tree);
+
+sub parse_tree {
+    chomp(my @lines = <>);
+    @lines or die "malformed tree\n";
+    $lines[0] =~ /^( +)\d/ or die "malformed tree\n";
+    my $tree = parse_subtree(\@lines, 0, length($1));
+    return $tree;
+}
+
+sub parse_subtree {
+    my($lines, $row, $col) = @_;
+
+    # parse root
+    my $value = substr($lines->[$row], $col, 1);
+    $value =~ /\d/ or die "malformed tree\n";
+    my $node = Tree->new(value => $value);
+
+    # parse children
+    if ($row+2 <= $#{$lines}) {
+        # parse left subtree
+        if ($col-2 >= 0 &&
+            $col-2 < length($lines->[$row+1]) &&
+            substr($lines->[$row+1], $col-1, 1) eq '/') {
+            my $child = parse_subtree($lines, $row+2, $col-2);
+            $node->left($child);
+        }
+        # parse right subtree
+        if ($col+2 < length($lines->[$row+2]) &&
+            substr($lines->[$row+1], $col+1, 1) eq '\\') {
+            my $child = parse_subtree($lines, $row+2, $col+2);
+            $node->right($child);
+        }
+    }
+    return $node;
+}
+
+sub invert_tree {
+    my($tree) = @_;
+    if ($tree) {
+        ($tree->{left}, $tree->{right}) = ($tree->{right}, $tree->{left});
+        invert_tree($tree->left);
+        invert_tree($tree->right);
+    }
+}
+
+sub dump_tree {
+    my($tree) = @_;
+    print $tree->value;
+    if ($tree->left || $tree->right) {
+        print "(";
+        dump_tree($tree->left);
+        print "|";
+        dump_tree($tree->right);
+        print ")";
+    }
+}
diff --git a/challenge-057/paulo-custodio/perl/ch-2.pl b/challenge-057/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..bde478b390
--- /dev/null
+++ b/challenge-057/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+# Challenge 057
+#
+# TASK #2 › Shortest Unique Prefix
+# Write a script to find the shortest unique prefix for each each word in the
+# given list. The prefixes will not necessarily be of the same length.
+#
+# Sample Input
+#     [ "alphabet", "book", "carpet", "cadmium", "cadeau", "alpine" ]
+# Expected Output
+#     [ "alph", "b", "car", "cadm", "cade", "alpi" ]
+
+use Modern::Perl;
+
+say shortest_prefix(@ARGV);
+
+sub shortest_prefix {
+    my(@words) = @_;
+    my @prefix;
+    for my $word (@words) {
+        push @prefix, shortest_prefix1($word, @words);
+    }
+    return @prefix;
+}
+
+sub shortest_prefix1 {
+    my($word, @words) = @_;
+    for my $i (1 .. length($word)) {
+        my $prefix = substr($word, 0, $i);
+        my @match = grep {/^$prefix/} @words;
+        return $prefix if @match==1;
+    }
+    return $word;
+}
diff --git a/challenge-057/paulo-custodio/t/test-1.yaml b/challenge-057/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..5043333db8
--- /dev/null
+++ b/challenge-057/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,10 @@
+- setup:
+  cleanup:
+  args:
+  input:    |
+            |        1
+            |       / \
+            |      3   2
+            |     / \
+            |    7   6
+  output:   1(2|3(6|7))
diff --git a/challenge-057/paulo-custodio/t/test-2.yaml b/challenge-057/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..9d34377967
--- /dev/null
+++ b/challenge-057/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,5 @@
+- setup:
+  cleanup:
+  args:     alphabet book carpet cadmium cadeau alpine
+  input:
+  output:   alph b car cadm cade alpi