These are some answers to the Week 249, Task 1, 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 December 31, 2023 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Equal Pairs

You are given an array of integers with even number of elements.

Write a script to divide the given array into equal pairs such that:

a) Each element belongs to exactly one pair. b) The elements present in a pair are equal.

Example 1

Input: @ints = (3, 2, 3, 2, 2, 2)
Output: (2, 2), (3, 3), (2, 2)

There are 6 elements in @ints.
They should be divided into 6 / 2 = 3 pairs.
@ints is divided into the pairs (2, 2), (3, 3), and (2, 2) satisfying all the conditions.

Example 2

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

There is no way to divide @ints 2 pairs such that the pairs satisfy every condition.

Equal Pairs in Raku

In Raku, we will first sort the input array and then pick up items from the sorted array two at a time. If they are equal, then we've found a matching pair and store it in the @pairs array; otherwise, the task is impossible for the input data and we can return immediately from the equal-pairs subroutine. If we get to the end of the for loop, then we can just return the @pairs array.

sub equal-pairs (@in) {
    my @pairs;
    for @in.sort -> $a, $b {
        return "()" unless $a == $b;
        push @pairs, ($a, $b);
    }
    return @pairs;
}

for (3, 2, 3, 2, 2, 2), (1, 2, 3, 4) -> @test {
    printf "%-15s => ", "@test[]";
    say equal-pairs @test;
}

This program displays the following output:

$ raku ./equal-pairs.raku
3 2 3 2 2 2     => [(2 2) (2 2) (3 3)]
1 2 3 4         => ()

Equal Pairs in Perl

