# April 2023 Archives

## Perl Weekly Challenge 213: Fun Sort

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

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

You are given a list of positive integers.

Write a script to sort the all even integers first then all odds in ascending order.

Example 1

``````Input: @list = (1,2,3,4,5,6)
Output: (2,4,6,1,3,5)
``````

Example 2

``````Input: @list = (1,2)
Output: (2,1)
``````

Example 3

``````Input: @list = (1)
Output: (1)
``````

### Fun Sort in Raku

In theory, this task should ideally use a special comparison subroutine to be used with `sort` that leads to the desired sorting order.

It is, however, simpler to separate even and odd numbers into two lists (for example using `grep`), sort the lists and then reassemble the lists in the proper order.

``````sub fun-sort (@in) {
return (@in.grep({\$_ %% 2}).sort,
@in.grep({\$_ % 2}).sort).flat;
}

for <1 2 3 4 5 6>, <1 2>, (1,),
1..15, (1..15).reverse -> @test {
say fun-sort @test;
}
``````

This program displays the following output:

``````\$ raku ./fun-sort.raku
(2 4 6 1 3 5)
(2 1)
(1)
(2 4 6 8 10 12 14 1 3 5 7 9 11 13 15)
(2 4 6 8 10 12 14 1 3 5 7 9 11 13 15)
``````

For the fun of it, or perhaps for the sake of trying to be pedantic `;-)` , let’s see how we can do the same using a special comparison subroutine. Note that `Less` and `More` (and also `Same`) are special values provided by the Order `enum` and are respectively equal to -1 and 1 (and 0). When the `fun-cmp` subroutine returns `Less` (i.e. -1), then the `sort` routine knows that the first parameter (`\$a` in this case) should be ordered before the second one (`\$b`). Conversely, the first parameter should be ordered after the second one if the comparison subroutine returns `More`. When both parameters are even, or both are odd, we just use the `<=>` numeric comparison operator (which also returns `Less`, `More`, or `Same` to the `sort` function).

``````sub fun-cmp (\$a, \$b) {
if \$a %% 2 {
return \$a <=> \$b if \$b %% 2;
return Less;
} else {
return \$a <=> \$b unless \$b %% 2;
return More;
}
}

for <1 2 3 4 5 6>, <1 2>, (1,),
1..15, (1..15).reverse -> @test {
say sort &fun-cmp, @test;
}
``````

This program displays the following output:

``````\$ raku ./fun-sort2.raku
(2 4 6 1 3 5)
(2 1)
(1)
(2 4 6 8 10 12 14 1 3 5 7 9 11 13 15)
(2 4 6 8 10 12 14 1 3 5 7 9 11 13 15)
``````

### Fun Sort in Perl

This is a port to Perl of the first Raku program above, splitting the input into two lists (even and odd numbers), sorting them separately and reassembling the sorted sub-lists at the end.

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

sub fun_sort {
return (sort { \$a <=> \$b } grep { \$_ % 2 == 0 } @_),
(sort { \$a <=> \$b } grep { \$_ % 2 != 0 } @_);
}

for my \$test ([<1 2 3 4 5 6>], [(1, 2)], [(1)],
[1..15], [reverse (1..15)]) {
say join " ", fun_sort @\$test;
}
``````

This program displays the following output:

``````\$ perl ./fun-sort.pl
2 4 6 1 3 5
2 1
1
2 4 6 8 10 12 14 1 3 5 7 9 11 13 15
2 4 6 8 10 12 14 1 3 5 7 9 11 13 15
``````

Note that we could also first sort the input and then split the result into even and odd numbers and finally rearrange them:

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

sub fun_sort {
my @sorted = sort { \$a <=> \$b } @_;
return (grep { \$_ % 2 == 0 } @sorted),
(grep { \$_ % 2 != 0 } @sorted);
}

for my \$test ([<1 2 3 4 5 6>], [(1, 2)], [(1)],
[1..15], [reverse (1..15)]) {
say join " ", fun_sort @\$test;
}
``````

This program displays the same output as before:

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

Finally, just as in Raku, we can also be pedantic in Perl and write a special comparison subroutine:

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

sub fun_cmp {
if (\$a % 2 == 0) {
return \$a <=> \$b unless \$b % 2;
return -1;
} else {
return \$a <=> \$b if \$b % 2;
return 1;
}
}

for my \$test ([<1 2 3 4 5 6>], [(1, 2)], [(1)],
[1..15], [reverse (1..15)]) {
say join " ", sort { fun_cmp } @\$test;
}
``````

This program displays again the same output:

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

This second task will be handled later, if I find the time.

## Wrapping up

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

## Perl Weekly Challenge 212: Rearrange Groups

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

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

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

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

Example 1

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

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

Example 2

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

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

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

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

Example 1:

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

