22 November 2024

Challenge 296

Compressed Matchsticks

• Task 1: String Compression
• Task 2: Matchstick Square

Task 1: String Compression

Submitted by: Mohammad Sajid Anwar

---

You are given a string of alphabetic characters, $chars.

Write a script to compress the string with run-length encoding, as shown in the examples.

A compressed unit can be either a single character or a count followed by a character.

BONUS: Write a decompression function.

Example 1

Input: $chars = "abbc"
Output: "a2bc"

Example 2

Input: $chars = "aaabccc"
Output: "3ab3c"

Example 3

Input: $chars = "abcc"
Output: "ab2c"

---

Solution

Run-length encoding and decoding as requested in this task can be achieved using the substitution operator, where the right operand is an evaluated perl expression.

On encoding, we search for two or more occurrences of the same character and insert the count in front of it.

On decoding, we search for decimal number in the string and repeat the following character accordingly.

use strict;
use warnings;

sub rle {
    shift =~ s/(([[:alpha:]])\2+)/length($1) . $2/ger;
}

sub rld {
    shift =~ s/([[:digit:]]+)([[:alpha:]])/$2 x $1/ger;
}

See the full solution to task 1.

Task 2: Matchstick Square

Submitted by: Mohammad Sajid Anwar

---

You are given an array of integers, @ints.

Write a script to find if it is possible to make one square using the sticks as in the given array @ints where $ints[i] is the length of ith stick.

Example 1

Input: @ints = (1, 2, 2, 2, 1)
Output: true

Top: $ints[1] = 2
Bottom: $ints[2] = 2
Left: $ints[3] = 2
Right: $ints[0] and $ints[4] = 2

Example 2

Input: @ints = (2, 2, 2, 4)
Output: false

Example 3

Input: @ints = (2, 2, 2, 2, 4)
Output: false

Example 4

Input: @ints = (3, 4, 1, 4, 3, 1)
Output: true

---

Solution

Assuming from the examples that all given sticks have to used to build the square.

I don’t see a way to solve this task without try-and-error in the general case. Somehow we need to pick subsets of the sticks that make a length of a quarter of the total sum. Here we’ll use a specialized iterator where the way how to proceed from a currently chosen subset and which subsets shall be processed further are controllable.

This iterator forselected($comp, $exec, $n) has three arguments:

• $comp is a sub ref that is called with the current element indices in @_. Its return value controls the next step:
  • a positive return value signals that the previously selected element shall be replaced by its successor.
  • a zero return value means: process this subset with the exec sub.
  • a negative return value signals that the successor of the previously selected element shall be added to the subset.
  • an undefined return value removes the last selected value from the subset and replaces the now most recently handled element with its successor.
• $exec is a sub ref that is called with element indices in @_, that satisfy the criterion as defined by $comp. It may signal “success” or “failure” and control the further processing in a slightly different way. On “success” the forselected sub returns immediately with a true value and failure is handled in the same way as an undefined value returned from the comparator.
• $n is the number of elements to operate on.

Using this iterator we find the first set of sticks that form one edge of the square. Operating on the descending sorted list, we may pick the first element and fix it for our edge. If it’s too large, then there is no solution at all. If it fits the edge size, we found the first edge. Otherwise we add the next stick and proceed similarly:

• If the sum is too large, try the next smaller one.
• If it fits, we have an edge.
• If the sum is too small, add the next stick and proceed.

Having found a subset forming an edge, we remove the selected sticks and proceed finding the next edge using recursion. For this purpose we need a sub make_equal as the actual workhorse that can handle a variable number of edges.

Furthermore, a sub make_square is needed to preprocess the list and perform the initial call to make_equal.

Putting aside the subset iterator, this results in:

use v5.12;
use warnings;
use List::Util 'sum';
use experimental 'signatures';
use constant N => 4;

our $lvl;
my $verbose = 1;

sub dbg {
    say "  " x (($lvl // 1) - 1), @_ if $verbose;
}

sub make_square {
    my $sum = sum @_;

    dbg("stop: sum=$sum not divisible by ", N),
    return if $sum % N;

    local $lvl = 0;
    make_equal(N, $sum / N, sort {$b <=> $a} @_);
}


sub make_equal ($count, $length, @ints) {
    local $lvl = $lvl + 1;
    dbg "subsets: count=$count, sum=$length items=(@ints)";

    my %seen;
    my $sel = sub {
        dbg("stop: loop done"),
        return if $_[0] > 0;
        return 1 if $seen{"@ints[@_]"}++;

        sum(@ints[@_]) <=> $length;
    };
    my $exec = sub {
        dbg "got subset (@ints[@_])";

        dbg("all done"),
        return 1 if $count <= 2;

        my @rest = @ints;
        delete @rest[@_];
        @rest = grep defined, @rest;

        make_equal($count - 1, $length, @rest);
    };

    forselected($sel, $exec, scalar @ints);
}

Note that we signal success when we are given the second last edge. The remaining elements must form a valid last edge.

Finally, we have the subset iterator, which turns out a bit cryptic. Though it would be possible to have the external logic inside a single subroutine, the split in two subs comes handy: The logic in these subs is independent and their return values serve different purposes. While the selector has fine-tuned control over the selection process, it cannot end the iterator in a peaceful way. The executor on the other hand has less control, but may end the iterator signaling “success”.

sub forselected ($sel, $exec, $n) {
    my @idx = 0;
    while () {
        my $c = $sel->(@idx);
        if (!defined $c) {
            pop @idx;
        } elsif (!$c) {
            ($exec->(@idx) && return 1) || pop @idx;
        } elsif ($c < 0) {
            push @idx, $idx[-1];
        }
        while () {
            return unless @idx;
            $idx[-1]++;
            last if $idx[-1] < $n;
            pop @idx;
        }
    }
}

The solution has become rather lengthy and I’d be glad to see other approaches with hopefully some clever tricks.

A list like (2, 2, 2, 3, 3,  4, 8, 12, 16, ... 60) reveals the weakness of the given implementation. It creates a lot of edges with a length of 123 until it disproves the list’s square property.

See the full solution to task 2.

---

If you have a question about this post or if you like to comment on it, feel free to open an issue in my github repository.