Merge pull request #4743 from jacoby/master

PL & JS, again

8 files changed, 395 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..29f99b60d3
--- /dev/null
+++ b/challenge-125/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,68 @@
+#!/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;
+}
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..8dd5fb4268
--- /dev/null
+++ b/challenge-125/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,176 @@
+#!/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;
+
+# DIAMETER refers to the edge count, not the node count, 
+# so the it's the node count minus one
+say join "\n", map { join " ", ( -1 + 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};
+}
diff --git a/challenge-126/dave-jacoby/blog.txt b/challenge-126/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..b8525fd32f
--- /dev/null
+++ b/challenge-126/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/08/18/that-one-is-mine-the-perl-and-js-weekly-challenge-126.html
diff --git a/challenge-126/dave-jacoby/node/ch-1.js b/challenge-126/dave-jacoby/node/ch-1.js
new file mode 100644
index 0000000000..1238a11136
--- /dev/null
+++ b/challenge-126/dave-jacoby/node/ch-1.js
@@ -0,0 +1,10 @@
+"use strict";
+
+let n = 25;
+let list = Array(n)
+  .fill()
+  .map((x, i) => i + 1)
+  .filter((x) => ! x.toString().match(/1/) )
+  ;
+console.log(list.join(", "));
+
diff --git a/challenge-126/dave-jacoby/node/ch-2.js b/challenge-126/dave-jacoby/node/ch-2.js
new file mode 100644
index 0000000000..7157f24e66
--- /dev/null
+++ b/challenge-126/dave-jacoby/node/ch-2.js
@@ -0,0 +1,58 @@
+"use strict";
+
+let minemap = [];
+let field = function () {
+  /*
+x * * * x * x x x x
+* * * * * * * * * x
+* * * * x * x * x *
+* * * x x * * * * *
+x * * * x * * * * x
+*/
+}
+  .toString()
+  .split(/\/\*/)[1]
+  .split(/\*\//)[0]
+  .split(/\n/)
+  .filter((x) => String(x).match(/\w/));
+
+let maxx = 0;
+let maxy = 0;
+
+for (let x in field) {
+  maxx = x;
+  let rowstr = field[x];
+  let row = rowstr.split(/\s+/g);
+  minemap[x] = new Array(row.length);
+  for (let y in row) {
+    maxy = y;
+    minemap[x][y] = "0";
+    if (row[y] === "x") {
+      minemap[x][y] = "x";
+    }
+  }
+}
+for (let x = 0; x <= maxx; x++) {
+  for (let y = 0; y <= maxy; y++) {
+    if (minemap[x][y] === "x") {
+      for (let i = -1; i <= 1; i++) {
+        for (let j = -1; j <= 1; j++) {
+          if (!(i == 0 && i == j)) {
+            let xx = x + i;
+            let yy = y + j;
+            if (xx >= 0 && yy >= 0 && xx <= maxx && yy <= maxy) {
+              if (minemap[xx][yy] != "x") {
+                minemap[xx][yy]++;
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+}
+for (let x = 0; x <= maxx; x++) {
+  console.log(minemap[x].join(" "));
+}
+
+// console.log([maxx, maxy, minemap]);
diff --git a/challenge-126/dave-jacoby/perl/ch-1.pl b/challenge-126/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..d71d1e9f8a
--- /dev/null
+++ b/challenge-126/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+
+use strict ;
+use warnings ;
+use feature qw{ say postderef signatures state } ;
+no warnings qw{ experimental } ;
+
+use Carp;
+use Getopt::Long;
+
+my $n = 15;
+GetOptions( 
+    'n=i' => \$n
+);
+
+croak 'Out of Range!' if $n < 1;
+
+say join ', ' , dont_contain( $n );
+
+sub dont_contain ($n ) {
+    return grep { ! /1/ } 1 .. $n
+}
diff --git a/challenge-126/dave-jacoby/perl/ch-2.pl b/challenge-126/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..bcdd6d9741
--- /dev/null
+++ b/challenge-126/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+
+use strict ;
+use warnings ;
+use feature qw{ say postderef signatures state } ;
+no warnings qw{ experimental } ;
+
+use JSON ;
+my $json = JSON->new->space_after->utf8 ;
+
+my $field = <<END;
+x * * * x * x x x x
+* * * * * * * * * x
+* * * * x * x * x *
+* * * x x * * * * *
+x * * * x * * * * x
+END
+
+my @field = map { [ split /\s/, $_ ] }
+    split /\n/, $field ;
+
+my $h = -1 + scalar @field ;
+my $w = -1 + scalar $field[ 0 ]->@* ;
+
+my @map ;
+
+for my $i ( 0 .. $h ) {
+    for my $j ( 0 .. $w ) {
+        $map[ $i ][ $j ] = $field[ $i ][ $j ] eq 'x' ? 'x' : 0 ;
+        }
+    }
+
+for my $i ( 0 .. $h ) {
+    for my $j ( 0 .. $w ) {
+        next unless $map[ $i ][ $j ] eq 'x' ;
+        for my $x ( -1 .. 1 ) {
+            for my $y ( -1 .. 1 ) {
+                my $xx = $i + $x ;
+                my $yy = $j + $y ;
+                next if $xx == 0 && $yy == 0 ;
+                next if $xx < 0 ;
+                next if $yy < 0 ;
+                next if $xx > $h ;
+                next if $yy > $w ;
+                next if $map[ $xx ][ $yy ] eq 'x' ;
+                $map[ $xx ][ $yy ]++ ;
+                }
+            }
+        }
+    }
+show_map( \@map ) ;
+
+sub show_map ( $ref ) {
+    say '-' x 20 ;
+    say join "\n", map { join ' ', $_->@* } $ref->@* ;
+    say '-' x 20 ;
+    say '' ;
+    }
+