These are some answers to the Week 258, 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 March 3, 2024 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: Count Even Digits Number

You are given a array of positive integers, @ints.

Write a script to find out how many integers have even number of digits.

Example 1

Input: @ints = (10, 1, 111, 24, 1000)
Output: 3

There are 3 integers having even digits i.e. 10, 24 and 1000.

Example 2

Input: @ints = (111, 1, 11111)
Output: 0

Example 3

Input: @ints = (2, 8, 1024, 256)
Output: 1

Count Even Digits Number in Raku

We use the chars function to count the characters of each integer, grep with the % modulo oprator to filter the counts that are even, and finally the elemsmethod to count the integers satisfying the desired condition. Altogether, a nice little oner-liner.

sub count-even-digits-ints (@in) {
    (grep { .chars %% 2 }, @in).elems;
}

my @tests = <10 1 111 24 1000>, <111 1 11111>, <2 8 1024 256>;
for @tests -> @test {
    printf "%-20s => ", "@test[]";
    say count-even-digits-ints @test;
}

This program displays the following output:

$ raku ./count-even-digits.raku
10 1 111 24 1000     => 3
111 1 11111          => 0
2 8 1024 256         => 1

Count Even Digits Number in Perl

This is a port to Perl of the above Raku program, using scalar and length to replace elems and chars. Also a concise one-liner.

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

sub count_even_digits_ints {
    scalar grep { ! (length($_) % 2) } @_;
}

my @tests = ( [<10 1 111 24 1000>], 
              [<111 1 11111>], [<2 8 1024 256>] );
for my $test (@tests) {
    printf "%-20s => ", "@$test";
    say count_even_digits_ints @$test;
}

This program displays the following output:

$ perl ./count-even-digits.pl
10 1 111 24 1000     => 3
111 1 11111          => 0
2 8 1024 256         => 1

Count Even Digits Number in Julia

Again, a port of the two previous programs to Julia. The only significant difference is that we need to explicitly convert integers to strings to be able to find their length (number of characters).

using Printf

function count_even_digits_ints(invals)
    evens = filter(x -> (mod(length(string(x)), 2 ) == 0), invals)
    return size(evens, 1)
end

tests = [ [100, 1, 111, 424, 1000],
          [111, 1, 11111], [2, 8, 1024, 256] ]

for test in tests
    @printf "%-25s => " "$test"
    println("$(count_even_digits_ints(test))")
end

This program displays the following output:

$ julia  count-even-digits.jl
[100, 1, 111, 424, 1000]  => 1
[111, 1, 11111]           => 0
[2, 8, 1024, 256]         => 1

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

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

Warning: I wrote the program below and this blog post from an hospital bed in a heart intensive care unit. I think my mind is clear, but there may very well be a better way to solve the task. Also, I do not have the energy to port this Raku program to other languages, nor to provide lengthy explanations.

Task 2: Reduced Row Echelon

Given a matrix M, check whether the matrix is in reduced row echelon form.

A matrix must have the following properties to be in reduced row echelon form:

1. If a row does not consist entirely of zeros, then the first
   nonzero number in the row is a 1. We call this the leading 1.
2. If there are any rows that consist entirely of zeros, then
   they are grouped together at the bottom of the matrix.
3. In any two successive rows that do not consist entirely of zeros,
   the leading 1 in the lower row occurs farther to the right than
   the leading 1 in the higher row.
4. Each column that contains a leading 1 has zeros everywhere else
   in that column.

For example:

[
   [1,0,0,1],
   [0,1,0,2],
   [0,0,1,3]
]

The above matrix is in reduced row echelon form since the first nonzero number in each row is a 1, leading 1s in each successive row are farther to the right, and above and below each leading 1 there are only zeros.

*For more information check out this wikipedia article.

Example 1

Input: $M = [
              [1, 1, 0],
              [0, 1, 0],
              [0, 0, 0]
            ]
Output: 0

Example 2

Input: $M = [
              [0, 1,-2, 0, 1],
              [0, 0, 0, 1, 3],
              [0, 0, 0, 0, 0],
              [0, 0, 0, 0, 0]
            ]
Output: 1

Example 3

Input: $M = [
              [1, 0, 0, 4],
              [0, 1, 0, 7],
              [0, 0, 1,-1]
            ]
Output: 1

Example 4

Input: $M = [
              [0, 1,-2, 0, 1],
              [0, 0, 0, 0, 0],
              [0, 0, 0, 1, 3],
              [0, 0, 0, 0, 0]
            ]
