1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
# Perl Weekly Challenge Club - 127
This is my first time submitting! I had a lot of fun and it was a good excuse
to work on my Perl.
## Task 1 > Disjoint Sets
You are given two sets with unique integers.
Write a script to figure out if they are disjoint.
The two sets are disjoint if they don't have any common members
### EXAMPLE
**Input:**
```perl
@s1 = (1, 2, 5, 3, 4);
@s2 = (4, 6, 7, 8, 9);
```
**Output:** `0` as the given sets have common member `4`.
**Input:**
```perl
@s1 = (1, 3, 5, 7, 9);
@s2 = (0, 2, 4, 6, 8);
```
**Output:** `1` as the given two sets do no have a common member.
### SOLUTION
```perl
sub is_disjoint {
my ($set1_ref, $set2_ref) = @_; # Our two sets for comparison
my @test_set = @$set1_ref; # Shallow copy
my %haystack = map { $_ => 1 } @$set2_ref; # Copy array values into a hash
my $disjoint = 1; # Trust, but verify
while ($disjoint and scalar @test_set) { # Iterate through copy
my $needle = pop(@test_set);
$disjoint = 0 if exists($haystack{$needle}); # Test if disjoint
}
return $disjoint;
}
```
### ch-1.pl
Running `./ch-1.pl` tests our solution against the following test cases,
printing `Passed` or `Failed` to the console:
#### Case 1:
```perl
1,2,5,3,4
4,6,7,8,9
0 # false, 4 is not unique
```
#### Case 2:
```perl
1,3,5,7,9
0,2,4,6,8
1
```
#### Case 3:
```perl
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
2
1 # Technically, the sets are still disjoint
```
#### Case 4:
```perl
😺,😸,😹,😻,😼,😽
😽,🙀,😿,😾
0 # False
```
#### Case 5:
```perl
🙂,🙃,😉,😌,😍,🥰,😘,😗,😙,😚,😋
🤤,😪,😵,🤐,🥴,🤢,🤮,🤧,😷,🤒,🤕
1 # True
```
### Custom Tests
`./ch-1.pl` will optionally accept a path to a test file or directory of test
files (ie: `$ ./ch-1.pl ./local_test.txt`). Test files must include no more than
2 lines of comma separated values with the last line being either `0` for tests
that should fail or `1` for tests that should pass. Lines beginning with `#`
will be ignored.
## Task 2 > Conflict Intervals
You are given a list of intervals.
Write a script to find out if the current interval conflicts with any of the
previous intervals.
### EXAMPLE
**Input:**
```perl
@intervals = ( [1, 4], [3, 5], [6, 8], [12, 13], [3, 20] );
```
**Output:**
```perl
( [3, 5], [3, 20] )
```
- The 1st interval `[1, 4]` does not have any previous intervals to compare
with, so skip it.
- The 2nd interval `[3, 5]` does conflict with previous interval `[1, 4]`.
- The 3rd interval `[6, 8]` does not conflict with any of the previous
intervals `[1, 4]` and `[3, 5]`, so skip it.
- The 4th interval `[12, 13]` again does not conflict with any previous
intervals `[1, 4]`, `[3, 5]`, or `[6, 8]` so skip it.
- The 5th interval `[3, 20]` conflicts with the first interval `[1, 4]`.
**Input:**
```perl
@intervals = ( [3, 4], [5, 7], [6, 9], [10, 12], [13, 15] );
```
**Output:**
```perl
( [6, 9] );
```
### SOLUTION
```perl
sub find_conflict_intervals {
my $set_ref = shift @_;
my @conflicts = ();
my @passed = ();
if (reftype $set_ref ne "ARRAY") {
print "Array reference not found\n";
return 0;
}
foreach my $set (@$set_ref) {
my ($a1, $a2) = sort { $a <=> $b } @$set;
my $conflict = grep {
my ($b1, $b2) = sort { $a <=> $b } @$_;
($a1 >= $b1 && $a1 <= $b2) ||
($a2 >= $b1 && $a2 <= $b2) ||
($a1 <= $b1 && $a2 >= $b2);
} @passed;
push @passed, [$a1, $a2] if not $conflict;
push @conflicts, [$a1, $a2] if $conflict;
}
return \@conflicts;
}
```
### ch-2.pl
Running `./ch-2.pl` tests our solution against the folowing test cases,
printing `Passed` or `Failed` to the console:
#### Case 1:
```perl
{
"input" => ([1, 4], [3, 5], [6, 8], [12, 13], [3, 20]),
"output" => ([3, 5], [3, 20])
}
```
#### Case 2:
```perl
{
"input" => ([3, 4], [5, 7], [6, 9], [10, 12], [13, 15]),
"output" => ([6, 9])
}
```
#### Case 3:
```perl
{
"input" => ([1.14, 1.56], [2.32, 3], [1.5, 1.72]),
"output" => ([1.5, 1.72])
}
```
#### Case 4:
```perl
{
"input" => ([-234, 10], [-1.12, 11], [11, 111111]),
"output" => ([-1.12, 11])
}
```
#### Case 5:
```perl
{
"input" => ([-1, -1], [1, 3], [3.1, 4], [4, 5]),
"output" => ([4, 5])
}
```
### Custom Tests
`./ch-2.pl` will optionally accept a path to a test file or directory of test
files (ie: `$ ./ch-2.pl ./local_test.json`). Test files must be properly
formatted JSON with both an `"input"` and an `"output"` key.
#### Example Test
```json
{
"input": [
[
1,
3
],
[
2,
4
],
[
6,
7
]
],
"output": [
[
2,
4
]
]
}
```
|
