diff options
| -rw-r--r-- | challenge-136/polettix/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-136/polettix/blog1.txt | 1 | ||||
| -rw-r--r-- | challenge-136/polettix/perl/ch-1.pl | 11 | ||||
| -rw-r--r-- | challenge-136/polettix/perl/ch-2.pl | 97 | ||||
| -rw-r--r-- | challenge-136/polettix/raku/ch-1.raku | 11 | ||||
| -rw-r--r-- | challenge-136/polettix/raku/ch-2.raku | 81 |
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; +} |