Perl Weekly Challenge 335.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 335.
Task 1: Common Characters
Submitted by: Mohammad Sajid Anwar
You are given an array of words.
Write a script to return all characters that is in every word in the given array
including duplicates.
Example 1
Input: @words = ("bella", "label", "roller")
Output: ("e", "l", "l")
Example 2
Input: @words = ("cool", "lock", "cook")
Output: ("c", "o")
Example 3
Input: @words = ("hello", "world", "pole")
Output: ("l", "o")
Example 4
Input: @words = ("abc", "def", "ghi")
Output: ()
Example 5
Input: @words = ("aab", "aac", "aaa")
Output: ("a", "a")
I count the appearances of each letter of each word, find the minimum over all words and repeat it the corresponding number of times in the output. This yields a two-liner.
Example 1:
perl -MList::Util=min -E '
for(@ARGV){my%l;$l{$_}++ for split "", $_;push @w, { %l}}%l=%{$w[0]};for $v
(keys%l){$l{$v}=min map{$_->{$v}}@w}say "@ARGV -> ", map{"$_ " x %l{$_}}keys %l;
' bella label roller
Results:
bella label roller -> e l l
Example 2:
perl -MList::Util=min -E '
for(@ARGV){my%l;$l{$_}++ for split "", $_;push @w, { %l}}%l=%{$w[0]};for $v
(keys%l){$l{$v}=min map{$_->{$v}}@w}say map{"$_ " x %l{$_}}keys %l;
' cool lock cook
Results:
o c
Example 3
perl -MList::Util=min -E '
for(@ARGV){my%l;$l{$_}++ for split "", $_;push @w, { %l}}%l=%{$w[0]};for $v
(keys%l){$l{$v}=min map{$_->{$v}}@w}say "@ARGV -> ", map{"$_ " x %l{$_}}keys %l;
' hello world pole
Results:
l o
Example 4
perl -MList::Util=min -E '
for(@ARGV){my%l;$l{$_}++ for split "", $_;push @w, { %l}}%l=%{$w[0]};for $v
(keys%l){$l{$v}=min map{$_->{$v}}@w}say "@ARGV -> ", map{"$_ " x %l{$_}}keys %l;
' abc def ghi
Results:
abc def ghi ->
Example 5
perl -MList::Util=min -E '
for(@ARGV){my%l;$l{$_}++ for split "", $_;push @w, { %l}}%l=%{$w[0]};for $v
(keys%l){$l{$v}=min map{$_->{$v}}@w}say "@ARGV -> ", map{"$_ " x %l{$_}}keys %l;
' aab aac aaa
Results:
aab aac aaa -> a a
Output: (“a”, “a”)
The full code is
1 # Perl weekly challenge 335
2 # Task 1: Common Characters
3 #
4 # See https://wlmb.github.io/2025/08/18/PWC335/#task-1-common-characters
5 use v5.36;
6 use List::Util qw(min);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 W1 W2...
9 to show characters common to all words W1 W2...
10 FIN
11 my @words;
12 for(@ARGV){ # count letters in each word
13 my %letters;
14 $letters{$_}++ for split "", $_;
15 push @words, { %letters}
16 }
17 my %result=%{$words[0]}; # check letters in first word
18 for my $letter(keys %result){
19 $result{$letter}=min map{$_->{$letter}//0} @words
20 }
21 say "@ARGV -> ", map {"$_ " x $result{$_}}
22 sort {$a cmp $b} keys %result;
Examples:
./ch-1.pl bella label roller
./ch-1.pl cool lock cook
./ch-1.pl hello world pole
./ch-1.pl abc def ghi
./ch-1.pl aab aac aaa
Results:
bella label roller -> e l l
cool lock cook -> c o
hello world pole -> l o
abc def ghi ->
aab aac aaa -> a a
Task 2: Find Winner
Submitted by: Mohammad Sajid Anwar
You are given an array of all moves by the two players.
Write a script to find the winner of the TicTacToe game if found based
on the moves provided in the given array.
UPDATE: Order move is in the order - A, B, A, B, A, ….
Example 1
Input: @moves = ([0,0],[2,0],[1,1],[2,1],[2,2])
Output: A
Game Board:
[ A _ _ ]
[ B A B ]
[ _ _ A ]
Example 2
Input: @moves = ([0,0],[1,1],[0,1],[0,2],[1,0],[2,0])
Output: B
Game Board:
[ A A B ]
[ A B _ ]
[ B _ _ ]
Example 3
Input: @moves = ([0,0],[1,1],[2,0],[1,0],[1,2],[2,1],[0,1],[0,2],[2,2])
Output: Draw
Game Board:
[ A A B ]
[ B B A ]
[ A B A ]
Example 4
Input: @moves = ([0,0],[1,1])
Output: Pending
Game Board:
[ A _ _ ]
[ _ B _ ]
[ _ _ _ ]
Example 5
Input: @moves = ([1,1],[0,0],[2,2],[0,1],[1,0],[0,2])
Output: B
Game Board:
[ B B B ]
[ A A _ ]
[ _ _ A ]
As the game ends at the moment there is a winner, I only have
to check the last move. It is a winning move if it lies on a straight
line with any two previous moves by the same player. I use PDL to
perform vector operations. The player P that plays the last move
wins if the determinant of V and W is zero, where V=some move by
P-last move and W=another move by P-last move. If the last player
doesn’t win and all nine moves have been played, there is a draw. If
not, the result is pending. If no player has finished three moves, the
result is pending. The code may be squeezed into a three-liner. I
explain it in more detail in the full code below.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
@j=qw(A B);for(@ARGV){$m=pdl($_);$p=1-($n=$m->dim(1))%2;$r="P", next if$n<5;$r=$j[$p],next
if w($m(:,$p:-2:2)-$m(:,-1));$r="D", next if $m->dim(1)==9;$r="P";}continue{say "$_ -> $r";}
sub w($m){$n=$m->dim(1);return(($m((0))*$m((1),*)-$m((1))*$m((0),*))==0)->sum>$n;}
' "[[0 0][2 0][1 1][2 1][2 2]]" "[[0 0][1 1][0 1][0 2][1 0][2 0]]" \
"[[0 0][1 1][2 0][1 0][1 2][2 1][0 1][0 2][2 2]]" "[[0 0][1 1]]" \
"[[1 1][0 0][2 2][0 1][1 0][0 2]]"
Results:
[[0 0][2 0][1 1][2 1][2 2]] -> A
[[0 0][1 1][0 1][0 2][1 0][2 0]] -> B
[[0 0][1 1][2 0][1 0][1 2][2 1][0 1][0 2][2 2]] -> D
[[0 0][1 1]] -> P
[[1 1][0 0][2 2][0 1][1 0][0 2]] -> B
Note that I compute the determinant of all pairs of previous relative moves. This yields trivial zeroes when I use the same move twice. Any other zero means a win.
The corresponding full code is:
1 # Perl weekly challenge 335
2 # Task 2: Find Winner
3 #
4 # See https://wlmb.github.io/2025/08/18/PWC335/#task-2-find-winner
5 use v5.36;
6 use feature qw(try);
7 use PDL;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 G1 G2...
10 to find the winner in the tic tac toe game Gi.
11 Each game is a string with the format
12 "[[X0 Y0][X1 Y1]...]"
13 where Xi Yi are the coordinates of the ith move, in the range 0..2.
14 Even numbered moves correspond to player A and odd to player B.
15 FIN
16 my @players=map {"Player $_"} qw(A B);
17 my $result;
18 for(@ARGV){
19 try {
20 my $moves=pdl($_);
21 die "Wrong shape. Expected array of 2D vectors: $_"
22 unless $moves->dim(0)==2; # each move should be 2D vector
23 die "Wrong move. Expected 0<=coordinate<=2: $_"
24 unless 0 <= $moves->min && $moves->max <= 2;
25 die "Repeated moves are invalid: $_"
26 unless $moves->uniqvec->dim(1)==$moves->dim(1);
27 my $length=$moves->dim(1); # length of game
28 my $last=1-$length%2; # last player
29 $result = "Pending", next if $length < 5; # game was too short
30 $result = $players[$last], next if
31 win(
32 $moves->slice(":,$last:-2:2") # previous moves of last player
33 -$moves->slice(":,-1") # with respect to last move
34 );
35 $result = "Draw", next
36 if $moves->dim(1)==9; # finished game without a winner
37 $result= "Pending"; # unfinished game
38 } catch($e) {
39 say $e;
40 undef $result;
41 }
42 } continue{
43 say "$_ -> $result" if defined $result;
44 }
45 sub win($relative){ # moves by one player relative to last
46 my $length=$relative->dim(1);
47 return (($relative->slice("(0)")*$relative->slice("(1),*")
48 - $relative->slice("(1)")*$relative->slice("(0),*")) # compute determinants
49 ==0)->sum # count zeroes
50 > $length; # win if larger than the trivial number
51 }
Example:
./ch-2.pl "[[0 0][2 0][1 1][2 1][2 2]]" "[[0 0][1 1][0 1][0 2][1 0][2 0]]" \
"[[0 0][1 1][2 0][1 0][1 2][2 1][0 1][0 2][2 2]]" "[[0 0][1 1]]" \
"[[1 1][0 0][2 2][0 1][1 0][0 2]]"
Results:
[[0 0][2 0][1 1][2 1][2 2]] -> Player A
[[0 0][1 1][0 1][0 2][1 0][2 0]] -> Player B
[[0 0][1 1][2 0][1 0][1 2][2 1][0 1][0 2][2 2]] -> Draw
[[0 0][1 1]] -> Pending
[[1 1][0 0][2 2][0 1][1 0][0 2]] -> Player B
/;
Written on August 18, 2025