diff options
| author | Mohammad S Anwar <Mohammad.Anwar@yahoo.com> | 2021-09-07 22:32:08 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2021-09-07 22:32:08 +0100 |
| commit | 315ff16e4ba63b4eec93a61318e5ccc9a43b2393 (patch) | |
| tree | 7874f2065afb8b6c1d773b65aa5f9c43e668de7e | |
| parent | 3c94f95af033e2daf3ab21daee70300e2ab6192e (diff) | |
| parent | 0808f9415c5d20cb9c531ad10d2c5567b3c70268 (diff) | |
| download | perlweeklychallenge-club-315ff16e4ba63b4eec93a61318e5ccc9a43b2393.tar.gz perlweeklychallenge-club-315ff16e4ba63b4eec93a61318e5ccc9a43b2393.tar.bz2 perlweeklychallenge-club-315ff16e4ba63b4eec93a61318e5ccc9a43b2393.zip | |
Merge pull request #4852 from choroba/ech129
Add solutions to 129: Root Distance & Add Linked Lists by E. Choroba
| -rwxr-xr-x | challenge-129/e-choroba/perl/ch-1.pl | 66 | ||||
| -rwxr-xr-x | challenge-129/e-choroba/perl/ch-2.pl | 43 |
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'; |
