Merge pull request #5124 from jacoby/master

Challenge 136

3 files changed, 106 insertions, 0 deletions

diff --git a/challenge-136/dave-jacoby/blog.txt b/challenge-136/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..4820c56511
--- /dev/null
+++ b/challenge-136/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/10/25/the-sequential-friendly-book-the-weekly-challenge-136.html
diff --git a/challenge-136/dave-jacoby/perl/ch-1.pl b/challenge-136/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..67eece6bc7
--- /dev/null
+++ b/challenge-136/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say state postderef signatures };
+no warnings qw{ experimental };
+
+my @examples = ( [ 8, 24 ], [ 26, 39 ], [ 4, 10 ], [ 24, 40 ] );
+
+for my $i (@examples) {
+    my ( $m, $n ) = $i->@*;
+    my $o = two_friendly( $i->@* );
+    say <<"END";
+    Input: \$m = $m \$n = $n
+    Output: $o
+END
+}
+
+# "Two-Friendly" means the greatest common
+# denominator is a power of two.
+
+# Greatest common denomonator is the product
+# of all the common denominators. 
+
+# So, the moment you get a common denominator 
+# that is NOT zero, you have a two-unfriendly
+# number and can securely return 0
+sub two_friendly ( $m = 8, $n = 16 ) {
+    my ($lower) = sort { $a <=> $b } $m, $n;
+    for my $i ( 2 .. $lower ) {
+        while ( $m % $i == 0 && $n % $i == 0 ) {
+            $m /= $i;
+            $n /= $i;
+            return 0 if $i != 2;
+        }
+    }
+    return 1;
+}
diff --git a/challenge-136/dave-jacoby/perl/ch-2.pl b/challenge-136/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..57f66a430a
--- /dev/null
+++ b/challenge-136/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,67 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+use JSON;
+use List::Util qw{ sum0 uniq };
+my $json = JSON->new->pretty->canonical;
+
+my @examples = qw{16 9 15};
+
+for my $n (@examples) {
+    my @o  = solve_task($n);
+    my $o  = scalar @o;
+    my $oo = join ",\n        ", map { ($_) } @o;
+
+    say <<"END";
+    Input: \$n = $n
+    Output: $o
+        $oo
+END
+}
+
+sub solve_task ($n) {
+    my @fib       = grep { $_ < $n } map { fib($_) } 1 .. $n;
+    my @sequences = recursion( $n, \@fib );
+    return @sequences;
+}
+
+# Let's call it what it is
+sub recursion ( $n, $ref, $x = [] ) {
+    my @output;
+    my $depth   = 1 + scalar $x->@*;
+    my $sum     = sum0 $x->@*;
+    my $nex->@* = sort $ref->@*;
+
+    return undef if $sum > $n;
+
+    if ( $sum == $n ) {
+        $x->@* = sort { $a <=> $b } map { int $_ } $x->@*;
+        my $answer = join ' + ', $x->@*;
+        return $answer;
+    }
+
+    for my $i ( 1 .. scalar $nex->@* ) {
+        my $v = shift $nex->@*;
+        my $y->@* = $x->@*;
+        push $y->@*, $v;
+
+        my @return = recursion( $n, $nex, $y );
+        push @output, @return;
+        push $nex->@*, $v;
+    }
+    return uniq sort grep { defined } @output;
+}
+
+sub fib ($n) {
+    state $fib;
+    $fib->{0} = 1;
+    $fib->{1} = 1;
+    if ( $fib->{$n} ) {
+        return $fib->{$n};
+    }
+    $fib->{$n} = fib( $n - 1 ) + fib( $n - 2 );
+}