RogerBW's Blog

Perl Weekly Challenge 102: Rare Hash 03 March 2021

I’ve been doing the Perl Weekly Challenges. The latest involved an obscure class of number and a self-consistent string format. (Note that this is open until 7 March 2021.)

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.

I don't really recommend that you look at that page; the guy may be mathematically competent, but nobody should ever have told him how to change text colour or increase font size.

But anyway, this is clearly a large search space, so I'll take him at his word and use the optimisations he gives.

sub rn {
  my $d=shift;
  my @out;
  my $mxm=10**($d-2)-1;

The first digit has to have one of these values.

  foreach my $a (2,4,6,8) {

And the final digit, one of these.

    foreach my $q (0,2,3,5,7,8) {

Then we can constrain on possible combinations.

      if ($a==2 && $q!=2) {
        next;
      }
      if ($a==4 && $q!=0) {
        next;
      }
      if ($a==6 && $q!=0 && $q!=5) {
        next;
      }
      if ($a==8 && $q!=2 && $q!=3 && $q!=7 && $q!=8) {
        next;
      }

If we're dealing with just two digits, that's it for eliminating candidates, so on to the final check.

      if ($d==2) {
        my $t="$a$q";
        if (is_rare($t)) {
          push @out,$t;
        }

I couldn't be bothered to do the three-digit case, and there aren't any valid answers of three digits anyway (by inspection at OEIS). So we move straight on to longer examples.

      } else {

Iterate over all middle values. (I could have made this faster by taking only valid second and penultimate digits, then filling in any remaining middle digits for the 5+-digit case, but I was getting very bored by this point. So if you actually have a use for this code, there's an optimisation for you.)

        foreach my $middledigits (map {sprintf('%0'.($d-2).'d',$_)} 0..$mxm) {
          my $b=substr($middledigits,0,1);
          my $p=substr($middledigits,-1,1);

More constraints on these digit combinations.

          if ($a==2 && $b!=$p) {
            next;
          }
          if ($a==4 && abs($b-$p)%2 != 0) {
            next;
          }
          if ($a==6 && abs($b-$p)%2 != 1) {
            next;
          }
          if ($a==8) {
            if ($q==2 && $b+$p != 9) {
              next;
            } elsif ($q==3 && $b-$p != 7 && $p-$b != 3) {
              next;
            } elsif ($q==7 && $b+$p != 1 && $b+$p != 11) {
              next;
            } elsif ($q==8 && $b!=$p) {
              next;
            }
          }

Finally, test for rare-ness.

          my $t="$a$middledigits$q";
          if (is_rare($t)) {
            push @out,$t;
          }
        }
      }
    }
  }
  return \@out;
}

And that rarity test is to reverse, check that the number is larger than its reverse, then check that the difference and the sum are both perfect squares.

sub is_rare {
  my $t=shift;
  my $d=join('',reverse(split '',$t));
  if ($d >= $t) {
    return 0;
  }
  foreach my $c ($t+$d,$t-$d) {

No perfect square ends with these digits, and checking that is faster than actually taking the square root if we don't have to.

    if ($c =~ /[2378]$/) {
      return 0;
    }
    my $s=int(sqrt($c));
    unless ($s*$s==$c) {
      return 0;
    }
  }
  return 1;
}

So that's that. It's basically the same in other languages, though Rust makes the transitions between string and integer relatively hard work and Ruby makes it very easy.

This seemed like a long enough task to be worth a timing test, so I did. In each case, the test was run on the same unloaded system, running the program twice and timing the second run. Perl took 132 seconds; Python 151; Ruby 211; and naïve Rust (compiling at the start of the run and leaving all debug info in place) 177. When I set the Rust code to optimise for release, it still compiled in less than a second, and the execution time dropped to 17 seconds flat.

I don't know how long Raku would have taken; I gave up after half an hour (1800 seconds). Even with all the optimisations turned on. Maybe modern Raku is faster than the version in Debian/stable (Rakudo 2018.12, compiled 9 January 2019).

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

I'll take your word for it, but this does mean that a depth-first search is an obvious solution. I represent the string as the series of integers that will lie in it, with an initial "#" shown as a value of 1. In Raku:

sub hcs($n) {
  my @s;
  my @t;
  while (1) {
    @s=();
    my $l=0;

If we have a candidate stub, load it into @s and calculate its current length.

    if (@t.elems) {
      @s=(pop @t).flat;
      $l=sum(map {($_==1 ?? 0 !! chars($_))+1}, @s);
    }

If that's the target length, that valid answer must be the only one, so drop out with it. If it's longer than the target, no point in extending it further.

    if ($l==$n) {
      last;
    }
    if ($l > $n) {
      next;
    }

If we're still here, it's shorter than the target, so work out possible extensions. Most of the time there will only be one, which keeps the search space conveniently small: if you have "#3#" then the only possible extension is "5#". But an empty string can be extended to make "#" or "2#"; a 7-character string can be extended by "9#" or "10#"; and so on at ~100 characters, ~1000, etc.

    my $c=$l;
    while (1) {
      my $tt=($c==1 ?? 0 !! chars($c))+$l+1;
      if ($c==$tt) {
        my @k=(@s».List.flat);
        push @k,$c;
        push @t,@k;
      }
      if ($c > $tt) {
        last;
      }
      $c++;
    }
  }
  return join('',map {($_==1 ?? '' !! $_) ~ '#'}, @s);
}

and the other languages look basically similar.

Full code on github.


  1. Posted by RogerBW at 10:45am on 11 March 2021

    Given that people managed to get Raku to solve problem #1, clearly some of them have faster runtimes than I do. Good! Parallelising would have improved speed, and would have taught me more about the languages; maybe next time.

    Abigail clearly got bored and used the OEIS listing, which seems fair enough.

    For part 2, the trick which most people spotted but I missed was to work backwards recursively: for target length 5 the string must end with "5#", so hcs(5) = hcs(3) concatenated with "5#", and so on.

Comments on this post are now closed. If you have particular grounds for adding a late comment, comment on a more recent post quoting the URL of this one.

Search
Archive
Tags 1920s 1930s 1940s 1950s 1960s 1970s 1980s 1990s 2000s 2010s 3d printing action aeronautics aikakirja anecdote animation anime army astronomy audio audio tech base commerce battletech beer boardgaming book of the week bookmonth chain of command children chris chronicle church of no redeeming virtues cold war comedy computing contemporary cornish smuggler cosmic encounter coup covid-19 cycling dead of winter doctor who documentary drama driving drone ecchi economics espionage essen 2015 essen 2016 essen 2017 essen 2018 essen 2019 existential risk falklands war fandom fanfic fantasy feminism film firefly first world war flash point flight simulation food garmin drive gazebo genesys geodata gin gkp gurps gurps 101 gus harpoon historical history horror hugo 2014 hugo 2015 hugo 2016 hugo 2017 hugo 2018 hugo 2019 hugo 2020 hugo-nebula reread in brief avoid instrumented life julie enfield kickstarter learn to play leaving earth linux liquor lovecraftiana mecha men with beards museum music mystery naval non-fiction one for the brow opera parody perl perl weekly challenge photography podcast politics powers prediction privacy project woolsack pyracantha python quantum rail raku ranting raspberry pi reading reading boardgames social real life restaurant reviews romance rpg a day rpgs ruby rust science fiction scythe second world war security shipwreck simutrans smartphone south atlantic war squaddies stationery steampunk stuarts suburbia superheroes suspense television the resistance thirsty meeples thriller tin soldier torg toys trailers travel type 26 type 31 type 45 vietnam war war wargaming weather wives and sweethearts writing about writing x-wing young adult
Special All book reviews, All film reviews
Produced by aikakirja v0.1