### Perl Weekly Challenge: Week 43

#### Challenge 1:

Olympic Rings

There are 5 rings in the Olympic Logo as shown below. They are color coded as in Blue, Black, Red, Yellow and Green.

```  /-------\   /--------\   /--------\
|       |   |        |   |        |
|   9   |   |    ?   |   |    8   |
|     /-------\    /-------\      |
\------?/   \?------?/   \?-------/
|   5   |    |   7   |
|       |    |       |
\-------/    \-------/
```

We have allocated some numbers to these rings as below:

• Blue: 8
• Yellow: 7
• Green: 5
• Red: 9

The Black ring is empty currently. You are given the numbers 1, 2, 3, 4 and 6. Write a script to place these numbers in the rings so that the sum of numbers in each ring is exactly 11.

I'm sure there must be a better algorithm to solve this problem but with 5 numbers there are 5! or 120 possible permutations which is a small enough quantity to attempt brute forcing the answer.

Heres the Perl version. The first step is to set up some data structures.

``````my %rings = (
'Blue'         => 8,
'Yellow'       => 7,
'Green'        => 5,
'Red'          => 9,
);
``````

`%rings` is a map of rings to their values where the values are known.

``````my @ringSegments = (
[qw/ Red Red-Green /],
[qw/ Green Red-Green Green-Black /],
[qw/ Black Green-Black Black-Yellow /],
[qw/ Yellow Black-Yellow Yellow-Blue /],
[qw/ Blue Yellow-Blue /],
);
``````

`@ringSegments` is an array of arrays. Each second-level array contains the parts of a particular ring both known and unknown. The total value of all of these parts has to equal 11.

``````my @unknowns = qw/ Black Red-Green Green-Black Black-Yellow Yellow-Blue /;
``````

The `@unknowns` list contains the parts of rings (or whole ring in the case of Black) for which we need to find values.

``````my @numbers = (1, 2, 3, 4, 6);
``````

And `@numbers` is the numbers we were given to work with.

``````my @permutations;
permute { push @permutations, \@_; } @numbers;
``````

As I noted above, there are 120 possible permutations of the numbers 1, 2, 3, 4, and 6. I calculate them and store them in an array. Perl has no built-in method for permutations and I did not want to use a module from CPAN like `Algorithm::Permute`. I was going to roll my own but I was short of time so nstead I used some of the code given in the question "How do I permute N elements of a list?" from the `perlfaq4` POD page. It implements the Fischer-Krause ordered permutation algorithm.

The rest of my script works on one of these permutations.

``````for my \$permutation (@permutations) {
my %try = %rings;
my \$i = 0;
map { \$try{\$_} = \$permutation->[\$i++]; } @unknowns;
``````

I make a copy of `%rings` and augment it with the list of unknowns which are each assigned a value from our `@numbers` permutation.

``````    my %sringValues;
map {\$ringValues{\$_->} = 0; } @ringSegments;
``````

Now I make a structure, `%ringValues` to hold the total value of each ring. Remember each of these has to equal 11 for a correct answer. The keys to this hash are the names of the rings which I have not stored separately. (Well, there is `%rings` but that does not contain Black.) Instead I get them from the first item in each list of ring segments. The value for each ring is set to 0.

``````    map {
my \$ring = \$_;
map { \$ringValues{\$ring->} += \$try{\$_} } @{\$ring};
} @ringSegments;
``````

Then for each ring I add up the total value of its comprising segments.

``````    if (scalar (grep { \$ringValues{\$_} == 11 } keys %ringValues) == 5) {
map { say "\$_ = \$try{\$_}"; } @unknowns;
``````

If all of these ring values equal 11, we have the correct answer. We can then print the values of all the unknown regions.

``````        last;
``````

As a final little optimization, there is little point in continuing checking the different permutations after we've already found the correct answer (I'm assuming there is only one correct answer which might not be true in all cases though it is here.) So I break out of the loop at this point.

``````    }
};
``````

(Full code on Github.)

This is the Raku version:

``````multi sub MAIN {
my %rings = (
'Blue'         => 8,
'Yellow'       => 7,
'Green'        => 5,
'Red'          => 9,
);

my @ringSegments = [
<< Red Red-Green >>,
<< Green Red-Green Green-Black >>,
<< Black Green-Black Black-Yellow >>,
<< Yellow Black-Yellow Yellow-Blue >>,
<< Blue Yellow-Blue >>,
];

my @unknowns = << Black Red-Green Green-Black Black-Yellow Yellow-Blue >>;
my @numbers = (1, 2, 3, 4, 6);

for @numbers.permutations -> @permutation {
my %try = %rings;
my \$i = 0;
@unknowns.map({ %try{\$_} = @permutation[\$i++]; });

my %ringValues;
@ringSegments.map({%ringValues{\$_} = 0; });

for @ringSegments -> @ring {
@ring.map({ %ringValues{@ring} += %try{\$_} });
}

if (%ringValues.values.all == 11) {
@unknowns.map({ say "\$_ = %try{\$_}"; });
last;
}
}
}
``````

(Full code on Github.)

As usual Raku is similar but more compact. It has a `.permutations` method so there is no need to write separate code for that and `.all` allows us to avoid the verbose `grep` when determining if we have a correct solution.

In case you were wondering, the answer to this problem is:

``````Black = 6
Red-Green = 2
Green-Black = 4
Black-Yellow = 1
Yellow-Blue = 3
``````

#### Challenge 2:

Self-descriptive Numbers

Contributed by Laurent Rosenfeld

Write a script to generate Self-descriptive Numbers in a given base.

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 10, then script should print 6210001000. For more information, please checkout wiki page.

The wiki page gives a formula for determining a (there may be more than one) for any given base except 1, 2, 3, and 6.

``````(\$base - 4) * (\$base ** (\$base - 1)) + (2 * \$base ** (\$base - 2)) + (\$base ** (\$base - 3)) + \$base ** 3
``````

(the code is the same in Perl and Raku.) However the result of this formula is in base 10. What we actually need is the answer in base `\$base`. In Raku, it's simple; just add `.base(\$base)` to the end of the answer. But Perl has no built-in method for converting bases so I wrote one which is a generalization of the base 35 conversion function from Challenge 2.

``````sub base {
my (\$number, \$base) = @_;
my @digits = (0 .. 9, 'A' .. 'Z');
my @result;
while (\$number > (\$base - 1)) {
my \$digit = \$number % \$base;
push @result, \$digits[\$digit];
\$number /=  \$base;
}
push @result, \$digits[\$number];

return join '', reverse @result;
}
``````

(Full Perl code on Github.)

(Full Raku code on Github.)

Bonus fun fact: self-descriptive numbers are also Harshad numbers!