Binary Strobe with Raku & Perl

[83] Published 18. July 2020.

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

Challenge #069.1: Strobogrammatic Number

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

Consulting Wikipedia is illuminating. It confirms that the challenge got it wrong; we do not turn the number upside down, but rotate it 180 degrees. The digits are: 0, 1 and 8 (symmetrical) and 6 and 9 (asymmetrical).

The wikipedia article also mentions 2 and 5 (asymmetrical) under the label Nonstandard systems. They should be familiar to users of calculators with dot matrix displays. The number 52 is a Strobogrammatic Number if we include 2 and 5. It is not present in the challenge, so should not be part of this solution. But it is easy to do so, and I have added a command line option to enable them.

File: strobonum

#! /usr/bin/env raku

unit sub MAIN (Int $A where $A >= 1,                             # [1]
               Int $B where $B >= $A && $B <= 10 ** 15,          # [2]
	       :$calculator,                                     # [3]
	       :$v, :$verbose = $v);                             # [4]

my %strobo = $calculator                                         # [5]
  ?? ( 0 => 0, 1 => 1, 2 => 5, 5 => 2, 6 => 9, 8 => 8, 9 => 6 )  # [5a]
  !! ( 0 => 0, 1 => 1, 6 => 9, 8 => 8, 9 => 6 );                 # [5b]

sub is-strobogrammatic (Int $number)                             # [10]
{
  return False unless all($number.comb) eq any(%strobo.keys);    # [11]

  my $strobo = $number.flip.comb.map({ %strobo{$_} }).join;      # [12]
      
  say ": $number -> $strobo" if $verbose;
  
  return $strobo eq $number;                                     # [13]
}

my @strobo;                                                      # [6]

for $A .. $B -> $candidate                                       # [7]
{
  @strobo.push: $candidate if $candidate.&is-strobogrammatic;    # [8]
}

say @strobo.join(", ");                                          # [9]

[1] The first value, with the lower limit.

[2] The second value, with the first value as lower limit, and the higher limit.

[3] Calculator mode (2 and 5).

[4] Note the shortcut «--v» for «--verbose».

[5] Legal stroboogrammatic digits and how to translate them (rotated 180 degrees). In normal mode, allow 0, 1, 6, 8 and 9 only [5b]. In calcular mode, use 2 and 5 as well [5a].

