Perl Weekly Challenge 102.

My solutions (task 1, task 1a, task 1b, task 1c and task 2) to the The Weekly Challenge - 102.

Task 1: Rare Numbers

Submitted by: Mohammad S Anwar You are given a positive integer $N.

Write a script to generate all Rare numbers of size $N if exists. Please checkout the page for more information about it.

Examples (a) 2 digits: 65 (b) 6 digits: 621770 (c) 9 digits: 281089082

A rare number x=x1x2x3…xN (with decimal digits x1, x2,…) is defined such that x+y and x-y are perfect squares, where y=y1y2…=xN…x3x2x1. A straightforward solution would be to generate and test all $N digit numbers for rareness. Afterwards I try other alternatives.

# Perl weekly challenge 102
# Task 1: Rare numbers
# Slowest, simplest version
#
# See https://wlmb.github.io/2021/03/01/PWC102/#task-1-rare-numbers
use strict;
use warnings;
use v5.12;
use POSIX qw(floor);
foreach my $N(@ARGV){
    foreach my $x(10**($N-1)..10**$N-1){
        # next if $x%10==0; #uncomment to disallow reversed numbers starting in 0
	my $y=join '', reverse split '', $x;
	next if $x<=$y; #use < to allow palindromes
	my $s=$x+$y;
	next unless $s==floor(sqrt($s))**2; # test squareness of sum
	my $d=$x-$y;
	next unless $d==floor(sqrt($d))**2; # test squareness of diff
	say "N=$N\tx=$x\ty=$y\tx+y=$s=", sqrt($s),"**2\tx-y=$d=",sqrt($d),"**2";
    }
}

Example:

(time ./ch-1.pl 2 3 4 5 6 7 8) 2>&1

Results:

N=2	x=65	y=56	x+y=121=11**2	x-y=9=3**2
N=6	x=621770	y=077126	x+y=698896=836**2	x-y=544644=738**2

real	1m45.232s
user	1m45.207s
sys	0m0.004s

The time grows very fast with the number of digits. For example:

(time ./ch-1.pl 9) 2>&1

Results:

N=9	x=281089082	y=280980182	x+y=562069264=23708**2	x-y=108900=330**2

real	17m9.807s
user	17m9.389s
sys	0m0.032s

To make the calculation slightly faster I use some of the stated properties of rare numbers, so that I don’t make an exhaustive search..

# Perl weekly challenge 102
# Task 1: Rare numbers
# Slightly faster through a reduction of the search space, but more elaborate.
#
# See https://wlmb.github.io/2021/03/01/PWC102/#task-2-rare-numbers
use strict;
use warnings;
use v5.12;
use POSIX qw(floor);

my %shown; # to avoid showing repetitions

for my $N(@ARGV){
    my($A, $B, $P, $Q); #first, second, next to last and last digits
    ($A, $Q)=(2,2); #explore possible combinations
    for $B(0..9){
	search($N, $A, $B, $B, $Q);
    }
    ($A, $Q)=(4,0);
    for $B(0..9){
	for $P(map {($B+2*$_)%10} (0..4)){
	    search($N, $A, $B, $P, $Q);
	}
    }
    $A=6;
    for $Q(0,5){
	for $B(0..9){
	    for $P(map {($B+1+2*$_)%10} (0..4)){
		search($N, $A, $B, $P, $Q);
	    }
	}
    }
    ($A, $Q)=(8, 2);
    for $B(0..9){
	$P=9-$B;
	search($N, $A, $B, $P, $Q);
    }
    ($A, $Q)=(8, 3);
    for $B(0..9){
	$P=($B-7)%10;
	search($N, $A, $B, $P, $Q);
    }
    ($A, $Q)=(8, 7);
    for $B(0..9){
	$P=(1-$B)%10;
	search($N, $A, $B, $P, $Q);
    }
    ($A, $Q)=(8, 8);
    for $B(0..9){
	$P=$B;
	search($N, $A, $B, $P, $Q);
    }

Next I write routines to build and test strings of length $N starting with the digits "$A$B" and ending in the digits "$P$Q".

    sub search{ #search $N digit numbers given first and last digits
	my ($N, $A, $B, $P, $Q)=@_;
	# return if $N<=3;
	test(join '', $A, $Q) if $N==2;
	test(join '', $A, $B, $Q) if $N==3;
	test(join '', $A, $P, $Q) if $N==3 && $P!=$B;
	test(join '', $A, $B, $P, $Q) if $N==4;
	return unless $N>4;
	my $format="%0".($N-4)."d";
	for my $m(map {sprintf($format, $_)} (0..10**($N-4)-1)){ #generate middle digits
	    test(join '',$A, $B, $m, $P, $Q);
	}
    }
    sub test { #test and report the single number
	my $x=shift;
	return if $shown{$x};
	# return if $x%10==0; #uncomment to disallow reversed numbers starting in 0
	my $y=join '', reverse split '', $x;
	return if $x<=$y; #use < to allow palindromes
	my $s=$x+$y;
	return unless $s==floor(sqrt($s))**2; # test squareness of sum
	my $d=$x-$y;
	return unless $d==floor(sqrt($d))**2; # test squareness of diff
	++$shown{$x};
	my $N=length $x;
	say "N=$N\tx=$x\ty=$y\tx+y=$s=", sqrt($s),"**2\tx-y=$d=",sqrt($d),"**2";
    }
}

