James Curtis-Smith

Here are solutions to this weeks challenges from the Perl Weekly Challenge.

You can find my full code on Github

Task 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:

• 2 digits: 65
• 6 digits: 621,770
• 9 digits: 281,089,082

The solution

There is a very naive solution to this problem.

#!/usr/local/bin/perl

use strict;

use warnings;

use feature qw(say);

use Test::More;

my @rare_ends = ( [2,[2]], [4,[0]], [6,[0,5]], [8,[2,3,7,8]] );

is( "@{[ rare_numbers( 2  ) ]}", '65' );

is( "@{[ rare_numbers( 6  ) ]}", '621770' );

is( "@{[ rare_numbers( 9  ) ]}", '281089082' );

done_testing();

sub rare_numbers {

  my $size = shift;

  my @ret;

  my $y;

  foreach( 10**($size-1) .. 10**$size - 1 ) {

    $y = reverse $_;

    push @ret, $_ if $_ > $y

                  && ($_-$y) == (int sqrt($_-$y))**2

                  && ($_+$y) == (int sqrt($_+$y))**2;

  }

  return @ret;

}

This naive approach though takes around 5 minutes on my linux box to run {most of the time is the loop through 10 billion numbers to get the answer for 9 digits...}

This really is impractical even for 10 digits - taking roughly and hour and (I'm guessing) 5 or 6 days to get the next number (with 12 digits), going up to 2 months, and 2 years for the answers for 13 and 14 digits...

We need to scale this back down to a reasonable number..

There are a number of different rules that drive both the first and last digits, and subsequently the second and penultimate digits.

If we encode this into the code we reduce the search space considerably.

On top of that it has been proven that the digit sum has to be 9, or rewriting that the number itself modulo 9 has to be zero;

Finally we can optimize the square check as we know squares must end in either 0, 1, 2, 4, 5, 6 or 9, and also cache the value of the this check as there will be numerous cases where we know that the difference between the two numbers will be the same. This leads us to the following code...

#!/usr/local/bin/perl


use strict;

use warnings;

use feature qw(say state);

use Test::More;

is( "@{[ rare_numbers( 2  ) ]}", '65' );

is( "@{[ rare_numbers( 6  ) ]}", '621770' );

is( "@{[ rare_numbers( 9  ) ]}", '281089082' );

is( "@{[ rare_numbers( 10 ) ]}", "2022652202 2042832002" );

done_testing();



sub rare_numbers {

  my $size = shift;

  return () if $size < 2; ## No solutions for size <2 as the

                          ## as the number is the reverse

                          ## of itself so will fail the $x!=$y

                          ## constraint

  ## List of start/end values

  my @rare_ends = ( [2,[2]], [4,[0]], [6,[0,5]], [8,[2,3,7,8]] );

  my @F=(0,1,0,1,1,0,1,1,0); ## rare_numbers have a digit sum 

                             ## (value mod 9) of either 9/0,2,5 or 8

  sub is_rare {

    sub is_sq {

      state %cache;

      return $cache{$_[0]} if exists $cache{$_[0]};

      return $cache{$_[0]} = $_[0] =~ m{[014569]$} &&

                           $_[0] == (int sqrt $_[0])**2;

    }

    my $x = shift;

    return () if $F[$x%9]; ## Digit sum is wrong...

    my $y = reverse $x;

    return () if $x == $y; ## Musn't be the same back and forth

    return $y if $x<$y && is_sq($x+$y) && is_sq($y-$x);

    ## Check both ways round!

    return $x if $y<$x && is_sq($x+$y) && is_sq($x-$y);

    return ();

  }

  my %res;

  my $low  = $size <= 4 ? '' : '0' x ($size-4);

  my $high = $size <= 4 ? '' : '9' x ($size-4);

  foreach my $tup ( @rare_ends ) {

    my $s = $tup->[0];             ## first digit has to be even 2,4,6,8

    foreach my $e (@{$tup->[1]}) { ## second digit has to be in list

                                   ## at start...

      if( $size == 2 ) {           ## As our method really starts at 4

                                   ## let us deal with 2 & 3 cases first

                                   ## as the optimized code is for 

                                   ## numbers of length 4 or more

        $res{$_}=1 foreach is_rare("$s$e");

        next;

      }

      if( $size == 3 ) {

        $res{$_}=1 foreach map { is_rare("$s$_$e") } 0..9;

        next;

      }

      ## Now we need to do the next group....

      foreach my $b (0..9) {    ## These are filters to apply 

        foreach my $f (0..9) {  ## for each group of numbers....

          next if $s==2 && $b!=$f

            || $s==4 && ($b-$f)%2

            || $s==6 && ! ($b-$f)%2

            || $s==8 && (

                  $e==2 && $b+$f!=9

               || $e==3 && $b-$f!=7 && $f-$b !=3

               || $e==7 && $b+$f!=1 && $b+$f !=11

               || $e==8 && $b!=$f

            );

          ## Now we try all additional numbers....

          ## The sequence '000' .. '999' gives all 3 digit numbers.... !

          $res{$_}=1 foreach map { is_rare("$s$b$_$f$e") } $low..$high;

        }

      }

    }

  }

  return sort keys %res;

}

Notes

• 
  Rather than having to do a sprintf to get a sequence of numbers of length n we can use the "string" version of the range to go from "000.." to "999.."
  


• 
  We can write the inner loop in a single line given that the is_rare function returns either an empty array of the rare number themselves.
  


• 
  Finally we don't use the array - as we may return the same rare numbers twice, show use the hash key trick to weed out duplicates.
  

Task 2: Hash-counting String

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:

• "#" is the counting string of length 1
• "2#" is the counting string of length 2
• "#3#" is the string of length 3
• "#3#5#7#10#" is the string of length 10
• "2#4#6#8#11#14#" is the string of length 14

The solution

Usually challenge 1 is the easiest solution but this week I think is an exception - although there is an easy solution to challenge 1 - the faster (optimized) one needs extra work.

With many of these problems there are two ways to solve this - we can start at one end or the other.

If we go forward we occasionally get to a point where we have to make a decision both sequences consisting of n 9s and a 1 and n 9s are valid at certain points.
So for length 9 we have "#3#5#7#9#" and length 10 we have "#3#5#7#10#"... Having to continue along two paths is always going to make things harder.

If we go backwards we don't have the same problem - we know the location of the "#" so we have no branching point. As we add the "n#" to the end of the string - then the remainder of the string is just the solution for n-1-length of n, with 1 exception if n is 1 - we just don't include the n. This leads to thoughts or recursion - or a simple loop. We though want to avoid the overhead of recursion if we can....

This reduces to something quite simple. We repeat until we get to the case we can't add "n#" anymore. One of the nice features of Perl is being able to modify more than one variable at a time with ($a,$b)=($c,$d). We can use this here to reduce the loop to a single line. At the end of the loop we get to the case when n is 0 or 1 - in the latter case we just need to prefix a "#" we could use a ternary ?: but in this case we can simplify the code down by using string multiplication x. As we need one copy of # if n is 1 and none if it is 0.

sub hash_count_string {
  my ( $s, $n ) = ( '',      @_            );
     ( $s, $n ) = ( "$n#$s", $n-1-length$n ) while $n > 1;
  return '#'x$n.$s;
}