Perl Weekly Challenge: Week 296

Challenge 1:

String Compression

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"

One of the great features of Raku is multi-dispatch. We can define two or more subroutines with the same name and different function signatures and Raku will use the version that matches best to the parameters given. This allows us to organize our code very cleanly as we shall see.

This function RLE encodes a string. It takes the mandatory command-line switch -efollowed by the string to encode (which will be stored in $e).

multi sub MAIN(
    Str :$e!    #= run-length encode a string
) {

I thought sbout breaking up the string into a list of characters and iterating through it encoding runs, but then I decided it is simple enough to do with regular expressions and the s/// operator.

A problem is that function parameters in Raku are immutable and s/// alters the strings it operates on by making substitutions. Luckily there is a workaround; Raku has a S/// operator that works on a copy of the string specified by given.

The first half of s/// will match and capture a character (labeled $0) followed by 1 or more of the same character which will also be captured as a group which from the parentheses will also be labeled $0 (and the old $0 from that perspective will be $0[0]). This is a bit confusing until you get it.

In the second half, $0 is replaced (in the copy string) with the length of $0 (found with .chars()) and $0[0]. The :g flag to S/// performs this operation globally on all runs found in the string. Finally say() prints out the encoded string.

    say S:g/((.)$0+)/$($0.chars)$0[0]/ given $e;
}

The bonus task was to create a decode function. This is done by a variant of MAIN() which takes the -d switch instead of-e.

multi sub MAIN(
    Str :$d!,  #= decode a run-length encoded string
) {

We also use S/// here but this time, we look for a number followed by a character and replace it with that number of the character using the x operator.

    say S:g/(\d+)(.)/$($1 x $0)/ given $d;
}

(Full code on Github.)

Perls' command-line processing is not as sophisticated as Raku. I chose to use the Getopt::Std module to cover the gaps.

The getopts() function from that module that specifies that this script takes two command-line switches, -d and -e each of which takes a string argument. We declare two package variables $opt_d and $opt_e two hold those strings.

our($opt_d, $opt_e);

getopts('d:e:');

Just as in Raku, we use regular expressions and the s/// operator (no need to worry about immutability.)

if (defined $opt_d) {
    $opt_d =~ s/(\d+)(.)/$2 x $1/ge;
    say $opt_d;
} elsif (defined $opt_e) {
    $opt_e =~ s/((.)\g2+)/(length $1) . $2/ge;
    say $opt_e;

If neither -d or -e was specified, we call our own usage() function and exit. Raku takes care of this kind of thing for us.

} else {
    usage();
}

(Full code on Github.)

Challenge 2:

Matchsick Square

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[ì] 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

Perl first for a change.

Think about this, a square has 4 sides of equal length. Therefore the sum of all the matchsticks must be evenly divisible by 4 and no matchstick can be longer than the length of a side. We can express that in Perl like this (assuming the matchsticks are input as command-line parameters.) We have to provide our own max() and sum() functions.

my $side = sum(@ARGV) / 4;
say $side == int($side) && max(@ARGV) <= $side ? 'true' : 'false';

(Full code on Github.)

In Raku we can squeeze this down to a one-liner.

my $a = @*ARGS.sum / 4; say $a %% 1 && @*ARGS.max <= $a

(Full code on Github.)