Perl Weekly Challenge: Week 109
Challenge 1:
Chowla Numbers
Write a script to generate first 20
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
Output:
0, 0, 0, 2, 0, 5, 0, 6, 3, 7, 0, 15, 0, 9, 8, 14, 0, 20, 0, 21
When I first read this, I groaned inwardly at the prospect of another Maths problem but suprisingly this was pretty easy to implement.
The main routine of the Raku version looks like this:
sub MAIN() {
my @numbers;
for 1 .. 20 -> $n {
@numbers.push(chowla($n));
}
@numbers.join(q{, }).say;
}
All it does is calculate the Chowla numbers from 1 to 20, and push them into an array. The array is then printed with each element separated by commas.
The chowla() subroutine is where the actual calculation takes place and it is a one-liner in Raku.
sub chowla(Int $n) {
return [+] (1 ^.. $n div 2).grep({ $n %% $_; });
}
(1 ^.. $n div 2) is a range from 2 to half of $n. (div is the integer division operator.) This is enough space to search
for all divisors except 1 and $n itself. .grep({ $n %% $_; }) gives the numbers in the range that divide without a remainder i.e divisors. And finally, [+] adds them all up.
In Perl we don't have convenient operators like div, %% and [+] so the code is longer.
sub chowla {
my ($n) = @_;
my $total = 0;
for my $i (2 .. $n / 2) {
if ($n % $i == 0) {
$total += $i;
}
}
return $total;
}
Challenge 2:
Four Squares Puzzle
You are given four squares as below with numbers named a,b,c,d,e,f,g.
(1) (3)
╔══════════════╗ ╔══════════════╗
║ ║ ║ ║
║ a ║ ║ e ║
║ ║ (2) ║ ║ (4)
║ ┌───╫──────╫───┐ ┌───╫─────────┐
║ │ ║ ║ │ │ ║ │
║ │ b ║ ║ d │ │ f ║ │
║ │ ║ ║ │ │ ║ │
║ │ ║ ║ │ │ ║ │
╚══════════╪═══╝ ╚═══╪══════╪═══╝ │
│ c │ │ g │
│ │ │ │
│ │ │ │
└──────────────┘ └─────────────┘
Write a script to place the given unique numbers in the square box so that sum of numbers in each box is the same.
Example
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
This is somewhat similar to the "Olympic Rings" problem in PWC 43 so I used a similar approach here.
sub MAIN(
*@n where { @n.elems == 7 } #= 7 integers
The input is given on the command line and stored as an array of seven elements.
) {
my @labels = 'a' .. 'g';
It will be easier to address parts of the boxes by array subscripts (i.e. 0 - 6) but the spec wants us to use the
letters a - g so the @labels array will be used to map between the two schemes.
for @n.permutations -> @permutation {
The .permutations() method, as the name suggests, returns a list of all the permutations of an array.
my $box1 = @permutation[0] + @permutation[1];
my $box2 = @permutation[1] + @permutation[2] + @permutation[3];
my $box3 = @permutation[3] + @permutation[4] + @permutation[5];
my $box4 = @permutation[5] + @permutation[6];
We take the values in each permutation and create the boxes.
if $box1 == $box2 == $box3 == $box4 {
for 0 ..^ @permutation.elems -> $i {
say @labels[$i], ' = ', @permutation[$i];
}
print "\n"
}
If all the boxes have the same value, we have a valid answer and we can print it out using @labels to make
the format the spec requires.
}
}
It turns out for the values 1 to 7, there are 8 possible combinations that will work.
This is the equivalent code in Perl. Perl doesn't have a builtin .permutations() method so once again I used the permute() function given in the perlfaq4 POD page to replace it.
my @labels = 'a' .. 'g';
my @permutations;
permute { push @permutations, \@_; } @ARGV;
for my $permutation (@permutations) {
my $box1 = $permutation->[0] + $permutation->[1];
my $box2 = $permutation->[1] + $permutation->[2] + $permutation->[3];
my $box3 = $permutation->[3] + $permutation->[4] + $permutation->[5];
my $box4 = $permutation->[5] + $permutation->[6];
A little peeve. Perl doesn't let you chain the == operator like Raku so you have to do it this way.
if ($box1 == $box2 && $box2 == $box3 && $box3 == $box4) {
for my $i (0 .. scalar @{$permutation} - 1) {
say $labels[$i], ' = ', $permutation->[$i];
}
print "\n"
}
}