Perl Weekly Challenge 043: Olympic Rings and Self-Descriptive Numbers

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:

baseself-descriptive number in the basethe number in base 10
41210, 2020100, 136
5212001425
73211000389305
8421010008946176
9521001000225331713
1062100010006210001000
1172100001000186492227801
128210000010006073061476032
.........
16C21000000000100013983676842985394176
.........
36W21000...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';

Leave a comment

About E. Choroba

user-pic I blog about Perl.