Perl Weekly Challenge 109.
My solutions (task 1 and task 2) to the The Weekly Challenge - 109.
Task 1: Chowla Numbers
Submitted by: Mohammad S Anwar 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) - 1 - n
Output:
0, 0, 0, 2, 0, 5, 0, 6, 3, 7, 0, 15, 0, 9, 8, 14, 0, 20, 0, 21
This is a one-liner task. I just have to sum the non-trivial distinct divisors
$d upto sqrt $n and including their complementary divisors
$n/$d$ that are larger than sqrt $n, taking care of not counting
twice the sqrt itself for perfect squares. This way of finding
divisors is faster for very large numbers than simply testing all
numbers between 2 and ~(n-1).
# Perl weekly challenge 109
# Task 2: Chowla Numbers
#
# See https://wlmb.github.io/2021/04/19/PWC109/#task-1-chowla-numbers
use strict;
use warnings;
use v5.12;
use List::Util qw(sum0);
say join ' ',
map {my $n=$_; sum0 map {$_**2==$n?$_:($_, $n/$_)}
grep {$n%$_==0} 2..sqrt($n)} @ARGV;
Example:
./ch-1.pl `seq 20`
Results:
0 0 0 2 0 5 0 6 3 7 0 15 0 9 8 14 0 20 0 21
Other examples:
./ch-1.pl 1e1 1e2 1e3 1e4 1e5 1e6 1e7 1e8 1e9 1e10
Results:
7 116 1339 14210 146077 1480436 14902279 149511590 1497558337 14987792456
Task 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
In a way the task is straightforward: I produce permutations of the inputs until I find one that fullfils the condition. I represent the squares as arrays of the letters they contain which are mapped to the corresponding array indices.
# Perl weekly challenge 109
# Task 2: Four squares puzzle
#
# See https://wlmb.github.io/2021/04/19/PWC109/#task-2-four-squares-puzzle
use strict;
use warnings;
use v5.12;
use List::Util qw(sum0);
use List::MoreUtils qw(uniq pairwise);
my @letters='a'..'g';
my %letters=map {($letters[$_], $_)} 0..$#letters;
my @squares=(['a','b'], ['b','c','d'], ['d','e','f'], ['f','g']);
die 'Usage: ./ch-2.pl n1 n2...n7 with 7 distinct numbers'
unless @ARGV==7 and (uniq @ARGV)==7;
my $perm= permutator(@ARGV);
while(my @perm=$perm->()){
next if (my @sums=uniq map {add($squares[$_], @perm)} (0..$#squares))>1;
say +(pairwise {"$a=$b "} @letters, @perm),
" since ", (join "=", map {join "+", @$_} @squares), "=$sums[0]";
# last; # Could stop here if I only one solution is desired
}
I need a function to calculate the sum of all the numbers within a square.
sub add { #Sum the numbers within some square
my $square=shift @_;
my @numbers=@_;
return sum0 map {$numbers[$letters{$_}]} @$square;
}
And I make myself an iterator to generate all permutations of the inputs.
The permutator is adapted from Higher order Perl, by Mark Jason
Dominus. It returns a function that returns a new permutation
numbered $n each time it is called, incrementing $n. It uses
modular arithmetic to decide which elements of the array are to be
transposed each call.
sub permutator { #returns an iterator for permutations
my @items=@_;
my $n_items=@items;
my $n=0;
my $done=0;
sub {
return if $done;
my $which=$n; #next item to transpose
return @items if $n++ == 0; #return first time through
my $with_whom=1; #with whom to permute
while($with_whom<=$n_items&&$which%$with_whom==0){
$which/=$with_whom;
++$with_whom;
}
$done=1, return if $with_whom >$n_items; #no more transpositions
$which=$with_whom-$which%$with_whom;
#use negative indices to transpose rightmost first
@items[-$with_whom+1..-1]=reverse @items[-$with_whom+1..-1]; #reorder
@items[-$which,-$with_whom]=@items[-$with_whom,-$which]; # transpose
return @items
}
}
Example:
./ch-2.pl 1 2 3 4 5 6 7
Results:
a=3 b=7 c=2 d=1 e=5 f=4 g=6 since a+b=b+c+d=d+e+f=f+g=10
a=4 b=5 c=3 d=1 e=6 f=2 g=7 since a+b=b+c+d=d+e+f=f+g=9
a=4 b=7 c=1 d=3 e=2 f=6 g=5 since a+b=b+c+d=d+e+f=f+g=11
a=5 b=6 c=2 d=3 e=1 f=7 g=4 since a+b=b+c+d=d+e+f=f+g=11
a=6 b=4 c=1 d=5 e=2 f=3 g=7 since a+b=b+c+d=d+e+f=f+g=10
a=6 b=4 c=5 d=1 e=2 f=7 g=3 since a+b=b+c+d=d+e+f=f+g=10
a=7 b=2 c=6 d=1 e=3 f=5 g=4 since a+b=b+c+d=d+e+f=f+g=9
a=7 b=3 c=2 d=5 e=1 f=4 g=6 since a+b=b+c+d=d+e+f=f+g=10
Notice that the sum is not unique and given a sum, the arrangements
are not unique either. Some rearrangements are the mirror image of one
another, i.e., mapping abcdefg to gfedcba, but there may be others.
Another example
./ch-2.pl 2 4 5 7 8 9 11
Results:
a=7 b=8 c=5 d=2 e=9 f=4 g=11 since a+b=b+c+d=d+e+f=f+g=15
a=11 b=4 c=9 d=2 e=5 f=8 g=7 since a+b=b+c+d=d+e+f=f+g=15
It could happen that there is no solution, as in
./ch-2.pl 1 2 4 6 8 10 12
Results:
In this example, at most two squares could add up to an odd number, so it is impossible for all squares to have equal sums.