From 06e323f78c6aab067bb0c7f59764f19f422fd4c5 Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Sat, 25 Apr 2020 22:36:18 +0200
Subject: Keep only two solutions to Invert Tree (and the bonus)

---
 challenge-057/e-choroba/perl/ch-1.pl  | 24 ++++++++----------------
 challenge-057/e-choroba/perl/ch-1a.pl | 17 -----------------
 challenge-057/e-choroba/perl/ch-1b.pl | 19 ++++++++++---------
 3 files changed, 18 insertions(+), 42 deletions(-)
 delete mode 100755 challenge-057/e-choroba/perl/ch-1a.pl

diff --git a/challenge-057/e-choroba/perl/ch-1.pl b/challenge-057/e-choroba/perl/ch-1.pl
index 5af1aa8245..f726f44b8a 100755
--- a/challenge-057/e-choroba/perl/ch-1.pl
+++ b/challenge-057/e-choroba/perl/ch-1.pl
@@ -1,25 +1,17 @@
 #!/usr/bin/perl
 use warnings;
 use strict;
-use feature qw{ say };
 
 use ARGV::OrDATA;
 
-use FindBin;
-use lib $FindBin::Bin;
-use Tree qw{ from_structure };
+my %invert = qw( L R R L );
 
-sub invert {
-    my ($node, $tree) = @_;
-    return $node unless exists $tree->{$node};
-
-    my @ch = reverse @{ $tree->{$node} };
-    return $node . '(' . join(',', map invert($_, $tree), @ch) . ')'
-}
-
-chomp( my $structure = <> );
-my ($root, $tree) = from_structure($structure);
-say '(', invert($root, $tree), ')';
+print s/ ([LR]) / $invert{$1} /r while <DATA>;
 
 __DATA__
-(1(2(4,5),3(6,7)))
+4 L 2
+5 R 2
+6 L 3
+7 R 3
+2 L 1
+3 R 1
diff --git a/challenge-057/e-choroba/perl/ch-1a.pl b/challenge-057/e-choroba/perl/ch-1a.pl
deleted file mode 100755
index f726f44b8a..0000000000
--- a/challenge-057/e-choroba/perl/ch-1a.pl
+++ /dev/null
@@ -1,17 +0,0 @@
-#!/usr/bin/perl
-use warnings;
-use strict;
-
-use ARGV::OrDATA;
-
-my %invert = qw( L R R L );
-
-print s/ ([LR]) / $invert{$1} /r while <DATA>;
-
-__DATA__
-4 L 2
-5 R 2
-6 L 3
-7 R 3
-2 L 1
-3 R 1
diff --git a/challenge-057/e-choroba/perl/ch-1b.pl b/challenge-057/e-choroba/perl/ch-1b.pl
index 5af1aa8245..ba8bffc893 100755
--- a/challenge-057/e-choroba/perl/ch-1b.pl
+++ b/challenge-057/e-choroba/perl/ch-1b.pl
@@ -3,12 +3,6 @@ use warnings;
 use strict;
 use feature qw{ say };
 
-use ARGV::OrDATA;
-
-use FindBin;
-use lib $FindBin::Bin;
-use Tree qw{ from_structure };
-
 sub invert {
     my ($node, $tree) = @_;
     return $node unless exists $tree->{$node};
@@ -17,9 +11,16 @@ sub invert {
     return $node . '(' . join(',', map invert($_, $tree), @ch) . ')'
 }
 
-chomp( my $structure = <> );
-my ($root, $tree) = from_structure($structure);
-say '(', invert($root, $tree), ')';
+chomp( my $structure = <DATA> );
+
+my %tree;
+while ($structure =~ s/([0-9]+) \( ([0-9]+) , ([0-9]+) \) /$1/x) {
+    my ($parent, $left, $right) = ($1, $2, $3);
+    $tree{$parent} = [$left, $right];
+}
+
+my ($root) = $structure =~ /[0-9]+/;
+say '(', invert($root, \%tree), ')';
 
 __DATA__
 (1(2(4,5),3(6,7)))
-- 
cgit 


From 090fd1cf8d3c10c847ce1f6f68706d28fd8d3b56 Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Sun, 26 Apr 2020 00:38:12 +0200
Subject: Add a blog post by E. Choroba about 057

Invert Tree and Shotest Unique Prefix

Also, fix the code according to the blog post.
---
 challenge-057/e-choroba/blog.txt      |  1 +
 challenge-057/e-choroba/perl/Tree.pm  |  4 +--
 challenge-057/e-choroba/perl/ch-1.pl  |  4 +--
 challenge-057/e-choroba/perl/ch-1b.pl | 18 ++++++++-----
 challenge-057/e-choroba/perl/ch-1c.pl |  6 ++---
 challenge-057/e-choroba/perl/ch-1d.pl | 48 +++++++++++++++++++++++++++++++++++
 challenge-057/e-choroba/perl/tree.t   |  5 ++--
 7 files changed, 69 insertions(+), 17 deletions(-)
 create mode 100644 challenge-057/e-choroba/blog.txt
 create mode 100755 challenge-057/e-choroba/perl/ch-1d.pl

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();
-- 
cgit