RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest involved finding numbers that looked the same inverted, and generating a very long string.

A strobogrammatic number is a number that looks the same when looked at upside down.

You are given two positive numbers $A and $B such that 1 <= $A <= $B <= 10^15.

Write a script to print all strobogrammatic numbers between the given two numbers.

Example

Input: $A = 50, $B = 100 Output: 69, 88, 96

Not specified is whether "1" is regarded as looking the same upside down or not. I assume not.

I'm using Test::More as a harness as in the last few posts, and defining a function to do the work.

sub sg {
  my @range=@_;
  my @out;

Here is the key. Each entry in %charges shows the corresponding number after inversion. If 1 is allowed, add 1 => 1 to the list.

  my %charges=(
    6 => 9,
    9 => 6,
    8 => 8,
    0 => 0,
      );
  my $cm=join('',keys %charges);
 OUTER:
  foreach my $n ($range[0]..$range[1]) {

If the candidate number doesn't consist entirely of the digits in %charges, reject it. Also if it ends in zero.

    if ($n !~ /^[$cm]*$/) {
      next;
    }
    if ($n =~ /0$/) {
      next;
    }

Now build a list of the digits that must occur in the inverted number, indexed by their positions.

    my $nl=length($n)-1;
    my %locs;
    foreach my $pos (0..$nl) {
      $locs{$nl-$pos}=$charges{substr($n,$pos,1)};
    }

For each entry in that list, check whether it exists in the original number, and abort if not.

    foreach my $pos (keys %locs) {
      if (substr($n,$pos,1) ne $locs{$pos}) {
        next OUTER;
      }
    }

Otherwise, we have a valid invertible number.

    push @out,$n;
  }
  return \@out;
}

Raku was similar but had some key differences; I had to put the whole regexp into $cm rather than just the numeric contents, and my version of the interpreter still doesn't handle last OUTER correctly, so I patched round it with a trap value.

A 0/1 string is a string in which every character is either 0 or 1.

Write a script to perform switch and reverse to generate S30 as described below:

switch:

Every 0 becomes 1 and every 1 becomes 0. For example, “101” becomes “010”.

reverse:

The string is reversed. For example, "001” becomes “100”.

S0 = “” S1 = “0” S2 = “001” S3 = “0010011” … SN = SN-1 + “0” + switch(reverse(SN-1))

As originally stated, the problem required the generation of S1000; a casual inspection will show that the string length is 2^N-1, so this would take up approximately 10^301 bytes to represent, far larger than any plausible computer. This tasted like an Advent of Code problem: challenge accepted! (In AoC it would be something like "what is the value at position 3452348123879?")

Then later the problem was reduced to generating S30. Ah well, we can do that too.

Obviously a sequence of zeroes and ones isn't going to be a standard thing, but there are more zeroes than ones. So let's write the generator as proposed, but also output the indices of each one in the output. (Each string starts with the previous string, so that will be consistent.)

my $s='';
my $n=0;
while (1) {
  print "S$n = \"$s\"\n";
  my @i;
  my $l=-1;
  do {
    $l=index($s,'1',$l+1);
    if ($l>-1) {
      push @i,$l+1;
    }
  } while ($l!=-1);
  print join(',',@i),"\n";
  $s=plusone($s);
  $n++;
  sleep 1;
}

sub plusone {
  my $in=shift;
  return join('',$in,'0',switch(rev($in)));
}

sub switch {
  my $str=shift;
  $str =~ s/1/x/g;
  $str =~ s/0/1/g;
  $str =~ s/x/0/g;
  return $str;
}

sub rev {
  my @in=split '',shift;
  return join('',reverse @in);
}

That shows a sequence: 3,6,7,11,12,14,15,19,22,23,24,27,28,30,31,… and that can be fed into OEIS. Sure enough, out comes A091067.

(Probably one could prove this. I'm satisfied that the identity holds for arbitrarily high numbers.)

There's no generator code for that sequence, but there is for A060833 which is the same thing one higher. So I can implement that, which will give me the sequence of positions with 1s in them. All other positions have zeroes. And we know the total length.

(If you actually want S1000, you should probably use Math::BigInt.)

use List::Util qw(min);

my $s=1000; # or 30 if you're a wimp
my $l=2**$s-1;

my $pos=1;
my $seq=4;
while (1) {

Find the position of the next 1.

  my $p1=$seq-1;

Fill in the space up to that position with 0s.

  my $n0=min($p1-$pos,$l-$pos);
  print '0' x $n0;
  $pos+=$n0;

If there's string length left, print that 1.

  if ($p1<=$l) {
    print '1';
    $pos++;
  }
  if ($pos>$l) {
    last;
  }
  $seq=nextseq($seq);
}
print "\n";

sub nextseq {
  my $prev=shift;
  my $c=$prev;
  while (1) {
    $c++;
    my $t=$c-1;
    while (1) {
      my $r=int($t/2);
      if ($t % 2 != 0) {
        last;
      }
      $t=$r;
    }
    if ($t % 4 == 3) {
      last;
    }
  }
  return $c;
}

Raku is essentially identical.