7 files changed, 69 insertions, 17 deletions
diff --git a/challenge-057/e-choroba/blog.txt b/challenge-057/e-choroba/blog.txt
new file mode 100644
index 0000000000..ce51b5b816
--- /dev/null
+++ b/challenge-057/e-choroba/blog.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/e_choroba/2020/04/perl-weekly-challenge-057-invert-tree-and-shortest-unique-prefix.html
diff --git a/challenge-057/e-choroba/perl/Tree.pm b/challenge-057/e-choroba/perl/Tree.pm
index 571d89d5fa..d64b158745 100644
--- a/challenge-057/e-choroba/perl/Tree.pm
+++ b/challenge-057/e-choroba/perl/Tree.pm
@@ -14,7 +14,7 @@ sub from_structure {
         my ($parent, $left, $right) = ($1, $2, $3);
         $tree{$parent} = [$left, $right];
     }
-    my ($root) = $structure =~ /[0-9]+/g;
+    my ($root) = $structure;
     return $root, \%tree
 }
 
@@ -49,7 +49,7 @@ sub to_structure {
     my @children = @{ $tree->{$node} };
     my $output = $node . '('
                . join(',', map to_structure($_, $tree, 1), @children) . ')';
-    return $inner ? $output : "($output)"
+    return $output
 }
 
 sub to_edges {
diff --git a/challenge-057/e-choroba/perl/ch-1.pl b/challenge-057/e-choroba/perl/ch-1.pl
index f726f44b8a..7c21bd217c 100755
--- a/challenge-057/e-choroba/perl/ch-1.pl
+++ b/challenge-057/e-choroba/perl/ch-1.pl
@@ -4,9 +4,7 @@ use strict;
 
 use ARGV::OrDATA;
 
-my %invert = qw( L R R L );
-
-print s/ ([LR]) / $invert{$1} /r while <DATA>;
+print tr/LR/RL/r while <DATA>;
 
 __DATA__
 4 L 2
diff --git a/challenge-057/e-choroba/perl/ch-1b.pl b/challenge-057/e-choroba/perl/ch-1b.pl
index ba8bffc893..f3ed480ce7 100755
--- a/challenge-057/e-choroba/perl/ch-1b.pl
+++ b/challenge-057/e-choroba/perl/ch-1b.pl
@@ -4,11 +4,15 @@ use strict;
 use feature qw{ say };
 
 sub invert {
+    my ($tree) = @_;
+    $_ = [reverse @$_] for values %$tree;
+}
+
+sub serialise {
     my ($node, $tree) = @_;
     return $node unless exists $tree->{$node};
-
-    my @ch = reverse @{ $tree->{$node} };
-    return $node . '(' . join(',', map invert($_, $tree), @ch) . ')'
+    return "$node("
+           . join(',', map serialise($_, $tree), @{ $tree->{$node} }) . ')'
 }
 
 chomp( my $structure = <DATA> );
@@ -19,8 +23,10 @@ while ($structure =~ s/([0-9]+) \( ([0-9]+) , ([0-9]+) \) /$1/x) {
     $tree{$parent} = [$left, $right];
 }
 
-my ($root) = $structure =~ /[0-9]+/;
-say '(', invert($root, \%tree), ')';
+invert(\%tree);
+
+my ($root) = $structure;
+say serialise($root, \%tree);
 
 __DATA__
-(1(2(4,5),3(6,7)))
+1(2(4,5),3(6,7))
diff --git a/challenge-057/e-choroba/perl/ch-1c.pl b/challenge-057/e-choroba/perl/ch-1c.pl
index ffd907a3f2..f4b39601ca 100755
--- a/challenge-057/e-choroba/perl/ch-1c.pl
+++ b/challenge-057/e-choroba/perl/ch-1c.pl
@@ -6,9 +6,9 @@ use FindBin;
 use lib $FindBin::Bin;
 use Tree qw{ to_graph from_structure from_edges };
 
-for my $g ('(1(2,3))',
-           '(1(200(4(8(16,17),9),5(10,11)),3(6(12,13),7(14,15))))',
-           '(10(200(4,50000),300000(6000000,700)))',
+for my $g ('1(2,3)',
+           '1(200(4(8(16,17),9),5(10,11)),3(6(12,13),7(14,15)))',
+           '10(200(4,50000),300000(6000000,700))',
 ) {
     print to_graph(from_structure($g));
 }
diff --git a/challenge-057/e-choroba/perl/ch-1d.pl b/challenge-057/e-choroba/perl/ch-1d.pl
new file mode 100755
index 0000000000..3352697e99
--- /dev/null
+++ b/challenge-057/e-choroba/perl/ch-1d.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+use Marpa::R2;
+
+sub invert {
+    my ($tree) = @_;
+    return $tree unless ref $tree;
+
+    my ($root) = keys %$tree;
+    $tree->{$root} =  [ reverse @{ $tree->{$root} } ];
+    invert($_) for @{ $tree->{$root} };
+}
+
+sub serialise {
+    my ($tree) = @_;
+    return $tree unless ref $tree;
+
+    my ($root) = keys %$tree;
+    return "$root(" . join(',', map serialise($_), @{ $tree->{$root} }) . ')'
+}
+
+
+my $dsl = << '__DSL__';
+
+lexeme default = latm => 1
+
+Tree ::= node                              action => ::first
+       | node ('(') Tree (',') Tree (')')  action => subtree
+node ~ [0-9]+
+
+__DSL__
+
+sub subtree { +{ $_[1] => [ $_[2], $_[3] ] } }
+
+my $grammar = 'Marpa::R2::Scanless::G'->new({ source => \$dsl });
+
+chomp( my $input = <DATA> );
+my $tree = ${ $grammar->parse(\$input, {semantics_package => 'main'}) };
+
+invert($tree);
+
+say serialise($tree);
+
+__DATA__
+1(2(4,5),3(6,7))
diff --git a/challenge-057/e-choroba/perl/tree.t b/challenge-057/e-choroba/perl/tree.t
index 084acf4499..1f991f6508 100755
--- a/challenge-057/e-choroba/perl/tree.t
+++ b/challenge-057/e-choroba/perl/tree.t
@@ -10,7 +10,7 @@ use Test::More;
 use Test::Deep;
 
 my @edges = ('4 L 2', '5 R 2', '6 L 3', '7 R 3', '2 L 1', '3 R 1');
-my $structure = '(1(2(4,5),3(6,7)))';
+my $structure = '1(2(4,5),3(6,7))';
 
 my ($root_e, $tree_e) = from_edges(@edges);
 cmp_deeply to_edges($tree_e), bag(map [split], @edges), 'edges';
@@ -24,7 +24,7 @@ cmp_deeply to_edges($tree_s), bag(map [split], @edges), 'structure to edges';
 
 my ($root_i, $tree_i) = from_structure($structure);
 invert($tree_i);
-is to_structure($root_i, $tree_i), '(1(3(7,6),2(5,4)))', 'invert';
+is to_structure($root_i, $tree_i), '1(3(7,6),2(5,4))', 'invert';
 
 cmp_deeply join("", to_graph($root_e, $tree_e)),
            join("\n", '1-+-2-+-4',
@@ -33,5 +33,4 @@ cmp_deeply join("", to_graph($root_e, $tree_e)),
                       '      \-7', ""),
            'graph';
 
-
 done_testing();