Perl Weekly Challenge 109 solution

This week I'm back to share my thoughts about the weekly challenge solutions, but only to task #2, since the first one is rather easy.

The task is described here: https://perlweeklychallenge.org/blog/perl-weekly-challenge-109/.

I have prepared solutions in Perl, PHP and Raku, which I've been learning lately. I started by crafting Raku solutions, then tried to translate them as closely as possible to Perl (without 3rd party modules), and then the same with Perl to PHP.

Challenge #2: Four Squares Puzzle

The task requires us to match given seven numbers with letters a, b, c, d, e, f, g so that the following is true: 1 == 2 == 3 == 4.

          (1)                    (3)
    ╔══════════════╗      ╔══════════════╗
    ║              ║      ║              ║
    ║      a       ║      ║      e       ║
    ║              ║ (2)  ║              ║  (4)
    ║          ┌───╫──────╫───┐      ┌───╫─────────┐
    ║          │   ║      ║   │      │   ║         │
    ║          │ b ║      ║ d │      │ f ║         │
    ║          │   ║      ║   │      │   ║         │
    ║          │   ║      ║   │      │   ║         │
    ╚══════════╪═══╝      ╚═══╪══════╪═══╝         │
               │       c      │      │      g      │
               │              │      │             │
               │              │      │             │
               └──────────────┘      └─────────────┘

Let me start by explaining my method.

There are some mathematical equations you can come up which can help you with filtering out wrong matches early. The puzzle is symmetrical, so one of these equations is a + 2b + c = e + 2f + g. Another one may be d = a - c and d = g - e. They are only hints however and will not help you much with getting started to actually match the numbers with their letter positions. It seems like permutation list of input numbers is required and you can then only narrow it down (I can be wrong though).

What I'm more interested in is how these numbers look like when you write them in a column:

a = 6
b = 4
c = 1
d = 5
e = 2
f = 3
g = 7

What my twisted mind has seen here is that you can group up the things you want to sum up in that column and they will look like this (each individual group to sum in a different column):

... and what we can do now is add a first and a last row to that, both with the value zero:

So now it's quite easy to make a 7-element list into four 3-element lists with a simple equation (take 3 elements, step back one element), and all their sums should be equal for us to have a solution.

I'm not going to bother with sanity checks (narrowing down the list of permutations before summing it up and checking, using the math discussed above). It will be straightforward grouping, summing up and comparing.

Starting with Raku:

constant $el-count = 7;

sub four-squares(@input where .elems == $el-count --> Array[Map])
{
    my Map @results;
    for @input.permutations -> @case {
        my @sum_groups = (0, |@case, 0).rotor(3 => -1);

        @results.push: %(flat zip 'a' .. 'g', @case)
            if [==] @sum_groups.map: { [+] $_ };
    }

    return @results;
}

say four-squares 1 .. 7;

This solution is very concise thanks to predefined permutations and rotor methods on lists, as well as extremely handy square bracketed infix operator, applying itself on the entire list, two elements at a time. Please note that I'm not yet that familiar with Raku, so there might even be a room for improvements on this.

Other than that, bonus points for type checking and my Python's favourite zip function. I think the result is readable, but mostly because it's zero boilerplate, and only once you're already somewhat familiar with Raku's ASCII / Unicode operator zoo. It wasn't very hard to write and required very little debugging, even with my limited ability.

I wanted to create a solution in Perl as well, to see how different would it look. That's what I've come up with as a direct translation:

use v5.30;
use warnings;
use List::Util qw(all sum0);

use constant EL_COUNT => 7;

sub permute
{
    my (@what) = @_;

    return [@what] if @what == 1;

    my @options;

    for my $el (@what) {
        my $seen = 0;
        push @options, map {
            [$el, @$_]
        } permute(grep {
            $_ != $el || $seen++
        } @what);
    }

    return @options;
}

sub four_squares
{
    my (@input) = @_;
    my @results;

    return @results if @input != EL_COUNT;

    for my $case (permute @input) {
        my @real_case = (0, @$case, 0);
        my @summed_groups = map {
            sum0 map { $real_case[$_] } $_ .. $_ + 2
        } grep {
            $_ % 2 == 0 && $_ <= @real_case - 2
        } keys @real_case;

        my $letter = 'a';
        push @results, {map { $letter++, $_ } @$case}
            if all { $_ == @summed_groups[0] } @summed_groups;
    }

    return @results;
}