Example 2:

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

Example 3:

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

Example 4:

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

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

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

### Rearrange Groups in Raku

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

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

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

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

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

This script displays the following output:

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

((1 2 3) 2)
-1

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

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

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

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

### Rearrange Groups in Perl

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

``````use warnings;
use feature "say";

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

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

This script displays the following output:

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

(1 2 3) (2)
-1

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

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

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

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

## Wrapping up

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

## Perl Weekly Challenge 212: Jumping Letters

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

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

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

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

Example 1

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

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

Example 2

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

### Jumping Letters in Raku

The ord routine translates a letter into its ASCII code (well, really, it’s a Unicode code point, but it is equivalent for our purpose here with values less than 128). The chr performs the inverse operation. So we can simply convert each letter of the input, add the relevant jump value and convert the result back to a letter. One little complication is that we need to subtract 26 from the code point if it gets beyond the upper case and lower case letter ranges after having added the jump value.

``````sub jump-letter (\$letter, \$val) {
my \$new_ascii = \$letter.ord + \$val;
return (\$new_ascii - 26).chr if \$new_ascii > 'z'.ord;
return (\$new_ascii - 26).chr if \$letter le 'Z'
and \$new_ascii > 'Z'.ord;
return \$new_ascii.chr;
}
my @test = "Perl", <2 22 19 9>;
for ("Perl", <2 22 19 9>), ("Raku", <24 4 7 17>) -> @test {
printf "%-10s => ", "@test";
for @test.comb Z @test.Array -> \$a {
print jump-letter \$a, \$a;
}
say " ";
}
``````

This script displays the following output:

``````\$ raku ./jumping-letters.raku
Perl       => Raku
Raku       => Perl
``````

### Jumping Letters in Perl

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

``````use strict;
use warnings;
use feature "say";

sub jump_letter  {
my (\$letter, \$val) = @_;
my \$new_ascii = ord(\$letter) + \$val;
return chr(\$new_ascii - 26) if \$new_ascii > ord 'z';
return chr(\$new_ascii - 26) if \$letter le 'Z'
and \$new_ascii > ord 'Z';
return chr \$new_ascii;
}

for my \$test (["Perl", [<2 22 19 9>]], ["Raku", [<24 4 7 17>]]) {
printf "%-10s => ", "\$test->";
my @letters = split //, \$test->;
for my \$i (0..\$#letters) {
print jump_letter \$letters[\$i], \$test->[\$i];
}
say " ";
}
``````

This script displays the following output:

``````\$ perl  ./jumping-letters.pl
Perl       => Raku
Raku       => Perl
``````

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

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

Example 1:

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

Example 2:

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

Example 3:

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

Example 4:

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

First, I think that example 3 above is wrong. I believe that `size` should probably be 3 for the example to make sense.

Update: this error in the task specifications has now been fixed.

Second, even though I started working on this second task (and think I probably have a working solution in Raku), I have no time today to complete this task, and probably won’t have time for several days. I still wanted to make my solutions to task 1 available today. I’ll hopefully write a new blog post or update this one later on.

Update: I have now written a second blog post dated April 13, 2023, providing solutions to this task 2 of the challenge.

## Wrapping up

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

## Perl Weekly Challenge 211: Toeplitz Matrix and Split Same Average

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

You are given a matrix `m x n`.

Write a script to find out if the given matrix is Toeplitz Matrix.

A matrix is Toeplitz if every diagonal from top-left to bottom-right has the same elements.

Example 1

``````Input: @matrix = [ [4, 3, 2, 1],
[5, 4, 3, 2],
[6, 5, 4, 3],
]
Output: true
``````

Example 2

``````Input: @matrix = [ [1, 2, 3],
[3, 2, 1],
]
Output: false
``````

One way to do that is to find if any item of the matrix has the same value as the item immediately above and immediately left. We return `False` for any case where this is not the case, and `True` if we get to the end of the loop.

### Toeplitz Matrix in Raku

The implementation is fairly straight forward:

``````sub is-toeplitz (@in) {
for 1..@in.end -> \$i {
for 1..@in.end -> \$j {
# say "\$i \$j @in[\$i][\$j] @in[\$i-1][\$j-1]";
return False if @in[\$i][\$j] != @in[\$i-1][\$j-1];
}
}
return True;
}

for ( <4 3 2 1>, <5 4 3 2>, <6 5 4 3> ),
( <3 2 1 0>, <4 3 2 1>, <5 4 3 2> ),
( <3 2 1 0>, <4 3 2 1>, <5 5 3 2> ),
( <1 2 3>, <3 2 1> ) -> @test {
say @test;
say is-toeplitz(@test), "\n";
}
``````

This program displays the following output:

``````\$ raku ./toeplitz-matrix.raku
((4 3 2 1) (5 4 3 2) (6 5 4 3))
True

