Perl Weekly Challenge 210.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 210.

Task 1: Kill and Win

Submitted by: Mohammad S Anwar
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.

From the description and the examples, it seems that all deleted numbers are added, irrespective of the reason for the deletion, i.e., for being chosen for deletion or for being neighbor of a deleted number. Thus, all the numbers in the array are counted. This observation yields a trivial one liner solution: simply add up all numbers.

perl -MList::Util=sum -E 'say "(@ARGV) -> ", sum @ARGV' 2 3 1
perl -MList::Util=sum -E 'say "(@ARGV) -> ", sum @ARGV' 1 1 2 2 2 3

Results:

(2 3 1) -> 6
(1 1 2 2 2 3) -> 11

The full code is almost identical:

 1  # Perl weekly challenge 210
 2  # Task 1:  Kill and Win
 3  #
 4  # See https://wlmb.github.io/2023/03/27/PWC210/#task-1-kill-and-win
 5  use v5.36;
 6  use List::Util qw(sum);
 7  die <<~"FIN" unless @ARGV;
 8      Usage: $0 N1 [N2...]
 9      to get the maximum points when killing the numbers N1 N2...
10      FIN
11  say "(@ARGV) -> ", sum @ARGV;

Examples:

./ch-1.pl 2 3 1
./ch-1.pl 1 1 2 2 2 3

Results:

(2 3 1) -> 6
(1 1 2 2 2 3) -> 11

Task 2: Number Collision

Submitted by: Mohammad S Anwar
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.

This tasks reminds me of a funny phenomenon. If a set of particles move each at constant velocity, each particle with its own speed, so that they explode when they collide, after a long time, the remaining particles would have highly correlated velocities, even though they have never interacted with each other. The particles that do interact, explode and disappear.

Anyway, coming back to the challenge, I’ll assume that 0 is allowed and corresponds to particle that don’t move but may collide with other moving particles. A simple solution may be obtained by searching an array of particles from left to right looking for a sign change from positive to negative, removing the exploding numbers using an appropriate splice and iterating until no more collisions are detected. This fits a two-liner:

perl -MList::Util=first -E '
@x=@ARGV; while(defined($i=first {$x[$_]>$x[$_+1]&&$x[$_]>=0>=$x[$_+1]}0..@x-2)){($j,$k)=
$x[$i]>-$x[$i+1]?($i+1,1):$x[$i]<-$x[$i+1]>0?($i,1):($i,2);splice @x,$j, $k} say "(@ARGV) -> (@x)"
' 2 3 -1

Results:

(2 3 -1) -> (2 3)

The other two given examples are

perl -MList::Util=first -E '
@x=@ARGV; while(defined($i=first {$x[$_]>$x[$_+1]&&$x[$_]>=0>=$x[$_+1]}0..@x-2)){($j,$k)=
$x[$i]>-$x[$i+1]?($i+1,1):$x[$i]<-$x[$i+1]>0?($i,1):($i,2);splice @x,$j, $k} say "(@ARGV) -> (@x)"
' 3 2 -4
perl -MList::Util=first -E '
@x=@ARGV; while(defined($i=first {$x[$_]>$x[$_+1]&&$x[$_]>=0>=$x[$_+1]}0..@x-2)){($j,$k)=
$x[$i]>-$x[$i+1]?($i+1,1):$x[$i]<-$x[$i+1]>0?($i,1):($i,2);splice @x,$j, $k} say "(@ARGV) -> (@x)"
' 1 -1

Results:

(3 2 -4) -> (-4)
(1 -1) -> ()

Some examples involving unmoving particles:

perl -MList::Util=first -E '
@x=@ARGV; while(defined($i=first {$x[$_]>$x[$_+1]&&$x[$_]>=0>=$x[$_+1]}0..@x-2)){($j,$k)=
$x[$i]>-$x[$i+1]?($i+1,1):$x[$i]<-$x[$i+1]>0?($i,1):($i,2);splice @x,$j, $k} say "(@ARGV) -> (@x)"
' ' -1' 0 0 1
perl -MList::Util=first -E '
@x=@ARGV; while(defined($i=first {$x[$_]>$x[$_+1]&&$x[$_]>=0>=$x[$_+1]}0..@x-2)){($j,$k)=
$x[$i]>-$x[$i+1]?($i+1,1):$x[$i]<-$x[$i+1]>0?($i,1):($i,2);splice @x,$j, $k} say "(@ARGV) -> (@x)"
' 1 0 0 0
perl -MList::Util=first -E '
@x=@ARGV; while(defined($i=first {$x[$_]>$x[$_+1]&&$x[$_]>=0>=$x[$_+1]}0..@x-2)){($j,$k)=
$x[$i]>-$x[$i+1]?($i+1,1):$x[$i]<-$x[$i+1]>0?($i,1):($i,2);splice @x,$j, $k} say "(@ARGV) -> (@x)"
' 0 0 0 -1
perl -MList::Util=first -E '
@x=@ARGV; while(defined($i=first {$x[$_]>$x[$_+1]&&$x[$_]>=0>=$x[$_+1]}0..@x-2)){($j,$k)=
$x[$i]>-$x[$i+1]?($i+1,1):$x[$i]<-$x[$i+1]>0?($i,1):($i,2);splice @x,$j, $k} say "(@ARGV) -> (@x)"
' 1 0 0 0 -1

Results:

( -1 0 0 1) -> ( -1 0 0 1)
(1 0 0 0) -> (1)
(0 0 0 -1) -> (-1)
(1 0 0 0 -1) -> ()

The full code is similar, slightly more explicit.

 1  # Perl weekly challenge 210
 2  # Task 2:  Number Collision
 3  #
 4  # See https://wlmb.github.io/2023/03/27/PWC210/#task-2-number-collision
 5  use v5.36;
 6  use List::Util qw(first);
 7  die <<~"FIN" unless @ARGV;
 8      Usage: $0 N1 [N2...]
 9      To find which numbers among N1 N2... survive all collisions
10      FIN
11  my @numbers=@ARGV; # copy input
12  while(defined( # search for index of next collision
13  	  my $collision=first {
14  	      $numbers[$_]>$numbers[$_+1] && $numbers[$_]>=0>=$numbers[$_+1]
15  	      }
16  	      0..@numbers-2
17        )
18      ){
19      splice @numbers, $collision + 1, 1  if $numbers[$collision] > -$numbers[$collision+1];
20      splice @numbers, $collision, 1      if $numbers[$collision] < -$numbers[$collision+1];
21      splice @numbers, $collision, 2      if $numbers[$collision] == -$numbers[$collision+1];
22  }
23  say "(@ARGV) -> (@numbers)"

Example:

perl -E 'system "./ch-2.pl $_" for ("2 3 -1", "3 2 -4", "1 -1", "-1 0 0 1", "1 0 0 0",
     "0 0 0 -1", "1 0 0 0 -1")'

Results:

(2 3 -1) -> (2 3)
(3 2 -4) -> (-4)
(1 -1) -> ()
(-1 0 0 1) -> (-1 0 0 1)
(1 0 0 0) -> (1)
(0 0 0 -1) -> (-1)
(1 0 0 0 -1) -> ()
Written on March 27, 2023