Olympic Numbers with Raku

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

Challenge #43.1: Olympic Rings

The question marks indicate that we can only place one number in each location, as there are 5 of them - as well as five remaining numbers to place.

It is actually easier to do this by hand than writing a program:

The initial state (with the rings in the correct olympic order), and the unassigned values:

The «trick» is to start at one of the ends (e.g. the Red ring), where we only have place for one value, and continue with the next ring (the Green ring) as that also have place for just one value now. The center ring (Black) has two unknown values, so we skip that and continue at the other end insted (the Blue ring), working back to the middle (the Yellow ring, and finnaly the Black ring).

The  Red ring  has the value 9, and we place the value 2 in the intersection with the  Green ring .

The  Red ring  is now full (9+2=11), the  Green ring  has the new value 7 (5+2), and we are left with the unassigned values 1, 3, 4 and 6:

The  Green ring  has the value 7 (5+2), and we place 4 in the intersection with the  Black ring .

The  Green ring  is now full (5+2+5=11), the  Black ring  has the new value 4, and we are left with the unassigned values 1, 3 and 6:

The  Black ring  has two unassigned values, so we skip it and does the other end instead.

The  Blue ring  has the value 8, and we place 3 in the intersection with the  Yellow ring .

The  Blue ring  is now full (8+3=11), the  Yellow ring  has the new value 10 (7+3), and we are left with the unassigned values 1 and 6:

The  Yellow ring  has the value 10 (7+3), and we place 1 in the intersection with the  Black ring .

The  Yellow ring  is now full (7+3+1=11), the  Black ring  has the new value 5 (4+1), and we are left with the unassigned value 6:

We place the value 6 in the  Black ring , and it is full as well (1+4+6=11):

The Program

my @curr = (8, 0, 7, 0, 0, 0, 5, 0, 9);              # [1]

for (1,2,3,4,6).permutations -> @permutation         # [2]
{
  @curr[1,3,4,5,7] = @permutation;                   # [3]

  if @curr[0] + @curr[1]            ==     # Blue    # [4]
     @curr[1] + @curr[2] + @curr[3] ==     # Yellow  # [4]
     @curr[3] + @curr[4] + @curr[5] ==     # Black   # [4]
     @curr[5] + @curr[6] + @curr[7] ==     # Green   # [4]
     @curr[7] + @curr[8]            == 11  # Red     # [4]
  {
    say "Values: @curr[] (from left to right)";      # [5]
    say "Blue:   @curr[0] + @curr[1]";               # [5]
    say "Yellow: @curr[1] + @curr[2] + @curr[3]";    # [5]
    say "Black:  @curr[3] + @curr[4] + @curr[5]";    # [5]
    say "Green:  @curr[5] + @curr[6] + @curr[7]";    # [5]
    say "Red:    @curr[7] + @curr[8]";               # [5]
    
    last;                                            # [6]
  }
}

[1] The already known values, and zero for the unknowns. I have placed the values in an array, with the indices as shown here:

[2] All the permutations of the not-yet-placed values.

[3] Put them in the array, at the as-yet-unfilled positions. (Unfilled as in not decided. The first time we do this the values replace the initial zeros, but after that they replace the values from the previous iteration).

[4] If all the circles have the correct value (of 11),

[5] • print the values,

[6] • and exit (by leaving the «for» loop).

See docs.raku.org/routine/permutations for more information about permutations.

Running it:

$ raku olympic
Values: 8 3 7 1 6 4 5 2 9 (from left to right)
Blue:   8 + 3
Yellow: 3 + 7 + 1
Black:  1 + 6 + 4
Green:  4 + 5 + 2
Red:    2 + 9

That is correct.

It is possible to optimise this for speed, by following my «by hand» approach. But that requires a lot of code, and isn't really worth while for this simple task. And brute force is fast enough.

One simple optimisation would be to place the value «11» first in the test. E.g. «if 11 == @curr[0] + @curr[1] == ...». The benefit shouldn't be very much, but the change is easy to do.

Challenge #42.2: Self-descriptive Numbers

This is quite straight forward, following the recipe given in wikipedia article: «There are no self-descriptive numbers in bases 1, 2, 3 or 6. In bases 7 and above, there is, if nothing else, a self-descriptive number of the form (...), which has b - 4 instances of the digit 0, two instances of the digit 1, one instance of the digit 2, one instance of digit b - 4, and no instances of any other digits.»

unit sub MAIN (UInt :$base = 10);          # [1]

