These are some answers to the Week 254, 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 4, 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: Reverse Vowels

You are given a string, $s.

Write a script to reverse all the vowels (a, e, i, o, u) in the given string.

Example 1

Input: $s = "Raku"
Output: "Ruka"

Example 2

Input: $s = "Perl"
Output: "Perl"

Example 3

Input: $s = "Julia"
Output: "Jaliu"

Example 4

Input: $s = "Uiua"
Output: "Auiu"

Example 4 just above shows us that we cannot simply reverse the vowels, but also need to deal with upper- and lower-case letters. To do this, I decided to reduce the whole input string to lowercase at the start, perform the required letter moves (or, rather, substitutions), and finally to turn the first letter of the result to uppercase (with the tc method in Raku and the ucfirst function in Perl).

Reverse Vowels in Raku

We first turn the input string to lower-case (see above why). Then we use a Regex match to build a list of the vowels in the input string. Then we use a regex substitution to replace vowels in the input words by the same vowels in reverse order (using pop). Finally, we use tc (title case) to capitalize the first letter of the result.

sub reverse-vowels ($in) {
    my $str = $in.lc;
    my @vowels = map { .Str }, $str ~~ m:g/<[aeiou]>/;
    $str ~~ s:g/<[aeiou]>/{pop @vowels}/;
    return $str.tc;
}

for <Raku Perl Julia Uiua> -> $test {
    say "$test \t => ", reverse-vowels $test;
}

This program displays the following output:

$ raku ./reverse-vowels.raku
Raku     => Ruka
Perl     => Perl
Julia    => Jaliu
Uiua     => Auiu

Reverse Vowels in Perl

This is a port to Perl of the Raku program above, using equivalent regular expressions. Please refer to the above sections if you need additional explanations.

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

sub reverse_vowels  {
    my $str = lc shift;
    my @vowels = $str =~ /[aeiou]/g;
    $str =~ s/[aeiou]/pop @vowels/ge;
    return ucfirst $str;
}

for my $test (qw <Raku Perl Julia Uiua>) {
    say "$test \t => ", reverse_vowels $test;
}

This program displays the following output:

$ perl ./reverse-vowels.pl
Raku     => Ruka
Perl     => Perl
Julia    => Jaliu
Uiua     => Auiu

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

These are some answers to the Week 254, 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 4, 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: Three Power

You are given a positive integer, $n.

Write a script to return true if the given integer is a power of three otherwise return false.

Example 1

Input: $n = 27
Output: true

27 = 3 ^ 3

Example 2

Input: $n = 0
Output: true

0 = 0 ^ 3

Example 3

Input: $n = 6
Output: false

First, we look for the candidate exponent, by computing the base-3 logarithm of the input integer. Then we check that we've actually a power of 3. Since floating point arithmetic can be tricky, we test with the integer immediately below and the integer immediately above the candidate exponent thus found.

Three Power in Raku

Please refer to the above section if you need explanations. Note that the Raku log routine can take two parameters, the number for which you want the logarithm and the base. The input number must be strictly positive, so we have to handle separately an input equal to 0. The returned value is a Boolean expression and will thus be either True or False.

sub exp-three ($in) {
    return True if $in == 0;
    my $exp = (log $in, 3).Int;
    return (3 ** $exp == $in or 3 ** ($exp + 1) == $in);
}

say "$_ \t=> ", exp-three $_ for <27 26 0 6>;

This program displays the following output:

$ raku ./power-of-three.raku
27      => True
26      => False
0       => True
6       => False

Three Power in Perl

This is a port to Perl of the Raku program above. Please refer to the above sections if you need additional explanations. Perl's built-in log function computes only natural logarithms (base e), but it is easy to compute base-3 logarithm of n as log n / log 3.

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

sub exp_three {
    my $in = shift;
    return "true" if $in == 0;
    my $exp = int (log $in / log 3);
    return (3 ** $exp == $in or 3 ** ($exp + 1) == $in)
        ? "true" : "false";
}