Examples:

(time ./ch-1a.pl 2 3 4 5 6 7 8 9) 2>&1

Results:

N=2	x=65	y=56	x+y=121=11**2	x-y=9=3**2
N=6	x=621770	y=077126	x+y=698896=836**2	x-y=544644=738**2
N=9	x=281089082	y=280980182	x+y=562069264=23708**2	x-y=108900=330**2

real	0m42.192s
user	0m42.117s
sys	0m0.020s

Much faster, but time would explode anyway for slightly larger N. I guess it would be better to look for numbers whose sum and difference yields squares and afterwards test their digit for mirrorness. If x+y=a2 and x-y=b2, then x=(a2+b2)/2 and y=(a2-b2)/2.

# Perl weekly challenge 102
# Task 1: Rare numbers
# Slightly faster through a reduction of the search space, but more elaborate.
#
# See https://wlmb.github.io/2021/03/01/PWC102/#task-2-rare-numbers
use strict;
use warnings;
use v5.12;
use integer;
use POSIX qw(floor);

for my $N(@ARGV){
    my ($min, $max)=(10**($N-1), 10**$N-1);
  A:
    for my $a(floor(sqrt($min))..floor(sqrt(2*$max))){
      B:
	for my $b(1..$a){
	    my $x=($a**2+$b**2);
	    next B unless $x%2==0;
	    $x/=2;
	    next B if $x<$min;
	    next A if $x>$max;
	    my $y=join '', reverse split '', $x;
	    next B unless $y==($a**2-$b**2)/2;
	    my ($s, $d)=($x+$y, $x-$y);
	    say "N=$N\tx=$x\ty=$y\tx+y=$s=", sqrt($s),"**2\tx-y=$d=",sqrt($d),"**2";
      }
  }
}

Examples:

(time ./ch-1b.pl 2 3 4 5 6 7 8) 2>&1

Results:

N=2	x=65	y=56	x+y=121=11**2	x-y=9=3**2
N=6	x=621770	y=077126	x+y=698896=836**2	x-y=544644=738**2

real	0m58.977s
user	0m58.950s
sys	0m0.008s

Another example:

(time ./ch-1b.pl 9) 2>&1

Results:

N=9	x=281089082	y=280980182	x+y=562069264=23708**2	x-y=108900=330**2

real	9m46.437s
user	9m45.803s
sys	0m0.036s

So it seems that this method is faster than the first one, but slower than the second one. The loops are shorter due to the square root, but there are two nested loops, so the number of iterations is of the same order.

I make a new attempt. Consider N-digit numbers x=xlxr and y=x’rx’l, where I assume N is even, I write x and y in terms of N/2-digit numbers, and the primes indicate inverted digits. If x+y and x-y are squares, then so are their right halves xr+x’l and xr-x’l, where I all operations are done modulo 10N/2. Thus I can find candidates, hopefully not too many, for x and y by exploring the much smaller space of N/2-digit numbers. The logic of the resulting program is not too complex. First I make a list of squares modulo 10N/2. Then I use it to obtain possible numbers xr and x’l. With them I build x and y and finally test them. If N is not even, I add a single digit in the middle.

