Perl Weekly Challenge 293.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 293.
Task 1: Similar Dominos
Submitted by: Mohammad Sajid Anwar
You are given a list of dominos, @dominos.
Write a script to return the number of dominoes that are similar to any other domino.
$dominos[i] = [a, b] and $dominos[j] = [c, d] are same if either (a = c and b = d) or
(a = d and b = c).
Example 1
Input: @dominos = ([1, 3], [3, 1], [2, 4], [6, 8])
Output: 2
Similar Dominos: $dominos[0], $dominos[1]
Example 2
Input: @dominos = ([1, 2], [2, 1], [1, 1], [1, 2], [2, 2])
Output: 3
Similar Dominos: $dominos[0], $dominos[1], $dominos[3]
I first sort each domino so that it is represented in some canonical way, with the lowest number first and the largest number second. Then I sort the set of dominoes on the first and then the second number. Finally I increase a counter whenever I find two indentical consecutive dominoes. I increment it additionally when I enter a group of two or more equivalent dominoes. I use PDL to simplify the input and the comparisons. The result fits a two-liner.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){@d=sort{$a((0))<=>$b((0))||$a((1))<=>$b((1))}pdl($_)->qsort->dog;$n=0;$c=0;
for(0..@d-2){if(($d[$_]==$d[$_+1])->all){++$n if !$c;++$c;++$n;}else{$c=0;}}say "$_ -> $n";}
' "[ [1 3][3 1][2 4][6 8] ]" "[ [1 2][2 1][1 1][1 2][2 2] ]"
Results:
[ [1 3][3 1][2 4][6 8] ] -> 2
[ [1 2][2 1][1 1][1 2][2 2] ] -> 3
The full code is:
1 # Perl weekly challenge 293
2 # Task 1: Similar Dominos
3 #
4 # See https://wlmb.github.io/2024/10/28/PWC293/#task-1-similar-dominos
5 use v5.36;
6 use PDL;
7 use PDL::NiceSlice;
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 D1 D2...
10 to find how many similar dominoes are in the set D1 D2...
11 Di is a string of the form [[a1 b1][a2 b2][a3 b3]...] where
12 each pair [an bn] represent a single domino.
13 FIN
14 for(@ARGV){
15 my @dominoes = sort {$a((0)) <=> $b((0)) || $a((1))<=>$b((1))} pdl($_)->qsort->dog;
16 my $similar = 0;
17 my $in_group = 0;
18 for(0..@dominoes-2){
19 if(($dominoes[$_]==$dominoes[$_+1])->all){
20 ++$similar if !$in_group;
21 ++$in_group;
22 ++$similar;
23 } else {
24 $in_group=0;
25 }
26 }
27 say "$_ -> $similar";
28 }
Example:
./ch-1.pl "[ [1 3][3 1][2 4][6 8] ]" "[ [1 2][2 1][1 1][1 2][2 2] ]"
Results:
[ [1 3][3 1][2 4][6 8] ] -> 2
[ [1 2][2 1][1 1][1 2][2 2] ] -> 3
Task 2: Boomerang
Submitted by: Mohammad Sajid Anwar
You are given an array of points, (x, y).
Write a script to find out if the given points are a boomerang.
A boomerang is a set of three points that are all distinct and
not in a straight line.
Example 1
Input: @points = ( [1, 1], [2, 3], [3,2] )
Output: true
Example 2
Input: @points = ( [1, 1], [2, 2], [3, 3] )
Output: false
Example 3
Input: @points = ( [1, 1], [1, 2], [2, 3] )
Output: true
Example 4
Input: @points = ( [1, 1], [1, 2], [1, 3] )
Output: false
Example 5
Input: @points = ( [1, 1], [2, 1], [3, 1] )
Output: false
Example 6
Input: @points = ( [0, 0], [2, 3], [4, 5] )
Output: true
Three points p, q and r are in a straight line if the area of
the triangle pqr is zero, i.e., if the cross product (q-p) x (r-p)
is zero. As the cross product is defined in 3D, I can instead use the
determinant of the matrix with rows q-p and r-p. If the points are
not all distinct, they would be in a straight line, so there is no
need for an additional test. I use PDL to manipulate the vectors, yielding a one-liner.
Examples:
perl -MPDL -MPDL::NiceSlice -E '
for(@ARGV){$m=pdl($_);$m(:,1:2)-=$m(:,0);say "$_ -> ",det($m(:,1:2))?"True":"False";}
' "[ [1 1][2 3][3 2] ]" "[ [1 1][2 2][3 3] ]" "[ [1 1][1 2][2 3] ]" \
"[ [1 1][1 2][1 3] ]" "[ [1 1][2 1][3 1] ]" "[ [0 0][2 3][4 5] ]"
Results:
[ [1 1][2 3][3 2] ] -> True
[ [1 1][2 2][3 3] ] -> False
[ [1 1][1 2][2 3] ] -> True
[ [1 1][1 2][1 3] ] -> False
[ [1 1][2 1][3 1] ] -> False
[ [0 0][2 3][4 5] ] -> True
The full code is:
1 # Perl weekly challenge 293
2 # Task 2: Boomerang
3 #
4 # See https://wlmb.github.io/2024/10/28/PWC293/#task-2-boomerang
5 use v5.36;
6 use PDL;
7 use PDL::NiceSlice;
8
9 die <<~"FIN" unless @ARGV;
10 Usage: $0 M1 M2...
11 to check if the three 2D row vectors forming each matrix M1 M2...
12 form a boomerang. The matrices should be strings in the format "[[x0 y0][x1 y1][x2 y2]]"
13 with xi, yi numbers.
14 FIN
15
16 for(@ARGV){
17 my $matrix=pdl($_);
18 say("Wrong format $m->info: $_"), next unless $m->dim(0)==2 && $->dim(1)==3;
19 my $first=$matrix(:,(0));
20 my $rest=$matrix(:,1:-1);
21 $rest -= $first; # Translate first vector to origin
22 my $determinant = $rest->det;
23 my $result = $determinant != 0? "True" : "False";
24 say "$_ -> $result";
25 }
Example:
./ch-2.pl "[ [1 1][2 3][3 2] ]" "[ [1 1][2 2][3 3] ]" "[ [1 1][1 2][2 3] ]" \
"[ [1 1][1 2][1 3] ]" "[ [1 1][2 1][3 1] ]" "[ [0 0][2 3][4 5] ]"
Results:
[ [1 1][2 3][3 2] ] -> True
[ [1 1][2 2][3 3] ] -> False
[ [1 1][1 2][2 3] ] -> True
[ [1 1][1 2][1 3] ] -> False
[ [1 1][2 1][3 1] ] -> False
[ [0 0][2 3][4 5] ] -> True
/;