use Data::Dumper;
say Dumper([four_squares 1 .. 7]);

Some starting boilerplate contains usage of List::Util module, which is in perl's core.

I had to write my own function for permutations, as I'm pretty sure there isn't one in core modules. That's also boilerplate which most likely can be removed with CPAN modules.

So the real solution is in four_squares function. A condition to exit early if there isn't seven input elements was added to match Raku's signature, but other than that there's no input / output value checking.

Lack of rotor function required me to write code that will assign to groups based on keys. That wasn't too bad, other than ugly key filtering and mapping it back to array values. With no easy [==] on a list and no zip function, some additional code blocks had to be introduced.

Additional thing that is always annoying in Perl is the output: hashes are randomized for security, so without sorting them manually the Dumper routine is just spitting pure randomness.

Overall, it isn't too bad, but all those maps, greps and boilerplate is making it kinda hard to see what's actually going on. It wasn't as easy to write because of all the references flying around, a pain to debug because I totally forgot to add the recursion ending condition in permute sub, so it was not returning anything. Oh, and it runs about eight times faster than Raku.

At this point I just wondered how majestic would this look after taking this 1:1 to PHP. Well...

<?php

const EL_COUNT = 7;

function permute($what)
{
    if (count($what) == 1) {
        return [$what];
    }

    $options = [];

    foreach($what as $el) {
        $seen = 0;
        array_push($options, ...array_map(
            fn ($arr) => [$el, ...$arr],
            permute(
                array_filter(
                    $what,
                    fn ($subel)
                        => $subel != $el || $seen++
                )
            )
        ));
    }

    return $options;
}

function four_squares($input)
{
    $results = [];

    if (count($input) != EL_COUNT) {
        return $results;
    }

    foreach (permute($input) as $case) {
        $real_case = [0, ...$case, 0];
        $summed_groups = array_map(
            fn ($el)
                => array_sum(
                    array_map(
                        fn ($subel)
                            => $real_case[$subel],
                    range($el, $el + 2))
                ),
            array_filter(
                array_keys($real_case),
                fn ($el)
                    => $el % 2 == 0 && $el <= count($real_case) - 2
            )
        );

        $matching_first = array_filter(
            $summed_groups,
            fn ($el)
                => $el == $summed_groups[0]
        );

        if (count($matching_first) == count($summed_groups)) {
            $case_results = [];
            for ($letter = 'a'; $letter != 'h'; ++$letter) {
                $case_results[$letter] = array_shift($case);
            }

            $results[] = $case_results;
        }
    }

    return $results;
}

var_dump(four_squares(range(1, 7)));

Not a PHP hater, but lets be honest: using some higher order functions like map and filter in PHP is a pleasurable experience... if you like to torment yourself.

Actually, at first it felt relieving when I could remove all the manual references I had in Perl, but really even with good new arrow functions these array_map and array_filter calls are quite awful. Plus, this is the only solution that would not work for more than 7 elements (if there weren't checks for 7 elements, that is), since I hardcoded letters a to h. Wonder why that is? I just don't know how to map into an associative array with PHP. Laravel's collections can do it, but I'm pretty sure plain PHP can't. So I could rewrite that to check if the array $case is empty instead, but at this point I was so mentally damaged that I just wanted to get this over with (I'm exaggerating obviously, but I really wanted a map instead of a foreach).

So obviously this was a stupid idea. And please don't tell anyone who does PHP, they would hurt me for not making this with multiple interfaced classes, service containers, no-more-than-5-line functions and other goodies.

Jokes aside, this gives us an interesting thing to look at.

Scroll up to Raku solution and see how an incompetent newbie's solution looks like in that language.

Then scroll back down to Perl or PHP solution and see how it looks when you know what you're doing but the language doesn't give you the right tools to address the problem and you just want to get this over with (since it's almost 2 AM).

I'm pretty sure Raku made the right design choices :)

Comments? Suggestions? Send to feedback@bbrtj.eu
Published on 2021-04-25