say "$_ \t=> ", exp_three $_ for qw<27 26 0 6>;

This program displays the following output:

$ perl ./power-of-three.pl
27      => true
26      => false
0       => true
6       => 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 February 11, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 253, 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 January 28, 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: Weakest Row

You are given an m x n binary matrix i.e. only 0 and 1 where 1 always appear before 0.

A row i is weaker than a row j if one of the following is true:

a) The number of 1s in row i is less than the number of 1s in row j.

b) Both rows have the same number of 1 and i < j.

Write a script to return the order of rows from weakest to strongest.

Example 1

Input: $matrix = [
                   [1, 1, 0, 0, 0],
                   [1, 1, 1, 1, 0],
                   [1, 0, 0, 0, 0],
                   [1, 1, 0, 0, 0],
                   [1, 1, 1, 1, 1]
                 ]
Output: (2, 0, 3, 1, 4)

The number of 1s in each row is:
- Row 0: 2
- Row 1: 4
- Row 2: 1
- Row 3: 2
- Row 4: 5

Example 2

Input: $matrix = [
                   [1, 0, 0, 0],
                   [1, 1, 1, 1],
                   [1, 0, 0, 0],
                   [1, 0, 0, 0]
                 ]
Output: (0, 2, 3, 1)

The number of 1s in each row is:
- Row 0: 1
- Row 1: 4
- Row 2: 1 Transform
- Row 3: 1

Note first that, for the purpose of this task, we don't really care whether the 1s come before the 0s in any row. We count the number of 1s in a given row by simply adding the items of the row.

Next, such a task is a perfect opportunity to use a powerful and efficient functional programming syntax construct called Schwartzian transform, named after Randal Schwartz, a famous author of Perl books. In its canonical form, the Schwartzian transform is a data pipeline consisting of three steps: map ... sort ... map (to be read from bottom to top and right to left), in which: 1. the first map (on the right) prepares the data by adding additional information, 2. the sort uses the data thus enriched to reorder the records, and 3. the last map (on the left) extract the desired data from the structure generated by the sort. The Schwartzian transform is quite commonly used in Perl, but less so in Raku, because the built-in Raku sort has some powerful features which can often cache the intermediate results in a simpler manner without this construct. In the specific case at hand, I felt that using the Schwartzian tranform was simpler.

Weakest Row in Raku

The solution is quite simple once you understand the Schwartzian transform explained in the previous section. The input is simply a list of row indexes (bottom right). The first map (at the bottom) creates a list of records containing the index and sum of items for each row, the sort sorts the record according to the row sum and, in the event of a draw, the row index, ands, finally the last map (at the top) extracts the row index from each record.

sub weakest-row (@matrix) {
    # Schwartzian transform
    return map { $_[0] }, 
    sort { $^a[1] <=> $^b[1] || $^a[0] <=> $^b[0]},
    map { [ $_, @matrix[$_].sum ] }, 0..@matrix[0].end;
}

my @tests = (
             [1, 1, 0, 0, 0],
             [1, 1, 1, 1, 0],
             [1, 0, 0, 0, 0],
             [1, 1, 0, 0, 0],
             [1, 1, 1, 1, 1]
            ),
            (
             [1, 0, 0, 0],
             [1, 1, 1, 1],
             [1, 0, 0, 0],
             [1, 0, 0, 0]
            );
for @tests -> @test {
    printf "%-12s ... %-12s  => ", "@test[0]", "@test[*-1]";
    say weakest-row @test; 
}

This program displays the following output:

$ raku ./weakest-row.raku
1 1 0 0 0    ... 1 1 1 1 1     => (2 0 3 1 4)
1 0 0 0      ... 1 0 0 0       => (0 2 3 1)

For the purpose of formatting the output on a reasonable line length, I only displayed the first and last rows of the input matrix.

Weakest Row in Perl

This is a port to Perl of the Raku program above, also using the Schwartzian transform described in the above sections. The only significant difference is that I have added a sum helper subroutine to compute the sum of the items of an input array.

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

