This is my response to the Perl Weekly Challenge #109.
Chowla Numbers, named after,
Sarvadaman D. S. Chowla, a London born Indian American mathematician.
It is defined as:
C(n) = sum of divisors of n except 1 and n
0, 0, 0, 2, 0, 5, 0, 6, 3, 7, 0, 15, 0, 9, 8, 14, 0, 20, 0, 21
This is yet another situation where gather/take
is the obvious choice to set up the sequence.
The procedure giving divisors has been copied from my Centenary Sequences with Raku Part 5 - Divisors and Factors article.
File: chowla-numbers
#! /usr/bin/env raku
unit sub MAIN ($limit = 20, :v(:$verbose));
my $chowla := gather
{
my $index = 1;
loop
{
my @divisors = divisors($index, :not-self, :not-one); # [1]
say "$index with divisors: { @divisors.join(", ") }" if $verbose;
take @divisors.sum; # [2]
$index++;
}
}
say $chowla[^$limit].join(", "); # [3]
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;
return @divisors;
}
[1] Get the diviors for the number n.
[2] Return the sum.
[3] Print the required number of values from the sequence.
Running it:
$ ./chowla-numbers
0, 0, 0, 2, 0, 5, 0, 6, 3, 7, 0, 15, 0, 9, 8, 14, 0, 20, 0, 21
$ ./chowla-numbers 25
0, 0, 0, 2, 0, 5, 0, 6, 3, 7, 0, 15, 0, 9, 8, 14, 0, 20, 0, 21, 10, 13, 0, \
35, 5
$ ./chowla-numbers 5
0, 0, 0, 2, 0
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use List::Util 'sum';
no warnings "experimental::signatures";
my $limit = $ARGV[0] // 20;
my @chowla;
for my $index (1 .. $limit)
{
my @divisors = divisors($index, 1, 1);
push(@chowla, (sum(@divisors) // 0));
}
say join(", ", @chowla);
sub divisors ($number, $not_self, $not_one)
{
my @divisors;
for my $candidate ( ($not_one ? 2 : 1) .. $number/2)
{
push(@divisors, $candidate) unless $number % $candidate;
}
push(@divisors, $number) unless $not_self;
return @divisors;
}
Running it gives the same result as the Raku version:
$ ./chowla-numbers-perl
0, 0, 0, 2, 0, 5, 0, 6, 3, 7, 0, 15, 0, 9, 8, 14, 0, 20, 0, 21
(1) (3)
╔══════════════╗ ╔══════════════╗
║ ║ ║ ║
║ a ║ ║ e ║
║ ║ (2) ║ ║ (4)
║ ┌───╫──────╫───┐ ┌───╫─────────┐
║ │ ║ ║ │ │ ║ │
║ │ b ║ ║ d │ │ f ║ │
║ │ ║ ║ │ │ ║ │
║ │ ║ ║ │ │ ║ │
╚══════════╪═══╝ ╚═══╪══════╪═══╝ │
│ c │ │ g │
│ │ │ │
│ │ │ │
└──────────────┘ └─────────────┘
Input: 1,2,3,4,5,6,7
Output:
a = 6
b = 4
c = 1
d = 5
e = 2
f = 3
g = 7
Box 1: a + b = 6 + 4 = 10
Box 2: b + c + d = 4 + 1 + 5 = 10
Box 3: d + e + f = 5 + 2 + 3 = 10
Box 4: f + g = 3 + 7 = 10
We have four equations (shown as box 1, box 2, box 3, and box 4). The four sums must be equal for us to get a solution. The actual right hand value does not matter.
No solutions at all is a possibility. Note that if we have one solution, we have at least one more as we can flip the squares horizontally (giving the order 4, 3, 2 and 1).
File: four-squares-puzzle
#! /usr/bin/env raku
unit sub MAIN (*@values where @values.elems ==7 && all(@values) ~~ Numeric, # [1]
:s(:$short), # [2]
:a(:$all) = $short); # [3]
for @values.permutations -> @perm # [4]
{
if check-values(@perm) # [5]
{
if $short # [7]
{
say "a=@perm[0], b=@perm[1], c=@perm[2], d=@perm[3], e=@perm[4]," ~
"f=@perm[5], g=@perm[6]";
}
else
{
my ($a, $b, $c, $d, $e, $f, $g); # [8]
say "a = { $a = @perm[0] }";
say "b = { $b = @perm[1] }";
say "c = { $c = @perm[2] }";
say "d = { $d = @perm[3] }";
say "e = { $e = @perm[4] }";
say "f = { $f = @perm[5] }";
say "g = { $g = @perm[6] }";
say "";
say "Box 1: a + b = $a + $b = { $a + $b }";
say "Box 2: b + c + d = $b + $c + $d = { $b + $c + $d }";
say "Box 3: d + e + f = $d + $e + $f = { $d + $e + $f }";
say "Box 4: f + g = $f + $g = { $f + $g }";
say "" if $all; # [9]
}
last unless $all; # [10]
}
}
sub check-values (@values) # [5a]
{
my ($a, $b, $c, $d, $e, $f, $g) = @values; # [6]
return $a + $b == $b + $c + $d == $d + $e + $f == $f + $g; # [6a]
}
[1] Get the values in a single array (a so called «slurpt array»; given with the
leading *.
[2] Use «short mode» to get a single line for each match. This enables «all mode» as well.
[3] We are done when we have found one match, unless «all mode» is used.
[4] The permutations method gives us the list in every possible sorted
order, which is exactly what we need for the equations in [5].
[5] Do we have a match?.
[6] Note the assignemnt to individual variables, as that makes the code more readable
than using offsets. Return True if the equations in [6a] are good.
[7] In «short mode», print a single line only for the match.
[8] Nicely named variables.
[9] Assign and print in one go.
[10] Quit after the first match, unless asked to do them all.
See
docs.raku.org/routine/permutations
for more information about permutations.
Running it:
$ ./four-squares-puzzle 1 2 3 4 5 6 7
a = 3
b = 7
c = 2
d = 1
e = 5
f = 4
g = 6
Box 1: a + b = 3 + 7 = 10
Box 2: b + c + d = 7 + 2 + 1 = 10
Box 3: c + d + e = 1 + 5 + 4 = 10
Box 4: f + g = 4 + 6 = 10
We did not get the same result as given in the challenge, but it is valid.
Let us try wth «all mode»:
$ ./four-squares-puzzle -a 1 2 3 4 5 6 7
a = 3
b = 7
c = 2
d = 1
e = 5
f = 4
g = 6
Box 1: a + b = 3 + 7 = 10
Box 2: b + c + d = 7 + 2 + 1 = 10
Box 3: d + e + f = 1 + 5 + 4 = 10
Box 4: f + g = 4 + 6 = 10
a = 4
b = 5
c = 3
d = 1
e = 6
f = 2
g = 7
Box 1: a + b = 4 + 5 = 9
Box 2: b + c + d = 5 + 3 + 1 = 9
Box 3: d + e + f = 1 + 6 + 2 = 9
Box 4: f + g = 2 + 7 = 9
a = 4
b = 7
c = 1
d = 3
e = 2
f = 6
g = 5
Box 1: a + b = 4 + 7 = 11
Box 2: b + c + d = 7 + 1 + 3 = 11
Box 3: d + e + f = 3 + 2 + 6 = 11
Box 4: f + g = 6 + 5 = 11
a = 5
b = 6
c = 2
d = 3
e = 1
f = 7
g = 4
Box 1: a + b = 5 + 6 = 11
Box 2: b + c + d = 6 + 2 + 3 = 11
Box 3: d + e + f = 3 + 1 + 7 = 11
Box 4: f + g = 7 + 4 = 11
a = 6
b = 4
c = 1
d = 5
e = 2
f = 3
g = 7
Box 1: a + b = 6 + 4 = 10
Box 2: b + c + d = 4 + 1 + 5 = 10
Box 3: d + e + f = 5 + 2 + 3 = 10
Box 4: f + g = 3 + 7 = 10
a = 6
b = 4
c = 5
d = 1
e = 2
f = 7
g = 3
Box 1: a + b = 6 + 4 = 10
Box 2: b + c + d = 4 + 5 + 1 = 10
Box 3: d + e + f = 1 + 2 + 7 = 10
Box 4: f + g = 7 + 3 = 10
a = 7
b = 2
c = 6
d = 1
e = 3
f = 5
g = 4
Box 1: a + b = 7 + 2 = 9
Box 2: b + c + d = 2 + 6 + 1 = 9
Box 3: d + e + f = 1 + 3 + 5 = 9
Box 4: f + g = 5 + 4 = 9
a = 7
b = 3
c = 2
d = 5
e = 1
f = 4
g = 6
Box 1: a + b = 7 + 3 = 10
Box 2: b + c + d = 3 + 2 + 5 = 10
Box 3: d + e + f = 5 + 1 + 4 = 10
Box 4: f + g = 4 + 6 = 10
Not really readable. «Short mode» to the rescue:
$ four-squares-puzzle -a -s 1 2 3 4 5 6 7
a=3, b=7, c=2, d=1, e=5, f=4, g=6
a=4, b=5, c=3, d=1, e=6, f=2, g=7
a=4, b=7, c=1, d=3, e=2, f=6, g=5
a=5, b=6, c=2, d=3, e=1, f=7, g=4
a=6, b=4, c=1, d=5, e=2, f=3, g=7
a=6, b=4, c=5, d=1, e=2, f=7, g=3
a=7, b=2, c=6, d=1, e=3, f=5, g=4
a=7, b=3, c=2, d=5, e=1, f=4, g=6
We got 8 solutions, and the fifth one (marked with green) is the same as given in the challenge.
We can try a set of values that cannot give a solution:
$ four-squares-puzzle -a -s 1 1 1 1 1 1 1
No solutions, thankfully…
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
no warnings "experimental::signatures";
use Getopt::Long;
use Algorithm::Combinatorics 'permutations';
my $short = 0;
my $all = 0;
GetOptions("short" => \$short,
"all" => \$all);
$all = 1 if $short;
my @values = @ARGV;
for my $perm (permutations(\@values))
{
if (check_values(@$perm))
{
my ($a, $b, $c, $d, $e, $f, $g) = @$perm;
if ($short)
{
say "a=$a, b=$b, c=$c, d=$d, e=$e, f=$f, g=$g";
}
else
{
say "a = $a";
say "b = $b";
say "c = $c";
say "d = $d";
say "e = $e";
say "f = $f";
say "g = $g";
say "";
say "Box 1: a + b = $a + $b = " . ($a + $b);
say "Box 2: b + c + d = $b + $c + $d = " . ($b + $c + $d);
say "Box 3: d + e + f = $d + $e + $f = " . ($d + $e + $f);
say "Box 4: f + g = $f + $g = " . ($f + $g);
say "" if $all;
}
last unless $all;
}
}
sub check_values (@values)
{
my ($a, $b, $c, $d, $e, $f, $g) = @values;
my $box1 = $a + $b;
my $box2 = $b + $c + $d;
my $box3 = $d + $e + $f;
my $box4 = $f + $g;
return ($box1 == $box2 && $box3 == $box4 && $box1 == $box3) # [1]
}
[1] Perl does not support nesting equations (as e.g. $a == $b == $c,
which is valid in Raku), so we have to write it like this.
Running it gives the same result as the Raku version:
$ ./four-squares-puzzle-perl 1 2 3 4 5 6 7
a = 3
b = 7
c = 2
d = 1
e = 5
f = 4
g = 6
Box 1: a + b = 3 + 7 = 10
Box 2: b + c + d = 7 + 2 + 1 = 10
Box 3: d + e + f = 1 + 5 + 4 = 10
Box 4: f + g = 4 + 6 = 10
$ ./four-squares-puzzle-perl -short 1 2 3 4 5 6 7
a=3, b=7, c=2, d=1, e=5, f=4, g=6
a=4, b=5, c=3, d=1, e=6, f=2, g=7
a=4, b=7, c=1, d=3, e=2, f=6, g=5
a=5, b=6, c=2, d=3, e=1, f=7, g=4
a=6, b=4, c=1, d=5, e=2, f=3, g=7
a=6, b=4, c=5, d=1, e=2, f=7, g=3
a=7, b=2, c=6, d=1, e=3, f=5, g=4
a=7, b=3, c=2, d=5, e=1, f=4, g=6
And that's it.