((3 2 1 0) (4 3 2 1) (5 4 3 2))
True

((3 2 1 0) (4 3 2 1) (5 5 3 2))
False

((1 2 3) (3 2 1))
False
``````

### Toeplitz Matrix in Perl

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

``````use strict;
use warnings;
use feature "say";

sub is_toeplitz {
my @in = @_;
my \$j_max = scalar @{\$in} - 1;
for my \$i (1..\$#in) {
for my \$j (1..\$j_max) {
# say "\$i \$j \$in[\$i][\$j] \$in[\$i-1][\$j-1]";
return "false" if \$in[\$i][\$j] != \$in[\$i-1][\$j-1];
}
}
return "true";
}

for my \$test
( [ [<4 3 2 1>], [<5 4 3 2>], [<6 5 4 3>] ],
[ [<3 2 1 0>], [<4 3 2 1>], [<5 4 3 2>] ],
[ [<3 2 1 0>], [<4 3 2 1>], [<5 5 3 2>] ],
[ [<1 2 3>], [<3 2 1>] ] ) {
say "[ ", (join ", ", map "[@\$_]", @\$test), " ]";
say is_toeplitz(@\$test), "\n";
}
``````

This program displays the following output:

``````\$ perl ./toeplitz-matrix.pl
[ [4 3 2 1], [5 4 3 2], [6 5 4 3] ]
true

[ [3 2 1 0], [4 3 2 1], [5 4 3 2] ]
true

[ [3 2 1 0], [4 3 2 1], [5 5 3 2] ]
false

[ [1 2 3], [3 2 1] ]
false
``````

## Task 2: Split Same Average

You are given an array of integers.

Write a script to find out if the given can be split into two separate arrays whose average are the same.

Example 1:

``````Input: @nums = (1, 2, 3, 4, 5, 6, 7, 8)
Output: true

We can split the given array into (1, 4, 5, 8) and (2, 3, 6, 7).
The average of the two arrays are the same i.e. 4.5.
``````

Example 2:

``````Input: @list = (1, 3)
Output: false
``````

Let us notice that each sub-array should have the same average as the full array’s average. So, we simply need to find a sub-array that has the same average, the other sub-array is bound to have the same average.

An additional comment is that there can be several solutions. In the case of the `(1, 2, 3, 4, 5, 6, 7, 8)` array, we find solution not the same as the one in the task specification, i.e. `[(1 2 3 6 7 8) (4 5)]`, but it is also a correct solution to the task, as both arrays have an average of 4.5.

### Split Same Average in Raku

``````sub avg (@a) { return ([+] @a) / @a.elems; }

sub find-partition (@current, @left) {
return if @left.elems <= 1;
# say "Current: ", avg @current if @current.elems > 0;
if @current.elems > 0 and \$*target == avg @current  {
push @*result, @current;
return;
}
for 0..@left.end -> \$i {
find-partition( (@current, @left[\$i]).flat,
(@left[0..\$i-1, \$i+1..@left.end]).flat);
return if @*result.elems > 0;
}
}

sub start-partition (@in) {
my \$*target = avg @in;
my @*result;
my @current;
find-partition @current, @in;
return @*result;
}

for <1 2 3 4 5 6 7 8>, <1 2 3>, <1 3> -> @test {
my @output = start-partition @test;
print @test, " => ";
if @output.elems == 0 {
say "false";
} else {
print "true : ";
push @output, (@test (-) @output).keys;
say @output;
}
}
``````

This program displays the following output:

``````\$ raku  ./split-same-avg.raku
1 2 3 4 5 6 7 8 => true : [(1 2 3 6 7 8) (4 5)]
1 2 3 => true : [(2) (1 3)]
1 3 => false
``````

### Split Same Average in Perl

``````use strict;
use warnings;
use feature "say";

my (\$target, @result);

sub avg {
my \$nb_elems = scalar @_;
my \$sum = shift;
\$sum += \$_ for @_;
return \$sum / \$nb_elems;
}

