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]} = 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 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;
}
Bonus fun fact: self-descriptive numbers are also Harshad numbers!