Merge pull request #5431 from jacoby/master

145 == 1! + 4! + 5!

3 files changed, 81 insertions, 0 deletions

diff --git a/challenge-145/dave-jacoby/blog.txt b/challenge-145/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..33f1837d9a
--- /dev/null
+++ b/challenge-145/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/12/27/products-above-trees-the-weekly-challenge-145.html
diff --git a/challenge-145/dave-jacoby/perl/ch-1.pl b/challenge-145/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..49595249a8
--- /dev/null
+++ b/challenge-145/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say state postderef signatures };
+no warnings qw{ experimental };
+
+use List::Util qw{ sum };
+
+my @examples;
+push @examples, [ [ 1, 2, 3 ], [ 4, 5, 6 ] ];
+push @examples,
+    [ [ map { int rand 10 } 1 .. 5 ], [ map { int rand 10 } 1 .. 5 ], ];
+
+for my $e (@examples) {
+    my $a = join ', ', $e->[0]->@*;
+    my $b = join ', ', $e->[1]->@*;
+    my $o = dot_product( $e->@* );
+    say <<"END";
+        \@a = ($a)
+        \@b = ($b)
+        \$dot_product = $o
+END
+}
+
+sub dot_product ( $x, $y ) {
+    return sum
+        map { $x->[$_] * $y->[$_] }
+        map { $_ - 1 } 1 .. scalar $x->@*;
+}
diff --git a/challenge-145/dave-jacoby/perl/ch-2.pl b/challenge-145/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..35cdbeee19
--- /dev/null
+++ b/challenge-145/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+my @examples;
+push @examples, 'redivider';
+push @examples, 'deific';
+push @examples, 'rotors';
+push @examples, 'challenge';
+push @examples, 'champion';
+push @examples, 'christmas';
+push @examples, 'sever';
+push @examples, 'seer';
+push @examples, 'reverse';
+
+for my $e (@examples) {
+    palindrome_tree($e);
+    say '';
+}
+
+sub palindrome_tree($e ) {
+    my %d;
+    my @output;
+    my @letters = grep { $d{$_}++ < 1 } split //, $e;
+
+    say $e;
+
+    for my $i (@letters) {
+        push @output, $i;
+        my $len = length $e;
+    LETTER: for my $x ( 0 .. $len ) {
+            my $l = substr $e, $x, 1;
+            next if $l ne $i;
+            my $string = substr $e, $x;
+            my $slen   = length $string;
+            for my $y ( reverse 2 .. $slen ) {
+                my $substr  = substr $string, 0, $y;
+                my $reverse = reverse $substr;
+                if ( $substr eq $reverse ) {
+                    push @output, $substr;
+                    next LETTER;
+                }
+            }
+        }
+    }
+    say join ' ', @output;
+}