sub find_partition {
my @current = @{\$_};
my @left = @{\$_};
return if scalar @left <= 1;
if (scalar @current > 0 and \$target == avg(@current)) {
push @result, @current;
return;
}
for my \$i (0..\$#left) {
find_partition( [@current, \$left[\$i]], [@left[0..\$i-1, \$i+1..\$#left]]);
return if @result > 0;
}
}

sub start_partition {
my @in = @_;
\$target = avg @in;
@result = ();
my @current;
find_partition [@current], [@in];
return @result;
}

for my \$test ([<1 2 3 4 5 6 7 8>], [<1 2 3>], [<1 3>]) {
my @output = start_partition @\$test;
print "@\$test => ";
if (scalar @output == 0) {
say "false";
} else {
print "true : [@output] ";
my %out = map { \$_ => 1 } @output;
say "[", join " ", grep { not exists \$out{\$_} } @\$test, "]";
}
}
``````

This program displays the following output:

``````\$ perl ./split-same-avg.pl
1 2 3 4 5 6 7 8 => true : [1 2 3 6 7 8] [4 5 ]
1 2 3 => true :  [1 3 ]
1 3 => 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 April 16, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can.

## Perl Weekly Challenge 210: Kill and Win and Number Collision

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

## Task 1: Kill and Win

You are given a list of integers.

Write a script to get the maximum points. You are allowed to take out (kill) any integer and remove from the list. However if you do that then all integers exactly one-less or one-more would also be removed. Find out the total of integers removed.

Example 1

``````Input: @int = (2, 3, 1)
Output: 6

First we delete 2 and that would also delete 1 and 3. So the maximum points we get is 6.
``````

Example 2

``````Input: @int = (1, 1, 2, 2, 2, 3)
Output: 11

First we delete 2 and that would also delete both the 1's and the 3. Now we have (2, 2).
Then we delete another 2 and followed by the third deletion of 2. So the maximum points we get is 11.
``````

In my understanding of the process, we will always be able to pick a few integers and thereby remove all integers from the list. So, the sum of removed integers is the sum of the input integer.

### Kill and Win in Raku

``````sub sum-deleted-digits (@in) {
# we can always delete all digits
return [+] @in;
}

for <2 3 1>, <1 1 2 2 2 3> -> @test {
say "@test[]".fmt("%-15s => "), sum-deleted-digits @test;
}
``````

This program displays the following output:

``````\$ raku ./kill-and-win.raku
2 3 1           => 6
1 1 2 2 2 3     => 11
``````

### Kill and Win in Perl

``````sub sum_deleted_digits {
# we can always delete all digits
my \$sum = 0;
\$sum += \$_ for @_;
return \$sum;
}

for my \$test ([<2 3 1>], [<1 1 2 2 2 3>])  {
printf "%-15s => %d \n", "@\$test", sum_deleted_digits @\$test;
}
``````

This program displays the following output:

``````\$ perl ./kill-and-win.pl
2 3 1           => 6
1 1 2 2 2 3     => 11
``````

You are given an array of integers which can move in right direction if it is positive and left direction when negative. If two numbers collide then the smaller one will explode. And if both are same then they both explode. We take the absolute value in consideration when comparing.

All numbers move at the same speed, therefore any 2 numbers moving in the same direction will never collide.

Write a script to find out who survives the collision.

Example 1:

``````Input: @list = (2, 3, -1)
Output: (2, 3)

The numbers 3 and -1 collide and -1 explodes in the end. So we are left with (2, 3).
``````

Example 2:

``````Input: @list = (3, 2, -4)
Output: (-4)

The numbers 2 and -4 collide and 2 explodes in the end. That gives us (3, -4).
Now the numbers 3 and -4 collide and 3 explodes. Finally we are left with -4.
``````

Example 3:

``````Input: @list = (1, -1)
Output: ()

The numbers 1 and -1 both collide and explode. Nothing left in the end.
``````

### Number Collision in Raku

``````sub number-collision (@in-array) {
my @in = @in-array;
loop {
return () if @in.elems == 0;
my @temp;
for 0..^@in.end -> \$i {
if @in[\$i] > 0 {
if @in[\$i+1] > 0 {
push @temp, @in[\$i];
} else {
next if abs(@in[\$i]) == abs(@in[\$i+1]);
push @temp,
abs(@in[\$i]) > abs(@in[\$i+1]) ??
@in[\$i] !! @in[\$i+1];
}
} elsif @in[\$i] < 0 {
push @temp, @in[\$i] and next
unless @in[\$i-1]:exists;
if @in[\$i-1] < 0 {
push @temp, @in[\$i];
} else {
shift @temp and next
if abs(@in[\$i]) == abs(@in[\$i+1]);
@temp[*-1] =
abs(@in[\$i]) > abs(@in[\$i-1]) ??
@in[\$i] !! @in[\$i-1];
}
} else {     # @in[\$i] == 0
push @temp, @in[\$i];
}
}
return @temp if @temp.all > 0 or @temp.all < 0;
@in = @temp;
}
}

for <2 3 -1>, <3 2 -4>, <1 -1> -> @test {
say "@test[]".fmt("%-10s => "), number-collision @test;
}
``````

This program displays the following output:

``````\$ raku ./number-collision.raku
2 3 -1     => [2 3]
3 2 -4     => [-4]
1 -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 April 9, 2023. And, please, also spread the word about the Perl Weekly Challenge if you can. I am the author of the "Think Perl 6" book (O'Reilly, 2017) and I blog about the Perl 5 and Raku programming languages.