E. Choroba

Olympic Rings

There are 5 rings in the Olympic Logo [as shown below]. They are colour coded as in Blue, Black, Red, Yellow and Green. 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.

My first idea was to go over all the possible permutation of the numbers and report those that satisfy the sum condition. I chose Math::Combinatorics as the module to handle the permutations.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

use Math::Combinatorics;

my $SUM = 11;
my ($red, $green, $yellow, $blue) = (9, 5, 7, 8);

my $mc = 'Math::Combinatorics'->new(data => [1, 2, 3, 4, 6]);
while (my ($black, $red_green, $black_green, $black_yellow, $blue_yellow)
           = $mc->next_permutation
) {
    my @sums = ($red + $red_green,
                $green + $red_green + $black_green,
                $black + $black_green + $black_yellow,
                $yellow + $black_yellow + $blue_yellow,
                $blue + $blue_yellow);
    say join ' ',
        $red_green, $black_green, $black, $black_yellow, $blue_yellow
        unless grep $_ != $SUM, @sums;
}

It tries all the 120 possible permutations, but from a computer point of view, it’s not so many. While finishing the solution, I already saw it could be solved in a much faster and straightforward way.

The secret tool to help us solve the problem is maths. We know the sum of each ring, and for each ring, we can infer the unknown numbers from its sum and the known numbers (or other “less unknown numbers”).

We don’t need any CPAN module, just the subtraction operator.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my $SUM = 11;
my ($red, $green, $yellow, $blue) = (9, 5, 7, 8);

my $red_green    = $SUM - $red;
my $blue_yellow  = $SUM - $blue;
my $black_green  = $SUM - $green - $red_green;
my $black_yellow = $SUM - $yellow - $blue_yellow;
my $black        = $SUM - $black_green - $black_yellow;

say join ' ', $red_green, $black_green, $black, $black_yellow, $blue_yellow; 

What’s missing is verification that the solution consists of the given numbers. But you can verify it yourself by looking at the output. So, interestingly, we didn’t need to know the missing numbers in advance.

Self-Descriptive Numbers

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 definition is a bit confusing, but the example helps. The Wikipedia page is also very helpful and also provides more test data:

base	self-descriptive number in the base	the number in base 10
4	1210, 2020	100, 136
5	21200	1425
7	3211000	389305
8	42101000	8946176
9	521001000	225331713
10	6210001000	6210001000
11	72100001000	186492227801
12	821000001000	6073061476032
...	...	...
16	C210000000001000	13983676842985394176
...	...	...
36	W21000...0001000 (Ellipsis omits 23 zeroes)	Approx. 2.14349 × 1053

Do you notice the pattern in the examples? I was too lazy to do anything else. From base 7 upwards, it’s (base - 4), 2, 1, (base - 7) zeros, 1, three zeros. For the numbers less than 7, four and five are special, the rest doesn't have any self-descriptive numbers.

my %irregular = (
    1 => undef,
    2 => undef,
    3 => undef,
    4 => 1210,
    5 => 21200,
    6 => undef,
);
sub self_descriptive_number {
    my ($base) = @_;

    if (exists $irregular{$base}) {
        die "No self descriptive number in base $base.\n"
            unless $irregular{$base};

        return $irregular{$base}
    }

    return join "",
           map $_ > 9 ? chr 55 + $_ : $_,
           ($base - 4, 2, 1, (0) x ($base - 7), 1, (0) x 3)
}

We can also convert the result to base 10 to generate the numbers from the third column of the table. I first tried Math::Int2Base, but it had problems with the larger bases, so switched to Convert::AnyBase.

use Convert::AnyBase;
sub convert {
    my ($base, $sdn) = @_;
    my $set = join "", ('0' .. '9', 'A' .. 'Z')[0 .. $base - 1];
    'Convert::AnyBase'->new(set => $set)->decode($sdn)
}

sub self_descriptive_number_10 {
    my ($base) = @_;

    if (exists $irregular{$base}) {
        die "No self descriptive number in base $base.\n"
            unless $irregular{$base};

        return convert($base, $irregular{$base})
    }

    return convert(
        $base,
        join "",
            map $_ > 9 ? chr 55 + $_ : $_,
            ($base - 4, 2, 1, (0) x ($base - 7), 1, (0) x 3))
}

And let’s test it’s correct. Just copy the table from Wikipedia and run transform-table-into-perl-tests in Emacs:

use Test::More;
use Test::Exception;

# No results.
throws_ok { self_descriptive_number(1) } qr/base 1/, 'base 1';
throws_ok { self_descriptive_number(2) } qr/base 2/, 'base 2';
throws_ok { self_descriptive_number(3) } qr/base 3/, 'base 3';
throws_ok { self_descriptive_number(6) } qr/base 6/, 'base 6';

# Irregular.
is self_descriptive_number(4), '1210', 'base 4';
is self_descriptive_number(5), '21200', 'base 5';

# Pattern.
is self_descriptive_number(7), '3211000', 'base 7';
is self_descriptive_number(8), '42101000', 'base 8';
is self_descriptive_number(9), '521001000', 'base 9';
is self_descriptive_number(10), '6210001000', 'base 10';
is self_descriptive_number(11), '72100001000', 'base 11';
is self_descriptive_number(12), '821000001000', 'base 12';

is self_descriptive_number(16), 'C210000000001000', 'base 16';
is self_descriptive_number(36), 'W21000' . '0' x 23  . '0001000', 'base 36';

# Base 10.
is self_descriptive_number_10(4, '1210'), 100, 'base 4 in 10';
is self_descriptive_number_10(5, '21200'), 1425, 'base 5 in 10';
is self_descriptive_number_10(7, '3211000'), 389305, 'base 7 in 10';
is self_descriptive_number_10(8, '42101000'), 8946176, 'base 8 in 10';
is self_descriptive_number_10(9, '521001000'), 225331713, 'base 9 in 10';
is self_descriptive_number_10(10, '6210001000'), 6210001000, 'base 10 in 10';
is self_descriptive_number_10(11, '72100001000'), 186492227801, 'base 11 in 10';
is self_descriptive_number_10(12, '821000001000'), 6073061476032, 'base 12 in 10';
is self_descriptive_number_10(16, 'C210000000001000'),
    13983676842985394176,
    'base 16 in 10';

# Base 36 sdn is so large it comes out in scientific notation.
like self_descriptive_number_10(36, 'W21000' . '0' x 23  . '0001000'),
    qr/2\.14349.*e\+53/,
    'base 36 in 10';

Oops, the last test failed! Maybe we got the precision wrong?

not ok 24 - base 36 in 10
#   Failed test 'base 36 in 10'
#   at ./1.pl line 87.
#                   '9.47329995388761e+55'
#     doesn't match '(?^:2\.14349.*e\+53)'

No, it seemed the result was totally different to what Wikipedia said! Interestingly, Math::Int2Base gave a similar answer, and so did a random solution from the Challenge’s git repository. So, instead of fixing a bug in the code, I fixed the test and Wikipedia.

like self_descriptive_number_10(36,'W21000' . '0' x 23  . '0001000'), 
    qr/9\.473.*e\+55/,
    'base 36 in 10';