Word Seeker

Here is my response to Slipstream's Word Seek. This script prints the same output to the screen as Word Seek, except this script actually searches the puzzle text to find the words. Go ahead and change the search terms and letters in the search area. It will still work.

Restrictions:

Search area must be in ALL CAPS

It only works on a 16x16 letter search area as shown.

use strict;       use warnings;

my  @hidden_words_to_find  =  (
'PERL',  'USESTRICT',  'ARRAY',
'PERLMONKS', 'LENGTH', 'WHILE',
'FOREACH', 'MODULUS',   'CPAN',
'SUBROUTINE','PRINT', 'SCALAR',
'REGEX', 'IF','ELSE',   'WARN',
'BLESS', 'EXIT','HASH', 'JAPH',

);$_='

P X U S E S T R I C T G L A F I
I E E R Z I A P S Z R E E A W N
X A R R A Y E K E D J D L D F J
D F S L W M N C J C E R I C E R
U H F C M O N L E N G T H I D O
M R X H M H Z W I E R X W A S D
H E Y L C E S T R V H W D E W Q
E G R X W M U A D F E G E L S E
C E M J F O R E A C H T R H E C
P X U H R D T Y R P Y N B X P B
W C B B Z U E N R A W A C V R E
D F U V D L S A C N B V Y A I T
S S E L B U B H E W S D L N N D
A D X G E S F K S J G A R T T F
F G I E B N S B Z A C W Q U E A
S D T G A E R N N S H P A J Q D

';my $a=q(s;\n;;g;s# ##g;@_=spl
it(//,$_);my$i=0;for(@_){($i%16
 eq 0)?(print $/):();print,prin
t ' ';$i++}for my$word(@hidden_
words_to_find){my$m=$word;my$g=
$m;$g =~ tr~A-Z~a-z~;my$gi='s/'
."$m".'/'."$g".'/gi';eval$gi;my
 @m=split(//,$m);my @g=split(//
,$g);$gi='s/';for($i=0;$i<(@m-1
);$i++){$gi.="$m[$i]".'(\w{15})
';}$gi.="$m[$i++]".'/';for($i=0
;$i<(@g-1);$i++){my$j=$i+1;$gi.
="$g[$i]".'$'."$j";}$gi.="$g[$i
++]".'/gi';eval$gi;@m=split(//,
$m);@g=split(//,$g);$gi='s/';fo
r($i=0;$i<(@m-1);$i++){$gi.="$m
[$i]".'(\w{16})';}$gi.="$m[$i++
]".'/';for($i=0;$i<(@g-1);$i++)
{my$j=$i+1;$gi.="$g[$i]".'$'."$
j";}$gi.="$g[$i++]".'/gi';eval$
gi;$gi='s/';for($i=0;$i<(@m-1);
$i++){$gi.="$m[$i]".'(\w{14})';
}$gi.="$m[$i++]".'/';for($i=0;$
i<(@g-1);$i++){my$j=$i+1;$gi.="
$g[$i]".'$'."$j";}$gi.="$g[$i++
]".'/gi';eval$gi;@m=reverse(@m)
;@g=reverse(@g);$gi='s/';for($i
=0;$i<(@m-1);$i++){$gi.="$m[$i]
".'(\w{16})';}$gi.="$m[$i++]".'
/';for($i=0;$i<(@g-1);$i++){my$
j=$i+1;$gi.="$g[$i]".'$'."$j";}
$gi.="$g[$i++]".'/gi';eval$gi;$
gi='s/';for($i=0;$i<(@m-1);$i++
){$gi.="$m[$i]".'(\w{14})';}$gi
.="$m[$i++]".'/';for($i=0;$i<(@
g-1);$i++){my$j=$i+1;$gi.="$g[$
i]".'$'."$j";}$gi.="$g[$i++]".'
/gi';eval$gi;$gi='s/';for($i=0;
$i<(@m-1);$i++){$gi.="$m[$i]".'
(\w{15})';}$gi.="$m[$i++]".'/';
for($i=0;$i<(@g-1);$i++){my$j=$
i+1;$gi.="$g[$i]".'$'."$j";}$gi
.="$g[$i++]".'/gi';eval$gi;$m=j
oin"",@m;$g=join"",@g;$gi='s/'.
"$m".'/'."$g".'/gi';eval$gi;}pr
int $/;s;[A-Z]; ;g;@_=split"",$
_;$i=0;for(@_){($i%16 eq 0)?(pr
int $/):();print,print ' ';$i++
});$a=~ s;$/;;g;eval$a; __END__
[download]

Now if only I could get it to work with erudil's find-a-func...

Update: Corrected the array->arrax bug. Well spotted Monarch!

Comment on Word Seeker Download Code

Replies are listed 'Best First'.
Re: Word Seeker by monarch (Priest) on Jun 16, 2005 at 07:53 UTC
Very funky indeed! But I get: `p u s e s t r i c t f i e s e a r r a x k l l n e i o l e n g t h r m i w e l t g r m u e l s e e f o r e a c h p x r d p p b u n r a w r u l n a i s s e l b u h l n x s s a t i a c t s h p a j` [download] Just wondering why array comes out as "arrax" in the puzzle output..?	[reply] [d/l]
Re^2: Word Seeker by ktross (Deacon) on Jun 16, 2005 at 12:55 UTC
"array" came out "arrax" because my translation range was wrong. `tr~A-Z~a-x~` instead of `tr~A-Z~a-z~`. Darn keys are too close together...It's fixed now, I think.	[reply] [d/l] [select]
Re: Word Seeker by kaif (Friar) on Jun 22, 2005 at 08:21 UTC
Here's my attempt to do the same thing. The same restrictions apply to my code. Hope you enjoy it! Note: I have taken a few liberties in my code: I have changed the format of the "header", because I like `qw`, and I have changed the word `warn` to `die`. use strict; use warnings; @_=my @hidden_words_to_find=qw( PERL USESTRICT ARRAY SUBROUTINE EXIT CPAN FOREACH MODULUS BLESS WHILE PERLMONKS PRINT SCALAR IF REGEX ELSE DIE LENGTH HASH JAPH );$_=' P X U S E S T R I C T G L A F I I E E R Z I A P S Z R E E I D N X A R R A Y E K E D J D L D X J D F S L W M N C J C E R I C E R U H F C M O N L E N G T H I D O M R X H M H Z W I E R X W A S D H E Y L C E S T R V H W D E W Q E G R X W M U A D F E G E L S E C E M J F O R E A C H T R H E C P X U H R D T Y R P Y N B X P B W C B B Z U E S C A E A C V R E D F U V D L S A C N B V Y A I T S S E L B U B H E W S D L N N D A D X G E S F K S J G A R T T F F G I E B N S B Z A C W Q U E A S D T G A E R N N S H P A J Q D ';print;s/\n/--/g;for$/(1,30,32 ,34){for$.(@_,map{reverse.""}@_ ){my$x;$"=join"(.{$/})",split// ,$.;$0="";s\|$"\|join"",map{(eval "\$@{[$x++]}") .$_}split//,lc$. \|gei;}}s/-{2}/\n/g;s/[A-Z]/ /g; print"Locations:";print;__END__ [download]	[reply] [d/l] [select]
Re^2: Word Seeker by ktross (Deacon) on Jun 22, 2005 at 14:23 UTC
I knew it could be done with less code than I used, but this is rediculous! kaif++	[reply]


Welcome to the Monastery
	PerlMonks