Arne Sommer

9 files changed, 361 insertions, 0 deletions

diff --git a/challenge-136/arne-sommer/blog.txt b/challenge-136/arne-sommer/blog.txt
new file mode 100644
index 0000000000..b88aac27cd
--- /dev/null
+++ b/challenge-136/arne-sommer/blog.txt
@@ -0,0 +1 @@
+https://raku-musings.com/friendly-fibonacci.html
diff --git a/challenge-136/arne-sommer/perl/ch-1.pl b/challenge-136/arne-sommer/perl/ch-1.pl
new file mode 100755
index 0000000000..e51eb0135b
--- /dev/null
+++ b/challenge-136/arne-sommer/perl/ch-1.pl
@@ -0,0 +1,59 @@
+#! /usr/bin/env perl
+
+use strict;
+use feature 'say';
+use feature 'signatures';
+no warnings qw(experimental::signatures);
+
+# use List::MoreUtils 'duplicates';
+use Getopt::Long;
+
+my $verbose = 0;
+GetOptions("verbose"  => \$verbose);
+
+my $m = shift(@ARGV) // die "Please specify two integers > 0";
+my $n = shift(@ARGV) // die "Please specify two integers > 0";
+
+die "Please specify an integer > 0" unless $m =~ /^[1-9]\d*$/;
+die "Please specify an integer > 0" unless $n =~ /^[1-9]\d*$/;
+
+my $gcd    = gcd($m, $n);
+my $binary = sprintf ("%b", $gcd);
+my $ones   = scalar grep { /1/ } split("", $binary);
+
+say ": GCD($m,$n): $gcd -> binary: $binary ($ones)" if $verbose;
+
+($gcd == 1 || $ones != 1) ? say 0 : say 1;
+
+sub gcd ($a, $b)
+{
+  my @a = divisors($a);
+  my @b = divisors($b);
+  my @common = duplicates(@a, @b);
+  my $gcd    = $common[$#common];
+  
+  return $gcd;
+}
+
+sub divisors ($number)
+{
+  my @divisors = (1);
+  
+  for my $candidate (2 .. $number/2)
+  {
+    push(@divisors, $candidate) if $number % $candidate == 0;
+  }
+  
+  push(@divisors, $number);
+  
+  return @divisors;
+}
+
+sub duplicates (@)
+{
+    my %seen = ();
+    my $k;
+    my $seen_undef;
+    return grep { 1 < (defined $_ ? $seen{$k = $_} : $seen_undef) }
+      grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;
+}
diff --git a/challenge-136/arne-sommer/perl/ch-2.pl b/challenge-136/arne-sommer/perl/ch-2.pl
new file mode 100755
index 0000000000..73f431785b
--- /dev/null
+++ b/challenge-136/arne-sommer/perl/ch-2.pl
@@ -0,0 +1,48 @@
+#! /usr/bin/env perl
+
+use strict;
+use feature 'say';
+use List::Util 'sum';
+use Algorithm::Combinatorics 'combinations';
+use Getopt::Long;
+
+my $verbose = 0;
+GetOptions("verbose"  => \$verbose);
+
+my $n = shift(@ARGV) // die "Please specify an integer > 0";
+die "Please specify an integer > 0" unless $n =~ /^[1-9]\d*$/;
+
+my @fib = (1, 2);
+
+while (1)
+{
+  my $new = $fib[-1] + $fib[-2];
+  last if $new > $n;
+  push(@fib, $new);
+}
+
+say ": Fibonacci(<=$n): ", join(", ", @fib) if $verbose;
+
+my $count = 0;
+
+for my $size (1 .. @fib)
+{
+  for my $perm (combinations(\@fib, $size))
+  {
+    my $sum = sum(@$perm);
+
+    print ": Sequence: ", join(", ", @$perm), " = $sum" if $verbose;
+
+    if ($sum == $n)
+    {
+      $count++;
+      say " match" if $verbose;
+    }
+    else
+    {
+      say "" if $verbose;
+    }
+  }  
+}
+
+say $count;
diff --git a/challenge-136/arne-sommer/perl/fibonacci-sequence-perl b/challenge-136/arne-sommer/perl/fibonacci-sequence-perl
new file mode 100755
index 0000000000..73f431785b
--- /dev/null
+++ b/challenge-136/arne-sommer/perl/fibonacci-sequence-perl
@@ -0,0 +1,48 @@
+#! /usr/bin/env perl
+
+use strict;
+use feature 'say';
+use List::Util 'sum';
+use Algorithm::Combinatorics 'combinations';
+use Getopt::Long;
+
+my $verbose = 0;
+GetOptions("verbose"  => \$verbose);
+
+my $n = shift(@ARGV) // die "Please specify an integer > 0";
+die "Please specify an integer > 0" unless $n =~ /^[1-9]\d*$/;
+
+my @fib = (1, 2);
+
+while (1)
+{
+  my $new = $fib[-1] + $fib[-2];
+  last if $new > $n;
+  push(@fib, $new);
+}
+
+say ": Fibonacci(<=$n): ", join(", ", @fib) if $verbose;
+
+my $count = 0;
+
+for my $size (1 .. @fib)
+{
+  for my $perm (combinations(\@fib, $size))
+  {
+    my $sum = sum(@$perm);
+
+    print ": Sequence: ", join(", ", @$perm), " = $sum" if $verbose;
+
+    if ($sum == $n)
+    {
+      $count++;
+      say " match" if $verbose;
+    }
+    else
+    {
+      say "" if $verbose;
+    }
+  }  
+}
+
+say $count;
diff --git a/challenge-136/arne-sommer/perl/two-friendly-perl b/challenge-136/arne-sommer/perl/two-friendly-perl
new file mode 100755
index 0000000000..e51eb0135b
--- /dev/null
+++ b/challenge-136/arne-sommer/perl/two-friendly-perl
@@ -0,0 +1,59 @@
+#! /usr/bin/env perl
+
+use strict;
+use feature 'say';
+use feature 'signatures';
+no warnings qw(experimental::signatures);
+
+# use List::MoreUtils 'duplicates';
+use Getopt::Long;
+
+my $verbose = 0;
+GetOptions("verbose"  => \$verbose);
+
+my $m = shift(@ARGV) // die "Please specify two integers > 0";
+my $n = shift(@ARGV) // die "Please specify two integers > 0";
+
+die "Please specify an integer > 0" unless $m =~ /^[1-9]\d*$/;
+die "Please specify an integer > 0" unless $n =~ /^[1-9]\d*$/;
+
+my $gcd    = gcd($m, $n);
+my $binary = sprintf ("%b", $gcd);
+my $ones   = scalar grep { /1/ } split("", $binary);
+
+say ": GCD($m,$n): $gcd -> binary: $binary ($ones)" if $verbose;
+
+($gcd == 1 || $ones != 1) ? say 0 : say 1;
+
+sub gcd ($a, $b)
+{
+  my @a = divisors($a);
+  my @b = divisors($b);
+  my @common = duplicates(@a, @b);
+  my $gcd    = $common[$#common];
+  
+  return $gcd;
+}
+
+sub divisors ($number)
+{
+  my @divisors = (1);
+  
+  for my $candidate (2 .. $number/2)
+  {
+    push(@divisors, $candidate) if $number % $candidate == 0;
+  }
+  
+  push(@divisors, $number);
+  
+  return @divisors;
+}
+
+sub duplicates (@)
+{
+    my %seen = ();
+    my $k;
+    my $seen_undef;
+    return grep { 1 < (defined $_ ? $seen{$k = $_} : $seen_undef) }
+      grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;
+}
diff --git a/challenge-136/arne-sommer/raku/ch-1.raku b/challenge-136/arne-sommer/raku/ch-1.raku
new file mode 100755
index 0000000000..e7953672d3
--- /dev/null
+++ b/challenge-136/arne-sommer/raku/ch-1.raku
@@ -0,0 +1,43 @@
+#! /usr/bin/env raku
+
+subset PositiveInt of Int where * > 0;
+
+unit sub MAIN (PositiveInt $m, PositiveInt $n, :v(:$verbose));
+
+say + is-power-of-two(gcd($m, $n));
+
+sub gcd ($a, $b)
+{
+  my @a      = divisors($a, :not-one)>>.Int;
+  my @b      = divisors($b, :not-one)>>.Int;
+  my @common = ( @a (&) @b ).keys.sort;
+
+  say ": Common divisors: { @common.join(", ") }" if $verbose;
+
+  my $gcd    = @common[* -1];
+
+  return $gcd;
+}
+
+sub divisors ($number, :$not-self, :$not-one)
+{
+  my @divisors;
+  
+  for ($not-one ?? 2 !! 1) .. $number/2 -> $candidate
+  {
+    @divisors.push: $candidate if $number %% $candidate;
+  }
+  
+  @divisors.push: $number unless $not-self;
+
+  say ": $number has divisors: { @divisors.join(", ") }" if $verbose;
+
+  return @divisors;
+}
+
+sub is-power-of-two ($integer)
+{
+  say ": $integer -> binary: { $integer.base(2) }" if $verbose;
+  
+  return $integer.base(2).comb.sum == 1;
+}
diff --git a/challenge-136/arne-sommer/raku/ch-2.raku b/challenge-136/arne-sommer/raku/ch-2.raku
new file mode 100755
index 0000000000..b7372813ff
--- /dev/null
+++ b/challenge-136/arne-sommer/raku/ch-2.raku
@@ -0,0 +1,30 @@
+#! /usr/bin/env raku
+
+subset PositiveInt of Int where * >= 1;
+
+unit sub MAIN (PositiveInt $n, :v(:$verbose));
+
+my $fibonacci := (1, 2, * + * ... *);
+
+my @fibonacci;
+
+for @$fibonacci -> $fib
+{
+  last if $fib > $n;
+  @fibonacci.push: $fib;
+}
+
+say ": Fibonacci(<= $n): ", @fibonacci.join(", ") if $verbose;
+
+my $count = 0;
+
+for @fibonacci.combinations(1 .. *) -> @perm
+{
+  my $sum = @perm.sum;
+  
+  say ": Candidate: { @perm.join(" + ") } = $sum { $sum == $n ?? "match" !! "" }" if $verbose;
+  
+  $count++ if $sum == $n;
+}
+
+say $count;
diff --git a/challenge-136/arne-sommer/raku/fibonacci-sequence b/challenge-136/arne-sommer/raku/fibonacci-sequence
new file mode 100755
index 0000000000..b7372813ff
--- /dev/null
+++ b/challenge-136/arne-sommer/raku/fibonacci-sequence
@@ -0,0 +1,30 @@
+#! /usr/bin/env raku
+
+subset PositiveInt of Int where * >= 1;
+
+unit sub MAIN (PositiveInt $n, :v(:$verbose));
+
+my $fibonacci := (1, 2, * + * ... *);
+
+my @fibonacci;
+
+for @$fibonacci -> $fib
+{
+  last if $fib > $n;
+  @fibonacci.push: $fib;
+}
+
+say ": Fibonacci(<= $n): ", @fibonacci.join(", ") if $verbose;
+
+my $count = 0;
+
+for @fibonacci.combinations(1 .. *) -> @perm
+{
+  my $sum = @perm.sum;
+  
+  say ": Candidate: { @perm.join(" + ") } = $sum { $sum == $n ?? "match" !! "" }" if $verbose;
+  
+  $count++ if $sum == $n;
+}
+
+say $count;
diff --git a/challenge-136/arne-sommer/raku/two-friendly b/challenge-136/arne-sommer/raku/two-friendly
new file mode 100755
index 0000000000..e7953672d3
--- /dev/null
+++ b/challenge-136/arne-sommer/raku/two-friendly
@@ -0,0 +1,43 @@
+#! /usr/bin/env raku
+
+subset PositiveInt of Int where * > 0;
+
+unit sub MAIN (PositiveInt $m, PositiveInt $n, :v(:$verbose));
+
+say + is-power-of-two(gcd($m, $n));
+
+sub gcd ($a, $b)
+{
+  my @a      = divisors($a, :not-one)>>.Int;
+  my @b      = divisors($b, :not-one)>>.Int;
+  my @common = ( @a (&) @b ).keys.sort;
+
+  say ": Common divisors: { @common.join(", ") }" if $verbose;
+
+  my $gcd    = @common[* -1];
+
+  return $gcd;
+}
+
+sub divisors ($number, :$not-self, :$not-one)
+{
+  my @divisors;
+  
+  for ($not-one ?? 2 !! 1) .. $number/2 -> $candidate
+  {
+    @divisors.push: $candidate if $number %% $candidate;
+  }
+  
+  @divisors.push: $number unless $not-self;
+
+  say ": $number has divisors: { @divisors.join(", ") }" if $verbose;
+
+  return @divisors;
+}
+
+sub is-power-of-two ($integer)
+{
+  say ": $integer -> binary: { $integer.base(2) }" if $verbose;
+  
+  return $integer.base(2).comb.sum == 1;
+}