sub sum {
    my $sum = 0;
    $sum += $_ for @_;
    return $sum;
}

sub weakest_row {
    my @matrix = @_;
    my $row_end = @{$matrix[0]} -1;
    # Schwartzian transform
    return map { "$_->[0] " }
    sort { $a->[1] <=> $b->[1] || $a->[0] <=> $b->[0]}
    map { [ $_, sum @{$matrix[$_]} ] } 0..$row_end;
}

my @tests = ( [
                [1, 1, 0, 0, 0],
                [1, 1, 1, 1, 0],
                [1, 0, 0, 0, 0],
                [1, 1, 0, 0, 0],
                [1, 1, 1, 1, 1]
              ],
              [
                [1, 0, 0, 0],
                [1, 1, 1, 1],
                [1, 0, 0, 0],
                [1, 0, 0, 0]
              ]
            );

for my $test (@tests) {
    printf "%-10s ... %-10s => ", 
        "@{$test->[0]}", "@{$test->[-1]}";
    say weakest_row @$test;
}

This program displays the following output:

$ perl ./weakest-row.pl
1 1 0 0 0  ... 1 1 1 1 1  => 2 0 3 1 4
1 0 0 0    ... 1 0 0 0    => 0 2 3 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 February 4, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 253, 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 January 28, 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: Split Strings

You are given an array of strings and a character separator.

Write a script to return all words separated by the given character excluding empty string.

Example 1

Input: @words = ("one.two.three","four.five","six")
       $separator = "."
Output: "one","two","three","four","five","six"

Example 2

Input: @words = ("$perl$$", "$$raku$")
       $separator = "$"
Output: "perl","raku"

Split Strings in Raku

Since we are passing two very different arguments to our split-strings subroutine, a single character and an array of strings, I thought it was a good opportunity to brush up my knowledge of named arguments to a subroutine. The arguments are supplied at the subroutine call as a list of pairs using the pair constructor syntax. In the subroutine signature, the parameters are retrieved with the so-called colon-pair syntax.

Otherwise, this is quite simple. We're using a grep to remove empty strings from the result.

sub split-strings (:$sep, :@strings) {
    my @result = grep { /\w+/ }, flat  
        map { split $sep, $_ }, @strings;
    return @result;
}


my @tests = {
    'separator' => '.',  
    'string' => ("one.two.three","four.five","six")
    }, {
    'separator' => '$', 
    'string' => ('$perl$$', '$$raku$')};
for @tests -> %test {
    printf "%-30s => ",  %test<string>;
    say split-strings(sep => %test<separator>, 
                      strings => %test<string>);
}

This program displays the following output:

$ raku  ./split-strings.raku
one.two.three four.five six    => [one two three four five six]
$perl$$ $$raku$                => [perl raku]

Split Strings in Perl

This is a port to Perl of the above Raku program, except that we use here normal positional parameters. Please loop at the previous section if you need further explanations. Note that we use the quotemeta operator to make sure that the separator will be properly backslashed (to transform the separator string into a regex).

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

sub split_strings {
    my ($sep, @strings) = @_;
    $sep = quotemeta $sep;
    my @result = grep { /\w+/ }  
        map { split $sep, $_ } @strings;
    return @result;
}

my @tests = ( [ '.', ["one.two.three","four.five","six"] ],
              [ '$', ['$perl$$', '$$raku$'] ] );
for my $test (@tests) {
    printf "%-30s => ",  "@{$test->[1]}";
    say join " ", split_strings $test->[0], @{$test->[1]};
}

This program displays the following output:

$ perl ./split-strings.pl
one.two.three four.five six    => one two three four five six
$perl$$ $$raku$                => perl raku

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

These are some answers to the Week 252, 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 January 21, 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: Unique Sum Zero

You are given an integer, $n.

Write a script to find an array containing $n unique integers such that they add up to zero.

Example 1

Input: $n = 5
Output: (-7, -1, 1, 3, 4)

