Trees && Triples

3 files changed, 261 insertions, 0 deletions

diff --git a/challenge-125/dave-jacoby/blog.txt b/challenge-125/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..0a0ccddd87
--- /dev/null
+++ b/challenge-125/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/08/09/trees-and-triples-the-perl-weekly-challenge-125.html
diff --git a/challenge-125/dave-jacoby/perl/ch-1.pl b/challenge-125/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..717d608a68
--- /dev/null
+++ b/challenge-125/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+
+use feature qw{say state signatures};
+use strict;
+use warnings;
+use utf8;
+no warnings qw{ experimental };
+
+use List::Util qw{ uniq };
+use JSON;
+use Carp;
+use Getopt::Long;
+my $json = JSON->new->canonical->space_after;
+
+my $n = 5;
+GetOptions( 'n=i' => \$n, );
+
+carp 'out of range' if $n <= 0;
+
+my $p = pythagorean_triples($n);
+say <<"END";
+
+    INPUT: $n
+    OUTPUT: $p
+
+END
+
+sub pythagorean_triples( $n ) {
+    my @output;
+    push @output, pt_a($n);
+    push @output, pt_c($n);
+    @output = sort grep { defined } @output;
+    return join ", ", @output if @output;
+    return -1;
+}
+
+sub pt_a ($n ) {
+    my @output;
+    my $n2 = $n**2;
+
+    for my $b1 ( 1 .. $n2 ) {
+        my $b2 = $b1**2;
+        my $c2 = $n2 + $b2;
+        my $c  = sqrt $c2;
+        next unless int $c == $c;
+        my @x = sort { $a <=> $b } map { int $_ } $n, $b1, $c;
+        push @output, $json->encode( \@x );
+    }
+    return uniq @output if @output;
+    return undef;
+}
+
+sub pt_c ($n ) {
+    my @output;
+    my $n2 = $n**2;
+
+    for my $b1 ( 1 .. $n2 ) {
+        my $b2 = $b1**2;
+        my $a2 = $n2 - $b2;
+        next unless $a2 > 0;
+        my $a1  = sqrt $a2;
+        next unless int $a1 == $a1;
+        my @x = sort { $a <=> $b } map { int $_ } $n, $b1, $a1;
+        push @output, $json->encode( \@x );
+    }
+    return uniq @output if @output;
+    return undef;
+
+    # my @output;
+    # my $n2 = $n**2;
+
+    # for my $a1 ( 1 .. $n2 ) {
+    #     my $a2 = $a1**2;
+    #     for my $b1 ( 1 .. $n2 ) {
+    #         my $b2 = $b1**2;
+    #         my $c2 = $a2 + $b2;
+    #         next if $c2 > $n2;
+    #         if ( $n2 == $c2 ) {
+    #             my @x = sort { $a <=> $b } map { int $_ } $a1, $b1, $n;
+    #             push @output, $json->encode( \@x );
+    #         }
+    #     }
+    # }
+    # return uniq @output if @output;
+    # return undef;
+}
diff --git a/challenge-125/dave-jacoby/perl/ch-2.pl b/challenge-125/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..b6e5e97817
--- /dev/null
+++ b/challenge-125/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,174 @@
+#!/usr/bin/env perl
+
+use feature qw{say state signatures};
+use strict;
+use warnings;
+use utf8;
+no warnings qw{ experimental };
+
+use List::Util qw{ max };
+use JSON;
+my $json = JSON->new->space_after->canonical;
+
+my %nodes;
+for my $n ( 1 .. 10 ) {
+    my $node = Node->new($n);
+    $nodes{$n} = $node;
+}
+
+$nodes{1}->left( $nodes{2} );
+$nodes{1}->right( $nodes{5} );
+$nodes{2}->left( $nodes{3} );
+$nodes{2}->right( $nodes{4} );
+$nodes{5}->left( $nodes{6} );
+$nodes{5}->right( $nodes{7} );
+$nodes{7}->left( $nodes{8} );
+$nodes{7}->right( $nodes{10} );
+$nodes{8}->left( $nodes{9} );
+
+my @diameters;
+for my $node ( sort values %nodes ) {
+    my $v = $node->value();
+    my $l = $node->is_leaf();
+    push @diameters, btd($node) if $l;
+}
+
+my $max = max map { scalar $_->@* } @diameters;
+my $done;
+
+@diameters =
+    grep {
+    my $s1 = join ' ', $_->@*;
+    my $s2 = join ' ', reverse $_->@*;
+    $done->{$s1}++;
+    $done->{$s2}++;
+    $done->{$s1} < 2;
+    }
+    grep { scalar $_->@* == $max }
+    sort { scalar $b->@* <=> scalar $a->@* } @diameters;
+
+say join "\n", map { join " ", ( scalar $_->@* ), ':', $_->@* }
+
+    @diameters;
+
+sub btd ( $node, $path = [] ) {
+    my @output;
+    my $v = $node->value();
+    push $path->@*, $v;
+
+    my @options;
+    if ( defined $node->parent() ) {
+        my $p  = $node->parent();
+        my $pv = $p->value();
+        my $is = grep /$pv/, $path->@* ? 1 : 0;
+        if ( !grep /$pv/, $path->@* ) {
+            push @options, 'parent';
+        }
+    }
+    if ( defined $node->left() ) {
+        my $p  = $node->left();
+        my $pv = $p->value();
+        my $is = grep /$pv/, $path->@* ? 1 : 0;
+        if ( !grep /$pv/, $path->@* ) {
+            push @options, 'left';
+        }
+    }
+    if ( defined $node->right() ) {
+        my $p  = $node->right();
+        my $pv = $p->value();
+        my $is = grep /$pv/, $path->@* ? 1 : 0;
+        if ( !grep /$pv/, $path->@* ) {
+            push @options, 'right';
+        }
+    }
+
+    if (@options) {
+        for my $option (@options) {
+            if ( $option eq 'parent' ) {
+                my $p = $node->parent();
+                my $path2->@* = map { int } $path->@*;
+                push @output, btd( $p, $path2 );
+            }
+            if ( $option eq 'left' ) {
+                my $p = $node->left();
+                my $path2->@* = map { int } $path->@*;
+                push @output, btd( $p, $path2 );
+            }
+            if ( $option eq 'right' ) {
+                my $p = $node->right();
+                my $path2->@* = map { int } $path->@*;
+                push @output, btd( $p, $path2 );
+            }
+        }
+    }
+    else {
+        push @output, [ map { int } $path->@* ];
+    }
+
+    return @output;
+}
+
+package Node;
+
+sub new ( $class, $value = 0 ) {
+    my $self = {};
+    $self->{value}      = $value;
+    $self->{left}       = undef;
+    $self->{right}      = undef;
+    $self->{horizontal} = undef;
+    $self->{parent}     = undef;
+    return bless $self, $class;
+}
+
+sub value ( $self, $value = undef ) {
+    if ( defined $value ) {
+        $self->{value} = $value;
+    }
+    else {
+        return $self->{value};
+    }
+}
+
+sub is_root ( $self ) {
+    return defined $self->{parent} ? 0 : 1;
+}
+
+sub is_leaf ( $self ) {
+    return ( !defined $self->{left} && !defined $self->{right} )
+        ? 1
+        : 0;
+}
+
+sub left ( $self, $node = undef ) {
+    if ( defined $node ) {
+        $self->{left}   = $node;
+        $node->{parent} = $self;
+    }
+    else {
+        return $self->{left};
+    }
+}
+
+sub right ( $self, $node = undef ) {
+    if ( defined $node ) {
+        $self->{right}  = $node;
+        $node->{parent} = $self;
+    }
+    else {
+        return $self->{right};
+    }
+}
+
+sub horizontal ( $self, $node = undef ) {
+    if ( defined $node ) {
+        $self->{horizontal} = $node;
+        $node->{parent}     = $self;
+    }
+    else {
+        return $self->{horizontal};
+    }
+}
+
+sub parent ($self ) {
+    return $self->{parent};
+}