### Perl Weekly Challenge: Week 43

#### Challenge 1:

Olympic RingsThere are

5 ringsin the Olympic Logo as shown below. They are color coded as inBlue,Black,Red,YellowandGreen.

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

We have allocated some numbers to these rings as below:

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

Blackring is empty currently. You are given the numbers1,2,3,4and6. Write a script to place these numbers in the rings so that the sum of numbers in each ring is exactly11.

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]} = 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->[0]} += $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.

```
}
};
```

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]} = 0; });
for @ringSegments -> @ring {
@ring.map({ %ringValues{@ring[0]} += %try{$_} });
}
if (%ringValues.values.all == 11) {
@unknowns.map({ say "$_ = %try{$_}"; });
last;
}
}
}
```

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 RosenfeldWrite a script to generate

Self-descriptive Numbersin 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 print6210001000. 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;
}
```

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