# Perl weekly challenge 102
# Task 1: Rare numbers
# Faster by breaking the number at the middle.
use strict;
use warnings;
use v5.12;
use POSIX qw(floor);

foreach my $N(@ARGV){
    my $min=10**($N-1);
    my $N2=floor($N/2);
    my $M=10**$N2;
    my %seen; # disctint squares mod $M
    foreach my $a(0..10**$N2){
	$seen{($a**2)%$M}=1;
    }
    my @squares=sort {$a<=>$b} keys %seen;
    foreach my $a2(@squares){
	foreach my $b2(@squares){
	    my $xr=($a2+$b2);
	    next unless $xr%2==0;
	    $xr=sprintf("%0${N2}d",($xr/2)%$M);
	    my $xl1=sprintf("%0${N2}d",(($a2-$b2)/2)%$M);
	    foreach my $mid($N%2==0?(''):(0..9)){
		my $x=join '', reverse(split '', $xl1), $mid, $xr;
		next unless $x>=$min;
		my $y=join '', reverse(split '', $x);
		next unless $x>$y;
		my $s=$x+$y;
		my $d=$x-$y;
		next unless floor(sqrt($s))**2==$s;
		next unless floor(sqrt($d))**2==$d;
		say "N=$N\tx=$x\ty=$y\tx+y=$s=", sqrt($s),"**2\tx-y=$d=",sqrt($d),"**2";
	    }
	}
    }
}

Examples:

(time ./ch-1c.pl 2 3 4 5 6 7 8 9) 2>&1

Results:

N=2	x=65	y=56	x+y=121=11**2	x-y=9=3**2
N=6	x=621770	y=077126	x+y=698896=836**2	x-y=544644=738**2
N=9	x=281089082	y=280980182	x+y=562069264=23708**2	x-y=108900=330**2

real	0m8.915s
user	0m8.911s
sys	0m0.004s

Another example:

(time ./ch-1c.pl 10) 2>&1

Results:

N=10	x=2042832002	y=2002382402	x+y=4045214404=63602**2	x-y=40449600=6360**2
N=10	x=2022652202	y=2022562202	x+y=4045214404=63602**2	x-y=90000=300**2

real	1m38.120s
user	1m38.111s
sys	0m0.000s

This seems to be a big improvement compared to the previous codes. I even got the fourth and fifth numbers in the series. The time still grows exponentially but with smaller factors, and the code seems somewhat cleaner, but I didn’t have patience to wait for the sixth number.

Task 2: Hash-Counting String

Submitted by: Stuart Little You are given a positive integer $N.

Write a script to produce Hash-counting string of that length.

The definition of a hash-counting string is as follows:

  • the string consists only of digits 0-9 and hashes, ‘#’
  • there are no two consecutive hashes: ‘##’ does not appear in your string
  • the last character is a hash
  • the number immediately preceding each hash (if it exists) is the position of that hash in the string, with the position being counted up from 1

It can be shown that for every positive integer N there is exactly one such length-N string.

Examples: (a) “#” is the counting string of length 1 (b) “2#” is the counting string of length 2 (c) “#3#” is the string of length 3 (d) “#3#5#7#10#” is the string of length 10 (e) “2#4#6#8#11#14#” is the string of length 14

This seems to be very straightforward. I build the pieces of the string from the end towards the beginning by appending a hash mark to its position and updating the position for the successive pieces.

# Perl weekly challenge 102
# Task 2: Hash-counting string
#
# See https://wlmb.github.io/2021/03/01/PWC102/#task-2-hash-counting-string
use strict;
use warnings;
use v5.12;

foreach my $length(@ARGV){
    my $remaining=$length;
    my @pieces;
    while($remaining>0){
	unshift @pieces, $remaining==1?"#":"$remaining#";
	$remaining-=length $pieces[0];
    }
    say "Length: $length\tString: ", join '', @pieces;
}

Examples:

./ch-2.pl 1 2 3 10 14

Results:

Length: 1	String: #
Length: 2	String: 2#
Length: 3	String: #3#
Length: 10	String: #3#5#7#10#
Length: 14	String: 2#4#6#8#11#14#
Written on March 1, 2021