Merge pull request #5932 from pauloscustodio/master

Add Perl solutions

30 files changed, 696 insertions, 0 deletions

diff --git a/challenge-053/paulo-custodio/Makefile b/challenge-053/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-053/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-053/paulo-custodio/README b/challenge-053/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-053/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-053/paulo-custodio/perl/ch-1.pl b/challenge-053/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..81f6eb8f96
--- /dev/null
+++ b/challenge-053/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+
+# Challenge 053
+#
+# TASK #1
+# Rotate Matrix
+# Write a script to rotate the followin matrix by given 90/180/270 degrees
+# clockwise.
+#
+# [ 1, 2, 3 ]
+# [ 4, 5, 6 ]
+# [ 7, 8, 9 ]
+# For example, if you rotate by 90 degrees then expected result should be like
+# below
+#
+# [ 7, 4, 1 ]
+# [ 8, 5, 2 ]
+# [ 9, 6, 3 ]
+
+use Modern::Perl;
+
+my @m = ([ 1, 2, 3 ],
+         [ 4, 5, 6 ],
+         [ 7, 8, 9 ]);
+
+display(rotate90(@m));
+display(rotate180(@m));
+display(rotate270(@m));
+
+
+sub rotate90 {
+    my(@m) = @_;
+    return ([ $m[2][0], $m[1][0], $m[0][0] ],
+            [ $m[2][1], $m[1][1], $m[0][1] ],
+            [ $m[2][2], $m[1][2], $m[0][2] ]);
+}
+
+sub rotate180 {
+    my(@m) = @_;
+    return rotate90(rotate90(@m));
+}
+
+sub rotate270 {
+    my(@m) = @_;
+    return rotate90(rotate90(rotate90(@m)));
+}
+
+sub display {
+    my(@m) = @_;
+    for (@m) {
+        say "[ ", join(", ", @$_), " ]"
+    }
+    say "";
+}
diff --git a/challenge-053/paulo-custodio/perl/ch-2.pl b/challenge-053/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..8eb54e16fa
--- /dev/null
+++ b/challenge-053/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,69 @@
+#!/usr/bin/env perl
+
+# Challenge 053
+#
+# TASK #2
+# Vowel Strings
+# Write a script to accept an integer 1 <= N <= 5 that would print all possible
+# strings of size N formed by using only vowels (a, e, i, o, u).
+#
+# The string should follow the following rules:
+#
+# ‘a’ can only be followed by ‘e’ and ‘i’.
+#
+# ‘e’ can only be followed by ‘i’.
+#
+# ‘i’ can only be followed by ‘a’, ‘e’, ‘o’, and ‘u’.
+#
+# ‘o’ can only be followed by ‘a’ and ‘u’.
+#
+# ‘u’ can only be followed by ‘o’ and ‘e’.
+#
+# For example, if the given integer N = 2 then script should print the following
+# strings:
+#
+# ae
+# ai
+# ei
+# ia
+# io
+# iu
+# ie
+# oa
+# ou
+# uo
+# ue
+
+use Modern::Perl;
+
+my $n = shift || 2;
+
+show_vowels($n, "");
+
+sub show_vowels {
+    my($n, $str) = @_;
+    if (length($str)==$n) {
+        say $str;
+    }
+    elsif ($str eq "") {
+        show_vowels($n, $str.$_) for (qw( a e i o u ));
+    }
+    elsif (substr($str, -1, 1) eq 'a') {
+        show_vowels($n, $str.$_) for (qw( e i ));
+    }
+    elsif (substr($str, -1, 1) eq 'e') {
+        show_vowels($n, $str.$_) for (qw( i ));
+    }
+    elsif (substr($str, -1, 1) eq 'i') {
+        show_vowels($n, $str.$_) for (qw( a e o u ));
+    }
+    elsif (substr($str, -1, 1) eq 'o') {
+        show_vowels($n, $str.$_) for (qw( a u ));
+    }
+    elsif (substr($str, -1, 1) eq 'u') {
+        show_vowels($n, $str.$_) for (qw( e o ));
+    }
+    else {
+        die;
+    }
+}
diff --git a/challenge-053/paulo-custodio/t/test-1.yaml b/challenge-053/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..7026d4ac62
--- /dev/null
+++ b/challenge-053/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,17 @@
+- setup:
+  cleanup:
+  args:
+  input:
+  output:   |
+            |[ 7, 4, 1 ]
+            |[ 8, 5, 2 ]
+            |[ 9, 6, 3 ]
+            |
+            |[ 9, 8, 7 ]
+            |[ 6, 5, 4 ]
+            |[ 3, 2, 1 ]
+            |
+            |[ 3, 6, 9 ]
+            |[ 2, 5, 8 ]
+            |[ 1, 4, 7 ]
+            |
diff --git a/challenge-053/paulo-custodio/t/test-2.yaml b/challenge-053/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..b69358fcba
--- /dev/null
+++ b/challenge-053/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,16 @@
+- setup:
+  cleanup:
+  args:     2
+  input:
+  output:   |
+            |ae
+            |ai
+            |ei
+            |ia
+            |ie
+            |io
+            |iu
+            |oa
+            |ou
+            |ue
+            |uo
diff --git a/challenge-054/paulo-custodio/Makefile b/challenge-054/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-054/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-054/paulo-custodio/README b/challenge-054/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-054/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-054/paulo-custodio/perl/ch-1.pl b/challenge-054/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..4aaa753da6
--- /dev/null
+++ b/challenge-054/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+
+# Challenge 054
+#
+# TASK #1
+# kth Permutation Sequence
+# Write a script to accept two integers n (>=1) and k (>=1). It should print the
+# kth permutation of n integers. For more information, please follow the wiki
+# page.
+#
+# For example, n=3 and k=4, the possible permutation sequences are listed below:
+#
+# 123
+# 132
+# 213
+# 231
+# 312
+# 321
+# The script should print the 4th permutation sequence 231.
+
+use Modern::Perl;
+use Math::Combinatorics;
+
+my($n, $k) = @ARGV;
+my @data = (1..$n);
+my $combinat = Math::Combinatorics->new(count => $k, data => \@data);
+while (my @permu = $combinat->next_permutation) {
+    say @permu;
+}
diff --git a/challenge-054/paulo-custodio/perl/ch-2.pl b/challenge-054/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..5aa109c437
--- /dev/null
+++ b/challenge-054/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+
+# Challenge 054
+#
+# TASK #2
+# Collatz Conjecture
+# Contributed by Ryan Thompson
+# It is thought that the following sequence will always reach 1:
+#
+# $n = $n / 2 when $n is even
+# $n = 3*$n + 1 when $n is odd
+# For example, if we start at 23, we get the following sequence:
+#
+# 23 ? 70 ? 35 ? 106 ? 53 ? 160 ? 80 ? 40 ? 20 ? 10 ? 5 ? 16 ? 8 ? 4 ? 2 ? 1
+#
+# Write a function that finds the Collatz sequence for any positive integer.
+# Notice how the sequence itself may go far above the original starting number.
+#
+# Extra Credit
+# Have your script calculate the sequence length for all starting numbers up to
+# 1000000 (1e6), and output the starting number and sequence length for the
+# longest 20 sequences.
+
+use Modern::Perl;
+
+my @longest;
+for my $n (1..1e6) {
+    my @seq = collatz($n);
+    my $len = scalar(@seq);
+    push @longest, [$n => $len];
+    @longest = sort {$b->[1] <=> $a->[1]} @longest;
+    pop @longest if @longest > 20;
+}
+
+for (@longest) {
+    my($n, $len) = @$_;
+    say "$n $len";
+}
+
+sub collatz {
+    my($n) = @_;
+    my @out = ($n);
+    while ($n != 1) {
+        if ($n%2==0) {
+            $n /= 2;
+        }
+        else {
+            $n = 3*$n+1;
+        }
+        push @out, $n;
+    }
+    return @out;
+}
diff --git a/challenge-054/paulo-custodio/t/test-1.yaml b/challenge-054/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..4f1abdea10
--- /dev/null
+++ b/challenge-054/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,11 @@
+- setup:
+  cleanup:
+  args:     3 3
+  input:
+  output:   |
+            |123
+            |132
+            |213
+            |231
+            |312
+            |321
diff --git a/challenge-054/paulo-custodio/t/test-2.yaml b/challenge-054/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..78babb1408
--- /dev/null
+++ b/challenge-054/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,25 @@
+- setup:
+  cleanup:
+  args:     20
+  input:
+  output:   |
+            |837799 525
+            |626331 509
+            |939497 507
+            |704623 504
+            |910107 476
+            |927003 476
+            |511935 470
+            |767903 468
+            |796095 468
+            |970599 458
+            |546681 452
+            |818943 450
+            |820022 450
+            |820023 450
+            |410011 449
+            |615017 447
+            |886953 445
+            |906175 445
+            |922524 445
+            |922525 445
diff --git a/challenge-055/paulo-custodio/Makefile b/challenge-055/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-055/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-055/paulo-custodio/README b/challenge-055/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-055/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-055/paulo-custodio/perl/ch-1.pl b/challenge-055/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..56668e4e45
--- /dev/null
+++ b/challenge-055/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/env perl
+
+# Challenge 055
+#
+# TASK #1
+# Flip Binary
+# You are given a binary number B, consisting of N binary digits 0 or 1: s0, s1,
+# …, s(N-1).
+#
+# Choose two indices L and R such that 0 = L = R < N and flip the digits s(L),
+# s(L+1), …, s(R). By flipping, we mean change 0 to 1 and vice-versa.
+#
+# For example, given the binary number 010, the possible flip pair results are
+# listed below:
+#
+# L=0, R=0 the result binary: 110
+# L=0, R=1 the result binary: 100
+# L=0, R=2 the result binary: 101
+# L=1, R=1 the result binary: 000
+# L=1, R=2 the result binary: 001
+# L=2, R=2 the result binary: 011
+# Write a script to find the indices (L,R) that results in a binary number with
+# maximum number of 1s. If you find more than one maximal pair L,R then print
+# all of them.
+#
+# Continuing our example, note that we had three pairs (L=0, R=0), (L=0, R=2),
+# and (L=2, R=2) that resulted in a binary number with two 1s, which was the
+# maximum. So we would print all three pairs.
+
+use Modern::Perl;
+
+my $bin = shift;
+my $max_1s = 0;
+my @max_1s_pairs;
+
+for my $l (0 .. length($bin)-1) {
+    for my $r ($l .. length($bin)-1) {
+        my @test = split //, $bin;
+        for my $i ($l .. $r) {
+            $test[$i] = 1-$test[$i];
+        }
+        my $_1s = scalar(grep {$_} @test);
+        if ($_1s > $max_1s) {
+            $max_1s = $_1s;
+            @max_1s_pairs = ([$l,$r]);
+        }
+        elsif ($_1s == $max_1s) {
+            push @max_1s_pairs, [$l,$r];
+        }
+    }
+}
+
+my @out;
+for (@max_1s_pairs) {
+    my($l,$r) = @$_;
+    push @out, "(L=$l, R=$r)";
+}
+say join(", ", @out);
diff --git a/challenge-055/paulo-custodio/perl/ch-2.pl b/challenge-055/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..bf28df9b78
--- /dev/null
+++ b/challenge-055/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,57 @@
+#!/usr/bin/env perl
+
+# Challenge 055
+#
+# TASK #2
+# Wave Array
+# Any array N of non-unique, unsorted integers can be arranged into a wave-like
+# array such that n1 = n2 = n3 = n4 = n5 and so on.
+#
+# For example, given the array [1, 2, 3, 4], possible wave arrays include
+# [2, 1, 4, 3] or [4, 1, 3, 2], since 2 = 1 = 4 = 3 and 4 = 1 = 3 = 2.
+# This is not a complete list.
+#
+# Write a script to print all possible wave arrays for an integer array N of
+# arbitrary length.
+#
+# Notes:
+# When considering N of any length, note that the first element is always
+# greater than or equal to the second, and then the =, =, =, … sequence
+# alternates until the end of the array.
+
+use Modern::Perl;
+
+my @n = @ARGV;
+
+show_waves([], [@n]);
+
+sub show_waves {
+    my($wave, $next) = @_;
+    my @wave = @$wave;
+    my @next = @$next;
+    if (@next==0) {
+        say "@wave";
+    }
+    elsif (@wave==0) {
+        for my $i (0 .. @next-1) {
+            show_waves([@wave, $next[$i]],
+                       [@next[0 .. $i-1], @next[$i+1 .. $#next]]);
+        }
+    }
+    elsif (scalar(@wave)%2 == 1) {      # going down
+        for my $i (0 .. @next-1) {
+            if ($wave[-1] >= $next[$i]) {
+                show_waves([@wave, $next[$i]],
+                           [@next[0 .. $i-1], @next[$i+1 .. $#next]]);
+            }
+        }
+    }
+    else {                              # going up
+        for my $i (0 .. @next-1) {
+            if ($wave[-1] <= $next[$i]) {
+                show_waves([@wave, $next[$i]],
+                           [@next[0 .. $i-1], @next[$i+1 .. $#next]]);
+            }
+        }
+    }
+}
diff --git a/challenge-055/paulo-custodio/t/test-1.yaml b/challenge-055/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..dca9170331
--- /dev/null
+++ b/challenge-055/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,5 @@
+- setup:
+  cleanup:
+  args:     010
+  input:
+  output:   (L=0, R=0), (L=0, R=2), (L=2, R=2)
diff --git a/challenge-055/paulo-custodio/t/test-2.yaml b/challenge-055/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..aedd16f29a
--- /dev/null
+++ b/challenge-055/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,10 @@
+- setup:
+  cleanup:
+  args:     1 2 3 4
+  input:
+  output:   |
+            |2 1 4 3
+            |3 1 4 2
+            |3 2 4 1
+            |4 1 3 2
+            |4 2 3 1
diff --git a/challenge-056/paulo-custodio/Makefile b/challenge-056/paulo-custodio/Makefile
new file mode 100644
index 0000000000..c3c762d746
--- /dev/null
+++ b/challenge-056/paulo-custodio/Makefile
@@ -0,0 +1,2 @@
+all:
+	perl ../../challenge-001/paulo-custodio/test.pl
diff --git a/challenge-056/paulo-custodio/README b/challenge-056/paulo-custodio/README
new file mode 100644
index 0000000000..87dc0b2fbd
--- /dev/null
+++ b/challenge-056/paulo-custodio/README
@@ -0,0 +1 @@
+Solution by Paulo Custodio
diff --git a/challenge-056/paulo-custodio/perl/ch-1.pl b/challenge-056/paulo-custodio/perl/ch-1.pl
new file mode 100644
index 0000000000..886f866b18
--- /dev/null
+++ b/challenge-056/paulo-custodio/perl/ch-1.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+
+# Challenge 056
+#
+# TASK #1
+# Diff-K
+# You are given an array @N of positive integers (sorted) and another non
+# negative integer k.
+#
+# Write a script to find if there exists 2 indices i and j such that
+# A[i] - A[j] = k and i != j.
+#
+# It should print the pairs of indices, if any such pairs exist.
+#
+# Example:
+#
+#     @N = (2, 7, 9)
+#     $k = 2
+# Output : 2,1
+
+use Modern::Perl;
+
+my($k, @n) = @ARGV;
+
+for my $i (0 .. $#n-1) {
+    for my $j ($i+1 .. $#n) {
+        if (abs($n[$i]-$n[$j])==$k) {
+            say "$i,$j";
+        }
+    }
+}
diff --git a/challenge-056/paulo-custodio/perl/ch-2.pl b/challenge-056/paulo-custodio/perl/ch-2.pl
new file mode 100644
index 0000000000..cdb3bdba5e
--- /dev/null
+++ b/challenge-056/paulo-custodio/perl/ch-2.pl
@@ -0,0 +1,85 @@
+#!/usr/bin/env perl
+
+# Challenge 056
+#
+# TASK #2
+# Path Sum
+# You are given a binary tree and a sum, write a script to find if the tree has
+# a path such that adding up all the values along the path equals the given sum.
+# Only complete paths (from root to leaf node) may be considered for a sum.
+#
+# Example
+# Given the below binary tree and sum = 22,
+#
+#           5
+#          / \
+#         4   8
+#        /   / \
+#       11  13  9
+#      /  \      \
+#     7    2      1
+# For the given binary tree, the partial path sum 5 ? 8 ? 9 = 22 is not valid.
+#
+# The script should return the path 5 ? 4 ? 11 ? 2 whose sum is 22.
+
+use Modern::Perl;
+use List::Util qw( sum );
+
+# tree object
+{
+    package Tree;
+    use Object::Tiny::RW qw( value left right );
+}
+
+my $sum = shift;
+my $tree = parse_tree();
+path_sum([], $sum, $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 path_sum {
+    my($path, $sum, $tree) = @_;
+    my @path = @$path;
+    push @path, $tree->value;
+
+    if (!$tree->left && !$tree->right) {
+        say "@path" if sum(@path)==$sum;
+    }
+    else {
+        path_sum([@path], $sum, $tree->left) if $tree->left;
+        path_sum([@path], $sum, $tree->right) if $tree->right;
+    }
+}
diff --git a/challenge-056/paulo-custodio/t/test-1.yaml b/challenge-056/paulo-custodio/t/test-1.yaml
new file mode 100644
index 0000000000..96371c5594
--- /dev/null
+++ b/challenge-056/paulo-custodio/t/test-1.yaml
@@ -0,0 +1,5 @@
+- setup:
+  cleanup:
+  args:     2  2 7 9
+  input:
+  output:   1,2
diff --git a/challenge-056/paulo-custodio/t/test-2.yaml b/challenge-056/paulo-custodio/t/test-2.yaml
new file mode 100644
index 0000000000..34676690bf
--- /dev/null
+++ b/challenge-056/paulo-custodio/t/test-2.yaml
@@ -0,0 +1,12 @@
+- setup:
+  cleanup:
+  args:     12
+  input:    |
+            |           5
+            |          / \
+            |         4   8
+            |        /   / \
+            |       1   3   9
+            |      / \       \
+            |     7   2       1
+  output:   5 4 1 2
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:
+