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

There are We have allocated some numbers to these rings as below: Blue: 8Yellow: 7Green: 5Red: 9
The |

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):

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.

Contributed by Laurent Rosenfeld
Write a script to generate In mathematics, a self-descriptive number is an integer m that in a given base b is b digits long in which each digit d at position n (the most significant digit being at position 0 and the least significant at position b - 1) counts how many instances of digit n are in m.
For example, if the given base is |

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.

> (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)

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

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

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

File: selfdesc-verify-bagunit 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:

File: selfdesc-verify (changes only)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.