laurent_r

These are some answers to the Week 125 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 1: Pythagorean Triples

You are given a positive integer $N.

Write a script to print all Pythagorean Triples containing $N as a member. Print -1 if it can’t be a member of any.

Triples with the same set of elements are considered the same, i.e. if your script has already printed (3, 4, 5), (4, 3, 5) should not be printed.

The famous Pythagorean theorem states that in a right angle triangle, the length of the two shorter sides and the length of the longest side are related by a²+b² = c².

A Pythagorean triple refers to the triple of three integers whose lengths can compose a right-angled triangle.

Example:

Input: $N = 5
Output:
    (3, 4, 5)
    (5, 12, 13)

Input: $N = 13
Output:
    (5, 12, 13)
    (13, 84, 85)

Input: $N = 1
Output:
    -1

It has been known since Euclid and is quite easy to prove that any integer larger than 2 can be part of a Pythagorean triple. We’ll use that knowledge in our implementation.

On the other hand, I don’t really know how to be sure that you really produce an exhaustive list of triples for a given input value.

Pythagorean Triples in Raku

There are several possible ways to go for this task, but I decided to build a data structure with all Pythagorean triples within a certain range. This is probably efficient if we’re going to test many input values (as done in the script below), but probably not for one single value.

use v6;

my @squares = map { $_² }, 1..Inf;
my $max = 200;
my $square-set = @squares[0..$max];
my @square-triples = gather {
    for (@squares[0..$max]).combinations(2) -> $comb {
        my $sum = [+] $comb;
        take (|$comb, $sum) if $sum (elem) $square-set;
    }
}
# say @square-triples;
my %look-up = 0 => -1, 1 => -1, 2 => -1;
for @square-triples -> $triple {
    push %look-up, $triple[$_].sqrt => (map { $_.sqrt}, $triple[0..2]) for 0..2;
}
# say %look-up{13};
for 1..20 -> $test {
    say "$test:\t", %look-up{$test};
}

This program displays the following output:

$ raku ./pythagorean-triples.raku
1:      -1
2:      -1
3:      (3 4 5)
4:      (3 4 5)
5:      [(3 4 5) (5 12 13)]
6:      (6 8 10)
7:      (7 24 25)
8:      [(6 8 10) (8 15 17)]
9:      [(9 12 15) (9 40 41)]
10:     [(6 8 10) (10 24 26)]
11:     (11 60 61)
12:     [(5 12 13) (9 12 15) (12 16 20) (12 35 37)]
13:     [(5 12 13) (13 84 85)]
14:     (14 48 50)
15:     [(8 15 17) (9 12 15) (15 20 25) (15 36 39) (15 112 113)]
16:     [(12 16 20) (16 30 34) (16 63 65)]
17:     [(8 15 17) (17 144 145)]
18:     [(18 24 30) (18 80 82)]
19:     (19 180 181)
20:     [(12 16 20) (15 20 25) (20 21 29) (20 48 52) (20 99 101)]

Pythagorean Triples in Raku

Again, we produce a data structure with all Pythagorean triples within a certain range. This is probably efficient if we’re going to test many input values (as done in the script below), but probably not for one single value.

Perl don’t have a built-in combinations function. So, we could use again the recursive combine subroutine of last week’s challenge:

sub combine {
    my $count = shift;
    my @out = @{$_[0]};
    my @in  = @{$_[1]};
    if ($count == 0) {
        push @combinations, [@out];
        return;
    }
    for my $i (0..$#in) {
        combine ($count - 1, [@out, $in[$i]], [@in[0..$i -1], @in[$i+1..$#in]]);
    }
}

and call it thus:

combine 2, [], [2..20]; # populates @combinations

But, here, we only need to produce combinations of two items, and it is therefore simpler to generate them directly like this:

my @combinations;
for my $i (2..200) {
    push @combinations, [$i, $_] for $i+1 .. $max;
}

So, this is my Perl implementation of the task:

use strict;
use warnings;
use feature qw/say/;

my $max = 300;
my @squares = map  $_ * $_ , 1..$max;
my %square_hash = map { $_ => 1 } @squares;
my @combinations;
for my $i (2..200) {
    push @combinations, [$i, $_] for $i+1 .. $max;
}   
my @triples;
for my $comb (@combinations) {
    my $sum_sq = $comb->[0] ** 2 + $comb->[1] ** 2;
    push @triples, [ @$comb, 0 + $sum_sq ** 0.5 ] if exists $square_hash{$sum_sq};
}
my %look_up = (0 => " [ -1 ] ", 1 => " [ -1 ] ", 2 => " [ -1 ] " );
for my $triple (@triples) {
    for my $val (@$triple) {
        $look_up{$val} .= " [ @$triple ] " ;
    }
}
for my $test (1..30) {
    my $result = $look_up{$test};
    say "$test:\t $result";
}

This program displays the following output:

$ perl pythagorean-triples.pl
1:        [ -1 ]
2:        [ -1 ]
3:        [ 3 4 5 ]
4:        [ 3 4 5 ]
5:        [ 3 4 5 ]  [ 5 12 13 ]
6:        [ 6 8 10 ]
7:        [ 7 24 25 ]
8:        [ 6 8 10 ]  [ 8 15 17 ]
9:        [ 9 12 15 ]  [ 9 40 41 ]
10:       [ 6 8 10 ]  [ 10 24 26 ]
11:       [ 11 60 61 ]
12:       [ 5 12 13 ]  [ 9 12 15 ]  [ 12 16 20 ]  [ 12 35 37 ]
13:       [ 5 12 13 ]  [ 13 84 85 ]
14:       [ 14 48 50 ]
15:       [ 8 15 17 ]  [ 9 12 15 ]  [ 15 20 25 ]  [ 15 36 39 ]  [ 15 112 113 ]
16:       [ 12 16 20 ]  [ 16 30 34 ]  [ 16 63 65 ]
17:       [ 8 15 17 ]  [ 17 144 145 ]
18:       [ 18 24 30 ]  [ 18 80 82 ]
19:       [ 19 180 181 ]
20:       [ 12 16 20 ]  [ 15 20 25 ]  [ 20 21 29 ]  [ 20 48 52 ]  [ 20 99 101 ]
21:       [ 20 21 29 ]  [ 21 28 35 ]  [ 21 72 75 ]  [ 21 220 221 ]
22:       [ 22 120 122 ]
23:       [ 23 264 265 ]
24:       [ 7 24 25 ]  [ 10 24 26 ]  [ 18 24 30 ]  [ 24 32 40 ]  [ 24 45 51 ]  [ 24 70 74 ]  [ 24 143 145 ]
25:       [ 7 24 25 ]  [ 15 20 25 ]  [ 25 60 65 ]
26:       [ 10 24 26 ]  [ 26 168 170 ]
27:       [ 27 36 45 ]  [ 27 120 123 ]
28:       [ 21 28 35 ]  [ 28 45 53 ]  [ 28 96 100 ]  [ 28 195 197 ]
29:       [ 20 21 29 ]
30:       [ 16 30 34 ]  [ 18 24 30 ]  [ 30 40 50 ]  [ 30 72 78 ]  [ 30 224 226 ]

I’m very late and have no time this week for the second task.

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on August 22, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.