Perl Weekly Challenge 149.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 149.
Task 1: Fibonacci Digit Sum
Submitted by: Roger Bell_West
Given an input $N, generate the first $N numbers for which the
sum of their digits is a Fibonacci number.
Example
f(20)=[0, 1, 2, 3, 5, 8, 10, 11, 12, 14, 17, 20, 21, 23, 26,
30, 32, 35, 41, 44]
A short solution may be obtained by using PDL, building an array of (more than) enough Fibonacci numbers and sequentially testing numbers until enough are found.
perl -MPDL -MPDL::NiceSlice -E '$N=$ARGV[0]; $f=pdl(0,1);
$f=append($f, $f((-1))+$f((-2)))for(2..$N);while(@o<$N){
$k=pdl(split "", $j)->sumover; push @o, $j if any($k-$f==0);++$j};
say "f($N)=",pdl(@o);' 20
Results:
f(20)=[0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44]
If a large amount $N of numbers is desired then the set of Fibonacci numbers can be made
much smaller; it could be grown only as required. Thus, the
full program is
1 # Perl weekly challenge 148
2 # Task 1: fibonacci digit sum
3 #
4 # See https://wlmb.github.io/2022/01/24/PWC149/#task-1-fibonacci-digit-sum
5 use v5.12;
6 use warnings;
7 use PDL;
8 use PDL::NiceSlice;
9 die "Usage: ./ch-1.pl N to obtain N numbers with Fibonacci digit sums\n" unless @ARGV;
10 my $N=$ARGV[0];
11 my $fibs=pdl(0,1); # first Fibonacci numbers
12 my @solutions;
13 my $try=0; # next number to try
14 while(@solutions<$N){
15 my $sum=pdl(split "", $try)->sumover; # sum of digits
16 $fibs=append($fibs, $fibs(-1)+$fibs(-2)) while($sum>$fibs((-1))); # grow $fibs array as needed
17 push @solutions, $try if any($sum-$fibs==0);
18 ++$try;
19 };
20 say "f($N)=",pdl(@solutions);
Example:
./ch-1.pl 20
Results:
f(20)=[0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44]
A larger example:
./ch-1.pl 40
Results:
f(40)=[0 1 2 3 5 8 10 11 12 14 17 20 21 23 26 30 32 35 41 44
49 50 53 58 62 67 71 76 80 85 94 100 101 102 104 107 110 111 113 116]
Task 2: Largest Square
Submitted by: Roger Bell_West
Given a number base, derive the largest perfect square with no
repeated digits and return it as a string. (For base>10, use
‘A’..‘Z’.)
Example:
f(2)="1"
f(4)="3201"
f(10)="9814072356"
f(12)="B8750A649321"
There are several possible approaches to solve this problem: generate a descending list of numbers and test them for non-repeating digits and for squareness, generate the sequences of non-repeating digits in descending order and test the corresponding numbers for squareness, or generate a descending list of numbers and test their squares for non-repeating digits. In a given base N, the first approach would explore of the order of NN numbers, the second about N! numbers and the third about NN/2 numbers (see below). Thus, I guess, the third approach is the best; it is also the simplest.
for b in 2 4 10 12; do
perl -MPOSIX=floor -MList::MoreUtils=duplicates -E '
@g=(0..9,A..Z);$b=$ARGV[0];$L=$b**floor($b/2);--$L while t($L*$L);
say "f($b)=",c($L*$L);sub t{duplicates(c(shift));} sub c{$d=shift; @d=();
do {push @d,$d%$b} while $d=floor($d/$b); return reverse map {$g[$_]} @d;}' $b
done
Results:
f(2)=1
f(4)=3201
f(10)=9814072356
f(12)=B8750A649321
The full version would be
1 # Perl weekly challenge 148
2 # Task 2: largest square
3 #
4 # See https://wlmb.github.io/2022/01/24/PWC149/#task-2-largest-square
5 use v5.12;
6 use warnings;
7 use List::MoreUtils qw(duplicates);
8 use POSIX qw(floor);
9 my @digits=(0..9,'A'..'Z');
10 my $largest_base=15; # might overflow above that
11 die "Usage: ./ch-2.pl N [P] [Q]... " .
12 "to obtain largest square in base N P Q...\n"
13 unless @ARGV;
14 foreach my $base(@ARGV){
15 say("Sorry: $base is too large"), next if $base>$largest_base;
16 my $root=$base**floor($base/2);
17 --$root while duplicates(convert($root*$root, $base));
18 say "f($base)=",convert($root*$root, $base);
19 }
20 sub convert{
21 my ($N, $base)=@_; # convert $N to $base
22 my @d=();
23 do {push @d, $N%$base} while $N=floor($N/$base);
24 return reverse map {$digits[$_]} @d;
25 }
Examples:
./ch-2.pl 2 4 10 12 13 14 15 16
Results:
f(2)=1
f(4)=3201
f(10)=9814072356
f(12)=B8750A649321
f(13)=CBA504216873
f(14)=DC71B30685A924
f(15)=EDBC7381904526
Sorry: 16 is too large
For base 16 the time is above a minute in my laptop and I suspect I might have precision problems, as 1616 seems to be above the 64 bit precission. I tried bigint, but the time increases significantly. Thus I put a cutoff at 16.
Anyway, I use bigint to test if my result for 15 is correct.
use v5.12;
use bigint;
my %map;
@map{(0..9,'A'..'Z')}=(0..35);
my @digits=map {$map{$_}} reverse split '', "EDBC7381904526";
my ($n, $p)=(0, 1);
$n+=$_*$p, $p*=15 for(@digits);
my $s=sqrt($n);
say "n=$n, sqrt(n)=$s sqrt(n)**2=", $s*$s;
Results:
n=29035778646052161, sqrt(n)=170398881 sqrt(n)**2=29035778646052161
So EDBC7381904526 in base 15 is n=29035778646052161 in base ten, and it is a perfect square.
My estimate of the running time of different approaches above may be wrong, as they correspond to exhaustive searches, but the search could be shortcircuited. Thus, I try a different approach using Algorithm::Combinatorics to generate combinations and permutations of sets of non-repeating digits and afterwards testing for squareness.
1 # Perl weekly challenge 148
2 # Task 2: largest square
3 #
4 # See https://wlmb.github.io/2022/01/24/PWC149/#task-2-largest-square
5 use v5.12;
6 use warnings;
7 use POSIX qw(floor);
8 use Algorithm::Combinatorics qw(combinations permutations);
9 use Try::Tiny;
10
11 die "Usage: ./ch-2a.pl N [P] [Q]... " .
12 "to obtain largest square in base N P Q...\n"
13 unless @ARGV;
14
15 my %map;
16 @map{(0..35)}=(0..9, 'A'..'Z');
17 my $largest=15;
18
19 try {say "f($_)=", largest_square($_)} catch {say $_} foreach(@ARGV);
20
21 sub largest_square {
22 my $base=shift;
23 die "Base $base is too large\n" if $base > $largest;
24 my @digits=reverse 0..$base-1;
25 my $result;
26 for my $i(0..$base-1){ # $base-$i is the number of digits to try
27 my $combinations=combinations(\@digits,$base-$i);
28 while(my $c=$combinations->next){
29 my $permutations=permutations($c);
30 my $candidate;
31 while(my $p=$permutations->next){
32 # ignore numbers with leading zeroes
33 # they would appear if when testing shorter candidates
34 next unless $p->[0];
35 my $number=digits_to_number($p, $base);
36 my $sqrt=floor(sqrt($number));
37 $candidate=$number, last if $number==$sqrt*$sqrt;
38 # Found a candidate. The first is the largest so I don't
39 # have to test further permutations
40 }
41 # But I may have to test different combinations
42 $result=$candidate if defined $candidate and (!defined $result or $result<$candidate);
43 }
44 return number_to_digits_base($result, $base) if defined $result;
45 # If I found a candidate for a given length, it is not necessary
46 # to test shorter candidates
47 }
48 }
49 sub digits_to_number {
50 my ($digits, $base)=@_;
51 my @digits=reverse @$digits;
52 my $power=1;
53 my $result=0;
54 $result+=$_*$power, $power*=$base for(@digits);
55 return $result;
56 }
57 sub number_to_digits_base {
58 my ($result, $base)=@_;
59 my @result=();
60 do {push @result, $result%$base} while $result=floor $result/=$base;
61 return map {$map{$_}} reverse @result;
62 }
Example:
./ch-2a.pl 2 4 10 12 20
Results:
f(2)=1
f(4)=3201
f(10)=9814072356
f(12)=B8750A649321
Base 20 is too large
So it does seem to work, but it takes much longer. For base 10 it is about 4x longer, for base 11 about 15x, and for base 12 about 80x. So the first approach seems better, as originally expected.
One problem with the program above is that, although permutations are
generated in descending order for a given group of digits, they may
not be in order when compared to other groups of digits. For example,
take the digits 210 and assume we are looking at two-digit
numbers. Then, the largest combination is 21 with permutations
21 and 12, but the next largest combination is 20 with
permutations 20 and 02, and 20 is larger than the previously
seen 12. Thus, for a given length I have to test all combinations
before being able to identify a candidate with the actual solution.
I can solve this problem and simplify the code by using the
variations function of Algorithm::Combinatorics which produces in
order all orderings of a given size taken from a given set.
1 # Perl weekly challenge 148
2 # Task 2: largest square
3 #
4 # See https://wlmb.github.io/2022/01/24/PWC149/#task-2-largest-square
5 use v5.12;
6 use warnings;
7 use POSIX qw(floor);
8 use Algorithm::Combinatorics qw(variations);
9 use Try::Tiny;
10
11 die "Usage: ./ch-2c.pl N [P] [Q]... " .
12 "to obtain largest square in base N P Q...\n"
13 unless @ARGV;
14
15 my %map;
16 @map{(0..35)}=(0..9, 'A'..'Z');
17 my $largest=15;
18
19 try {say "f($_)=", largest_square($_)} catch {say $_} foreach(@ARGV);
20
21 sub largest_square {
22 my $base=shift;
23 die "Base $base is too large\n" if $base > $largest;
24 my @digits=reverse 0..$base-1;
25 for my $i(0..$base-1){ # $i is the number of digits to skip
26 my $variations=variations(\@digits, $base-$i);
27 while(my $p=$variations->next){
28 # ignore numbers with leading zeroes
29 # they would appear if when testing shorter candidates
30 last unless $p->[0];
31 my $number=digits_to_number($p, $base);
32 my $sqrt=floor(sqrt($number));
33 return number_to_digits_base($number, $base) if $number==$sqrt*$sqrt;
34 # Found a candidate. The first is the largest so I don't
35 # have to test further permutations
36 }
37 }
38 }
39 sub digits_to_number {
40 my ($digits, $base)=@_;
41 my @digits= reverse @$digits;
42 my $power=1;
43 my $result=0;
44 $result+=$_*$power, $power*=$base for(@digits);
45 return $result;
46 }
47 sub number_to_digits_base {
48 my ($result, $base)=@_;
49 my @result=();
50 do {push @result, $result%$base} while $result=floor $result/=$base;
51 return map {$map{$_}} reverse @result;
52 }
Example:
./ch-2b.pl 2 4 10 12 20
Results:
f(2)=1
f(4)=3201
f(10)=9814072356
f(12)=B8750A649321
Base 20 is too large
However, this turns out to be just marginally faster. The first method is still the best, so far.