These are some answers to the Week 271, 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 June 2, 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: Sort by 1 Bits

You are given an array of integers, @ints.

Write a script to sort the integers in ascending order by the number of 1 bits in their binary representation. In case more than one integers have the same number of 1 bits then sort them in ascending order.

Example 1

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

0 = 0 one bits
1 = 1 one bits
2 = 1 one bits
4 = 1 one bits
8 = 1 one bits
3 = 2 one bits
5 = 2 one bits
6 = 2 one bits
7 = 3 one bits

Example 2

Input: @ints = (1024, 512, 256, 128, 64)
Output: (64, 128, 256, 512, 1024)

All integers in the given array have one 1-bits, so just sort them in ascending order.

Sort by 1 Bits in Raku

We first build an auxiliary bit weight subroutine (bit-w), which returns the number of 1's in the binary representation of the input integer. This is done by converting the input integer into its binary representation, using the base routine, splitting this binary representation into individual digits, and computing the sum of these digits.

We then simply sort the input array by bit weight or by value when the bit weights are equal.

sub bit-w($in) {
    # bit weight function: returns number of 1s in the
    # binary representation of the input integer
    return [+] $in.base(2).comb;
}
sub bit-sort (@test) {
    sort { bit-w($^a) cmp bit-w($^b) or $^a cmp $^b }, @test;
}

my @tests = (0, 1, 2, 3, 4, 5, 6, 7, 8), 
            (1024, 512, 256, 128, 64),
            (7, 23, 512, 256, 128, 64);
for @tests -> @test {
    printf "%-20s => ", "@test[]";
    say bit-sort @test;
}

This program displays the following output:

$ raku ./sort-1-bit.raku
0 1 2 3 4 5 6 7 8    => (0 1 2 4 8 3 5 6 7)
1024 512 256 128 64  => (64 128 256 512 1024)
7 23 512 256 128 64  => (64 128 256 512 7 23)

Note that the two subroutines each have only one code line. In fact, the implementation is so simple that we could compact it into a Raku one-liner (shown here over three lines for blog post formatting reasons):

$ raku -e 'my @in = say sort { [+] $^a.Int.base(2).comb
    cmp [+] $^b.Int.base(2).comb or $^a cmp $^b }, 
    @*ARGS'  0 1 2 3 4 5 6 7 8
(0 1 8 4 2 3 5 6 7)

But I would think that the original version with two subroutines is probably clearer.

Sort by 1 Bits in Perl

This is a port to Perl of the above Raku program. The only significant change is the use of a loop to compute the sum of the digits of the binary representation of the input integer.

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

sub bit_w {
    # bit weight function: returns number of 1s in the
    # binary representation of the input integer
    my $out = 0;
    $out += $_ for split //, sprintf "%b", shift;
    return $out;
}
sub bit_sort {
    sort { bit_w($a) <=> bit_w($b) or $a <=> $b } @_;
}

my @tests = ( [0, 1, 2, 3, 4, 5, 6, 7, 8], 
              [1024, 512, 256, 128, 64],
              [7, 23, 512, 256, 128, 64] );
for my $test (@tests) {
    printf "%-20s => ", "@$test";
    say join " ", bit_sort @$test;
}

This program displays the following output:

$ perl ./sort-1-bit.pl
0 1 2 3 4 5 6 7 8    => 0 1 2 4 8 3 5 6 7
1024 512 256 128 64  => 64 128 256 512 1024
7 23 512 256 128 64  => 64 128 256 512 7 23

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

These are some answers to the Week 271, 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 June 2, 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 Ones

You are given a m x n binary matrix.

Write a script to return the row number containing maximum ones, in case of more than one rows then return smallest row number.

Example 1

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

Row 1 and Row 2 have the same number of ones, so return row 1.

Example 2

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

Row 2 has the maximum ones, so return row 2.

Example 3

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

Row 2 have the maximum ones, so return row 2.