Output: 0

Example 5

Input: $M = [
              [0, 1, 0],
              [1, 0, 0],
              [0, 0, 0]
            ]
Output: 0

Example 6

Input: $M = [
              [4, 0, 0, 0],
              [0, 1, 0, 7],
              [0, 0, 1,-1]
            ]
Output: 0

Reduced Row Echelon in Raku

sub is-first-echelon (@mat) {
    my @leading;
    for 0..@mat.end -> $i {
        my @row = |@mat[$i];
        for 0..@row.end -> $j {
            next if @row[$j] == 0;
            if @row[$j] == 1 {
                @leading[$i] = $j;
                last;
            } else {
            }
        }
        @leading[$i] = Inf unless defined @leading[$i];
    }
    return False unless [<] grep { $_ < Inf }, @leading; # rules 2 and 3
    return False unless [<=] @leading; 
    for 0..@leading.end -> $i {
        last if @leading[$i] == Inf;
        next unless defined @leading[$i];
        for 0..@mat.end -> $k {
            next if $i == @leading[$k];
            return False if @mat[$k][$i] != 0;
        }
    }
    return True;
}

my @tests = 
    [ [1,0,0,1], [0,1,0,2], [0,0,1,3]],
    [ [1, 1, 0], [0, 1, 0], [0, 0, 0]],
    [ [0, 1,-2, 0, 1], [0, 0, 0, 1, 3], [0, 0, 0, 0, 0], [0, 0, 0, 0, 0]],
    [ [1, 0, 0, 4], [0, 1, 0, 7], [0, 0, 1,-1]],
    [ [0, 1,-2, 0, 1], [0, 0, 0, 0, 0], [0, 0, 0, 1, 3], [0, 0, 0, 0, 0]],
    [ [0, 1, 0], [1, 0, 0], [0, 0, 0]],
    [ [4, 0, 0, 0], [0, 1, 0, 7], [0, 0, 1,-1]];

for @tests -> @test {
    printf "%-20s => ", "@test[0] ...";
    say is-first-echelon @test;
}

This program displays the following output:

$ raku ./first-echelon.raku
1 0 0 1 ...          => True
1 1 0 ...            => False
0 1 -2 0 1 ...       => True
1 0 0 4 ...          => True
0 1 -2 0 1 ...       => False
0 1 0 ...            => False
4 0 0 0 ...          => False

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 March 3, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 257, 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 February 25, 2024 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: Smaller than Current

You are given a array of integers, @ints.

Write a script to find out how many integers are smaller than current i.e. foreach ints[i], count ints[j] < ints[i] where i != j.

Example 1

Input: @ints = (5, 2, 1, 6)
Output: (2, 1, 0, 3)

For $ints[0] = 5, there are two integers (2,1) smaller than 5.
For $ints[1] = 2, there is one integer (1) smaller than 2.
For $ints[2] = 1, there is none integer smaller than 1.
For $ints[3] = 6, there are three integers (5,2,1) smaller than 6.

Example 2

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

Example 3

Input: @ints = (0, 1)
Output: (0, 1)

Example 4

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

First, we don't really care of the requirement that i != j, because, if i == j, there is no way we could have ints[j] < ints[i].

One thing that we could do is to sort the input data and build a structure (e.g. a hash) mapping each number of the input with its rank in the sorted array. This would give us directly the number of items less than any given item. That would work well with all four examples provided, but it might fail to provide the correct answer when the input contains duplicates. Since dealing with duplicates isn't so easy, it will be simpler to use brute-force nested loops.

Smaller than Current in Raku

As said above, we simply implement two nested for loops, count the number of items less than the current one and store the counts in the @result array.

sub count-smaller (@in) {
    my @result;
    for @in -> $i {
        my $count = 0;
        for @in -> $j {
            $count++ if $j < $i;
        }
        push @result, $count;
    }
    return @result;
}

my @tests = <5 2 1 6>, <1 2 0 3>, <0 1>, <9 4 9 2>;
for @tests -> @test {
    printf "%-12s => ", "@test[]";
    say count-smaller @test;
}

This program displays the following output:

$ raku ./smaller-than-current.raku
5 2 1 6      => [2 1 0 3]
1 2 0 3      => [1 2 0 3]
0 1          => [0 1]
9 4 9 2      => [2 1 2 0]

