January 2020 Archives

Perl Weekly Challenge 045: Square Secret Code & Source Dumper

Square Secret Code

The square secret code mechanism first removes any space from the original message. Then it lays down the message in a row of 8 columns. The coded message is then obtained by reading down the columns going left to right.

For example, the message is “The quick brown fox jumps over the lazy dog”. The code message would be as below:

tbjrd hruto eomhg qwpe unsl ifoa covz kxey

Let’s start with the test:

use warnings;
use strict;

use Test::More tests => 1;
is square_secret_code('The quick brown fox jumps over the lazy dog'),
    'tbjrd hruto eomhg qwpe unsl ifoa covz kxey',

Let’s use a regex to extract groups of 8 letters from the message. Then split each group into individual letters and append each of them to a string corresponding to an output word.

use Syntax::Construct qw{ /r // };

sub square_secret_code {
    my ($message) = @_;
    my @code = ("") x 8;
    for my $group ($message =~ s/\s//gr =~ m/(.{1,8})/g) {
        $code[$_] .= (split //, $group)[$_] // "" for 0 .. 7;
    return join ' ', @code

Perl Weekly Challenge 044: One Hundred, Two Hundred

Only 100, please

You are given a string “123456789”. Write a script that would insert ”+” or ”-” in between digits so that when you evaluate, the result should be 100.

We can populate each place “between digits” with one of three possible values: a plus sign, minus sign, or nothing. To check all the possible permutations, we’ll use an indicator function similarly to The Knapsack Problem. In this case, though, there are three possible values, so we need to loop over numbers in the ternary numeral system.

The only operation we’ll need will be the increment, so we don’t need the full support for arithmetic in base 3. We can implement the increment ourselves: we start from the right of the number, change any 2 into 0 and move left. Once we find 0 or 1, we increment it and we’re done.

To create the expression, we just need to intersperse the digits with the operators. See the apply subroutine below.

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.

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.

About E. Choroba

user-pic I blog about Perl.