Note that, in Perl, Raku, and most programming languages, array subscripts start at 0, so that the first row of a matrix would have index 0. Here, the task specification uses common sense row ranks rather than traditional array subscripts. So we will have to add one to the index found to return a common sense row rank.

Maximum Ones in Raku

Since input is a binary matrix, i.e. populated only with 0 and 1, to find the number of ones in a row, we can simply add the items of the row, which we can do with the sum method. We just need to iterate over the matrix rows and keep track of the index of the row with the largest sum.

sub maximum-ones (@mat) {
    my $max = 0; 
    my $max-i;
    for 0..@mat.end -> $i {
        my $sum = @mat[$i].sum;
        if $sum > $max {
            $max = $sum;
            $max-i = $i;
        }
    }
    return $max-i + 1;
}

my @tests = [ [0, 1], [1, 0] ],
            [ [0, 0, 0], [1, 0, 1] ],
            [ [0, 0], [1, 1], [0, 0] ];
for @tests -> @test {
    printf "%-20s => ", @test.gist;
    say maximum-ones @test;
}

This program displays the following output:

$ raku ./maximum-ones.raku
[[0 1] [1 0]]        => 1
[[0 0 0] [1 0 1]]    => 2
[[0 0] [1 1] [0 0]]  => 2

Maximum Ones in Perl

This is a port to Perl of the above Raku program. We iterate over the matrix rows, compute the sum of the row items, and keep track of the index of the row with the largest sum.

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

sub maximum_ones {
    my @mat = @_;
    my $max = 0; 
    my $max_i;
    for my $i (0..$#mat) {
        my $sum = 0;
        $sum += $_ for @{$mat[$i]};
        if ($sum > $max) {
            $max = $sum;
            $max_i = $i;
        }
    }
    return $max_i + 1;
}

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

This program displays the following output:

$ perl ./maximum-ones.pl
[0 1]   , [1 0]   , ... => 1
[0 0 0] , [1 0 1] , ... => 2
[0 0]   , [1 1]   , ... => 2`

Note that we display only the first two rows of each input test matrix.

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

These are some answers to the Week 270, 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 May 26, 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 Positions

You are given a m x n binary matrix.

Write a script to return the number of special positions in the given binary matrix.

A position (i, j) is called special if $matrix[i][j] == 1 and all other elements in the row i and column j are 0.

Example 1

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

There is only one special position (1, 2) as $matrix[1][2] == 1
and all other elements in row 1 and column 2 are 0.

Example 2

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

Special positions are (0,0), (1, 1) and (2,2).

Special Positions in Raku

We use an array slice (with the any junction) to check rows and standard for loop to check columns.

sub special-positions (@mat) {
    my $row-max = @mat[0].end;
    my $count = 0;
    IND_I: for 0..$row-max -> $i {
        for 0..@mat.end -> $j {                            `
            next if @mat[$i][$j] != 1;
            next unless 
                (@mat[$i][0..^$j, $j^..$row-max]).any != 0;
            for 0..@mat.end -> $k {
                next if $k == $i;
                next IND_I unless @mat[$i][$k] == 0;
            }
            # say "$i, $j"; # uncomment to see the positions
            $count++;
        }
    }
    return $count;
}

my @tests = 
        [ [1, 0, 0],
          [0, 0, 1],
          [1, 0, 0],
        ],
        [ [1, 0, 0],
          [0, 1, 0],
          [0, 0, 1],
        ];
for @tests -> @test {
    printf "%-8s %-8s ... => ", "@test[0]", "@test[1]";
    say special-positions @test;
}

This program displays the following output:

$ raku ./special-positions.raku
1 0 0    0 0 1    ... => 1
1 0 0    0 1 0    ... => 3

Special Positions in Perl

This is a port to Perl of the above Raku program. Since Perl doesn't have any junction, we had to replace it with a for loop.

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