We'll use a completely different approach in Perl. The equal_pairs subroutine counts the number of occurrences of each integer in the %histo hash. We have no solution and return "()" if any of the frequencies is odd. When a frequency is even (we may have 2 items, but also possibly 4, 6, etc.), we add pairs to the $pairs string until we've exhausted them. Note that I have used here a C-style loop; I do that so rarely that I had to look up the syntax in the documentation (I wasn't sure of the order of the three expressions in the loop header).

use strict;
use warnings;
use feature 'say';


sub equal_pairs {
    my %histo;
    my $pairs;
    $histo{$_}++ for @_;  # histogram to store frequencies
    for my $key (keys %histo) {
        return "()" if $histo{$key} % 2;
        for (my $i = $histo{$key}; $i > 0; $i -= 2) {
            $pairs .= "($key $key) ";
        }
    }
    return $pairs;
}

for my $test ([3, 2, 3, 2, 2, 2], [1, 2, 3, 4]) {
    printf "%-15s => ", "@$test";
    say equal_pairs @$test;
}

This program displays the following output:

$ perl  ./equal-pairs.pl
3 2 3 2 2 2     => (2 2) (2 2) (3 3)
1 2 3 4         => ()

Note that it would probably simpler, better and more perlish to remove the inner C-style for loop and replace it with something like this:

    for my $key (keys %histo) {
        return "()" if $histo{$key} % 2;
        $pairs .= "($key $key) " x ($histo{$key} / 2);
    }

yielding the same result.

Wrapping up

Season's greetings to everyone. 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 January 7, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 248, Task 2, 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 December 24, 2023, at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Submatrix Sum

You are given a NxM matrix A of integers.

Write a script to construct a (N-1)x(M-1) matrix B having elements that are the sum over the 2x2 submatrices of A,

b[i,k] = a[i,k] + a[i,k+1] + a[i+1,k] + a[i+1,k+1]

Example 1

Input: $a = [
              [1,  2,  3,  4],
              [5,  6,  7,  8],
              [9, 10, 11, 12]
            ]

Output: $b = [
               [14, 18, 22],
               [30, 34, 38]
             ]

Example 2

Input: $a = [
              [1, 0, 0, 0],
              [0, 1, 0, 0],
              [0, 0, 1, 0],
              [0, 0, 0, 1]
            ]

Output: $b = [
               [2, 1, 0],
               [1, 2, 1],
               [0, 1, 2]
             ]

This is not very difficult. To keep it simple, we simply need to work row by row, and make sure we don't mess indices around.

Submatrix Sum in Raku

As said above, it is quite simple if we work row by row.

sub submatrix-sum (@in) {
    my $max-row = @in.end;
    my $max-col = @in[0].end;
    my @result;
    for 0..^$max-row -> $i {
        my @row;
        for 0..^$max-col -> $j {
            push @row, @in[$i][$j] + @in[$i][$j+1] + 
                @in[$i+1][$j] + @in[$i+1][$j+1];
        }
        push @result, @row; # push doesn't flatten 
    }
    return @result;
}

my @tests = [
              [1,  2,  3,  4],
              [5,  6,  7,  8],
              [9, 10, 11, 12]
            ],
            [
              [1, 0, 0, 0],
              [0, 1, 0, 0],
              [0, 0, 1, 0],
              [0, 0, 0, 1]
            ];
for @tests -> @test {
    print @test.gist, " => ";;
    say submatrix-sum @test;
}

This program displays the following output:

$ raku ./submatrix-sum.raku
[[1 2 3 4] [5 6 7 8] [9 10 11 12]] => [[14 18 22] [30 34 38]]
[[1 0 0 0] [0 1 0 0] [0 0 1 0] [0 0 0 1]] => [[2 1 0] [1 2 1] [0 1 2]]

Submatrix Sum in Perl

This a port to Perl of the above Raku program. It is slightly more complicated in Perl than in Raku, because we need to use references for nested data structures, but it is really not that difficult.

use strict;
use warnings;
use feature 'say';

sub submatrix_sum {
    my @in = @_;
    my $max_row = $#in - 1;
    my $max_col = $#{$in[0]};
    my @result;
    for my $i (0..$max_row ) {
        my @row;
        for my $j (0..$max_col - 1) {
            push @row, $in[$i][$j] + $in[$i][$j+1] + 
                $in[$i+1][$j] + $in[$i+1][$j+1];
        }
        push @result, [@row];
    }
    return @result;
}

my @tests = ([
              [1,  2,  3,  4],
              [5,  6,  7,  8],
              [9, 10, 11, 12]
             ],
             [
              [1, 0, 0, 0],
              [0, 1, 0, 0],
              [0, 0, 1, 0],
              [0, 0, 0, 1]
             ]);
for my $test (@tests) {
    print join ", ", map { "[@$_]" } @$test;
    print " => ";
    say join ", ", map { "[@$_]" } submatrix_sum @$test;
}

This program displays the following output:

$ perl  ./submatrix-sum.pl
[1 2 3 4], [5 6 7 8], [9 10 11 12] => [14 18 22], [30 34 38]
[1 0 0 0], [0 1 0 0], [0 0 1 0], [0 0 0 1] => [2 1 0], [1 2 1], [0 1 2]

Wrapping up

Season's greetings to everyone. 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 December 31, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 248, Task 1, 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 December 24, 2023 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Shortest Distance

You are given a string and a character in the given string.

Write a script to return an array of integers of size same as length of the given string such that:

distance[i] is the distance from index i to the closest occurrence of the given character in the given string.

The distance between two indices i and j is abs(i - j).

Example 1

Input: $str = "loveleetcode", $char = "e"
Output: (3,2,1,0,1,0,0,1,2,2,1,0)

The character 'e' appears at indices 3, 5, 6, and 11 (0-indexed).
The closest occurrence of 'e' for index 0 is at index 3, so the distance is abs(0 - 3) = 3.
The closest occurrence of 'e' for index 1 is at index 3, so the distance is abs(1 - 3) = 2.
For index 4, there is a tie between the 'e' at index 3 and the 'e' at index 5,
but the distance is still the same: abs(4 - 3) == abs(4 - 5) = 1.
The closest occurrence of 'e' for index 8 is at index 6, so the distance is abs(8 - 6) = 2.

Example 2

Input: $str = "aaab", $char = "b"
Output: (3,2,1,0)

Note that there is the special case of a tie (index 4 in the first example above), but we don’t need to worry about that: if the two distances are equal, we simply use any of them.

Shortest Distance in Raku

From a given position in the input string, we use the built-in index and rindex routines to find, respectively, the next and the previous occurrence of the searched letter, and use the occurrence with the smallest distance. If any of the two occurrences is not found (undefined), we simply use the distance of the other.

sub shortest-distance ($char, $str) {
    my @result;
    for 0..^$str.chars -> $i {
        my $next = $str.index($char, $i);
        my $prev = $str.rindex($char, $i);
        push @result, abs($i - $next) and next 
            unless defined $prev;
        push @result, abs($i - $prev) and next 
            unless defined $next;
        my $dist = abs($i - $next) < abs($i - $prev) ?? 
                   abs($i - $next) !! abs($i - $prev);
        push @result, $dist;
    }
    return "@result[]";
}

my @tests = { str => "loveleetcode", char => "e" },
            { str => "aaab", char => "b"};
for @tests -> %test {
    printf "%-1s - %-15s => ", %test{"char"}, %test{"str"};
    say shortest-distance %test{"char"}, %test{"str"};
}

This program displays the following output:

$ raku ./shortest-distance.raku
e - loveleetcode    => 3 2 1 0 1 0 0 1 2 2 1 0
b - aaab            => 3 2 1 0

Shortest Distance in Perl

This program is a port to Perl of the above Raku program. It also uses the built-in index and rindex functions. Asides from minor syntax changes, the only significant difference is that the Perl index and rindex functions return -1 (instead of an undefined value in Raku) when they found no match, so we test for a possible negative value. .

use strict;
use warnings;
use feature 'say';

sub shortest_distance {
    my ($char, $str) = @_;
    my @result;
    my $max_idx = length($str) - 1;
    for my $i (0..$max_idx) {
        my $next = index ($str, $char, $i);
        my $prev = rindex( $str, $char, $i);
        push @result, abs($i - $next) and next if $prev < 0;
        push @result, abs($i - $prev) and next if $next < 0;
        my $dist = abs($i - $next) < abs($i - $prev) ? 
                   abs($i - $next) : abs($i - $prev);
        push @result, $dist;
    }
    return "@result";
}

my @tests = ( { str => "loveleetcode", char => "e" },
              { str => "aaab",         char => "b" } );
for my $t (@tests) {
    printf "%-1s -  %-15s => ", $t->{"char"}, $t->{"str"};
    say shortest_distance $t->{"char"}, $t->{"str"};
}

This program displays the following output:

$ perl ./shortest-distance.pl
e -  loveleetcode    => 3 2 1 0 1 0 0 1 2 2 1 0
b -  aaab            => 3 2 1 0

Wrapping up

Seasons greeting to everyone. 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 December 31, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 247, Task 2, 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 December 17, 2023, at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 2: Most Frequent Letter Pair

You are given a string S of lower case letters 'a'..'z'.

Write a script that finds the pair of consecutive letters in S that appears most frequently. If there is more than one such pair, chose the one that is the lexicographically first.

Example 1

Input: $s = 'abcdbca'
Output: 'bc'

'bc' appears twice in `$s`

Example 2

Input: $s = 'cdeabeabfcdfabgcd'
Output: 'ab'

'ab' and 'cd' both appear three times in $s and 'ab' is lexicographically smaller than 'cd'.

Most Frequent Letter Pair in Raku

We first split the input string into an array of letters, build all the possible pairs of consecutive letters, and store the pairs and their frequency in a hash. Once this is completed, we sort the %pairs hash in descending order of their frequencies and, when the frequency is equal, in alphabetic order, and return the first item of the sorted list.

sub most-frequent-pair ($str) {
    my %pairs;
    my @letters = $str.comb;
    for 1..@letters.end -> $i {
        my $pair = @letters[$i-1] ~ @letters[$i];
        %pairs{$pair}++;
    }
    return (sort { %pairs{$^b} <=> %pairs{$^a} || 
                $^a leg $^b }, %pairs.keys)[0];
}

for 'abcdbca', 'cdeabeabfcdfabgcd', 'bcabbc' -> $test {
    printf "%-20s => ", $test;
    say most-frequent-pair $test;
}

This program displays the following output:

$ raku ./most-frequent-pair.raku
abcdbca              => bc
cdeabeabfcdfabgcd    => ab
bcabbc               => bc

Most Frequent Letter Pair in Perl

This is a port to Perl of the above Raku program. Please refer to the above section if you need further explanations on how it works.

use strict;
use warnings;
use feature 'say';

sub most_frequent_pair {
    my %pairs;
    my @letters = split //, shift;
    for my $i (1..$#letters) {
        my $pair = $letters[$i-1] . $letters[$i];
        $pairs{$pair}++;
    }
    return (sort { $pairs{$b} <=> $pairs{$a} || 
                $a cmp $b } keys %pairs)[0];
}

for my $test ('abcdbca', 'cdeabeabfcdfabgcd', 'bcabbc') {
    printf "%-20s => ", $test;
    say most_frequent_pair $test;
}

This program displays the following output:

$ perl ./most-frequent-pair.pl
abcdbca              => bc
cdeabeabfcdfabgcd    => ab
bcabbc               => bc

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 December 24, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 246, Task 2, 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 December 10, 2023 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: Linear Recurrence of Second Order

You are given an array @a of five integers.

Write a script to decide whether the given integers form a linear recurrence of second order with integer factors.

A linear recurrence of second order has the form

a[n] = p * a[n-2] + q * a[n-1] with n > 1

where p and q must be integers.

Example 1

Input: @a = (1, 1, 2, 3, 5)
Output: true

@a is the initial part of the Fibonacci sequence a[n] = a[n-2] + a[n-1]
with a[0] = 1 and a[1] = 1.

Example 2

Input: @a = (4, 2, 4, 5, 7)
Output: false

a[1] and a[2] are even. Any linear combination of two even numbers with integer factors is even, too.
Because a[3] is odd, the given numbers cannot form a linear recurrence of second order with integer factors.

Example 3

Input: @a = (4, 1, 2, -3, 8)
Output: true

a[n] = a[n-2] - 2 * a[n-1]

Finding whether:

a[n] = p * a[n-2] + q * a[n-1]

isn't very difficult, except that p and q can both take an infinite number of values. We need to limit the range of these two integers. I initially wrote a Raku program in which p and q iterated over hard-coded integers from -5 to +5. It was OK for testing (and it worked for the test cases outlined in the task specification), but I did not find that satisfactory. So, I changed the range for p and q to be the minimum and maximum of the input array. This seems to work in all cases, but I can't prove it. Also, there may be a better solution to use a narrower range. But I do not have the energy to investigate the math aspect of it.

Linear Recurrence of Second Order in Raku

We have three nested loops iterating over the values of p and q as described above and over the input array. Note that, in most cases, the most inner loop short-circuits almost immediately when the values of p and q are found to be not suitable for the input array.

sub linear-rec (@in) {
    my @range = @in.minmax;
    for @range -> $p {
        for @range -> $q {
            for 2..@in.end -> $i {
                last if @in[$i] != 
                    $p * @in[$i-2] + $q * @in[$i-1];
                # say "$p $q $i";
                return ("True:  p = $p, q = $q") 
                    if $i == @in.end;
            }
        }
    }
    return (False);
}

my @tests = <1 1 2 3 5>, <4 2 4 5 7>, <4 1 2 -3 8>;
for @tests -> @test {
    printf "%-12s => ", "@test[]";
    say linear-rec @test;
}

This program displays the following output:

$ raku ./linear-recurrence.raku
1 1 2 3 5    => True:  p = 1, q = 1
4 2 4 5 7    => False
4 1 2 -3 8   => True:  p = 1, q = -2

Linear Recurrence of Second Order in Perl

This is a port to Perl of the above Raku program (see the previous sections for explanations).

use strict;
use warnings;
use feature 'say';

sub linear_rec {
    my @in = @_;
    my ($min, $max) = (sort {$a <=> $b} @in)[0, -1];
    for my $p ($min .. $max) {
        for my $q ($min .. $max) {
            for my $i (2..$#in) {
                last if $in[$i] != 
                    $p * $in[$i-2] + $q * $in[$i-1];
                # say "$p $q $i";
                return ("True:  p = $p, q = $q") 
                    if $i == $#in;
            }
        }
    }
    return "False";
}

my @tests = ([<1 1 2 3 5>], [<4 2 4 5 7>], [<4 1 2 -3 8>]);
for my $test (@tests) {
    printf "%-12s => ", "@$test";
    say linear_rec @$test;
}

This program displays the following output:

$ perl linear-recurrence.pl
1 1 2 3 5    => True:  p = 1, q = 1
4 2 4 5 7    => False
4 1 2 -3 8   => True:  p = 1, q = -2

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 December 17, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 246, Task 1, 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 December 10, 2023 at 23:59). This blog post provides some solutions to this challenge. Please don’t read on if you intend to complete the challenge on your own.

