laurent_r

These are some answers to the Week 212 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on April 16, 2023 at 23:59). This blog post offers some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Jumping Letters

You are given a word having alphabetic characters only, and a list of positive integers of the same length.

Write a script to print the new word generated after jumping forward each letter in the given word by the integer in the list. The given list would have exactly the number as the total alphabets in the given word.

Example 1

Input: $word = 'Perl' and @jump = (2,22,19,9)
Output: Raku

'P' jumps 2 place forward and becomes 'R'.
'e' jumps 22 place forward and becomes 'a'. (jump is cyclic i.e. after 'z' you go back to 'a')
'r' jumps 19 place forward and becomes 'k'.
'l' jumps 9 place forward and becomes 'u'.

Example 2

Input: $word = 'Raku' and @jump = (24,4,7,17)
Output: 'Perl'

This task was the subject of this post published on April 10, 2023.

Task 2: Rearrange Groups

You are given a list of integers and group size greater than zero.

Write a script to split the list into equal groups of the given size where integers are in sequential order. If it can’t be done then print -1.

Example 1:

Input: @list = (1,2,3,5,1,2,7,6,3) and $size = 3
Output: (1,2,3), (1,2,3), (5,6,7)

Example 2:

Input: @list = (1,2,3) and $size = 2
Output: -1

Example 3:

Input: @list = (1,2,4,3,5,3) and $size = 3
Output: (1,2,3), (3,4,5)

Example 4:

Input: @list = (1,5,2,6,4,7) and $size = 3
Output: -1

First, there was initially an error in Example 3 above of the task specification ($size was 2 instead of 3, and that did not fit with the suggested output), but this has been fixed now.

Next, I first thought of sorting the input list of integers and, assuming for example a group size of 3, to try sequences of 3 successive integers in the list. But then I thought that it would be easier to store the input in a Raku Bag and to remove items used to construct groups as we go. As this turned out to be quite simple, I decided, as you will see, to use the same method in Perl, simulating bags with hashes.

Rearrange Groups in Raku

First, note that bags are immutable in Raku. This means that you cannot change the inner items of the bag (or add or remove items), but this does not preclude you from re-assigning bags, as we do in the last statement of the while loop in the code below.

Using bags means that we can use operators with set theory semantics, such as the infix (<=) or infix ⊆ is a subset of or equal to,infix⊆), or the infix (-), infix ∖ set difference,infix%E2%88%96), operators.

In the rearrange subroutine, the while loop runs as long as there are some items left in the bag. The loop looks for the smallest item in the bag, construct a sequence ($list) of $size successive items. If $list is a subset of (or equal to) the bag, we store the $list into the @result and remove the items of the $list from the bag. If $list is not part of the bag, then we failed and return -1. If we get normally out of the loop (because the bag is now empty), then we succeeded to build equal groups of items and can return the @result.

sub rearrange (@in, $size) {
    my @result;
    return -1 unless @in.elems %% $size; 
    my $bag  = @in.Bag;
    while ($bag) {
        my $min = $bag.min.key;
        my @list = $min..^($min + $size);
        return -1 unless @list ⊆ $bag;
        push @result, @list;
        $bag = $bag (-) @list;  # set difference
    }
    return @result;
}

for ((1,2,3,5,1,2,7,6,3), 3), ((1,2,3), 2), ((1,2,3), 3),
    ((1,2,4,3,5,3), 3), ((1,5,2,6,4,7), 3),
    ((1,5,2,6,4,7), 2) -> @test {
    say @test;
    say rearrange(|@test), "\n"; 
}

This script displays the following output:

$ raku ./rearrange-groups.raku
((1 2 3 5 1 2 7 6 3) 3)
[[1 2 3] [1 2 3] [5 6 7]]

((1 2 3) 2)
-1

((1 2 3) 3)
[[1 2 3]]

((1 2 4 3 5 3) 3)
[[1 2 3] [3 4 5]]

((1 5 2 6 4 7) 3)
-1

((1 5 2 6 4 7) 2)
[[1 2] [4 5] [6 7]]

Rearrange Groups in Perl

I initially thought of using a different technique for solving the task in Perl, since there is no built-in bag data structure in Perl, but then I found that it was quite easy to simulate a bag with a hash containing an histogram of the input values. So this program essentially works the same as the Raku implementation (read the previous section if you need explanations). The for loop checks that all the values of $list exist in the bag and remove these items from the bag.

use warnings;
use feature "say";

sub rearrange {
    my @in = @{$_[0]};
    my $size = $_[1];
    my @result;
    return "-1" if @in % $size; 
    my %bag;
    $bag{$_}++ for @in;
    while (%bag) {
        my $min = (sort { $a <=> $b } keys %bag)[0];
        my @list = $min..($min + $size -1);
        for my $item (@list) {
            return "-1" unless exists $bag{$item};
            $bag{$item}--;
            delete $bag{$item} if $bag{$item} == 0;
        }
        push @result, \@list;
    }
    return @result;
}

for my $test( [[1,2,3,5,1,2,7,6,3], 3],
              [[1,2,3], 2], [[1,2,3], 3],
              [[1,2,4,3,5,3], 3],
              [[1,5,2,6,4,7], 3],
              [[1,5,2,6,4,7], 2] )
              {
    say "(@{$test->[0]})", " ", "($test->[1])";
    my @result = rearrange(@$test);
    if ($result[0] == "-1") {
        say -1;
    } else {
        say map { "[@$_] " } @result;
    }
    say " ";
}

This script displays the following output:

$ perl ./rearrange-groups.pl
(1 2 3 5 1 2 7 6 3) (3)
[1 2 3] [1 2 3] [5 6 7]

(1 2 3) (2)
-1

(1 2 3) (3)
[1 2 3]

(1 2 4 3 5 3) (3)
[1 2 3] [3 4 5]

(1 5 2 6 4 7) (3)
-1

(1 5 2 6 4 7) (2)
[1 2] [4 5] [6 7]

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on April 23, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.