Two other possible solutions could be as below:
(-5, -1, 1, 2, 3) and (-3, -1, 2, -2, 4).

Example 2

Input: $n = 3
Output: (-1, 0, 1)

Example 3

Input: $n = 1
Output: (0)

Unique Sum Zero in Raku

We just take a number of distinct strictly positive integers equal to the rounded half of the input number and take these numbers and their negative counterpart, so that the sum is always 0. And we add 0 if the input number was odd. For fun, I decided to use the built-in pick method (which generates in our case distinct random integers in the specified range). As you can see in the tests below, this makes it possible to get different solutions in successive runs of the program.

sub zero-sum ($n) {
    my @result;
    for (1..$n*2).pick(($n/2).Int) -> $i {
        append @result, ($i, -$i);
    }
    append @result, 0 unless $n %% 2;
    return @result;
}
for 3, 4, 5, 1 -> $test {
    say "$test => ", zero-sum $test;
}

This program displays the following output (two successive runs):

$ raku ./zero-sum.raku
3 => [3 -3 0]
4 => [8 -8 6 -6]
5 => [7 -7 2 -2 0]
1 => [0]

~
$ raku ./zero-sum.raku
3 => [2 -2 0]
4 => [1 -1 5 -5]
5 => [6 -6 1 -1 0]
1 => [0]

Unique Sum Zero in Perl

This is essentially a port to Perl of the Raku program above, except that we don't pick random numbers, but simply consecutive integers. Please refer to the previous section if you need further explanations.

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

sub zero_sum {
    my $n = shift;
    my @result;
    for my $i (1.. int $n/2) {
        push @result, ($i, -$i);
    }
    push @result, 0 if $n % 2;
    return @result;
}
for my $test (3, 4, 5,  1) {
    say "$test => ", join " ", zero_sum $test;
}

This program displays the following output:

$ perl ./zero-sum.pl
3 => 1 -1 0
4 => 1 -1 2 -2
5 => 1 -1 2 -2 0
1 => 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 January 28, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 252, 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 January 21, 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: Special Numbers

You are given an array of integers, @ints.

Write a script to find the sum of the squares of all special elements of the given array.

An element $int[i] of @ints is called special if i divides n, i.e. n % i == 0, where n is the length of the given array. Also the array is 1-indexed for the task.

Example 1

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

There are exactly 3 special elements in the given array:
$ints[1] since 1 divides 4,
$ints[2] since 2 divides 4, and
$ints[4] since 4 divides 4.

Hence, the sum of the squares of all special elements of given array:
1 * 1 + 2 * 2 + 4 * 4 = 21.

Example 2

Input: @ints = (2, 7, 1, 19, 18, 3)
Output: 63

There are exactly 4 special elements in the given array:
$ints[1] since 1 divides 6,
$ints[2] since 2 divides 6,
$ints[3] since 3 divides 6, and
$ints[6] since 6 divides 6.

Hence, the sum of the squares of all special elements of given array:
2 * 2 + 7 * 7 + 1 * 1 + 3 * 3 = 63

Perl has a special variable to make an array 1-indexed instead of 0-indexed, but its use is rather dangerous and somewhat deprecated. I do not think that such feature exists in Raku. Both in Raku and Perl, we'll use 0-indexed arrays and add 1 to the subscript when required.

Special Numbers in Raku

We'll loop over the indexes and add the square of the value to an accumulator variable ($sq-sum) when the index (plus 1) evenly divides n, i.e. the number of items in the input array.

sub special-numbers (@in) {
    my $n = @in.elems;
    my $sq-sum = 0;
    for 0..@in.end -> $i {
        $sq-sum += @in[$i]² if $n %% ($i+1);
    }
    return $sq-sum;
}

for <1 2 3 4>, <2 7 1 19 18 3> -> @test {
    printf "%-15s => ", "@test[]";
    say special-numbers @test;
}

This program displays the following output:

$ raku ./spec-nums.raku
1 2 3 4         => 21
2 7 1 19 18 3   => 63