sub special_positions {
    my $mat = shift;
    my $row_max = $#{$mat->[0]};
    my $col_max =  $#{$mat};
    my $count = 0;
    for my $i (0..$row_max) {
    IND_J: for my $j (0..$col_max) {
            next if $mat->[$i][$j] != 1;
            # check row
            for my $m (0..$row_max) {
                next if $m == $i;
                next IND_J unless $mat->[$m][$j] == 0;
            }
            # check column
            for my $k (0..$col_max) {
                next if $k == $j;
                next IND_J unless $mat->[$i][$k] == 0;
            }
            # say "$i, $j"; # uncomment to see the positions
            $count++;
        }
    }
    return $count;
}

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

his program displays the following output:

$ perl ./special-positions.pl
[1 0 0    0 0 1    ...] => 1
[1 0 0    0 1 0    ...] => 3

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

These are some answers to the Week 269, 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 May 19, 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: Distribute Elements

You are given an array of distinct integers, @ints.

Write a script to distribute the elements as described below:

1) Put the 1st element of the given array to a new array @arr1. 2) Put the 2nd element of the given array to a new array @arr2.

Once you have one element in each arrays, @arr1 and @arr2, then follow the rule below:

If the last element of the array @arr1 is greater than the last element of the array @arr2 then add the first element of the given array to @arr1 otherwise to the array @arr2.

When done distribution, return the concatenated arrays. @arr1 and @arr2.

Example 1

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

1st operation:
Add 1 to @arr1 = (2)

2nd operation:
Add 2 to @arr2 = (1)

3rd operation:
Now the last element of @arr1 is greater than the last element
of @arr2, add 3 to @arr1 = (2, 3).

4th operation:
Again the last element of @arr1 is greate than the last element
of @arr2, add 4 to @arr1 = (2, 3, 4)

5th operation:
Finally, the last element of @arr1 is again greater than the last
element of @arr2, add 5 to @arr1 = (2, 3, 4, 5)

Now we have two arrays:
@arr1 = (2, 3, 4, 5)
@arr2 = (1)

Concatenate the two arrays and return the final array: (2, 3, 4, 5, 1).

Example 2

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

1st operation:
Add 1 to @arr1 = (3)

2nd operation:
Add 2 to @arr2 = (2)

3rd operation:
Now the last element of @arr1 is greater than the last element
of @arr2, add 4 to @arr1 = (3, 4).

Now we have two arrays:
@arr1 = (3, 4)
@arr2 = (2)

Concatenate the two arrays and return the final array: (3, 4, 2).

Example 3

Input: @ints = (5, 4, 3 ,8)
Output: (5, 3, 4, 8)

1st operation:
Add 1 to @arr1 = (5)

2nd operation:
Add 2 to @arr2 = (4)

3rd operation:
Now the last element of @arr1 is greater than the last element
of @arr2, add 3 to @arr1 = (5, 3).

4th operation:
Again the last element of @arr2 is greate than the last element
of @arr1, add 8 to @arr2 = (4, 8)

Now we have two arrays:
@arr1 = (5, 3)
@arr2 = (4, 8)

Concatenate the two arrays and return the final array: (5, 3, 4, 8).

Distribute Elements in Raku

We can hardly do anything else than just follow the procedure described in the task specification.

sub distribute-elements (@in is copy) {
    my @arr1 = shift @in;
    my @arr2 = shift @in;
    for @in -> $item {
        if @arr1[*-1] > @arr2[*-1] {
            push @arr1, $item;
        } else {
            push @arr2, $item;
        }
    }
    return (@arr1, @arr2).flat;
}
my @tests = <2 1 3 4 5>, <3 2 4>, <5 4 3 8>;
for @tests -> @test {
    printf "%-10s => ", "@test[]";
    say distribute-elements @test;
}

This program displays the following output:

$ raku ./distribute-elements.raku
2 1 3 4 5  => (2 3 4 5 1)
3 2 4      => (3 4 2)
5 4 3 8    => (5 3 4 8)

