Add polettix's solution to challenge-136

6 files changed, 202 insertions, 0 deletions

diff --git a/challenge-136/polettix/blog.txt b/challenge-136/polettix/blog.txt
new file mode 100644
index 0000000000..fd81ba240a
--- /dev/null
+++ b/challenge-136/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/10/27/pwc136-two-friendly/
diff --git a/challenge-136/polettix/blog1.txt b/challenge-136/polettix/blog1.txt
new file mode 100644
index 0000000000..2a3990987b
--- /dev/null
+++ b/challenge-136/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2021/10/28/pwc136-fibonacci-sequence/
diff --git a/challenge-136/polettix/perl/ch-1.pl b/challenge-136/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..c645cbf728
--- /dev/null
+++ b/challenge-136/polettix/perl/ch-1.pl
@@ -0,0 +1,11 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+say two_friendly(@ARGV ? @ARGV[0, 1] : (8, 24)) ? 1 : 0;
+sub two_friendly ($m, $n) { positive_power2(gcd($m, $n)) }
+sub positive_power2 ($x) { $x > 1 && is_power2($x) }
+sub is_power2 ($x) { $x == 1 || $x > 0 && !($x % 2) && is_power2($x >> 1) }
+sub gcd ($A, $B) { ($A, $B) = ($B % $A, $A) while $A; $B }
diff --git a/challenge-136/polettix/perl/ch-2.pl b/challenge-136/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..f9f591c098
--- /dev/null
+++ b/challenge-136/polettix/perl/ch-2.pl
@@ -0,0 +1,97 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use English qw< -no_match_vars >;
+use autodie;
+
+main(shift || 1);
+
+sub main {
+   my ($n) = @_;
+
+   # compute the "basic" Zeckendorf decomposition of $n
+   my $lk = lekkerkerker($n);
+
+   # compute a "reasonable" decomposition into possible non-overlapping
+   # components
+   my @components;
+   for my $i (reverse 0 .. $#{$lk->{indexes}}) {
+      my $index = $lk->{indexes}[$i];
+      my $low_index = $i ? $lk->{indexes}[$i - 1] : 0;
+      my $alts = alternatives($index, $low_index);
+      push @components, $alts;
+   }
+
+   # compute all possible arrangements, reject those with overlaps and
+   # print the others
+   my $count = 0;
+   nested_loops_recursive(
+      \@components,
+      sub {
+         my %seen;
+         my $sum = 0;
+         for my $constituent (@_) {
+            for my $i (@$constituent) {
+               return if $seen{$i}++;
+               my $fi = $lk->{fibo}[$i];
+               $sum += $fi;
+            }
+         }
+         die "sum mismatch ($sum vs $n)\n" unless $n == $sum;
+         ++$count;
+      }
+   );
+
+   say $count;
+}
+
+sub lekkerkerker {
+   my ($n) = @_;
+   my @fibo = (1, 2);
+   push @fibo, $fibo[-2] + $fibo[-1] while $fibo[-1] < $n;
+   my $i = $#fibo;
+   my @indexes;
+   while ($n > 0) {
+      --$i while $fibo[$i] > $n;
+      unshift @indexes, $i;
+      $n -= $fibo[$i];
+   }
+   return {
+      fibo => \@fibo,
+      indexes => \@indexes,
+   };
+}
+
+# split an input index into the Fibonacci array into possible alternative
+# index sets representing the same Fibonacci number in alternative ways,
+# down to a lower index $il
+sub alternatives {
+   my ($i, $il) = @_;
+   my @item = ($i);
+   my @retval = ([$i]);
+   while ($i > $il + 1) {
+      pop @item;
+      push @item, $i - 1, $i - 2;
+      push @retval, [@item];
+      $i -= 2;
+   }
+   return \@retval;
+}
+
+# simplified from
+# https://github.polettix.it/ETOOBUSY/2020/07/28/nested-loops-recursive/
+sub nested_loops_recursive {
+   my ($dims, $cb, $accumulator) = @_;
+   $accumulator = [] unless defined $accumulator;
+   my $level = @{$accumulator};
+   if ($level == @{$dims}) { # fire callback!
+      $cb->(@{$accumulator});
+      return;
+   }
+   for my $item (@{$dims->[$level]}) {
+      push @{$accumulator}, $item;
+      nested_loops_recursive($dims, $cb, $accumulator);
+      pop @{$accumulator};
+   }
+   return;
+}
diff --git a/challenge-136/polettix/raku/ch-1.raku b/challenge-136/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..af7dff25c0
--- /dev/null
+++ b/challenge-136/polettix/raku/ch-1.raku
@@ -0,0 +1,11 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN ($m = 8, $n = 24) { put two-friendly($m, $n) ?? 1 !! 0 }
+subset Pint of Int where * > 0;
+sub two-friendly (Pint:D $m, Pint:D $n) { positive-power2(gcd($m, $n)) }
+sub positive-power2 ($x) { $x > 1 && is-power2($x) }
+multi sub is-power2 (1) { True }
+multi sub is-power2 ($x where * <= 0) { False }
+multi sub is-power2 ($x where * %% 2) { is-power2($x +> 1) }
+multi sub is-power2 ($x) { False }
+sub gcd ($A is copy, $B is copy) { ($A, $B) = $B % $A, $A while $A; $B }
diff --git a/challenge-136/polettix/raku/ch-2.raku b/challenge-136/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..ae0809a560
--- /dev/null
+++ b/challenge-136/polettix/raku/ch-2.raku
@@ -0,0 +1,81 @@
+#!/usr/bin/env raku
+use v6;
+
+sub MAIN (Int:D $n where * > 0 = 1) {
+   # compute the "basic" Zeckendorf decomposition of $n
+   my %lk = lekkerkerker($n);
+
+   # compute a "reasonable" decomposition into possible non-overlapping
+   # components
+   my @components;
+   for (0 .. %lk<indexes>.end).reverse -> $i {
+      my $index = %lk<indexes>[$i];
+      my $low_index = $i ?? %lk<indexes>[$i - 1] !! 0;
+      my @alts = alternatives($index, $low_index);
+      @components.push: @alts;
+   }
+
+   # compute all possible arrangements, reject those with overlaps and
+   # print the others
+   my $count = 0;
+   nested_loops_recursive(
+      @components,
+      sub (*@stuff) {
+         my %seen;
+         my $sum = 0;
+         for @stuff -> $constituent {
+            for @$constituent -> $i {
+               return if %seen{$i}++;
+               my $fi = %lk<fibo>[$i];
+               $sum += $fi;
+            }
+         }
+         die "sum mismatch ($sum vs $n)\n" unless $n == $sum;
+         ++$count;
+      }
+   );
+   $count.put;
+}
+
+sub lekkerkerker (Int:D $n is copy) {
+   my @fibo = 1, 2;
+   push @fibo, @fibo[*-2] + @fibo[*-1] while @fibo[*-1] < $n;
+   my $i = @fibo.end;
+   my @indexes;
+   while $n > 0 {
+      --$i while @fibo[$i] > $n;
+      @indexes.unshift: $i;
+      $n -= @fibo[$i];
+   }
+   return (
+      fibo => @fibo,
+      indexes => @indexes,
+   ).hash;
+}
+
+sub alternatives (Int:D $i is copy where * >= 0, Int:D $il where * >= 0) {
+   my @item = $i;
+   my @retval = [$i],;
+   while $i > $il + 1 {
+      @item.pop;
+      @item.push: $i - 1;
+      @item.push: $i - 2;
+      @retval.push: [@item.List];
+      $i -= 2;
+   }
+   return @retval;
+}
+
+sub nested_loops_recursive (@dims, &cb, @accumulator = []) {
+   my $level = @accumulator.elems;
+   if $level == @dims.elems { # fire callback!
+      &cb(@accumulator);
+      return;
+   }
+   for @dims[$level].List -> $item {
+      @accumulator.push: $item;
+      nested_loops_recursive(@dims, &cb, @accumulator);
+      @accumulator.pop;
+   }
+   return;
+}