Special Numbers in Perl

This is a port to Perl of the above Raku program. Please loop at the previous section if you need further explanations.

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

sub special_numbers {
    my @in = @_;
    my $n = scalar @in;
    my $sq_sum = 0;
    for my $i (0..$#in) {
        $sq_sum += $in[$i] ** 2 unless $n % ($i+1);
    }
    return $sq_sum;
}

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

This program displays the following output:

$ perl ./spec-nums.pl
1 2 3 4         => 21
2 7 1 19 18 3   => 63

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

These are some answers to the Week 251, 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 January 14, 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: Lucky Number

You are given a m x n matrix of distinct numbers.

Write a script to return the lucky number, if there is one, or -1 if not.

A lucky number is an element of the matrix such that it is the minimum element in its row and maximum in its column.

Example 1

Input: $matrix = [ [ 3,  7,  8],
                   [ 9, 11, 13],
                   [15, 16, 17] ];
Output: 15

15 is the only lucky number since it is the minimum in its row and the maximum in its column.

Example 2

Input: $matrix = [ [ 1, 10,  4,  2],
                   [ 9,  3,  8,  7],
                   [15, 16, 17, 12] ];
Output: 12

Example 3

Input: $matrix = [ [7 ,8],
                   [1 ,2] ];
Output: 7

An important point here is that the input matrix may contain only distinct numbers. This means that we may always find one and only one minimum item in the rows and one maximum item in the columns. So we don't have to worry about having several minimum (or maximum) values.

If the input matrix may contain negative numbers, there is a possibility that - 1 is the lucky number for that matrix. When we receive - 1 as a return value, we may not be able to know whether this value is the lucky number for that matrix, or whether the subroutine has returned that value because it wasn't able to find a lucky number. To avoid that problem, we will add to the specification that the matrix may contain only distinct positive integers.

Lucky Number in Raku

The idea is to iterate over the rows of the input matrix and, for each row, to find the index of the minimum value, using the built-in min function. Note that, as of the 2023.08 Rakudo compiler release, it is possible to use the :k named argument to get directly the index of minimum value. But I can't use this here, since my version of Rakudo is only v2023.06. So, instead, I used a callable argument introduced by the :by named argument. Once the index of the minimum value of a row, we check whether it is the maximum value of its column. If so, we return that value. And we return -1 at the end if we were not able to find a lucky number.

sub lucky-number (@in) {
    ROW-LABEL:
    for 0..@in.end -> $row {
        my $min_i = min(0..@in[$row].end, :by( {@in[$row][$_] }));
        my $min_val = @in[$row][$min_i];
        for 0..@in.end -> $i {
            next ROW-LABEL if @in[$i][$min_i] > $min_val;
        }
        return $min_val;
    }
    return -1
}


for ( <3 7 8>, <9 11 13>, <15 16 17>),
    ( <1 10 4 2>, <9 3 8 7>, <15 16 17 12>),
    ( <7 8>, <1 2> ) -> @test {

    printf "%-40s => ", @test.gist;
    say lucky-number @test;
}

This program displays the following output:

$ raku ./lucky-number.raku
((3 7 8) (9 11 13) (15 16 17))           => 15
((1 10 4 2) (9 3 8 7) (15 16 17 12))     => 12
((7 8) (1 2))                            => 7

Lucky Number in Perl

This is a port to Perl of the above Raku program, except that dealing with nested arrays tends to be slightly more complicated in Perl because we have to deal with array references everywhere. The method to find the lucky number is the same, so you can check the explanations in the section above if needed. An additional change is that we had to write our own min subroutine to find the index of the minimum value in a given input list or array.

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

sub min {
    my @in = @_;
    my $min = $in[0];
    my $min_i = 0;
    for my $i (0..$#in) {
        if ($in[$i] < $min) {
            $min_i = $i;
            $min = $in[$i];
        }
    }
    return $min_i;
}

