Perl Weekly Challenge 125.

My solutions (task 1, and task 2 ) to the The Weekly Challenge - 125.

Task 1: Pythagorean Triples

Submitted by: Cheok-Yin Fung
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. i

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^2 + b^2 = c^2.

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

Consider a complex number a+i b with integer real and imaginary parts a and b. Its square (a + i b)2=x+iy has real and imaginary parts x=a2-b2 and y=2ab. Notice that its squared modulus is |x+iy|2=x2+y2=(a2-b2)2+4a2b2=(a2+b2)2, so that (x, y, z) with z=|a+ib|2=a2+b2 form a Pythagorean triplet, x2+y2=z2. It turns out that all Pythagorean triplets are integer multiples of triplets of this form. Thus, given N we can check if it is a multiple of some a2-b2, 2ab or a2+b2 for any pair of integers a,b and some multiplier k. If we succeed, a Pythagorean triplet would be k(a2-b2), k(2ab) and k(a2+b2). If we only consider positive numbers, then we can assume b<a. As a2-b2=(a-b)(a+b) is a positive multiple of a+b, a may not be larger than N, bounding our search. Thus, we can test all pairs such that 0<a<N and 0<b<a to get all the Pythagorean triplets that contain N, if there is any.

# Perl weekly challenge 125
# Task 1:  Pythagorean triplets
#
# See https://wlmb.github.io/2021/08/10/PWC125/#task-1-pythagorean-triples
use warnings;
use strict;
use v5.12;
use POSIX qw(floor);
use List::Util qw(uniq);

die "Usage: ./ch-1.pl N1 N2... to search for pythagorean triplets containing Ni"
    unless @ARGV;
foreach(@ARGV){
    my $N=floor($_); # check non-negative integer arguments
    warn("Expected natural"), next unless $N>=0 and $N==$_;
    my @found=();
    foreach my $a(1..$N-1){
	foreach my $b (1..$a-1){
	    push @found, [$a, $b, $_/($a**2-$b**2)] if $_%($a**2-$b**2)==0;
	    push @found, [$a, $b, $_/(2*$a*$b)] if $_%(2*$a*$b)==0;
	    push @found, [$a, $b, $_/($a**2+$b**2)] if $_%($a**2+$b**2)==0;
	}
    }
    say "Input; $_\nOutput:";
    say "\t$_" foreach uniq map { #remove duplicates
	my($A,$B,$K)=@$_; # careful not to confuse with $a and $b from sort
	my ($x, $y, $z)=sort {$a <=> $b} map {$K*$_} ($A**2-$B**2, 2*$A*$B, $A**2+$B**2);
	"\t($x, $y, $z)";
    } @found;
    say("\t-1, no result found") unless @found;
}

Example:

./ch-1.pl `seq 15`

Results:

Input; 1
Output:
	-1, no result found
Input; 2
Output:
	-1, no result found
Input; 3
Output:
		(3, 4, 5)
Input; 4
Output:
		(3, 4, 5)
Input; 5
Output:
		(3, 4, 5)
		(5, 12, 13)
Input; 6
Output:
		(6, 8, 10)
Input; 7
Output:
		(7, 24, 25)
Input; 8
Output:
		(6, 8, 10)
		(8, 15, 17)
Input; 9
Output:
		(9, 12, 15)
		(9, 40, 41)
Input; 10
Output:
		(6, 8, 10)
		(10, 24, 26)
Input; 11
Output:
		(11, 60, 61)
Input; 12
Output:
		(12, 16, 20)
		(9, 12, 15)
		(5, 12, 13)
		(12, 35, 37)
Input; 13
Output:
		(5, 12, 13)
		(13, 84, 85)
Input; 14
Output:
		(14, 48, 50)
Input; 15
Output:
		(15, 20, 25)
		(9, 12, 15)
		(15, 36, 39)
		(8, 15, 17)
		(15, 112, 113)

