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 `0`

s.

```
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.

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.