sub lucky_number {
    my @in = @_;
    ROW_LABEL:
    for my $row (0..$#in) {
        my $min_i = min @{$in[$row]};
        my $min_val = $in[$row][$min_i];
        for my $i (0..$#in) {
            next ROW_LABEL if $in[$i][$min_i] > $min_val;
        }
        return $min_val;
    }
    return -1
}

for my $test ( [ [<3 7 8>], [<9 11 13>], [<15 16 17>] ],
      [ [<1 10 4 2>], [<9 3 8 7>], [<15 16 17 12>] ],
      [ [<7 8>], [<1 2>] ]) {

    my @gist = map { " [@$_]" } @$test;
    printf "%-40s => ", "@gist ";
    say lucky_number @$test;
}

This program displays the following output:

$ perl  ./lucky-number.pl
 [3 7 8]  [9 11 13]  [15 16 17]          => 15
 [1 10 4 2]  [9 3 8 7]  [15 16 17 12]    => 12
 [7 8]  [1 2]                            => 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 January 21, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 251, 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 January 14, 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: Concatenation Value

You are given an array of integers, @ints.

Write a script to find the concatenation value of the given array.

The concatenation of two numbers is the number formed by concatenating their numerals.

For example, the concatenation of 10, 21 is 1021.
The concatenation value of @ints is initially equal to 0.
Perform this operation until @ints becomes empty:

If there exists more than one number in @ints, pick the first element
and last element in @ints respectively and add the value of their
concatenation to the concatenation value of @ints, then delete the
first and last element from @ints.

If one element exists, add its value to the concatenation value of
@ints, then delete it.

Example 1

Input: @ints = (6, 12, 25, 1)
Output: 1286

1st operation: concatenation of 6 and 1 is 61
2nd operation: concaternation of 12 and 25 is 1225

Concatenation Value => 61 + 1225 => 1286

Example 2

Input: @ints = (10, 7, 31, 5, 2, 2)
Output: 489

1st operation: concatenation of 10 and 2 is 102
2nd operation: concatenation of 7 and 2 is 72
3rd operation: concatenation of 31 and 5 is 315

Concatenation Value => 102 + 72 + 315 => 489

Example 3

Input: @ints = (1, 2, 10)
Output: 112

1st operation: concatenation of 1 and 10 is 110
2nd operation: only element left is 2

Concatenation Value => 110 + 2 => 112

Concatenation Value in Raku

So long as there are 2 or more items in the input array, we remove from the array and retrieve the first and last item (with the shift and pop methods), concatenate their values, and add the result to the $concat accumulator. At the end, we add the last item (if any) to the accumulator.

sub concat-vals (@in is copy) {
    my $concat;
    while @in.elems > 1 {
        $concat += @in.shift ~ @in.pop;
    }
    $concat += shift @in if @in.elems > 0; # last item if any
    return $concat;
}        

for <6 12 25 1>, <10 7 31 5 2 2>, <1 2 10> -> @test {
    printf "%-15s => ", "@test[]";
    say concat-vals @test;
}

This program displays the following output:

$ raku ./concat-values.raku
6 12 25 1       => 1286
10 7 31 5 2 2   => 489
1 2 10          => 112

Concatenation Value in Raku

This is a port to Perl of the above Raku program. Please refer to the previous section if you need any explanations.

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

sub concat_vals {
    my @in = @_;
    my $concat;
    while (@in > 1) {
        $concat += (shift @in) . (pop @in);
    }
    $concat += shift @in if @in > 0; # if we have 1 item left
    return $concat;
}        

for my $test ([<6 12 25 1>], [<10 7 31 5 2 2>], [<1 2 10>]) {
    printf "%-15s => ", "@$test";
    say concat_vals @$test;
}

This program displays the following output:

$ perl ./concat-values.pl
6 12 25 1       => 1286
10 7 31 5 2 2   => 489
1 2 10          => 112

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

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

Task 1: Alphanumeric String Value

You are given an array of alphanumeric strings.

