# 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  #
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]
``````

``````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  #
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  #
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  #
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.

Written on January 24, 2022