Rare Counting with Raku and Perl

[118] Published 6. March 2021.

This is my response to the Perl Weekly Challenge #102.

Challenge #102.1: Rare Numbers

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

Let us start with the the procedure deciding if the given number is a rare number:

File: rare-numbers1 (partial)

sub is-rare ($number)
{
  my $reverse  = $number.flip;               # [1]
  my $add      = $number + $reverse;         # [2]
  my $subtract = $number - $reverse;         # [2a]

  return False if any($add, $subtract) < 0;  # [3]

  my $add-sqrt = $add.sqrt;                  # [4]
  my $sub-sqrt = $subtract.sqrt;             # [4a]

  return $add.sqrt.Int == $add.sqrt && $sub-sqrt.Int == $sub-sqrt;  # [5]
}

[1] The reverse of the number. (Note that in Raku flip reverses a string, whereas reverse reverses a list.)

[2] Add the reverse, and subtract the reverse [2a].

[3] Bail out if any of them are negative, as square roots of negative numbers are not ok.

[4] Get the square roots.

[5] Check if both square roots are integers. If so, we have a rare number.

See docs.raku.org/routine/flip for more information about flip.

See docs.raku.org/routine/reverse for more information about reverse.

See docs.raku.org/routine/sqrt for more information about sqrt.

Then the program using the procedure:

File: rare-numbers1 (the first part)

#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0, :v(:$verbose));  # [6]

my $lower = 1 ~ 0 x ($N -1);                         # [7]
my $upper = 9 x $N;                                  # [7a]

say ": Range: $lower - $upper" if $verbose;          # [7b]

for $lower .. $upper -> $candidate                   # [8]
{
  say $candidate if is-rare($candidate);             # [8a]
}

[6] Ensure a positive integer.

