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
|
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw{ say signatures state };
no warnings qw{ experimental };
use Getopt::Long;
my $word_grid = 'word_grid.txt';
my $dictionary = '/usr/share/dict/words';
my $output = {};
GetOptions(
'dictionary=s' => \$dictionary,
'wordsearch=s' => \$word_grid,
);
my $words = get_words($dictionary);
my $word_search = get_word_search($word_grid);
do_word_search( $word_search, $words );
my $wc = scalar keys $output->%*;
say join "\n\t", "There were $wc unique words in this word search",
sort keys $output->%*;
sub do_word_search ( $graph, $dictionary ) {
my $xp = scalar $graph->@* - 1;
my $yp = scalar $graph->[0]->@* - 1;
for my $x ( 0 .. $xp ) {
for my $y ( 0 .. $yp ) {
my $l = $graph->[$x][$y];
find_word_vertical( $x + 1, $y, [$l], $graph, $dictionary );
find_word_horizontal( $x, $y + 1, [$l], $graph, $dictionary );
find_word_diagonal( $x + 1, $y + 1, [$l], $graph, $dictionary );
find_word_diagonal2( $x + 1, $y - 1, [$l], $graph, $dictionary );
}
}
}
sub find_word_vertical ( $x, $y, $strp, $graph, $dictionary ) {
my $l = $graph->[$x][$y];
return unless defined $l;
push $strp->@*, $l;
my $w1 = join '', $strp->@*;
my $w2 = join '', reverse $strp->@*;
$output->{$w1}++ if $dictionary->{$w1};
$output->{$w2}++ if $dictionary->{$w2};
find_word_vertical( $x + 1, $y, $strp, $graph, $dictionary );
}
sub find_word_horizontal ( $x, $y, $strp, $graph, $dictionary ) {
my $l = $graph->[$x][$y];
return unless defined $l;
push $strp->@*, $l;
my $w1 = join '', $strp->@*;
my $w2 = join '', reverse $strp->@*;
$output->{$w1}++ if $dictionary->{$w1};
$output->{$w2}++ if $dictionary->{$w2};
find_word_horizontal( $x, $y + 1, $strp, $graph, $dictionary );
}
sub find_word_diagonal ( $x, $y, $strp, $graph, $dictionary ) {
my $l = $graph->[$x][$y];
return unless defined $l;
push $strp->@*, $l;
my $w1 = join '', $strp->@*;
my $w2 = join '', reverse $strp->@*;
$output->{$w1}++ if $dictionary->{$w1};
$output->{$w2}++ if $dictionary->{$w2};
find_word_diagonal( $x + 1, $y + 1, $strp, $graph, $dictionary );
}
sub find_word_diagonal2 ( $x, $y, $strp, $graph, $dictionary ) {
my $l = $graph->[$x][$y];
return unless defined $l;
push $strp->@*, $l;
my $w1 = join '', $strp->@*;
my $w2 = join '', reverse $strp->@*;
$output->{$w1}++ if $dictionary->{$w1};
$output->{$w2}++ if $dictionary->{$w2};
find_word_diagonal( $x + 1, $y - 1, $strp, $graph, $dictionary );
}
sub get_word_search( $file ) {
my $ws = [];
if ( -f $file && open my $fh, '<', $file ) {
while ( my $line = <$fh> ) {
my @line = map { uc $_ } split /\W/, $line;
push $ws->@*, [@line];
}
}
return wantarray ? $ws->@* : $ws;
}
sub get_words ($file) {
my %words;
if ( -f $file && open my $fh, '<', $file ) {
while ( my $word = <$fh> ) {
chomp $word;
$word = uc $word;
next if $word =~ /\W/;
$words{$word} = 1;
}
}
return wantarray ? %words : \%words;
}
|