Distribute Elements in Perl

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

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

sub distribute_elements {
    my @arr1 = shift;
    my @arr2 = shift;
    for my $item (@_) {
        if ($arr1[-1] > $arr2[-1]) {
            push @arr1, $item;
        } else {
            push @arr2, $item;
        }
    }
    return "@arr1 @arr2";
}
my @tests = ( [<2 1 3 4 5>], [<3 2 4>], [<5 4 3 8>] );
for my $test (@tests) {
    printf "%-10s => ", "@$test";
    say distribute_elements @$test;
}

This program displays the following output:

$ perl ./distribute-elements.pl
2 1 3 4 5  => 2 3 4 5 1
3 2 4      => 3 4 2
5 4 3 8    => 5 3 4 8

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

These are some answers to the Week 269, 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 May 19, 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: Bitwise OR

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

Write a script to find out if it is possible to select two or more elements of the given array such that the bitwise OR of the selected elements has at least one trailing zero in its binary representation.

Example 1

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

Say, we pick 2 and 4, their bitwise OR is 6. The binary representation of 6 is 110.
Return true since we have one trailing zero.

Example 2

Input: @ints = (2, 3, 8, 16)
Output: true

Say, we pick 2 and 8, their bitwise OR is 10. The binary representation of 10 is 1010.
Return true since we have one trailing zero.

Example 3

Input: @ints = (1, 2, 5, 7, 9)
Output: false

First, we should state that the binary representation of an integer has a trailing zero if (and only if) it is an even number. Second, we should notice that a bitwise OR between two integers will yield an even number only if both numbers are even: if any of the two integers is odd (binary representation with a trailing 1), then the bitwise OR between them will also have a trailing 1 (and it will be odd).

To illustrate this, the following small Raku program performs a bitwise OR between all combinations of integers between 0 and 8:

say "\t", join " ", 0..8;
for 0..8 -> $i {
    say "$i\t", join " ", map { $i +| $_}, 0..8;
}

This program displays the following output:

        0 1 2 3 4 5 6 7 8
0       0 1 2 3 4 5 6 7 8
1       1 1 3 3 5 5 7 7 9
2       2 3 2 3 6 7 6 7 10
3       3 3 3 3 7 7 7 7 11
4       4 5 6 7 4 5 6 7 12
5       5 5 7 7 5 5 7 7 13
6       6 7 6 7 6 7 6 7 14
7       7 7 7 7 7 7 7 7 15
8       8 9 10 11 12 13 14 15 8

In other words, it will be "possible to select two or more elements of the given array such that the bitwise OR of the selected elements has least one trailing zero in its binary representation" if and only if there are at least two even integers in the input list. So, all we need to do is to count the number of even integers in the input list.

Bitwise OR in Raku

Based on the explanations above, we simply count the number of even numbers and return True if this count is two or more (and False otherwise).

sub bitwise-or (@in) {
    my @evens = grep { $_ %% 2 }, @in;
    return @evens.elems >= 2 ?? True !! False;
}

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

This program displays the following output:

$ raku ./bitwise-or.raku
1 2 3 4 5    => True
2 3 8 16     => True
1 2 5 7 9    => False

Bitwise OR in Perl

Based on the explanations above, we simply count the number of even numbers and return "True" if this count is two or more (and "False" otherwise).

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

sub bitwise_or {
    my @evens = grep { $_ % 2 == 0} @_;
    return scalar @evens >= 2 ? "True" : "False";
}

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

This program displays the following output:

$ perl  ./bitwise-or.pl
1 2 3 4 5    => True
2 3 8 16     => True
1 2 5 7 9    => 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 May 26, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 268, 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 May 12, 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: Number Game

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

Write a script to create a new array made up of elements of the given array. Pick the two smallest integers and add it to new array in decreasing order i.e. high to low. Keep doing until the given array is empty.

Example 1

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

