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
|
#! /opt/local/bin/perl
#
# where_is_wigged.pl
#
# "departed succor blunts malignant social viruses"
#
# it's an unexpectedly dark list of hidden words
#
# TASK #2 › Word Search
# Submitted by: Neil Bowers
# Reviewed by: Ryan Thompson
# Write a script that takes two file names. The first file would
# contain word search grid as shown below. The second file contains
# list of words, one word per line. You could even use local
# dictionary file.
#
# Print out a list of all words seen on the grid, looking both
# orthogonally and diagonally, backwards as well as forwards.
#
# Search Grid
# B I D E M I A T S U C C O R S T
# L D E G G I W Q H O D E E H D P
# U S E I R U B U T E A S L A G U
# N G N I Z I L A I C O S C N U D
# T G M I D S T S A R A R E I F G
# S R E N M D C H A S I V E E L I
# S C S H A E U E B R O A D M T E
# H W O V L P E D D L A I U L S S
# R Y O N L A S F C S T A O G O T
# I G U S S R R U G O V A R Y O C
# N R G P A T N A N G I L A M O O
# E I H A C E I V I R U S E S E D
# S E T S U D T T G A R L I C N H
# H V R M X L W I U M S N S O T B
# A E A O F I L C H T O D C A E U
# Z S C D F E C A A I I R L N R F
# A R I I A N Y U T O O O U T P F
# R S E C I S N A B O S C N E R A
# D R S M P C U U N E L T E S I L
# Output
# Found 55 words of length 5 or more when checked against the local
# dictionary. You may or may not get the same result but that is fine.
#
#
#
#
# 2020 colin crain
## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
use warnings;
use strict;
use feature ":5.26";
## ## ## ## ## MAIN:
my $file = shift @ARGV // 'wordsearch.txt';
my $dict = shift @ARGV // '/usr/share/dict/words';
my $MINWORD = shift @ARGV // 5;
my $matrix = load_search_matrix($file);
print_matrix($matrix);
my $words = build_word_hash($dict);
my @possibles;
my $height = @$matrix - 1;
my $width = $matrix->[0]->@* - 1 ;
for my $y (0..$height) {
for my $x (0..$width) {
push @possibles, word_vectors( $x, $y, $matrix)->@*;
}
}
my @output = grep { exists $words->{$_} } @possibles;
say '';
say "found ", scalar @output, " words of minimum length $MINWORD: \n";
say for sort @output;
## ## ## ## ## SUBS:
sub word_vectors {
my ($x, $y, $matrix) = @_;
my $height = @$matrix - 1;
my $width = $matrix->[0]->@* - 1 ;
my @words;
my @vec ;
my $i;
## horz forward
push $vec[0]->@*, $matrix->[$y][$_] for ($x..$width);
## horz back
push $vec[1]->@*, $matrix->[$y][$_] for reverse (0..$x);
## vert down
push $vec[2]->@*, $matrix->[$_][$x] for ($y..$height);
## vert up
push $vec[3]->@*, $matrix->[$_][$x] for reverse (0..$y);
## diag down forward
$i = $x;
for ($y..$height) { ## y to height index
last if $i > $width;
push $vec[4]->@*, $matrix->[$_][$i++];
}
## diag down back
$i = $x;
for ($y..$height) { ## y to height index
last if $i < 0;
push $vec[5]->@*, $matrix->[$_][$i--];
}
## diag up forward
$i = $x;
for (reverse (0..$y)) { ## 0 to y
last if $i > $width;
push $vec[6]->@*, $matrix->[$_][$i++];
}
## diag up back
$i = $x;
for (reverse (0..$y)) { ## 0 to y
last if $i < 0;
push $vec[7]->@*, $matrix->[$_][$i--];
}
## turn vectors into strings $MINWORD letters or longer
for my $v (@vec) {
next if @$v < $MINWORD;
my $stem = join '', @$v[0..$MINWORD-2];
push @words, map { $stem .= $_ } @$v[$MINWORD-1..@$v-1];
}
return \@words;
}
sub load_search_matrix {
my $file = shift;
open my $fh, '<', $file
or die "cannot open file $file: $!\n";
my @search;
while (my $line = <$fh>) {
push @search, [split /\s/, $line];
}
close $fh;
return \@search;
}
sub print_matrix {
my $matrix = shift;
for (@$matrix) {
say join ' ', @$_;
}
}
sub build_word_hash {
my $dict = shift;
my %hash;
open my $fh, "<", $dict
or die "can't open $dict to read: $!";
while (my $word = <$fh>) {
$word =~ s/[\n\r]//g;
$word = uc($word);
$hash{$word} = 1;
}
return \%hash;
}
|
