-
Notifications
You must be signed in to change notification settings - Fork 320
/
ch-1.pl
executable file
·43 lines (35 loc) · 1.25 KB
/
ch-1.pl
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
#!/usr/bin/perl
use v5.16; # The Weekly Challenge - 2023-09-04
use utf8; # Week 233 task 1 - Similar words
use strict; # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
similar_words('aba', 'aabb', 'abcd', 'bac', 'aabc');
similar_words('aabb', 'ab', 'ba');
similar_words('nba', 'cba', 'dba');
similar_words(qw[discovery cervid ciders coders corves cosied cosier covers coveys
credos cyders decors decoys descry devoir dicers dioecy divers dories drives droves
scored scried scrive videos vireos voiced voicer voices voider]);
sub similar_words {
my (@words, $j, $k, $pairs, $rubric);
@words = @_;
$pairs = 0;
# sort letters within each word and remove duplicates
for ($j = 0; $j < scalar @words; $j ++) {
$words[$j] = join('', sort(split('', $words[$j])));
$words[$j] =~ s|(.)\1+|$1|g;
# compare the result with all previous results
if ($j > 0) {
for ($k = 0; $k < $j; $k ++) {
# we have a pair
if ($words[$k] eq $words[$j]) {
$pairs ++;
$rubric .= qq[ Pair $pairs: similar words ('$_[$j]', '$_[$k]')\n];
}
}
}
}
# report
say qq[\nInput: \@words = ('] . join(qq[', '], @_) . qq[')];
say qq[Output: $pairs];
say substr($rubric, 0, -1) if $pairs;
}