Round 1: we picked (2, 3) and push it to the new array (3, 2)
Round 2: we picked the remaining (4, 5) and push it to the new array (5, 4)

Example 2

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

Example 3

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

Number Game in Raku

In Raku, a for loop using a pointy block syntax can use two (or more) parameters, as shown with three block parameters in the Raku REPL example below:

> for 1..9 -> $a, $b, $c { say "$a, $b and $c" }
1, 2 and 3
4, 5 and 6
7, 8 and 9

We use this feature to pick up and reverse two items at a time of the input array:

sub number-game (@in) {
    my @result;
    for @in.sort -> $i, $j {
        push @result, $j, $i;
    }
    return @result;
}

my @tests = <2 5 3 4>, <1 1 4 3 6 4 9 6>, <1 2 2 3>;
for @tests -> @test {
    printf "%-16s => ", "@test[]";
    say number-game @test;
}

This program displays the following output:

$ raku ./number-game.raku
2 5 3 4          => [3 2 5 4]
1 1 4 3 6 4 9 6  => [1 1 4 3 6 4 9 6]
1 2 2 3          => [2 1 3 2]

Number Game in Perl

Perl doesn't have the Raku syntax with several parameters, but we can easily simulate it with two shift statements, as shown in the code below:

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

sub number_game {
    my @in = sort { $a <=> $b } @_;
    my @result;
    while (@in) {
        my $i = shift @in;
        my $j = shift @in;
        push @result, $j, $i;
    }

    return join " ", @result;
}

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

Note that this code could be made significantly shorter using a splice statement:

sub number_game {
    my @in = sort { $a <=> $b } @_;
    my @result;
    push @result, reverse splice @in, 0, 2 while @in;
    return join " ", @result;
}

This program displays the following output (both versions):

$ perl ./number-game.pl
2 5 3 4          => 3 2 5 4
1 1 4 3 6 4 9 6  => 1 1 4 3 6 4 9 6
1 2 2 3          => 2 1 3 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 May 19, 2024. And, please, also spread the word about the Perl Weekly Challenge if you can.

These are some answers to the Week 268, 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 May 12, 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: Magic Number

You are given two arrays of integers of same size, @x and @y.

Write a script to find the magic number that when added to each elements of one the array gives the second array. Elements order is not important.

Example 1

Input: @x = (3, 7, 5)``
       @y = (9, 5, 7)
Output: 2

The magic number is 2.
@x = (3, 7, 5)
   +  2  2  2
@y = (5, 9, 7)

Example 2

Input: @x = (1, 2, 1)
       @y = (5, 4, 4)
Output: 3

The magic number is 3.
@x = (1, 2, 1)
   +  3  3  3
@y = (5, 4, 4)

Example 3

Input: @x = (2)
       @y = (5)
Output: 3

We should first notice that it is possible that there is no solution. In fact, with random input, the probability is high that there will be no solution, and I believe we should consider this case. In both my implementations (Raku and Perl) below, I have added one such case to the examples provided with the task.

Magic Number in Raku

The task specifies that elements order is not important. But any solution will rely on the order being the same, either ascending or descending (or some other custom order). So we will sort the input arrays and compare the items pairwise.

In the following Raku implementation, we sort the items and build an array (@gaps) of the pairwise differences between the sorted items. We have a solution if all the pairwise differences are equal, which we find out using the [==] reduction meta-operator.

sub magic-nr (@x, @y) {
    my @in1 = @x.sort;                                                                                 `
    my @in2 = @y.sort;                                                ]                                              `
    my @gaps = map {@in1[$_] - @in2[$_]}, 0..@x.end;
    return Nil unless [==] @gaps;
    return @gaps[0].abs;
}

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

This program displays the following output:

$ raku ./magic-numbers.raku
3 7 5  - 9 5 7  => 2
1 2 1  - 5 4 4  => 3
2      - 5      => 3
3 7 5  - 6 5 7  => Nil

Magic Number in Perl

