Perl Weekly Challenge 343.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 343.
Task 1: Zero Friend
Submitted by: Mohammad Sajid Anwar
You are given a list of numbers.
Find the number that is closest to zero and return its distance to zero.
Example 1
Input: @nums = (4, 2, -1, 3, -2)
Output: 1
Values closest to 0: -1 and 2 (distance = 1 and 2)
Example 2
Input: @nums = (-5, 5, -3, 3, -1, 1)
Output: 1
Values closest to 0: -1 and 1 (distance = 1)
Example 3
Input: @ums = (7, -3, 0, 2, -8)
Output: 0
Values closest to 0: 0 (distance = 0)
Exact zero wins regardless of other close values.
Example 4
Input: @nums = (-2, -5, -1, -8)
Output: 1
Values closest to 0: -1 and -2 (distance = 1 and 2)
Example 5
Input: @nums = (-2, 2, -4, 4, -1, 1)
Output: 1
Values closest to 0: -1 and 1 (distance = 1)
A simple solution is simply to take the absolute value and chose the minimum. I use the Perl Data Language (PDL) to process the arrays. The inputs are strings parsed by PDL into arrays. The result is a simple half-liner.
Examples:
perl -MPDL -E '
say "$_ -> ", pdl($_)->abs->min for @ARGV;
' "[4 2 -1 3 -2]" "[-5 5 -3 3 -1 1]" "[7 -3 0 2 -8]" "[-2 -5 -1 -8]" "[-2 2 -4 4 -1 1]"
Results:
[4 2 -1 3 -2] -> 1
[-5 5 -3 3 -1 1] -> 1
[7 -3 0 2 -8] -> 0
[-2 -5 -1 -8] -> 1
[-2 2 -4 4 -1 1] -> 1
The full code is:
1 # Perl weekly challenge 343
2 # Task 1: Zero Friend
3 #
4 # See https://wlmb.github.io/2025/10/18/PWC343/#task-1-zero-friend
5 use v5.36;
6 use feature qw(try);
7 use PDL;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 A0 A1...
10 to find the minimum distance from the elements of the array Ai to zero.
11 Each Ai is a string of the form "[x0 x1...]", i.e., space separated
12 numbers xi within square brackets.
13 FIN
14 for(@ARGV){
15 try{ say "$_ -> ", pdl($_)->abs->min; }
16 catch($e){ "warn $e"}
17 }
Example:
./ch-1.pl "[4 2 -1 3 -2]" "[-5 5 -3 3 -1 1]" "[7 -3 0 2 -8]" "[-2 -5 -1 -8]" "[-2 2 -4 4 -1 1]"
Results:
[4 2 -1 3 -2] -> 1
[-5 5 -3 3 -1 1] -> 1
[7 -3 0 2 -8] -> 0
[-2 -5 -1 -8] -> 1
[-2 2 -4 4 -1 1] -> 1
Task 2: Champion Team
Submitted by: Mohammad Sajid Anwar
You have n teams in a tournament. A matrix grid tells you
which team is stronger between any two teams:
If grid[i][j] == 1, then team i is stronger than team j
If grid[i][j] == 0, then team j is stronger than team i
Find the champion team - the one with most wins, or if
there is no single such team, the strongest of the teams
with most wins. (You may assume that there is a definite answer.)
Example 1
Input: @grid = (
[0, 1, 1],
[0, 0, 1],
[0, 0, 0],
)
Output: Team 0
[0, 1, 1] => Team 0 beats Team 1 and Team 2
[0, 0, 1] => Team 1 beats Team 2
[0, 0, 0] => Team 2 loses to all
Example 2
Input: @grid = (
[0, 1, 0, 0],
[0, 0, 0, 0],
[1, 1, 0, 0],
[1, 1, 1, 0],
)
Output: Team 3
[0, 1, 0, 0] => Team 0 beats only Team 1
[0, 0, 0, 0] => Team 1 loses to all
[1, 1, 0, 0] => Team 2 beats Team 0 and Team 1
[1, 1, 1, 0] => Team 3 beats everyone
Example 3
Input: @grid = (
[0, 1, 0, 1],
[0, 0, 1, 1],
[1, 0, 0, 0],
[0, 0, 1, 0],
)
Output: Team 0
[0, 1, 0, 1] => Team 0 beats teams 1 and 3
[0, 0, 1, 1] => Team 1 beats teams 2 and 3
[1, 0, 0, 0] => Team 2 beats team 0
[0, 0, 1, 0] => Team 3 beats team 2
Of the teams with 2 wins, Team 0 beats team 1.
Example 4
Input: @grid = (
[0, 1, 1],
[0, 0, 0],
[0, 1, 0],
)
Output: Team 0
[0, 1, 1] => Team 0 beats Team 1 and Team 2
[0, 0, 0] => Team 1 loses to Team 2
[0, 1, 0] => Team 2 beats Team 1 but loses to Team 0
Example 5
Input: @grid = (
[0, 0, 0, 0, 0],
[1, 0, 0, 0, 0],
[1, 1, 0, 1, 1],
[1, 1, 0, 0, 0],
[1, 1, 0, 1, 0],
)
Output: Team 2
[0, 0, 0, 0, 0] => Team 0 loses to all
[1, 0, 0, 0, 0] => Team 1 beats only Team 0
[1, 1, 0, 1, 1] => Team 2 beats everyone except self
[1, 1, 0, 0, 0] => Team 3 loses to Team 2
[1, 1, 0, 1, 0] => Team 4 loses to Team 2
I use the Perl Data Language (PDL) to deal with the matrices. The naive solution is to choose the winner is the team that has more 1’s in a row. This yields a one-liner.
Examples:
perl -MPDL -E '
say $m=pdl($_)," -> ", $m->sumover->maximum_ind for @ARGV;
' "[[0 1 1][0 0 1][0 0 0]]" "[[0 1 0 0][0 0 0 0][1 1 0 0][1 1 1 0]]" \
"[[0 1 0 1][0 0 1 1][1 0 0 0][0 0 1 0]]" "[[0 1 1][0, 0, 0][0 1 0]]" \
"[[0 0 0 0 0][1 0 0 0 0][1 1 0 1 1][1 1 0 0 0][1 1 0 1 0]]"
Results:
[
[0 1 1]
[0 0 1]
[0 0 0]
]
-> 0
[
[0 1 0 0]
[0 0 0 0]
[1 1 0 0]
[1 1 1 0]
]
-> 3
[
[0 1 0 1]
[0 0 1 1]
[1 0 0 0]
[0 0 1 0]
]
-> 0
[
[0 1 1]
[0 0 0]
[0 1 0]
]
-> 0
[
[0 0 0 0 0]
[1 0 0 0 0]
[1 1 0 1 1]
[1 1 0 0 0]
[1 1 0 1 0]
]
-> 2
Although the results are correct, this code may fail when there is a tie. For example, making a variaton of example 3,
perl -MPDL -E '
say $m=pdl($_)," -> ", $m->sumover->maximum_ind for @ARGV;
' "[[0 1 0 1][0 0 1 1][1 0 0 0][0 0 1 0]]" "[[0 0 1 1][1 0 0 1][0 1 0 0][0 0 1 0]]"
Results:
[
[0 1 0 1]
[0 0 1 1]
[1 0 0 0]
[0 0 1 0]
]
-> 0
[
[0 0 1 1]
[1 0 0 1]
[0 1 0 0]
[0 0 1 0]
]
-> 0
the second result is wrong and should have been 1, as the example is the same as for the first result but interchanging team 0 with team 1.
One solution is to remove all teams which are not candidates for the first place and run the first algorithm again, yielding a two liner.
perl -MPDL -E '
for(@ARGV){$m=($i=pdl($_))->copy;$m->diagonal(0,1).=1;$s=$m->sumover;$l=which($s!=$s->maxover);$m
->dice($l).=0,$m->dice("X",$l).=0 unless $l->isempty;$s=$m->sumover;say "$i- > ",$s->maximum_ind;}
' "[[0 1 1][0 0 1][0 0 0]]" "[[0 1 0 0][0 0 0 0][1 1 0 0][1 1 1 0]]" \
"[[0 1 0 1][0 0 1 1][1 0 0 0][0 0 1 0]]" "[[0 1 1][0, 0, 0][0 1 0]]" \
"[[0 0 0 0 0][1 0 0 0 0][1 1 0 1 1][1 1 0 0 0][1 1 0 1 0]]"
Results:
[
[0 1 1]
[0 0 1]
[0 0 0]
]
- > 0
[
[0 1 0 0]
[0 0 0 0]
[1 1 0 0]
[1 1 1 0]
]
- > 3
[
[0 1 0 1]
[0 0 1 1]
[1 0 0 0]
[0 0 1 0]
]
- > 0
[
[0 1 1]
[0 0 0]
[0 1 0]
]
- > 0
[
[0 0 0 0 0]
[1 0 0 0 0]
[1 1 0 1 1]
[1 1 0 0 0]
[1 1 0 1 0]
]
- > 2
The results are the expected ones.
Now I apply the same to example 3 and the permutted example 3:
perl -MPDL -E '
for(@ARGV){$m=($i=pdl($_))->copy;$m->diagonal(0,1).=1;$s=$m->sumover;$l=which($s!=$s->maxover);$m
->dice($l).=0,$m->dice("X",$l).=0 unless $l->isempty;$s=$m->sumover;say "$i- > ",$s->maximum_ind;}
' "[[0 1 0 1][0 0 1 1][1 0 0 0][0 0 1 0]]" "[[0 0 1 1][1 0 0 1][0 1 0 0][0 0 1 0]]"
Results:
[
[0 1 0 1]
[0 0 1 1]
[1 0 0 0]
[0 0 1 0]
]
- > 0
[
[0 0 1 1]
[1 0 0 1]
[0 1 0 0]
[0 0 1 0]
]
- > 1
So this time we do get the correct results. There may still be a problem in some situations such as team 0 stronger than team 1, team 1 stronger than team 2 and team 2 stronger than team 0, in which case there is not a well defined winner, but the program above would choose the first team:
perl -MPDL -E '
for(@ARGV){$m=($i=pdl($_))->copy;$m->diagonal(0,1).=1;$s=$m->sumover;$l=which($s!=$s->maxover);$m
->dice($l).=0,$m->dice("X",$l).=0 unless $l->isempty;$s=$m->sumover;say "$i- > ",$s->maximum_ind;}
' "[[0 1 0 ][0 0 1 ][1 0 0]]"
Results:
[
[0 1 0]
[0 0 1]
[1 0 0]
]
- > 0
To fix this case, I get the list of all possible winners and display it as a list, unless the winner is unique. This yields a three liner.
perl -MPDL -E '
for(@ARGV){$m=($i=pdl($_))->copy;$m->diagonal(0,1).=1;$s=$m->sumover;
$l=which($s!=$s->maxover);$m->dice($l).=0,$m->dice("X",$l).=0 unless
$l->isempty;$s=$m->sumover;say "$i- > ",which($s==$s->maximum)->squeeze;}
' "[[0 1 0 ][0 0 1 ][1 0 0]]" "[[0 1 0 ][0 0 1 ][0 0 0]]"
Results:
[
[0 1 0]
[0 0 1]
[1 0 0]
]
- > [0 1 2] # three candidates
[
[0 1 0]
[0 0 1]
[0 0 0]
]
- > 0 # well defined winner
The full code is:
1 # Perl weekly challenge 343
2 # Task 2: Champion Team
3 #
4 # See https://wlmb.github.io/2025/10/18/PWC343/#task-2-champion-team
5 use v5.36;
6 use feature qw(try);
7 use PDL;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 M0 M1...
10 to find the champion team given the strength matrix Mn.
11 The j-th entry of the i-th row of Mn is 1 if team i beats team j.
12 Otherwise it is a zero. Each Mn is a string of the form
13 "[[m00 m01...][m10 m11...]...]" where mij is 0 or 1.
14 The value of mii is ignored.
15 FIN
16 for(@ARGV){
17 try {
18 my $work=(my $input=pdl($_))->copy;
19 $work->diagonal(0,1).=1; # For the case of no tie
20 die "Only zeroes and ones are allowed" unless all(($work==0)|($work==1));
21 my $sum=$work->sumover; # Relative strength of teams
22 my $losers=which($sum!=$sum->maxover); # Teams that cannot win
23 if(!$losers->isempty){ # Remove losers from further consideration.
24 $work->dice($losers).=0; # Columns
25 $work->dice("X",$losers).=0; # and rows
26 }
27 $sum=$work->sumover; # recompute with possible winners only
28 my $winners=which($sum==$sum->maxover); # teams that can win
29 say "$input -> ", $winners->squeeze; # scalar for single winner
30 }
31 catch($e){
32 warn $e;
33 }
34 }
Examples:
echo "Original examples"
./ch-2.pl "[[0 1 1][0 0 1][0 0 0]]" "[[0 1 0 0][0 0 0 0][1 1 0 0][1 1 1 0]]" \
"[[0 1 0 1][0 0 1 1][1 0 0 0][0 0 1 0]]" "[[0 1 1][0, 0, 0][0 1 0]]" \
"[[0 0 0 0 0][1 0 0 0 0][1 1 0 1 1][1 1 0 0 0][1 1 0 1 0]]"
echo
echo "Permuted teams"
./ch-2.pl "[[0 1 0 1][0 0 1 1][1 0 0 0][0 0 1 0]]" "[[0 0 1 1][1 0 0 1][0 1 0 0][0 0 1 0]]"
echo
echo "Ambiguous case"
./ch-2.pl "[[0 1 0 ][0 0 1 ][1 0 0]]"
Results:
Original examples
[
[0 1 1]
[0 0 1]
[0 0 0]
]
-> 0
[
[0 1 0 0]
[0 0 0 0]
[1 1 0 0]
[1 1 1 0]
]
-> 3
[
[0 1 0 1]
[0 0 1 1]
[1 0 0 0]
[0 0 1 0]
]
-> 0
[
[0 1 1]
[0 0 0]
[0 1 0]
]
-> 0
[
[0 0 0 0 0]
[1 0 0 0 0]
[1 1 0 1 1]
[1 1 0 0 0]
[1 1 0 1 0]
]
-> 2
Permuted teams
[
[0 1 0 1]
[0 0 1 1]
[1 0 0 0]
[0 0 1 0]
]
-> 0
[
[0 0 1 1]
[1 0 0 1]
[0 1 0 0]
[0 0 1 0]
]
-> 1
Ambiguous case
[
[0 1 0]
[0 0 1]
[1 0 0]
]
-> [0 1 2]
/;
Written on October 18, 2025