Skip to content

Commit e64c29e

Browse files
jacobyjacoby
committed
Blogged 293
1 parent 7946eb7 commit e64c29e

File tree

1 file changed

+198
-0
lines changed

1 file changed

+198
-0
lines changed

‎_posts/2024-10-30-taking-a-new-angle-weekly-challenge-293.markdown‎

Lines changed: 198 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,198 @@
1+
---
2+
layout: post
3+
title: "Taking A New Angle: Weekly Challenge #293"
4+
author: "Dave Jacoby"
5+
date: "2024-10-30 15:21:50 -0400"
6+
categories: ""
7+
---
8+
9+
Here we are, into Halloween and [_**Weekly Challenge #293!**_](https://theweeklychallenge.org/blog/perl-weekly-challenge-293/)
10+
11+
### Task 1: Similar Dominos
12+
13+
> Submitted by: Mohammad Sajid Anwar
14+
> You are given a list of dominos, `@dominos`.
15+
>
16+
> Write a script to return the number of dominoes that are similar to any other domino.
17+
>
18+
> `$dominos[i] = [a, b]` and `$dominos[j] = [c, d]` are same if either `(a = c and b = d)` or `(a = d and b = c)`.
19+
20+
#### Let's Talk About it
21+
22+
The key thing about dominos is that they're not directional. `1, 3` is the same as `3, 1`, so we need to orient them the same so that we can compare them. So, I numerically `sort` each domino, concatenate them, use a hash and `$hash{$value}++` to count them, sort the keys by values and return the highest value.
23+
24+
#### Show Me The Code
25+
26+
```perl
27+
#!/usr/bin/env perl
28+
29+
use strict;
30+
use warnings;
31+
use experimental qw{ say state postderef signatures };
32+
33+
use List::Util qw{ first max };
34+
35+
my @examples = (
36+
37+
[ [ 1, 3 ], [ 3, 1 ], [ 2, 4 ], [ 6, 8 ] ],
38+
[ [ 1, 2 ], [ 2, 1 ], [ 1, 1 ], [ 1, 2 ], [ 2, 2 ] ],
39+
);
40+
41+
for my $example (@examples) {
42+
my $output = similar_dominos( $example->@* );
43+
my $input = join ', ', map { qq{[$_]} }
44+
map { join ', ', $_->@* } $example->@*;
45+
say <<"END";
46+
Input: \$ints = ($input)
47+
Output: $output
48+
END
49+
}
50+
51+
sub similar_dominos (@dominos) {
52+
my %hash;
53+
map { $hash{$_}++ }
54+
map { join ',', $_->@* }
55+
map {
56+
[ sort { $a <=> $b } $_->@* ]
57+
} @dominos;
58+
my @values =
59+
map { $hash{$_} }
60+
sort { $hash{$b} <=> $hash{$a} }
61+
keys %hash;
62+
return shift @values;
63+
}
64+
```
65+
66+
```text
67+
$ ./ch-1.pl
68+
Input: $ints = ([1, 3], [3, 1], [2, 4], [6, 8])
69+
Output: 2
70+
71+
Input: $ints = ([1, 2], [2, 1], [1, 1], [1, 2], [2, 2])
72+
Output: 3
73+
74+
```
75+
76+
#### Task 2: Boomerang
77+
78+
> Submitted by: Mohammad Sajid Anwar
79+
> You are given an array of points, `(x, y)`.
80+
>
81+
> Write a script to find out if the given points are a boomerang.
82+
>
83+
> A **boomerang** is a set of three points that are all distinct and not in a straight line.
84+
85+
#### Let's Talk About it
86+
87+
I had a thought, coded, committed and uploaded it, then had a thought and rewrote the thing.
88+
89+
Points are defined by `x` and `y` coordinates, and unlike dominos, you cannot flip them around. An `x` is an `x`. There's a lot of old standbys I go to, and this one makes use of [Algorithm::Permute](https://metacpan.org/pod/Algorithm::Permute). Say you want to deal with 3 elements, `A`, `B` and `C`. You pass in a reference to an array with those three elements and you get an iterator that gives you all the various ways for them to be arranged, which are:
90+
91+
> A B C
92+
> A C B
93+
> B A C
94+
> B C A
95+
> C A B
96+
> C B A
97+
98+
And the elements within that anonymous array can by anything, including two-element lists that are playing as points.
99+
100+
My first pass involved finding the distance between `A` and `B` (defined as `i = B - A` for both `x` and `y` coordinates), and seeing if `B + i = C`. And the thing is, that's a test but not the right one. A **vector** is direction and magnitude, so in the `x,y` plane, `0,0` and `1,1` are separated by a vector `1,1`, so `2,2` would be the same vector away from `1,1`, but that's not the question. `3,3` would be on the same line, making those three points **not a boomerang**, but this test would mean nothing for the point `7,7`.
101+
102+
Clearly, I have committed a naiïve and wrong solution, and now I have to correct it. And it came to me while I had descended to sleep. The Permute idea is right, but I needed to find the angle starting at one point, `AB` and `AC` if you will. And as it turns out, I *had* that code in a toy project I wrote recently, using SVG graphics to create a Star Trek-like starscape. For that, I insert dots randomly within the image area, determine the distance and angle that is from the center, then move it 110% or so from the center on that same angle. This is the kind of thing that each generation goes into mathematics courses to learn, then immediately forget after the test.
103+
104+
```javascript
105+
function angleDeg(x1, y1, x2, y2) {
106+
return (Math.atan2(y2 - y1, x2 - x1) * 180) / Math.PI;
107+
}
108+
```
109+
110+
Rather than say `my $pi = 3.14159`, I used [Math::Trig](https://metacpan.org/pod/Math::Trig) to give us `pi`. (I always consider using [utf8](https://metacpan.org/pod/utf8) to allow the use of unicode symbols as variable names so I can make it `$π`.) `atan2` doesn't need a module to be used.
111+
112+
And as is common, we write tests on the data, return `false` when they fail and `true` at the end. It's easier flow control than if statements.
113+
114+
#### Show Me The Code
115+
116+
```perl
117+
#!/usr/bin/env perl
118+
119+
use strict;
120+
use warnings;
121+
use experimental qw{ say state postderef signatures };
122+
123+
use Algorithm::Permute;
124+
use Math::Trig;
125+
my @examples = (
126+
127+
[ [ 1, 1 ], [ 2, 3 ], [ 3, 2 ] ],
128+
[ [ 1, 1 ], [ 2, 2 ], [ 3, 3 ] ],
129+
[ [ 1, 1 ], [ 1, 2 ], [ 2, 3 ] ],
130+
[ [ 1, 1 ], [ 1, 2 ], [ 1, 3 ] ],
131+
[ [ 1, 1 ], [ 2, 1 ], [ 3, 1 ] ],
132+
[ [ 0, 0 ], [ 2, 3 ], [ 4, 5 ] ],
133+
[ [ 1, 1 ], [ 1, 1 ], [ 1, 3 ] ],
134+
);
135+
136+
for my $example (@examples) {
137+
my $input = join ', ', map { qq{[$_]} }
138+
map { join ', ', $_->@* } $example->@*;
139+
my $output = boomerang( $example->@* );
140+
say <<"END";
141+
Input: \@points = ( $input )
142+
Output: $output
143+
END
144+
}
145+
146+
sub boomerang (@points) {
147+
148+
# all distinct
149+
my %hash;
150+
map { $hash{$_}++ }
151+
map { join ',', $_->@* } @points;
152+
my @values =
153+
map { $hash{$_} }
154+
sort { $hash{$b} <=> $hash{$a} }
155+
keys %hash;
156+
return 'false' if $values[0] > 1;
157+
158+
# not in a straight line
159+
my $p = Algorithm::Permute->new( \@points );
160+
while ( my @d = $p->next ) {
161+
my $angle1 = get_angle( $d[0]->@*, $d[1]->@* );
162+
my $angle2 = get_angle( $d[0]->@*, $d[2]->@* );
163+
return 'false' if $angle1 == $angle2;
164+
}
165+
return 'true';
166+
}
167+
168+
sub get_angle ( $x1, $y1, $x2, $y2 ) {
169+
return ( 180 / pi ) * atan2( $y2 - $y1, $x2 - $x1 );
170+
}
171+
```
172+
173+
```text
174+
$ ./ch-2.pl
175+
Input: @points = ( [1, 1], [2, 3], [3, 2] )
176+
Output: true
177+
178+
Input: @points = ( [1, 1], [2, 2], [3, 3] )
179+
Output: false
180+
181+
Input: @points = ( [1, 1], [1, 2], [2, 3] )
182+
Output: true
183+
184+
Input: @points = ( [1, 1], [1, 2], [1, 3] )
185+
Output: false
186+
187+
Input: @points = ( [1, 1], [2, 1], [3, 1] )
188+
Output: false
189+
190+
Input: @points = ( [0, 0], [2, 3], [4, 5] )
191+
Output: true
192+
193+
Input: @points = ( [1, 1], [1, 1], [1, 3] )
194+
Output: false
195+
196+
```
197+
198+
#### If you have any questions or comments, I would be glad to hear it. Ask me on [Mastodon](https://mastodon.xyz/@jacobydave) or [make an issue on my blog repo.](https://github.com/jacoby/jacoby.github.io)

0 commit comments

Comments
 (0)