Our Perl implementation will be slightly different and, we hope, slightly more efficient in some failure cases: we don't need to compute and compare all items, we can stop the iteration as soon as we find a mismatch.

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

sub magic_nr  {
    my @in1 = sort {$a<=>$b} @{$_[0]};
    my @in2 = sort {$a<=>$b} @{$_[1]};
    my $gap = $in1[0] - $in2[0];
    for my $i (1..$#in1) {
        return "undef" if $in1[$i] - $in2[$i] != $gap;
    }
    return abs $gap;
}

my @tests = ([[<3 7 5>], [<9 5 7>]], [[<1 2 1>], [<5 4 4>]],
             [[2,], [5]], [[<3 7 5>], [<6 5 7>]] );

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

This program displays the following output:

$ perl ./magic-numbers.pl
3 7 5  - 9 5 7  => 2
1 2 1  - 5 4 4  => 3
2      - 5      => 3
3 7 5  - 6 5 7  => undef

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

These are some answers to the Week 267, 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 May 5, 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: Line Count

You are given a string, $str, and a 26-items array @widths containing the width of each character from a to z.

Write a script to find out the number of lines and the width of the last line needed to display the given string, assuming you can only fit 100 width units on a line.

Example 1

Input: $str = "abcdefghijklmnopqrstuvwxyz"
       @widths = (10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10)
Output: (3, 60)

Line 1: abcdefghij (100 pixels)
Line 2: klmnopqrst (100 pixels)
Line 3: uvwxyz (60 pixels)

Example 2

Input: $str = "bbbcccdddaaa"
       @widths = (4,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10)
Output: (2, 4)

Line 1: bbbcccdddaa (98 pixels)
Line 2: a (4 pixels)

Line Count in Raku

The first step is to build a hash, %widths, mapping each letter of the alphabet to its width. Then, we iterate over the letters of the input string: we keep adding letters to the current line so long as the line is not more than 100, or we start a new line.

sub line-count(@in_widths, $in_str) {
    my $i = 0;
    my %widths;
    for 'a'..'z' -> $let {
        %widths{$let} = @in_widths[$i++];
    }
    my $line-count = 1;
    my $line-width = 0;
    for $in_str.comb -> $let {
        my $tmp = $line-width + %widths{$let};
        if $tmp <= 100 {
            $line-width = $tmp;
        } else {
            $line-count++;
            $line-width = %widths{$let};
        }
    }
    return "($line-count, $line-width)";
}            

my @tests = (10 xx 26, "abcdefghijklmnopqrstuvwxyz"),
            ([4,10,10,10,10,10,10,10,10,10,10,10,10,10,10,
            10,10,10,10,10,10,10,10,10,10,10], "bbbcccdddaaa"); 

for @tests -> @test {
    printf "%-28s => ", @test[1];
    say line-count @test[0], @test[1];
}

This program displays the following output:

$ raku ./line-count.raku
abcdefghijklmnopqrstuvwxyz   => (3, 60)
bbbcccdddaaa                 => (2, 4)

Line Count in Perl

This is a port to Perl of the above Raku program. We first build a hash to map letters to their width, and then iterate over the letters of the input string to fill lines with length not more than 100.

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

sub line_count {
    my @in_widths = @{$_[0]};
    my $in_str = $_[1];
    my $i = 0;
    my %widths;
    for my $let ('a'..'z') {
        $widths{$let} = $in_widths[$i++];
    }
    my $line_count = 1;
    my $line_width = 0;
    for my $let (split //, $in_str) {
        my $tmp = $line_width + $widths{$let};
        if ($tmp <= 100) {
            $line_width = $tmp;
        } else {
            $line_count++;
            $line_width = $widths{$let};
        }
    }
    return "($line_count, $line_width)";
}            

