This is my response to the Perl Weekly Challenge #136.
$m and $n.
Two Friendly.
Input: $m = 8, $n = 24
Output: 1
Reason: gcd(8,24) = 8 => 2 ^ 3
Input: $m = 26, $n = 39
Output: 0
Reason: gcd(26,39) = 13
Input: $m = 4, $n = 10
Output: 1
Reason: gcd(4,10) = 2 => 2 ^ 1
«Positive numbers» is unprecise. We want «Non-negative Integers». Non-integer values does not work with divisors, and zero has no divisors at all (as it cannot be divided).
File: two-friendly
#! /usr/bin/env raku
subset PositiveInt of Int where * > 0; # [1]
unit sub MAIN (PositiveInt $m, PositiveInt $n, :v(:$verbose)); # [1]
say + is-power-of-two(gcd($m, $n)); # [2] [4]
sub gcd ($a, $b) # [3]
{
my @a = divisors($a, :not-one)>>.Int; # [5]
my @b = divisors($b, :not-one)>>.Int; # [5]
my @common = ( @a (&) @b ).keys.sort; # [5a]
say ": Common divisors: { @common.join(", ") }";
my $gcd = @common[* -1];
return $gcd;
}
sub divisors ($number, :$not-self, :$not-one) # [3a]
{
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(", ") }";
return @divisors;
}
sub is-power-of-two ($integer) # [4]
{
say ": $integer -> binary: { $integer.base(2) }" if $verbose;
return $integer.base(2).comb.sum == 1; # [4a]
}
[1] Ensure that the input is positive integers with a custom
type, set up with subset.
See
docs.raku.org/language/typesystem#index-entry-subset-subset
for more information about subset.
[2] Get the GCD value, check that it is
a power-of-two value, and coerce the Boolean value to an integer (False => 0,
True => 1) with the Prefix Operator +.
See
docs.raku.org/routine/+ for
more information about the Prefix Operator +.
[3] This procedure (and the helper procedure «divisors»; [3a]) has been copied from Magical Sum with Raku and Perl, my response to challenge #089. They are presented here slightly modified.
[4] Positive integers that are powers-of-two, have exactly 1 binary digit as 1. Except for the decimal value 1, which we have to exclude. That is done by [5].
[5] Get rid of «1», as that is not a value that we want in the result. Also note
the coercion to integer values. The problem is that values originating from division
are of the Rat type, and the number itself is a plain integer. When we coerce the
to lists to a Set (with (&)) we will get duplicates - as e.g. «13 (Rat)»
is not the same as «13 (int)». That was a nasty surprise…
Running it:
$ ./two-friendly 8 24
1
$ ./two-friendly 26 39
0
$ ./two-friendly 4 10
1
Looking good.
With verbose mode:
$ ./two-friendly -v 8 24
: 8 has divisors: 1, 2, 4, 8
: 24 has divisors: 1, 2, 3, 4, 6, 8, 12, 24
: Common divisors: 1, 2, 4, 8
: 8 -> binary: 1000
1
$ ./two-friendly -v 26 39
: 26 has divisors: 1, 2, 13, 26
: 39 has divisors: 1, 3, 13, 39
: Common divisors: 1, 13
: 13 -> binary: 1101
0
$ ./two-friendly -v 4 10
: 4 has divisors: 1, 2, 4
: 10 has divisors: 1, 2, 5, 10
: Common divisors: 1, 2
: 2 -> binary: 10
1
#! /usr/bin/env perl
use strict;
use feature 'say';
use feature 'signatures';
no warnings qw(experimental::signatures);
# use List::MoreUtils 'duplicates'; # [1]
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); # [2]
say ": GCD($m,$n): $gcd -> binary: $binary ($ones)" if $verbose;
($gcd == 1 || $ones != 1) ? say 0 : say 1; # [3]
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++ } @_;
}
[1] This module does not work on my PC, so I have copied in «duplicates» at the end.
[2] Counting the number of «1» in a binary string. Compare with the elegant way
we did this in Raku: ($gcd.comb.sum).
[3] This version gives us «1» as a divisor, so we have to explicitly exclude that from the result.
Running it gives the same result as the Raku version. Shown her with verbose mode, which is rather terse in this version:
$ ./two-friendly-perl -v 8 24
: GCD(8,24): 8 -> binary: 1000 (1)
1
$ ./two-friendly-perl -v 26 39
: GCD(26,39): 13 -> binary: 1101 (3)
0
$ ./two-friendly-perl -v 4 10
: GCD(4,10): 2 -> binary: 10 (1)
1
$n.
Input: $n = 16
Output: 4
Reason: There are 4 possible sequences that can be created using
Fibonacci numbers
i.e. (3 + 13), (1 + 2 + 13), (3 + 5 + 8) and (1 + 2 + 5 + 8).
Input: $n = 9
Output: 2
Reason: There are 2 possible sequences that can be created using
Fibonacci numbers i.e. (1 + 3 + 5) and (1 + 8).
Input: $n = 15
Output: 2
Reason: There are 2 possible sequences that can be created using
Fibonacci numbers i.e. (2 + 5 + 8) and (2 + 13).
Starting the Fibonacci Sequence with 1,2,… is a novel idea. So novel that Wikipedia has not heard about it. The benefit of skipping the first «1» (and possibly even «0» before that again) is that we avoid duplicates, as two instances of «1» would lead to. So yes, starting at the second «1», as done here, is a good idea. But it isn't the Fibonacci Sequence.
File: fibonacci-sequence
#! /usr/bin/env raku
subset PositiveInt of Int where * >= 1;
unit sub MAIN (PositiveInt $n, :v(:$verbose));
my $fibonacci := (1, 2, * + * ... *); # [1]
my @fibonacci;
for @$fibonacci -> $fib # [2]
{
last if $fib > $n; # [2a]
@fibonacci.push: $fib; # [2b]
}
say ": Fibonacci(<= $n): ", @fibonacci.join(", ") if $verbose;
my $count = 0;
for @fibonacci.combinations(1 .. *) -> @perm # [3]
{
my $sum = @perm.sum; # [4a]
say ": Candidate: { @perm.join(" + ") } = $sum \
{ $sum == $n ?? "match" !! "" }" if $verbose;
$count++ if $sum == $n; # [4]
}
say $count;
[1] The Fibonacci Sequence, as described in e.g. Challenge #77. Adapted to start with the second «1».
[2] Iterate over the (lazy) Fibonacci numbers, and add them to the array [2b]
until we reach $N [2a]. We need an upper limit, and this is the
highest possible choice for the solution (where the number itself is a
Fibonacci Number).
[3] Get all the possible combinations of the numbers, with size 1 to infinity (i.e. all)
[4] Is the sum of the numbers the same as the number itself? If so, increase the count.
See
docs.raku.org/routine/combinations
for more information about combinations.
Running it:
$ ./fibonacci-sequence 16
4
$ ./fibonacci-sequence 9
2
$ ./fibonacci-sequence 15
2
Looking good.
One of them with verbose mode:
$ ./fibonacci-sequence -v 16
: Fibonacci(<= 16): 1, 2, 3, 5, 8, 13
: Candidate: 1 = 1
: Candidate: 2 = 2
: Candidate: 3 = 3
: Candidate: 5 = 5
: Candidate: 8 = 8
: Candidate: 13 = 13
: Candidate: 1 + 2 = 3
: Candidate: 1 + 3 = 4
: Candidate: 1 + 5 = 6
: Candidate: 1 + 8 = 9
: Candidate: 1 + 13 = 14
: Candidate: 2 + 3 = 5
: Candidate: 2 + 5 = 7
: Candidate: 2 + 8 = 10
: Candidate: 2 + 13 = 15
: Candidate: 3 + 5 = 8
: Candidate: 3 + 8 = 11
: Candidate: 3 + 13 = 16 match
: Candidate: 5 + 8 = 13
: Candidate: 5 + 13 = 18
: Candidate: 8 + 13 = 21
: Candidate: 1 + 2 + 3 = 6
: Candidate: 1 + 2 + 5 = 8
: Candidate: 1 + 2 + 8 = 11
: Candidate: 1 + 2 + 13 = 16 match
: Candidate: 1 + 3 + 5 = 9
: Candidate: 1 + 3 + 8 = 12
: Candidate: 1 + 3 + 13 = 17
: Candidate: 1 + 5 + 8 = 14
: Candidate: 1 + 5 + 13 = 19
: Candidate: 1 + 8 + 13 = 22
: Candidate: 2 + 3 + 5 = 10
: Candidate: 2 + 3 + 8 = 13
: Candidate: 2 + 3 + 13 = 18
: Candidate: 2 + 5 + 8 = 15
: Candidate: 2 + 5 + 13 = 20
: Candidate: 2 + 8 + 13 = 23
: Candidate: 3 + 5 + 8 = 16 match
: Candidate: 3 + 5 + 13 = 21
: Candidate: 3 + 8 + 13 = 24
: Candidate: 5 + 8 + 13 = 26
: Candidate: 1 + 2 + 3 + 5 = 11
: Candidate: 1 + 2 + 3 + 8 = 14
: Candidate: 1 + 2 + 3 + 13 = 19
: Candidate: 1 + 2 + 5 + 8 = 16 match
: Candidate: 1 + 2 + 5 + 13 = 21
: Candidate: 1 + 2 + 8 + 13 = 24
: Candidate: 1 + 3 + 5 + 8 = 17
: Candidate: 1 + 3 + 5 + 13 = 22
: Candidate: 1 + 3 + 8 + 13 = 25
: Candidate: 1 + 5 + 8 + 13 = 27
: Candidate: 2 + 3 + 5 + 8 = 18
: Candidate: 2 + 3 + 5 + 13 = 23
: Candidate: 2 + 3 + 8 + 13 = 26
: Candidate: 2 + 5 + 8 + 13 = 28
: Candidate: 3 + 5 + 8 + 13 = 29
: Candidate: 1 + 2 + 3 + 5 + 8 = 19
: Candidate: 1 + 2 + 3 + 5 + 13 = 24
: Candidate: 1 + 2 + 3 + 8 + 13 = 27
: Candidate: 1 + 2 + 5 + 8 + 13 = 29
: Candidate: 1 + 3 + 5 + 8 + 13 = 30
: Candidate: 2 + 3 + 5 + 8 + 13 = 31
: Candidate: 1 + 2 + 3 + 5 + 8 + 13 = 32
4
#! /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); # [1]
while (1) # [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) # [2]
{
for my $perm (combinations(\@fib, $size)) # [2]
{
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;
[1] The Fibonacci generation is not as neat as in Raku, but the neeed for an extra loop in that version does make it look untidy.
[2] «combinations» does not support multiple lengths, but wrapping it in an outer loop solves that problem.
Running it gives the same result as the Raku version:
$ ./fibonacci-sequence-perl 16
4
$ ./fibonacci-sequence-perl 9
2
$ ./fibonacci-sequence-perl 15
2
And that's it.