2 files changed, 109 insertions, 0 deletions
diff --git a/challenge-129/e-choroba/perl/ch-1.pl b/challenge-129/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..07ba6cacb6
--- /dev/null
+++ b/challenge-129/e-choroba/perl/ch-1.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+# In a tree. the "root distance" is usually called a "rank".
+
+{   package Tree;
+    use Moo;
+
+    has root => (is => 'ro');
+    has parent => (is => 'lazy');
+
+    sub add_child {
+        my ($self, $value, $parent) = @_;
+        die "Unknown parent $parent" unless exists $self->parent->{$parent};
+
+        die "Duplicate parent for $value" if defined $self->parent->{$value}
+                                          && $self->parent->{$value} != $parent;
+
+        $self->parent->{$value} = $parent;
+    }
+
+    sub rank {
+        my ($self, $value) = @_;
+        return 0 unless $self->parent->{$value};
+
+        return 1 + $self->rank($self->parent->{$value})
+    }
+
+    sub _build_parent {
+        my ($self) = @_;
+        +{ $self->root => 0 }
+    }
+}
+
+use Test2::V0;
+plan 11;
+
+my $tree1 = 'Tree'->new(root => 1);
+$tree1->add_child(@$_) for [2, 1], [3, 1], [4, 3], [5, 4], [6, 4];
+
+is $tree1->rank(6), 3, 'Example 1a';
+is $tree1->rank(5), 3, 'Example 1b';
+is $tree1->rank(2), 1, 'Example 1c';
+is $tree1->rank(4), 2, 'Example 1d';
+
+my $tree2 = 'Tree'->new(root => 1);
+$tree2->add_child(@$_) for [2, 1], [4, 2], [6, 4], [8, 6],
+                           [9, 6], [3, 1], [5, 3], [7, 5];
+is $tree2->rank(7), 3, 'Example 2a';
+is $tree2->rank(8), 4, 'Example 2b';
+is $tree2->rank(6), 3, 'Example 2c';
+
+is $tree1->rank(1), 0, 'Root';
+is $tree2->rank(1), 0, 'Root';
+
+my $tree3 = 'Tree'->new(root => 1);
+like dies { $tree3->add_child(3, 2) },
+    qr/Unknown parent 2/,
+    'unknown root';
+
+my $tree4 = 'Tree'->new(root => 1);
+$tree4->add_child(2, 1);
+like dies { $tree4->add_child(1, 2) },
+    qr/Duplicate parent for 1/,
+    'duplicate parent';
diff --git a/challenge-129/e-choroba/perl/ch-2.pl b/challenge-129/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..3aee8a022d
--- /dev/null
+++ b/challenge-129/e-choroba/perl/ch-2.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub add_linked_lists {
+    my ($l1, $l2) = @_;
+
+    my $carry = 0;
+    my $reversed;
+
+    while (@$l1 || @$l2 || $carry) {
+        my $e1 = shift @$l1 // 0;
+        $l1    = shift @$l1 || [];
+        my $e2 = shift @$l2 // 0;
+        $l2    = shift @$l2 || [];
+
+        my $r = $e1 + $e2 + $carry;
+        $carry = int($r / 10);
+        $r %= 10;
+
+        $reversed = $reversed ? [$r, $reversed] : [$r];
+    }
+    return [] unless $reversed;
+
+    my $result = [shift @$reversed];
+    while (@$reversed) {
+        $reversed =  shift @$reversed;
+        $result   = [shift @$reversed, $result];
+    }
+    return $result
+}
+
+use Test2::V0;
+plan 3;
+
+is add_linked_lists([3, [2, [1]]],[1, [2, [3]]]),
+    [4, [4, [4]]], 'Example 1';
+
+is add_linked_lists([5, [4, [3, [2, [1]]]]], [5, [5, [6]]]),
+    [0, [0, [0, [3, [1]]]]], 'Example 2';
+
+is add_linked_lists([5, [9]], [5]),
+    [0, [0, [1]]], 'Carry not lost even when both lists are exhausted';