Task 1: 6 out of 49

6 out of 49 is a German lottery.

Write a script that outputs six unique random integers from the range 1 to 49.

Output:

3
10
11
22
38
49

For space reasons, we will display the random integers on the same line. Also, it appears that the integers in the example above are sorted in ascending order. It would be very easy to sort the output, but we will not do it, since it is not part of the specification for the task. Also, note that we need six unique integers (i.e. without repetition).

6 out of 49 in Raku

This is very easy in Raku, since the built-in pick method returns the specified number of elements chosen at random and without repetition from the invocant.

say (1..49).pick: 6;

This program displays the following output:

$ raku ./german-lottery.raku
(40 36 17 9 41 25)

Of course, the program is so simple that we can run it as a Raku one-liner at the command line:

$ raku -e 'say (1..49).pick: 6;'
(44 10 18 12 46 21)

6 out of 49 in Perl

This is slightly more complex in Perl, because we need to transform the numbers generated into integers and to prevent the generation of duplicates. We use a hash to store the result, and add integers to the hash only when the integer has not been seen before.

use strict;
use warnings;
use feature 'say';

my %result;
while (%result < 6) {
    # get random integers in the range 1..49
    my $rand = int( rand 49) + 1;
    # discard duplicates
    $result{$rand} = 1 unless exists $result{$rand};
}
say join " ", keys %result;