[7] The lower limit. Start with «1», and add zeroes (with the string repetition operator x to get it. The upper limit is easier (8a). Print both values, if we have used verbose mode (to ensure that we got it right).

[8] Iterate over all the values, and print it if it is rare (8a).

See docs.raku.org/routine/x for more information about the string repetition operator x.

Running it:

$ ./rare-numbers1 -v 2
: Range: 10 - 99
65

$ ./rare-numbers1 -v 6
: Range: 100000 - 999999
621770

Looking good, so far. But...

$ ./rare-numbers1 -v 9
: Range: 100000000 - 999999999
^C

I killed off the last one after 24 hours. It had not computed a single value by then. I'll have a look at speeding it up, but let us do the perl version first.

A Perl Version

This is straight forward translation of the Raku version.

File: rare-numbers-perl

#! /usr/bin/env perl

use strict;
use feature 'say';
use feature 'signatures';
no warnings 'experimental::signatures';
use Getopt::Long;

my $verbose = 0;

GetOptions("verbose" => \$verbose);

my $N = shift(@ARGV) // die 'Please specify $N';

die '$N is not a positive integer' unless $N =~ /^[1-9][0-9]*$/;  # [1]

my $lower = 1 . 0 x ($N -1);
my $upper = 9 x $N;

say ": Range: $lower - $upper" if $verbose;

for my $candidate ($lower .. $upper)
{
  say $candidate if is_rare($candidate);
}

sub is_rare ($number)
{
  my $reverse  = reverse $number;
  my $add      = $number + $reverse;
  my $subtract = $number - $reverse;

  return 0 if $add < 0 || $subtract < 0;

  my $add_sqrt = sqrt($add);
  my $sub_sqrt = sqrt($subtract);

  return int($add_sqrt) == $add_sqrt && int($sub_sqrt) == $sub_sqrt;
}

[1] This regex matching ensures that we got a positive integer.

Running it gives the same result as the Raku version:

$ ./rare-numbers-perl -v 2
: Range: 10 - 99
65

$ ./rare-numbers-perl -v 6
: Range: 100000 - 999999
621770

2$ ./rare-numbers-perl -v 9
: Range: 100000000 - 999999999
200040002
204060402
242484242
281089082
291080192

The last one (9 digits) took about 7 minutes to execute on my pc. That is not very fast, but it is way better than the Raku version that had not produced a single value after 24 hours.

Raku on Speed

Let us have a go at speeding up the raku version.

Basic assumption: The square root operation is time intensive.

Let us get rid of one of them, in most cases.

File: rare-numbers2 (changes only)

sub is-rare ($number)
{
  my $reverse  = $number.flip;
  my $add      = $number + $reverse;
  my $subtract = $number - $reverse;

  return False if any($add, $subtract) < 0;

  my $add-sqrt = $add.sqrt;

  if $add-sqrt.Int == $add-sqrt
  {
    my $sub-sqrt = $subtract.sqrt;      # [1]
    return $sub-sqrt.Int == $sub-sqrt;  # [2]
  }
}

[1] Do not calcalate the second square root if we do not need it.

[2] Note the missing return False at the end. We get that for free, as the last value calculated inside a block will be the return value.

The result timings:

rare-numbers1 6	1m 53s
rare-numbers2 6	1m 49s

That was, surprising.

A Timely Warning

The actual timings are not that important, as they depend on a lot of factors on my pc. But comapring them with each other is useful.

So the square root calculation is actually not a problem.

Ok. Let us try getting rid of the any junction.

File: rare-numbers3 (changes only)

sub is-rare ($number)
{
  my $reverse  = $number.flip;
  my $add      = $number + $reverse;
  my $subtract = $number - $reverse;

  return False if $add      < 0;
  return False if $subtract < 0;

  my $add-sqrt = $add.sqrt;

  if $add-sqrt.Int == $add-sqrt
  { 
    my $sub-sqrt = $subtract.sqrt;
    return $sub-sqrt.Int == $sub-sqrt;
  }
}

The result timings (updated):

rare-numbers1 6	1m 53s
rare-numbers2 6	1m 49s
rare-numbers3 6	0m 32s

That was, interesting. Junctions are obviously expensive.

We can delay the subtraction, and possibly shave off some further execution time if it is not needed:

File: rare-numbers4 (changes only)

sub is-rare ($number)
{
  my $reverse  = $number.flip;

  my $add      = $number + $reverse;
  return False if $add < 0;

  my $subtract = $number - $reverse;
  return False if $subtract < 0;

  my $add-sqrt = $add.sqrt;

  if $add-sqrt.Int == $add-sqrt
  { 
    my $sub-sqrt = $subtract.sqrt;
    return $sub-sqrt.Int == $sub-sqrt;
  }
}

The result timings (updated):

rare-numbers1 6	1m 53s
rare-numbers2 6	1m 49s
rare-numbers3 6	0m 32s
rare-numbers4 6	0m 28s

Slightly better.

It turns out that flip, that works on strings, returns a string:

> say 12.WHAT;       # -> (Int)
> say 12.flip.WHAT;  # -> (Str)

The program uses the $reverse variable twice, and one can suspect that the coercion from string to integer has some overhead.

Let us fix that:

File: rare-numbers5 (changes only)

sub is-rare ($number)
{
  my $reverse  = $number.flip.Int;

  my $add      = $number + $reverse;
  return False if $add < 0;

  my $subtract = $number - $reverse;
  return False if $subtract < 0;

  my $add-sqrt = $add.sqrt;

  if $add-sqrt.Int == $add-sqrt
  { 
    my $sub-sqrt = $subtract.sqrt;
    return $sub-sqrt.Int == $sub-sqrt;
  }
}

The result timings (updated):

rare-numbers1 6	1m 53s
rare-numbers2 6	1m 49s
rare-numbers3 6	0m 32s
rare-numbers4 6	0m 28s
rare-numbers5 6	0m 31s

That was surprising. Oh, well.

Smartmatch Gotcha

We could try replacing the coercion (.Int) and comparison (==) with a smartmatch (~~) instead.

That is, replacing this line:

if $add-sqrt.Int == $add-sqrt

with this:

if $add.sqrt ~~ Int

But it will fail, as the sqrt function does not return an integer - even if the value is an integer (in a mathematical sense):

> say 2 ~~ Int;       # -> True
> say 4.sqrt ~~ Int;  # -> False
> say 2.WHAT;         # -> (Int)
> say 4.sqrt.WHAT;    # -> (Num)

We can try inlining the procedure:

File: rare-numbers6

#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0, :v(:$verbose));

my $lower = 1 ~ 0 x ($N -1);
my $upper = 9 x $N;

say ": Range: $lower - $upper" if $verbose;

for $lower .. $upper -> $number
{
  my $reverse  = $number.flip.Int;

  my $add      = $number + $reverse;
  next if $add < 0;

  my $subtract = $number - $reverse;
  next if $subtract < 0;

  my $add-sqrt = $add.sqrt;

  if $add-sqrt.Int == $add-sqrt
  { 
    my $sub-sqrt = $subtract.sqrt;
    return $sub-sqrt.Int == $sub-sqrt;
  } 
}

The result timings (updated):

rare-numbers1 6	1m 53s
rare-numbers2 6	1m 49s
rare-numbers3 6	0m 32s
rare-numbers4 6	0m 28s
rare-numbers5 6	0m 31s
rare-numbers6 6	0m 29s

That is better. We have managed to reduce the time usage by 75%, compared with the first version.

Sequential Bonus

The rare numbers would have been suitable for my Centenary Sequences with Raku article, but I did not know about them when I wrote it.

So here they are, as a sequence (wrapped in a helper program):

File: rare-numbers-sequence

#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0);    # [1]

my $rns = (1..Inf).grep( *.&is-rare );  # [2]

say $rns[^$N];                          # [1a]

sub is-rare ($number)
{
  my $reverse  = $number.flip;
  my $add      = $number + $reverse;
  my $subtract = $number - $reverse;

  return False if any($add, $subtract) < 0;

  my $add-sqrt = $add.sqrt;
  my $sub-sqrt = $subtract.sqrt;

  return $add.sqrt.Int == $add.sqrt && $sub-sqrt.Int == $sub-sqrt;
}

[1] Print (in [1a]) the $N first values in the sequence.

[2] Note the special .& calling syntax allowing us to pretend that a procedure is a method.

Running it:

$ ./rare-numbers-sequence 3
(2 8 65)

$ ./rare-numbers-sequence 4
(2 8 65 242)

$ ./rare-numbers-sequence 6
(2 8 65 242 20402 24642)

See docs.raku.org/language/operators#methodop_.& for more information about the special procedure invocation syntax .&.

Sequential Look Again

Let us have a go at the original program yet another time, using the sequence (from the bonus section):

File: rare-numbers7

#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0, :v(:$verbose));

my $lower = 1 ~ 0 x ($N -1);
my $upper = 9 x $N;

say ": Range: $lower - $upper" if $verbose;

say ($lower .. $upper).grep( *.&is-rare ).join("\n");

sub is-rare ($number)
{
  my $reverse  = $number.flip.Int;

  my $add      = $number + $reverse;
  return False if $add < 0;

  my $subtract = $number - $reverse;
  return False if $subtract < 0;

  my $add-sqrt = $add.sqrt;

  if $add-sqrt.Int == $add-sqrt
  { 
    my $sub-sqrt = $subtract.sqrt;
    return $sub-sqrt.Int == $sub-sqrt;
  }
}

Running time: 31 seconds. Oh well.

Let us see what happens if we ensure that the range limits (the values before and after the .. operator) are integers:

File: rare-numbers8

#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0, :v(:$verbose));

my $lower = (1 ~ 0 x ($N -1)).Int;
my $upper = (9 x $N).Int;

say ": Range: $lower - $upper" if $verbose;

say ($lower .. $upper).grep( *.&is-rare ).join("\n");

sub is-rare ($number)
{
  my $reverse  = $number.flip.Int;

  my $add      = $number + $reverse;
  return False if $add < 0;

  my $subtract = $number - $reverse;
  return False if $subtract < 0;

  my $add-sqrt = $add.sqrt;

  if $add-sqrt.Int == $add-sqrt
  { 
    my $sub-sqrt = $subtract.sqrt;
    return $sub-sqrt.Int == $sub-sqrt;
  }
}

Running time: 5 seconds.

Now, that was impressive!

We can try to speed it up even further by running the grep block in parallel, with hyper:

File: rare-numbers9 (changes only)

($lower .. $upper).hyper.grep( *.&is-rare )>>.say;

See docs.raku.org/routine/hyper for more information about hyper.

Running time: 5 seconds. So we did not gain anything. The overhead is probably eating up the gains.

We can try with race instead of hyper, like this:

($lower .. $upper).race.grep( *.&is-rare )>>.say;

hyper ensures that we get the values in order (the same order as in the input). Use race if the order is not important.

See docs.raku.org/routine/race for more information about race.

But that does not affect the running time.

Let us go back to «rare-numbers6», the inlined version, and add the .Int coercers (from «rare-numbers8»):

File: rare-numbers10

#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0, :v(:$verbose));

my $lower = (1 ~ 0 x ($N -1)).Int;
my $upper = (9 x $N).Int;

say ": Range: $lower - $upper" if $verbose;

for $lower .. $upper -> $number
{
  my $reverse  = $number.flip.Int;

  my $add      = $number + $reverse;
  next if $add < 0;

  my $subtract = $number - $reverse;
  next if $subtract < 0;

  my $add-sqrt = $add.sqrt;

  if $add-sqrt.Int == $add-sqrt
  { 
    my $sub-sqrt = $subtract.sqrt;
    say $number if $sub-sqrt.Int == $sub-sqrt;
  }
}

Running time: 3 seconds. That is better.

We are creating and throwing away an awful lot of variables. What happens if we move them out of the loop?

File: rare-numbers

#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0, :v(:$verbose));

my $lower = (1 ~ 0 x ($N -1)).Int;
my $upper = (9 x $N).Int;

my ($reverse, $add, $subtract, $add-sqrt, $sub-sqrt);
 
say ": Range: $lower - $upper" if $verbose;

for $lower .. $upper -> $number
{
  $reverse  = $number.flip.Int;

  $add      = $number + $reverse;
  next if $add < 0;

  $subtract = $number - $reverse;
  next if $subtract < 0;

  $add-sqrt = $add.sqrt;

  if $add-sqrt.Int == $add-sqrt
  { 
    $sub-sqrt = $subtract.sqrt;
    say $number if $sub-sqrt.Int == $sub-sqrt;
  }
}

Running time: 2 seconds. That is even better.

Trying it with 9 digits actually works:

$ ./rare-numbers 9
200040002
204060402
242484242
281089082
291080192

Running time: 31 minutes. The Perl version, which is not optimised, used 7 minutes. Oh well.

Challenge #102.2: Hash-counting String

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

The beginning of the string differs between "#" and "2", but how do we choose? The second character in (c) and (d) is «3» - but only because we did not start with «2» (as in (e)). In that case the number would have been «4» instead if «3».

The solution is to start (so to speak) from the end. The last character is always a «#». We know the length we are after, and thus the position of that «#». Add that before the «#». Then we have a new position to fill (with a «#», and a number before it). We do know the position this time as well, so we add that number followed by the «#». This goes on until we have filled the string (upto the given length). The only difficulty here is ensuring that we do not add a starting «2» digit when we should not.

File: hash-counting-string-ternary

#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0);                      # [1]

my $position = $N;                                        # [2]
my $string   = "";                                        # [3]

while ($position > 0)                                     # [4]
{
  my $prefix = $position != 1 ?? $position ~ '#' !! '#';  # [5]

  $string = $prefix ~ $string;                            # [6]
  $position -= $prefix.chars;                             # [7]
}

say $string;                                              # [8]

[1] Ensure a postive integer (for the length of the string).

[2] The current position (in the string we are going to build), starting at the end.

[3] The string.

[4] As long as we have not reached the beginning.

[5] The current value (string) to add: A number (the current position) followed by «#». If we are at the first position, there is not room for the digit («2», as you remember from the discussion before the program) - and we add the «#» only.

[6] Add the current value,

[7] and move the position to the left (as many characters as we have added).

[8] We are done. Print the result.

Running it:

$ ./hash-counting-string-ternary 1
#

$ ./hash-counting-string-ternary 2
2#

$ ./hash-counting-string-ternary 3
#3#

$ ./hash-counting-string-ternary 10
#3#5#7#10#

$ ./hash-counting-string-ternary 14
2#4#6#8#11#14#

Looking good.

The ternary check (in [5]) is not very smart, as it only kicks in (if at all) when we reach the beginning of the string (the last iteration of the loop). We can move it out of the loop:

File: hash-counting-string

#! /usr/bin/env raku

unit sub MAIN (Int $N where $N > 0);

my $position = $N;
my $string   = "";

while ($position > 1)             # [1]
{
  my $prefix = $position ~ '#';   # [1a]

  $string = $prefix ~ $string;
  $position -= $prefix.chars;
}

say $string.chars == $N           # [2]    
  ?? $string                      # [2a]
  !! "#$string";                  # [2b]

[1] Note the changed value in the check, from 0 to 1. And the missing ternary in the assignment (in [1a]).

[2] Do we have the right number of characters? If so print them [2a]. If not add the «#» sign before it [2b].

$ ./hash-counting-string 1
#

$ ./hash-counting-string 2
2#

$ ./hash-counting-string 3
#3#

$ ./hash-counting-string 10
#3#5#7#10#

$ ./hash-counting-string 14
2#4#6#8#11#14#

Looking good.

And some more:

$ ./hash-counting-string 4
2#4#

$ ./hash-counting-string 5
#3#5#

$ ./hash-counting-string 6
2#4#6#

$ ./hash-counting-string 7
#3#5#7#

$ ./hash-counting-string 8
2#4#6#8#

$ ./hash-counting-string 9
#3#5#7#9#

$ ./hash-counting-string 11
2#4#6#8#11#

$ ./hash-counting-string 12
#3#5#7#9#12#

$ ./hash-counting-string 13
#3#5#7#10#13#

$ ./hash-counting-string 25
#3#5#7#10#13#16#19#22#25#

$ ./hash-counting-string 50
2#4#6#8#11#14#17#20#23#26#29#32#35#38#41#44#47#50#

./hash-counting-string 75
#3#5#7#9#12#15#18#21#24#27#30#33#36#39#42#45#48#51#54#57#60#63#66#69#72#75#

Perl

This is a straight forward translation of the second Raku version.

File: hash-counting-string-perl

#! /usr/bin/env perl

use strict;
use feature 'say';

my $N = shift(@ARGV) // die 'Please specify $N';

die '$N is not a positive integer' unless $N =~ /^[1-9][0-9]*$/;

my $position = $N;
my $string   = "";

while ($position > 0)
{
  my $prefix = $position != 1 ? $position . '#' : '#';

  $string = $prefix . $string;
  $position -= length($prefix);
}

say $string;

Running it gives the same result as the Raku version:

$ ./hash-counting-string-perl 1
#

$ ./hash-counting-string-perl 2
2#

$ ./hash-counting-string-perl 3
#3#

$ ./hash-counting-string-perl 10
#3#5#7#10#

$ ./hash-counting-string-perl 14
2#4#6#8#11#14#

A translation of the first Raku version is included in the zip file, as «hash-counting-string-ternary-perl».

And that's it.

Links

About me
Keyword Index
Raku Courses
Beginning Raku (book)
RSS Feed
Code (zip)
Reddit Comments