if $base == any(0,1,2,3,6) || $base > 39   # [2]
{
  say "Error";                             # [2]
}
# elsif $base == 4                         # [3]
# {
#   say "1210";                            # [3]
# }
elsif $base == 5                           # [4]
{
  say "21200";   # Prevent "11100"         # [4]
}
else                                       # [5]
{
  my $number = "{ ($base -4).base(36) }21" ~ "0" x ($base - 3);  # [5]
  # ############# # 5a ############### 5b ## 5c ##############

  $number.substr-rw(*-4,1) = 1;            # [6]
  say $number;
}

[1] The default base is 10, but we can specify another one with the «--base» command line option. The type «UInt» means Unsigned Int i.e. it prevents negative values.

[2] Zero is a positive integer, and we block that here, as well as the values 1, 2, 3 and 6 which do not have a matching Self-descriptive Number. I'll get back to the upper limit (of 39) in [5a].

[3] This value is given in the wikipedia article in addition to «2020». I chose one of them. («(1210 2020).pick» could have been ok, but would give unpredictability. Note that I have commented out this code, as the block in [6] works for this base.

[4] As above, but were we have only one value. Note that the block in [6] gives a wrong answer (11100), so this must be hard coded.

[5] The first digit is the base minus 4 [5a]. A base of 14 or higher would give a double digit value, so we convert the number to base 36, so that the values only have one «digit». As we subtract 4 from the value, we can allow up to base 39 as input (see [2]). The next part is the value «21» [5b] and a lot of zeroes (where «a lot» is the base - 3).

[6] And finally the fourth digit from the right is a 1. «substr-rw» allows us to change the value, whereas the normal «substr» gives a read-only value.

See docs.raku.org/routine/substr-rw for more information about substr-rw.

Running it:

$ raku selfdesc --base=1
Error

$ raku selfdesc --base=2
Error

$ raku selfdesc --base=3
Error

$ raku selfdesc --base=4
1210

$ raku selfdesc --base=5
21200

$ raku selfdesc --base=6
Error

$ raku selfdesc --base=7
3211000

$ raku selfdesc --base=8
42101000

$ raku selfdesc --base=9
521001000

$ raku selfdesc --base=10
6210001000

$ raku selfdesc --base=11
72100001000

$ raku selfdesc --base=12
821000001000

$ raku selfdesc --base=13
9210000001000

$ raku selfdesc --base=14
A2100000001000

$ raku selfdesc --base=36
W21000000000000000000000000000001000

$ raku selfdesc --base=40
Error

$ raku selfdesc --base=-10
Usage:
  selfdesc [--base=]

That looks ok.

Base 36 Bonus

> (1..36)>>.base(36)
(1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 10)

Base 16, or hexadecimal, is perhaps more familiar:

> (1..36)>>.base(16)
(1 2 3 4 5 6 7 8 9 A B C D E F 10 11 12 13 14 15 16 17 18 19 \
 1A 1B 1C 1D 1E 1F 20 21 22 23 24)

Verification Bonus

unit sub MAIN (Int $val, :$verbose);  # [1]

my @digits = $val.comb;               # [2]
my $base   = $val.chars;              # [3]
my %coll   = @digits.Bag;             # [4]
my $sum    = @digits.sum;             # [5]

if $sum != $base                      # [5]
{
  say "NOT OK"; exit;                 # [5a]
}

for ^$base                            # [6]
{
  say "- $_: { %coll{$_} // 0 } (count) == @digits[$_] (pos) - "  # [7]
    ~ "{ (%coll{$_} // 0) == @digits[$_] }" if $verbose;
  if ( %coll{$_} // 0) != @digits[$_] { say "NOT OK"; exit; }     # [8]
}

say "OK";                            # [9]

[1] The number to check, and the «--verbose» flag if we require more information.

[2] Split the number into the individual digits.

[3] The base is the length of the number - and the number of elements in the array.

[4] Count the digit types in a «Bag». The keys are the values in the array, and the value is the count (the number of times they occured in the array).

[5] The sum of all the digits should be the same as the base (which is the sum of all the digits in the first place). Complain and exit [5a] if not so.

[6] For each digit in the base (from 0 to one below the base):

[7] • Verbose output if you want to see what is going on.

[8] • Complain and exit if the digit in the number (the array) is not the same as the count (the Bag).

[9] If it didn' fail, it is OK.

Running it with the sample value:

$ $ raku selfdesc-verify-hash 6210001000
OK

$ raku selfdesc-verify-hash --verbose 6210001000
- 0: 6 (count) == 6 (pos) - True
- 1: 2 (count) == 2 (pos) - True
- 2: 1 (count) == 1 (pos) - True
- 3: 0 (count) == 0 (pos) - True
- 4: 0 (count) == 0 (pos) - True
- 5: 0 (count) == 0 (pos) - True
- 6: 1 (count) == 1 (pos) - True
- 7: 0 (count) == 0 (pos) - True
- 8: 0 (count) == 0 (pos) - True
- 9: 0 (count) == 0 (pos) - True
OK

Bag Gotcha 1

> my $coll = 6210001000.comb.Bag;  # -> Bag(0(6), 1(2), 2, 6)
> my %coll = 6210001000.comb.Bag;  # -> {0 => 6, 1 => 2, 2 => 1, 6 => 1}

> say $coll{3};  # -> 0
> say %coll{3};  # -> (Any)

The «selfdesc-verify-hash» program assigns the «Bag» to %coll, which coerces it to a hash. And we have to use // 0 to trap the undefined values.

We can assign the «bag» to $coll to avoid that. (Or use «my %coll is Bag = 6210001000.comb.Bag», if we want to use the «%» sigil.)

Bag Gotcha 2

> say %coll{1};    # -> 2
> say %coll{"1"};  # -> 2

> say $coll{"1"};  # -> 2
> say $coll{1};    # -> 0

This applies to Raku 2019.11. I haven't checked earlier versions.

So we must use numbers or strings, not both. «comb» gives a list of single characters, and converting them to integers does the trick:

unit sub MAIN (Int $val, :$verbose);

my @digits = $val.comb>>.Int; # [1]
my $base   = $val.chars;
my $coll   = @digits.Bag;
my $sum    = @digits.sum;

if $sum != $base
{
  say "NOT OK"; exit;
}

for ^$base
{
  say "- $_: { $coll{$_}  } (count) == @digits[$_] (pos) - " # [2]
    ~ "{ $coll{$_} == @digits[$_] }" if $verbose;            # [2]
  if $coll{$_} != @digits[$_] { say "NOT OK"; exit; }        # [2]
}

say "OK";

[1] Convert the digits (as strings) to digits (as numbers). The «>>.» hyper operator call invokes the method on each of the elements in the list.

[2] Looking up non-existing entries in a Bag gives «0», so the «// 0» addition from the hash lookup has gone.

The program behaves just as the previous version:

$ $ raku selfdesc-verify-bag 6210001000
OK

$ raku selfdesc-verify-bag --verbose 6210001000
- 0: 6 (count) == 6 (pos) - True
- 1: 2 (count) == 2 (pos) - True
- 2: 1 (count) == 1 (pos) - True
- 3: 0 (count) == 0 (pos) - True
- 4: 0 (count) == 0 (pos) - True
- 5: 0 (count) == 0 (pos) - True
- 6: 1 (count) == 1 (pos) - True
- 7: 0 (count) == 0 (pos) - True
- 8: 0 (count) == 0 (pos) - True
- 9: 0 (count) == 0 (pos) - True
OK

But it chokes on non-numeric «digits», as they fail to satisfy the «Int» type check on the input:

$ raku selfdesc --base=14
A2100000001000

$ raku selfdesc-verify-bag A2100000001000
Usage:
  selfdesc-verify-bag [--verbose=<Any>] 

This problem applies to the first version as well, but is easy to fix:

unit sub MAIN (Str $val, :$verbose);      # [1]

my @digits = $val.comb>>.parse-base(36);  # [2]

[1] Allow «Str» input instead of «Int».

[2] Convert all the characters to numbers. 0-9 gives the same values (but as numbers), and higher values will use letters, e.g. 10 is A.

Running it:

$ raku selfdesc-verify A2100000001000
OK

raku selfdesc-verify --verbose A2100000001000
- 0: 10 (count) == 10 (pos) - True
- 1: 2 (count) == 2 (pos) - True
- 2: 1 (count) == 1 (pos) - True
- 3: 0 (count) == 0 (pos) - True
- 4: 0 (count) == 0 (pos) - True
- 5: 0 (count) == 0 (pos) - True
- 6: 0 (count) == 0 (pos) - True
- 7: 0 (count) == 0 (pos) - True
- 8: 0 (count) == 0 (pos) - True
- 9: 0 (count) == 0 (pos) - True
- 10: 1 (count) == 1 (pos) - True
- 11: 0 (count) == 0 (pos) - True
- 12: 0 (count) == 0 (pos) - True
- 13: 0 (count) == 0 (pos) - True
OK

Note that «base» and «parse-base» complement each other. See docs.raku.org/routine/base and docs.raku.org/routine/parse-base for more information.

And that's it.