my @tests = ( [[10,10,10,10,10,10,10,10,10,10,10,10,10,10,
                10,10,10,10,10,10,10,10,10,10,10,10], 
                "abcdefghijklmnopqrstuvwxyz"],
              [[4,10,10,10,10,10,10,10,10,10,10,10,10,10,
                10,10,10,10,10,10,10,10,10,10,10,10], 
                "bbbcccdddaaa"]); 

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

This program displays the following output:

$ perl ./line_count.pl
abcdefghijklmnopqrstuvwxyz   => (3, 60)
bbbcccdddaaa                 => (2, 4)

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

These are some answers to the Week 267, 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 May 5, 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: Product Sign

You are given an array of @ints.

Write a script to find the sign of product of all integers in the given array. The sign is 1 if the product is positive, -1 if the product is negative and 0 if product is zero.

Example 1

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

The product -1 x -2 x -3 x -4 x 3 x 2 x 1 => 144 > 0

Example 2

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

The product 1 x 2 x 0 x -2 x -1 => 0

Example 3

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

The product -1 x -1 x 1 x -1 x 2 => -2 < 0

Product Sign in Raku

We can simply compute the product of all the integers in the input array. For this, the canonical way in Raku would be to use the [*] reduction operator. Once we have computed the product, we can use the ?? .. !! ternary conditional operator to output 1, 0, or -1, depending on the sign of the product. This is simple enough to be done in a Raku one-liner:

$ raku -e 'my $p = [*] @*ARGS; say $p > 0 ?? 1 !! $p == 0 ?? 0 !! -1;' 2 4 3 6
1

$ raku -e 'my $p = [*] @*ARGS; say $p > 0 ?? 1 !! $p == 0 ?? 0 !! -1;' 2 -4 3 6
-1

$ raku -e 'my $p = [*] @*ARGS; say $p > 0 ?? 1 !! $p == 0 ?? 0 !! -1;' 2 -4 3 6 0 -3
0

This can be made even simpler (or, at least, shorter) using the cmp "smart" three-way comparator. Note that, in Raku, cmp is a "smart" comparison operator, that it is compares strings with string semantics and numbers with number semantics. Also note that cmp returns order objects (Same, More, or Less), but these get coerced into 0, 1, or -1, respectively, in numeric context. We use a + to force a numeric context.

$ raku -e 'my $p = [*] @*ARGS; say +($p <=> 0)' 2 -4 3 6
-1

$ raku -e 'my $p = [*] @*ARGS; say +($p <=> 0)' 2 -4 3 6 -6
1

$ raku -e 'my $p = [*] @*ARGS; say +($p <=> 0)' 2 -4 3 6 0 -6
0

This being said, computing the full product when we only need its sign may be a waste of CPU cycles if the integers of the input list are large. We can read the input integers one by one and keep track of the product sign 0, 1, or -1). Here, we use again the cmp "smart" three-way comparator at each iteration through the input list..

sub product-sign (@in) {
    my $result = 1;
    for @in -> $i {
        $result *= $i cmp 0;
    }
    return $result;
}
my @tests = <-1 -2 -3 -4 3 2 1>, <1 2 0 -2 -1>, <-1 -1 1 -1 2>;
for @tests -> @test {
    printf "%-18s => ", "@test[]";
    say product-sign @test;
}

This program displays the following output:

$ raku ./product-sign.raku
-1 -2 -3 -4 3 2 1  => 1
1 2 0 -2 -1        => 0
-1 -1 1 -1 2       => -1

Product Sign in Perl

This is a port to Perl of the above Raku program. Note that we have to use the <=> numeric comparison operator (instead of cmp) to force a numeric comparison semantics.

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

sub product_sign {
    my $result = 1;
    for my $i (@_) {
        $result *= $i <=> 0;
    }
    return $result;
}
my @tests = ( [<-1 -2 -3 -4 3 2 1>], 
              [<1 2 0 -2 -1>], 
              [<-1 -1 1 -1 2>] );
for my $test (@tests) {
    printf "%-18s => ", "@$test";
    say product_sign @$test;
}

This program displays the following output:

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