Running the program a few times displays the following output:

$ perl ./german-lottery.pl
18 33 43 31 44 41

~
$ perl ./german-lottery.pl
45 49 15 19 37 43

~
$ perl ./german-lottery.pl
16 3 23 26 31 9

~
$ perl ./german-lottery.pl
27 48 1 8 40 24

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 December 17, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 245, Task 2, of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Task 2: Largest of Three

You are given an array of integers >= 0.

Write a script to return the largest number formed by concatenating some of the given integers in any order which is also a multiple of 3. Return -1 if none found.

Example 1

Input: @ints = (8, 1, 9)
Output: 981

981 % 3 == 0

Example 2

Input: @ints = (8, 6, 7, 1, 0)
Output: 8760

Example 3

Input: @ints = (1)
Output: -1

We will use the Raku built-in combinations routine to generate the various possibilities. Note that if any number is a multiple of 3, then, any permutation of its digits is also a multiple of 3. So sorting the input array in descending order will provide us with combinations leading to the largest concatenations of integers.

Largest of Three in Raku

Using the above comments, we arrive at the following Raku solution:

sub largest-three (@ints) {
    my $max = -1;
    my @sorted = @ints.sort.reverse;
    for @sorted.combinations: 1..@ints.elems -> @seq {
        my $val = [~] @seq;
        next unless $val %% 3;
        $max = $val if $val > $max;
    }
    return $max > 0 ?? $max !! -1;
}

my @tests = <8 1 9>, <8 1 9 3>, <8 6 7 1 0>, (0,);
for @tests -> @test {
    printf "%-10s => ", "@test[]";
    say largest-three @test;
}

This program displays the following output:

$ raku ./largest-three.raku    
8 1 9      => 981
8 1 9 3    => 9831
8 6 7 1 0  => 8760
0          => -1

Largest of Three in Perl

Not enough time this week for a solution to this challenge in Perl. Sorry.

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 December 10, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.