diff options
| -rwxr-xr-x | challenge-125/jo-37/perl/ch-1.pl | 126 | ||||
| -rwxr-xr-x | challenge-125/jo-37/perl/ch-2.pl | 79 |
2 files changed, 205 insertions, 0 deletions
diff --git a/challenge-125/jo-37/perl/ch-1.pl b/challenge-125/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..8ab6939963 --- /dev/null +++ b/challenge-125/jo-37/perl/ch-1.pl @@ -0,0 +1,126 @@ +#!/usr/bin/perl -s + +use v5.16; +use Test2::V0; +use Math::Prime::Util qw(fordivisors sqrtint lastfor is_power); +use experimental 'signatures'; + +our ($tests, $examples); + +run_tests() if $tests || $examples; # does not return + +die <<EOS unless @ARGV == 1; +usage: $0 [-examples] [-tests] [-verbose] [N] + +-examples + run the examples from the challenge + +-tests + run some tests + +N + Find all Pythagorean triples containing N + +EOS + + +### Input and Output + +map {say "(@$_)"} find_pythagorean_triples(pop @ARGV) or say -1; + + +### Implementation + +# According to Euclid's formula, all Pythagorean triples x² + y² = z² +# can be parametrized using u > v > 0: +# x = u² - v² +# y = 2uv +# z = u² + v². +# +# There is a solution for every n > 2: +# (k + 1)² - k² = 2k + 1, therefore every odd number > 2 appears as x +# and on the other hand every even number > 2 appears as y. +# +# References: +# https://en.wikipedia.org/wiki/Pythagorean_triple + + +# Loop over three subs that find all valid parameters u and v +# reproducing the given number as x, y or z and collect their results. +sub find_pythagorean_triples ($n) { + my @pt; + $_->(\@pt, $n) for + # Triples with x = n + sub ($pt, $x) { + # There is no v < u if u² - (u - 1)² > x or u² ≤ x. + # Resolved to u: + for my $u (sqrtint($x) + 1 .. ($x + 1) / 2) { + # The three-argument version of "is_power" checks if the + # given number is a perfect power and returns the + # integer root at the same time. Incredibly handy. + next unless is_power($u**2 - $x, 2, \my $v); + push @$pt, [$x, 2 * $u * $v, $u**2 + $v**2]; + } + }, + # Triples with y = n + sub ($pt, $y) { + return if $y % 2; + fordivisors { + my ($u, $v) = ($y / (2 * $_), $_); + lastfor, return if $v >= $u; + push @$pt, [$u**2 - $v**2, $y, $u**2 + $v**2]; + } $y / 2; + }, + # Triples with z = n + sub ($pt, $z) { + # There is no u > v if (v + 1)² + v² > z. + # Resolved to v: + for my $v (1 .. (sqrtint(2 * $z - 1) - 1) / 2) { + next unless is_power($z - $v**2, 2, \my $u); + push @$pt, [$u**2 - $v**2, 2 * $u * $v, $z]; + } + }; + + @pt; +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + + like [find_pythagorean_triples(5)], + bag {item [5, 12, 13]; item [3, 4, 5]; end}, 'example 1'; + + like [find_pythagorean_triples(13)], + bag {item [13, 84, 85]; item [5, 12, 13]}, 'example 2'; + + is [find_pythagorean_triples(1)], [], 'example 3' + } + + SKIP: { + skip "tests" unless $tests; + + like [find_pythagorean_triples(20)], + bag { + item [12, 16, 20]; + item [99, 20, 101]; + item [21, 20, 29]; + item [20, 48, 52]; + end}, 'n in all positions'; + is [find_pythagorean_triples(2)], [], + 'the only other number without a solution'; + + like [find_pythagorean_triples(7)], + bag {item [7, 24, 25]; etc}, 'as x'; + like [find_pythagorean_triples(30)], + bag {item [224, 30, 226]; item [16, 30, 34]; etc}, 'as y'; + like [find_pythagorean_triples(13)], + bag {item [5, 12, 13]; etc}, 'as z'; + } + + done_testing; + exit; +} diff --git a/challenge-125/jo-37/perl/ch-2.pl b/challenge-125/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..b6e34eef53 --- /dev/null +++ b/challenge-125/jo-37/perl/ch-2.pl @@ -0,0 +1,79 @@ +#!/usr/bin/perl -s + +use v5.16; +use Test2::V0; +use Graph; +use experimental qw(signatures); + +our ($tests, $examples, $verbose); + +run_tests() if $tests || $examples; # does not return + +die <<EOS unless @ARGV; +usage: $0 [-examples] [-tests] [-verbose] [id:left:right ...] + +-examples + run the examples from the challenge + +-tests + run some tests + +-verbose + show diameter path instead of its length + +id:left:right ... + nodes of the binary tree as node id, left child, right child. + Childs may be omitted. The example may be specified as: + 1:2:5 2:3:4 5:6:7 7:8:10 8:9 + +EOS + + +### Input and Output + +if ($verbose) { + say "path=(@{[grep defined, tree_diameter(@ARGV)]})"; +} else { + say "diameter=", tree_diameter(@ARGV) // 0; +} + + +### Implementation + +# Build the binary tree as a graph and return its diameter. As we are +# allowed to move up and down the tree for a maximum length path, the +# graph has to be undirected. The root node gets lost with this +# construction: any vertex with a degree of one or two may be taken as +# the root node. This doesn't matter here as a diameter path need not +# pass through the root node. +sub tree_diameter (@nodes) { + my $g = Graph->new(undirected => 1); + for my $node (@nodes) { + my ($id, $left, $right) = split /:/, $node; + $g->add_edge($id, $left) if $left; + $g->add_edge($id, $right) if $right; + } + # Return the diameter in scalar context, any diameter path in + # list context or undef if there is no path at all. + $g->diameter; +} + + +### Examples and tests + +sub run_tests { + SKIP: { + skip "examples" unless $examples; + is scalar(tree_diameter(qw(1:2:5 2:3:4 5:6:7 7:8:10 8:9))), + 6, 'example 1'; + } + + SKIP: { + skip "tests" unless $tests; + is scalar(tree_diameter(1)), U(), + 'single root node, (here: the empty graph)'; + } + + done_testing; + exit; +} |