Smaller than Current in Perl

This is a port to Perl of the above Raku program:

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

sub count_smaller {
    my @in = @_;
    my @result;
    for my $i (@in) {
        my $count = 0;
        for my $j (@in) {
            $count++ if $j < $i;
        }
        push @result, $count;
    }
    return @result;
}

my @tests = ([<5 2 1 6>], [<1 2 0 3>], [<0 1>], [<9 4 9 2>]);
for my $test (@tests) {
    printf "%-12s => ", "@$test";
    say join " ", count_smaller @$test;
}

This program displays the following output:

$ perl ./smaller-than-current.pl
5 2 1 6      => 2 1 0 3
1 2 0 3      => 1 2 0 3
0 1          => 0 1
9 4 9 2      => 2 1 2 0

Smaller than Current in Julia

This is a port to Julia of the above Raku and Perl programs:

using Printf

function count_smaller(input)
    result = []
    for i in input
        count = 0
        for j in input
            if j < i
                count += 1
            end
        end
        push!(result, count)
    end
    return join(result, " ");
end

tests = [ [5, 2, 1, 6], [1, 2, 0, 3], [0, 1], [9, 4, 9, 2] ]

for test in tests
    @printf "%-15s => " "$test"
    println("$(count_smaller(test))")
end

This program displays the following output:

$ julia ./smaller-than-current.jl
[5, 2, 1, 6]    => 2 1 0 3
[1, 2, 0, 3]    => 1 2 0 3
[0, 1]          => 0 1
[9, 4, 9, 2]    => 2 1 2 0

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 March 3, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 256, 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 February 18, 2024 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: Merge Strings

You are given two strings, $str1 and $str2.

Write a script to merge the given strings by adding in alternative order starting with the first string. If a string is longer than the other then append the remaining at the end.

Example 1

Input: $str1 = "abcd", $str2 = "1234"
Output: "a1b2c3d4"

Example 2

Input: $str1 = "abc", $str2 = "12345"
Output: "a1b2c345"

Example 3

Input: $str1 = "abcde", $str2 = "123"
Output: "a1b2c3de"

Merge Strings in Raku

For such a task, the first thing that comes to mind in Raku is to use the built-in zip routine, which iterates through each of the input lists synchronously, 'Zipping' them together, so that elements are grouped according to their input list index, in the order that the lists are provided. The slight problem, though, is that, if the input lists have an unequal number of elements, then zip terminates once the shortest input list is exhausted, and trailing elements from longer input lists are discarded. This is not what we want here, since the task says: "If a string is longer than the other, then append the remaining at the end." We could still use zip and add at the end the left-overs from the longer list, but we can do better.

Raku has another built-in similar routine, roundrobin, which does not terminate once one or more of the input lists become exhausted, but proceeds until all elements from all lists have been processed. This is exactly what we need here, and the work is done with just one code-line.

sub merge-strings ($str1, $str2) {
    my $res = join "", roundrobin $str1.comb, $str2.comb, :slip;
    return $res;
}

my @tests = <abcd 1234>, <abc 12345>, <abcde 123>;
for @tests -> @test {
    printf "%-12s => ", "@test[]";
    say merge-strings @test[0], @test[1];
}

This program displays the following output:

$ raku ./merge-strings.raku
abcd 1234    => a1b2c3d4
abc 12345    => a1b2c345
abcde 123    => a1b2c3de

Merge Strings in Perl

Perl doesn't have built-in routines such as zip or roundrobin, so we need to build the result manually. We loop over the indexes of the longer list and add the items from both lists (or an empty string if a value is not defined for a given index).

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