To my surprise, it seems that most numbers are part of a Pythagorean triplet, if not all numbers beyond 2. I tested up to 1000 and found no non-Phytagorean number N>2. Then I found a reason for that (thanks to Elías Mochán): Any even number N>2 is clearly of the form 2ab (take a=N/2, b=1). Any odd number is of the form a2-b2 (take a=(N+1)/2 and b=(N-1)/2). Thus, either ((N/2)2-1, N, (N/2)2+1/ or (N, (N2-1)/2,(N2+1)/2) form a Pythagorean triplet that contains N for any N>2.

Task 2: Binary Tree Diameter

Submitted by: Mohammad S Anwar
You are given binary tree as below:

    1
   / \
  2   5
 / \ / \
3  4 6  7
       / \
      8  10
     /
    9
Write a script to find the diameter of the given binary tree.

The diameter of a binary tree is the length of the longest
path between any two nodes in a tree. It doesn’t have to pass
through the root.

For the above given binary tree, possible diameters (7) are:

3, 2, 1, 5, 7, 8, 9

or

4, 2, 1, 5, 7, 8, 9

I will assume the input is a string that may be evaluated to yield an anonymous array of the form [value, left, right] which represents the given tree, where left and right are subtrees or empty arrays. This is an ugly but simple representation.

I translate this representation into an anonymous hash for each node of the form {value=>...,left=>..., right=>..., depth=>..., diameter=>...,deepest=>...,head=>...} I construct the tree and calculate its depth recursively from the largest depth of its branches, and its diameter is obtained from the diameters of its children or from the sum of their depths, whichever yields the largest value. I also mantain a reference to the subtree with the deepest path and that with the largest diameter (it may be a self-reference). From it I get the longest path from one leave to another.

# Perl weekly challenge 125
# Task 1:  Binary tree diameter
#
# See https://wlmb.github.io/2021/08/10/PWC125/#task-2-binary-tree-diameter
use warnings;
use strict;
use v5.12;
use List::Util qw(max);

foreach(@ARGV){
    die("Only []0-9, and spaces allowed") unless m/^([][0-9,\s])*$/;
    my $tree_as_array=eval $_;
    warn("eval failed $@"), next if $@;
    my $tree_as_hash=make_tree($tree_as_array);
    my @path=(reverse(path($tree_as_hash->{head}{left})), $tree_as_hash->{head}{value},
	      path($tree_as_hash->{head}{right}));
    say "Input: $_\nDiameter: $tree_as_hash->{diameter}\nPath: ",
        join "-", @path;
}
sub make_tree {
    my $array=shift;
    my %node;
    die "Wrong format" unless ref($array) eq "ARRAY";
    return undef if @$array==0;
    my $value=$array->[0];
    my ($left,$right)=map {make_tree($_)} map {$array->[$_]} (1,2);
    my ($dl, $dr)=map {defined $_?$_->{depth}+1:0} ($left, $right);
    my $depth=max ($dl, $dr);
    my $deepest=$depth==$dl?$left:$right;
    my ($Dl, $Dr)=map {defined $_?$_->{diameter}:0} ($left, $right);
    my $D=(defined $left?$dl:0)+(defined $right?$dr:0)+1;
    my $diameter=max($D, $Dl, $Dr);
    my $head=$diameter==$D?\%node # self reference or
             :$diameter==$dl?$left->{head} # reference to child
             :$right->{head};
    @node{qw(value left right depth deepest diameter head)} # Build the node
    =($value,$left,$right,$depth,$deepest,$diameter,$head);
    return \%node;
}

sub path {
    my $tree=shift;
    return () unless defined $tree;
    return ($tree->{value},path($tree->{deepest}));
}

Given example:

- 1
  - 2
    - 3
    - 4
  - 5
    - 6
    - 7
      - 8
	- 9
      - 10

./ch-2.pl "[1,[2,[3,[],[]],[4,[],[]]],[5,[6,[],[]],[7,[8,[9,[],[]],[]],[10,[],[]]]]]"

Results:

Input: [1,[2,[3,[],[]],[4,[],[]]],[5,[6,[],[]],[7,[8,[9,[],[]],[]],[10,[],[]]]]]
Diameter: 7
Path: 3-2-1-5-7-8-9

Another example:

- 1
  - 2
    - 3
      - 4
      - 5
    - 6
      - 7
      - 8
  - 9

./ch-2.pl "[1,[],[2,[3,[4,[],[]],[5,[],[]]],[6,[7,[],[]],[8,[],[]]]],[9,[],[]]]"

Results:

Input: [1,[],[2,[3,[4,[],[]],[5,[],[]]],[6,[7,[],[]],[8,[],[]]]],[9,[],[]]]
Diameter: 5
Path: 4-3-2-6-7

This case illustrates a tree where the diameter doesn’t include the root.

Written on August 10, 2021