Write a script to return the maximum value of alphanumeric string in the given array.

The value of alphanumeric string can be defined as

a) The numeric representation of the string in base 10 if it is made up of digits only. b) otherwise the length of the string

Example 1

Input: @alphanumstr = ("perl", "2", "000", "python", "r4ku")
Output: 6

"perl" consists of letters only so the value is 4.
"2" is digits only so the value is 2.
"000" is digits only so the value is 0.
"python" consits of letters so the value is 6.
"r4ku" consists of letters and digits so the value is 4.

Example 2

Input: @alphanumstr = ("001", "1", "000", "0001")
Output: 1

Alphanumeric String Value in Raku

We transform in input array into an array of numerical values where strings containing digits only are transformed into their numerical values, and other strings replaced by their length, and finally return the maximum value.

sub alphanum-string (@in) {
    my @out = map {  /^\d+$/ ?? 0 + $_ !! $_.chars }, @in;
    return max @out;
}

for ( "perl", "2", "000", "python", "r4ku"),  
    ("001", "1", "000", "0001") -> @test {
    say alphanum-string @test;
}

This program displays the following output:

$ raku ./alphanum-string.raku
6
1

Alphanumeric String Value in Perl

This is a port to Perl of the above Raku program. Please refer to the previous section if you need any explanations.

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

sub alphanum_string {
    my @out = map {  /^\d+$/ ? 0 + $_ : length $_ } @_;
    return (sort { $a <=> $b } @out)[-1];
}

for my $test ( ["perl", "2", "000", "python", "r4ku"],
    ["001", "1", "000", "0001"]) {
    say alphanum_string @$test;
}

This program displays the following output:

$ perl ./alphanum-string.pl
6
1

Wrapping up

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

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

Task 1: Smallest Index

You are given an array of integers, @ints.

Write a script to find the smallest index i such that i mod 10 == $ints[i] otherwise return -1.

Example 1

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

i=0: 0 mod 10 = 0 == $ints[0].
i=1: 1 mod 10 = 1 == $ints[1].
i=2: 2 mod 10 = 2 == $ints[2].
All indices have i mod 10 == $ints[i], so we return the smallest index 0.

Example 2

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

i=0: 0 mod 10 = 0 != $ints[0].
i=1: 1 mod 10 = 1 != $ints[1].
i=2: 2 mod 10 = 2 == $ints[2].
i=3: 3 mod 10 = 3 != $ints[3].
2 is the only index which has i mod 10 == $ints[i].

Example 3

Input: @ints = (1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
Output: -1
Explanation: No index satisfies i mod 10 == $ints[i].

Smallest Index in Raku

We'll simply use a for loop to iterate over the input array indexes. We exit the loop and return the current index if suitable. We return -1 if we get to the end of the loop.

sub smallest_index (@in) {
    for 0..@in.end -> $i {
        return $i if $i % 10 == @in[$i];
    }
    return -1
}

for (0, 1, 2), (4, 3, 2, 1), 
    qw/1 2 3 4 5 6 7 8 9 0/ -> @test {
    printf "%-20s => ", "@test[]";
    say smallest_index @test;
}

This program displays the following output:

$ raku ./smallest-index.raku
0 1 2                => 0
4 3 2 1              => 2
1 2 3 4 5 6 7 8 9 0  => -1

Smallest Index in Perl

This is a port to Perl of the above Raku program. Please refer to the previous section if you need any explanations.

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

sub smallest_index {
    my @in = @_;
    for my $i (0..$#in) {
        return $i if $i % 10 == $in[$i];
    }
    return -1
}

for my $test ([0, 1, 2], [4, 3, 2, 1], 
    [qw/1 2 3 4 5 6 7 8 9 0/]) {
    printf "%-20s => ", "@$test";
    say smallest_index @$test;
}

This program displays the following output:

$ perl ./smallest-index.pl
0 1 2                => 0
4 3 2 1              => 2
1 2 3 4 5 6 7 8 9 0  => -1

Wrapping up

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