sub merge_strings  {
    my ($str1, $str2) = @_;
    my @let1 = split //, $str1;
    my @let2 = split //, $str2;
    my $end = scalar @let1 > scalar @let2 ? $#let1 : $#let2;
    my @result = map { ($let1[$_] // "") . 
                       ($let2[$_] // "") } 0..$end;
    return join "", @result;
}

my @tests = ([<abcd 1234>], [<abc 12345>], [<abcde 123>]);
for my $test (@tests) {
    printf "%-12s => ", "@$test";
    say merge_strings $test->[0], $test->[1];
}

This program displays the following output:

$ perl ./merge-strings.pl
abcd 1234    => a1b2c3d4
abc 12345    => a1b2c345
abcde 123    => a1b2c3de

Merge Strings in Julia

Yet a slightly different method. We loop over the indexes of the shorter list and add the items from both lists. At the end, we add at the end the trailing items from the longer list.

using Printf

function merge_strings(str1, str2) 
    result = []
    let1 = split(str1, "")
    let2 = split(str2, "")
    size1 = size(let1, 1)
    size2 = size(let2, 1)
    last_i = size1 > size2 ? size2 : size1
    for i in 1:last_i
        push!(result, let1[i], let2[i])
    end    
    if size1 > size2
        for i in last_i + 1:size1
            push!(result, let1[i])
        end
    else
        for i in last_i + 1:size2
            push!(result, let2[i])
        end    
    end
    return join(result, "");
end

tests = [["abcd", "1234"], ["abc", "12345"], ["abcde", "123"]]
for test in tests
    @printf "%-18s => " "$test"
    println(merge_strings(test[1], test[2]))
end

This program displays the following output:

$ julia ./merge-strings.jl
["abcd", "1234"]   => a1b2c3d4
["abc", "12345"]   => a1b2c345
["abcde", "123"]   => a1b2c3de

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 February 25, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 256, 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 February 18, 2024 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: Maximum Pairs

You are given an array of distinct words, @words.

Write a script to find the maximum pairs in the given array. The words $words[i] and $words[j] can be a pair one is reverse of the other.

Example 1

Input: @words = ("ab", "de", "ed", "bc")
Output: 1

There is one pair in the given array: "de" and "ed"

Example 2

Input: @words = ("aa", "ba", "cd", "ed")
Output: 0

Example 3

Input: @words = ("uv", "qp", "st", "vu", "mn", "pq"))
Output: 2

Maximum Pairs in Raku

We just run two nested loops on the input array and increment a counter whenever one word is ther reverse of another one. The Raku routine for reversing a word is flip.

sub find-pairs (@in) {
    my $nb-pairs = 0;
    for 0..@in.end -> $i {
        for $i^..@in.end -> $j {
            $nb-pairs++ if @in[$i] eq @in[$j].flip;
        }
    }
    return $nb-pairs;
}

my @tests = <ab de ed bc>, <aa ba cd ed>, <uv qp st vu mn pq> ;
for @tests -> @test {
    printf "%-20s => ", "@test[]";
    say find-pairs @test;
}

This program displays the following output:

$ raku ./find-pairs.raku
ab de ed bc          => 1
aa ba cd ed          => 0
uv qp st vu mn pq    => 2

Maximum Pairs in Perl

This is a port to Perl of the above Raku program, with also two nested loops.

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

sub find_pairs {
    my @in = @_;
    my $nb_pairs = 0;
    for my $i (0..$#in) {
        for my $j ($i + 1 ..$#in) {
            $nb_pairs++ if $in[$i] eq reverse $in[$j];
        }
    }
    return $nb_pairs;
}

my @tests = ([<ab de ed bc>], [<aa ba cd ed>],
             [<uv qp st vu mn pq>]);
for my $test (@tests) {
    printf "%-20s => ", "@$test";
    say find_pairs @$test;
}

This program displays the following output:

$ perl ./find-pairs.pl
ab de ed bc          => 1
aa ba cd ed          => 0
uv qp st vu mn pq    => 2

Maximum Pairs in Julia

This is a port to Julia of the above Raku program, with also two nested loops. Remember that Julia array indexes start at 1, not 0.

using Printf

function find_pairs(in)
    nb_pairs = 0
    for i in 1:size(in, 1)
        for j in i+1:size(in, 1)
            if in[i] == reverse(in[j])
                nb_pairs += 1
            end
        end
    end
    return nb_pairs
end

tests = [ ["ab", "de", "ed", "bc"],
          ["aa", "ba", "cd", "ed"],
          ["uv", "qp", "st", "vu", "mn", "pq"] ]

for test in tests
    @printf "%-40s => " "$test"
    println(find_pairs(test))
end

This program displays the following output:

$  julia ./find-pairs.jl
["ab", "de", "ed", "bc"]                 => 1
["aa", "ba", "cd", "ed"]                 => 0
["uv", "qp", "st", "vu", "mn", "pq"]     => 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 February 25, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 255, 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 February 11, 2024, 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 Word

You are given a paragraph $p and a banned word $w.

Write a script to return the most frequent word that is not banned.

Example 1

Input: $p = "Joe hit a ball, the hit ball flew far after it was hit."
       $w = "hit"
Output: "ball"

The banned word "hit" occurs 3 times.
The other word "ball" occurs 2 times.

Example 2

Input: $p = "Perl and Raku belong to the same family. Perl is the most popular language in the weekly challenge."
       $w = "the"
Output: "Perl"

The banned word "the" occurs 3 times.
The other word "Perl" occurs 2 times.

Most Frequent Word in Raku

We first use the tr/// in-place transliteration operator to remove punctuation characters from the input paragraph, which makes it possible to use the words to split the paragraph into words. We then use grep to remove the banned word from the word list and convert the resulting list into a Bag, histo (for histogram). Finally, we return the item from the bag having the highest frequency.

sub most-frequent-word ($para is copy, $banned) {
    $para ~~ tr/,.:;?!//;
    my $histo = $para.words.grep({$_ ne $banned}).Bag;
    return $histo.keys.max({$histo{$_}});
}

my $t = "Joe hit a ball, the hit ball flew far after it was hit.";
printf "%-30s... => ", substr $t, 0, 28;
say most-frequent-word $t, "hit";

$t = "Perl and Raku belong to the same family. Perl is the most popular language in the weekly challenge.";
printf "%-30s... => ", substr $t, 0, 28;
say most-frequent-word $t, "the";

This program displays the following output:

$ raku ./most-frequent-word.raku
Joe hit a ball, the hit ball  ... => ball
Perl and Raku belong to the   ... => Perl

Most Frequent Word in Perl

This is a port to Perl of the Raku program above, using a hash instead of a Bag and the split function instead of words.

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

sub most_frequent_word {
    my ($para, $banned) = @_;
    $para =~ tr/,.:;?!//;
    my %histo;
    %histo = map { $_ => ++$histo{$_} } 
        grep {$_ ne $banned} split /\W/, $para;
    return (sort { $histo{$b} <=> $histo{$a} } keys %histo )[0];
}

my $t = "Joe hit a ball, the hit ball flew far after it was hit.";
printf "%-30s... => ", substr $t, 0, 28;
say most_frequent_word $t, "hit";

$t = "Perl and Raku belong to the same family. Perl is the most popular language in the weekly challenge.";
printf "%-30s... => ", substr $t, 0, 28;
say most_frequent_word $t, "the";

This program displays the following output:

$ perl ./most-frequent-word.pl
Joe hit a ball, the hit ball  ... => ball
Perl and Raku belong to the   ... => Perl

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 February 18, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 255, 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 February 11, 2024 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: Odd Character

You are given two strings, $s and $t. The string $t is generated using the shuffled characters of the string $s with an additional character.

Write a script to find the additional character in the string $t.

Example 1

Input: $s = "Perl" $t = "Preel"
Output: "e"

Example 2

Input: $s = "Weekly" $t = "Weeakly"
Output: "a"

Example 3

Input: $s = "Box" $t = "Boxy"
Output: "y"

Odd Character in Raku

This task is really simple in Raku: we simply convert each input string into a Bag of its letters, and then use the (-) infix set difference operator to find the extra item in $t. So we end up with a short one-line subroutine.

sub odd-char ($s, $t) {
    return ~ ($t.comb.Bag (-) $s.comb.Bag);
}

for <Perl Preel>, <Weekly Weeakly>, <Box Boxy> -> @test {
    printf "%-8s %-8s => ", @test;
    say odd-char @test[0], @test[1];
}

This program displays the following output:

$ raku ./odd-characters.raku
Perl     Preel    => e
Weekly   Weeakly  => a
Box      Boxy     => y

Odd Character in Perl

The solution is slightly more complicated in Perl, because Perl doesn't have Bags and set difference operators. We can easily replace bags with hashes (with values being the frequency of each letter). Then we have to find the extra hash item in %t.

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

sub odd_char {
    my (%s, %t);
    %s = map { $_ => ++$s{$_} } split //, $_[0];
    %t = map { $_ => ++$t{$_} } split //, $_[1];
    my @result = grep { (not defined $s{$_}) 
        or $t{$_} - $s{$_} > 0 } keys %t;
}

for my $test ([<Perl Preel>], [<Weekly Weeakly>], [<Box Boxy>]) {
    printf "%-8s %-8s => ", @$test;
    say odd_char $test->[0], $test->[1];
}

This program displays the following output:

$ perl  ./odd-characters.pl
Perl     Preel    => e
Weekly   Weeakly  => a
Box      Boxy     => y

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 February 18, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.