[6] We collect the strobo(grammatic values here.

[7] Iterate over the values given by the input limits.

[8] • add it to the list if it is strobo>grammatic. Note the syntax, allowing us to call a regular procedure as a method. (It really just is a fancy procedure calling syntax.)

[9] Print the reslut, if any.

[10] Is the number strobogrammatic?

[11] • no, if it contains anything besides the legal digits.

[12] Flip the number and replace the strobogrammatic digits. (flip works on strings, whereas reverse works on list like structuress.)

[13] The number is strobogrammatic if the new one is the same as the original number.

See docs.raku.org/routine/** for more information about the exponentiation operator **.

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

See docs.raku.org/routine/all for more information about all, docs.raku.org/routine/any for more information about any and docs.raku.org/type/Junction for more information about Junctions.

See docs.raku.org/routine/flip for more information about the string reversing operator flip.

See docs.raku.org/routine/reverse for more information about the general reversing operator reverse.

Running it:

$ ./strobonum 50 100
69, 88, 96

$ ./strobonum --calculator 50 100
52, 69, 88, 96

We can make it more compact. The lines marked [6] to [9] can be replaced with a single line:

File: strobonum-grep (changes only)

say ($A .. $B).grep( *.&is-strobogrammatic ).join(", ");

A Perl Version

This is pretty much a straight forward translation from the Raku version:

File: strobonum-perl

#! /usr/bin/env perl

use strict;                                        # [1]
use warnings;                                      # [1]
use feature 'say';                                 # [1]
use feature 'signatures';                          # [1]

no warnings "experimental::signatures";            # [1]

my $verbose; 
my $calculator;

while (@ARGV && substr($ARGV[0],0,2) eq "--")      # [2]
{
  my $arg = shift(@ARGV);
  if    ($arg eq "--calculator") { $calculator++ }
  elsif ($arg eq "--verbose"   ) { $verbose++    }
}

my $A = shift(@ARGV) // die 'Please specify $A and $B';
my $B = shift(@ARGV) // die 'Please specify $A and $B';

die "$A: Not a positive integer" unless $A =~ /^\d+$/;
die "$B: Not a positive integer" unless $B =~ /^\d+$/;

die "$A: Out of range" unless $A >= 1  && $A <= 10 ** 15;
die "$B: Out of range" unless $B >= $A && $B <= 10 ** 15;

my %strobo = $calculator
  ? ( 0 => 0, 1 => 1, 2 => 5, 5 => 2, 6 => 9, 8 => 8, 9 => 6 )
  : ( 0 => 0, 1 => 1, 6 => 9, 8 => 8, 9 => 6 );

sub is_strobogrammatic ($number)
{
  my $strobo = join("", map { $strobo{$_} // return 0 }
   	                split("", reverse($number)) );    # [3]

  say ": $number -> $strobo" if $verbose;

  return $strobo eq $number;
}

say join(", ", grep { is_strobogrammatic($_) } ($A .. $B));

[1] A future (and just announced) Perl 7 can make all of these lines disappear. The backwards compatibility in Perl 5 is in general a good idea, but this is the price we pay. For now..

[2] Handling the arguments takes a lot of code, compared to the Raku version with one line of code (shown with newlines to make it easier to read). I could have used a module, but there are so many to choose from.

[3] I replaced the all and any junctions in The Raku version with a simple return inside the map. (The «List::Util» module supplies them, so it is possible to use them in Perl.) The result is a very compact line of code, that is hard to understand.

A Perl and Raku Comparison

The last line in the program really shows off the advantage of Raku over Perl in producing readable code:

Raku:

say ($A .. $B).grep( *.&is-strobogrammatic ).join(", ");

Perl:

say join(", ", grep { is_strobogrammatic($_) } ($A .. $B));

The Perl version is harder to comprehend.

Challenge #069.2: 0/1 String

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 S0 becomes S1 and every S1 becomes S0. For example, 101 becomes 010. reverse:
The string is reversed. For example, 001 becomes 100.

UPDATE (2020-07-13 17:00:00): It was brought to my notice that generating S1000 string would be nearly impossible. So I have decided to lower it down to S30.

Please follow the rule as below:

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

We can use gather/take to set up a sequence of values:

File: 01-string

#! /usr/bin/env raku

unit sub MAIN ($limit = 30);

sub switch ($string)
{
  return $string.comb.map({ $_ eq "1" ?? 0 !! 1 }).join;
}

my $string01 := gather
{
  take "";
  my $prev = "0"; take "0";

  loop
  {
    $prev = $prev ~ "0" ~ switch($prev.flip);
    take $prev;
  }
}

say "S$_ = \"{ $string01[$_] }\"" for 0..$limit;

See my Raku Gather, I Take article or docs.raku.org/syntax/gather take for more information about gather/take.

Running it:

$ ./01-string 4
S0 = ""
S1 = "0"
S2 = "001"
S3 = "0010011"
S4 = "001001100011011"

Running the program to 30 caused my pc to crash, but I'll get back to that later.

We can make the program shorter by optimizing the gather/take block:

File: 01-string-smart (partial)

my $string01 := gather
{
  my $prev = "";

  loop
  {
    take $prev;
    $prev = $prev ~ "0" ~ switch($prev.flip);
  }
}

Running it:

$ ./01-string-smart 5
S0 = ""
S1 = "0"
S2 = "001"
S3 = "0010011"
S4 = "001001100011011"
S5 = "0010011000110110001001110011011"

A Perl Version

Perl does not have gather/take, but a loop works fine:

File: 01-string-perl

#! /usr/bin/env perl

use strict;
use warnings;
use feature 'say';
use feature 'signatures';

no warnings "experimental::signatures";

my $limit = $ARGV[0] // 30;

sub switch ($string)
{
  return join("", map { $_ eq "1" ? 0 : 1 } split("", $string));
}

my  $prev = "";
for my $counter (0 .. $limit)
{
  say "S" . $counter++ . " = \"$prev\"";
  $prev = $prev . "0" . switch(reverse($prev));
}

Running it:

$ ./01-string-perl 6
S0 = ""
S1 = "0"
S2 = "001"
S3 = "0010110"
S4 = "001011001101001"
S5 = "0010110011010010110100110010110"
S6 = "001011001101001011010011001011001101001100101101001011001101001"

Some Thoughts

Running it to 30 crashes my pc again. Here are the values that worked out, with the time usage. The Raku numbers are for «01-string-smart».

Value	Raku	Perl
1	0.156 sec	0.009 sec
2	0.156 sec	0.009 sec
5	0.156 sec	0.009 sec
10	0.160 sec	0.010 sec
15	0.213 sec	0.035 sec
20	1.038 sec	0.677 sec
22	4 sec	3 sec
24	14 sec	12 sec
26	1m 6 sec	47 sec
27	2m	1m 34 sec

The values are not that important in themselves, but the exponenential trend certainly is.

We can have a go at why.

> my $s := (0, 1, -> $a { ($a +1) * 2 } ... Inf);
> say "$_: $s[$_]" for ^31;
0: 0
1: 1
2: 4
3: 10
4: 22
5: 46
6: 94
7: 190
8: 382
9: 766
10: 1534
11: 3070
12: 6142
13: 12286
14: 24574
15: 49150
16: 98302
17: 196606
18: 393214
19: 786430
20: 1572862
21: 3145726
22: 6291454
23: 12582910
24: 25165822
25: 50331646
26: 100663294
27: 201326590
28: 402653182
29: 805306366
30: 1610612734

The number after the colon is the length of the string.

We could try to reduce the length of the string. We are using it to store a binary number, so we are wasting a lot of space. Using a Raku Buf object to make it more efficient will not work, as leading zeroes in numbers are a lost cause.

And that's it.

Links

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