Word search: Difference between revisions

</pre>

=={{header|Perl}}==

<lang perl>#!/usr/bin/perl

use strict; # http://www.rosettacode.org/wiki/Word_search

use warnings;

use Path::Tiny;

use List::Util qw( shuffle );

my $size = 10;

my $s1 = $size + 1;

$_ = <<END;

.....R....

......O...

.......S..

........E.

T........T

.A........

..C.......

...O......

....D.....

.....E....

END

my @words = shuffle path('/usr/share/dict/words')->slurp =~ /^[a-z]{3,7}$/gm;

my @played;

my %used;

for my $word ( (@words) x 5 )

{

my ($pat, $start, $end, $mask, $nulls) = find( $word );

defined $pat or next;

$used{$word}++ and next; # only use words once

$nulls //= '';

my $expand = $word =~ s/\B/$nulls/gr;

my $pos = $start;

if( $start > $end )

{

$pos = $end;

$expand = reverse $expand;

}

substr $_, $pos, length $mask,

(substr( $_, $pos, length $mask ) & ~ "$mask") | "$expand";

push @played, join ' ', $word, $start, $end;

tr/.// > 0 or last;

}

print " 0 1 2 3 4 5 6 7 8 9\n\n";

my $row = 0;

print s/(?<=.)(?=.)/ /gr =~ s/^/ $row++ . ' ' /gemr;

print "\nNumber of words: ", @played . "\n\n";

my @where = map

{

my ($word, $start, $end) = split;

sprintf "%11s %s", $word, $start < $end

? "(@{[$start % $s1]},@{[int $start / $s1]})->" .

"(@{[$end % $s1 - 1]},@{[int $end / $s1]})"

: "(@{[$start % $s1 - 1]},@{[int $start / $s1]})->" .

"(@{[$end % $s1]},@{[int $end / $s1]})";

} sort @played;

print splice(@where, 0, 3), "\n" while @where;

tr/.// and die "incomplete";

sub find

{

my ($word) = @_;

my $n = length $word;

my $nm1 = $n - 1;

my %pats;

for my $space ( 0, $size - 1 .. $size + 1 )

{

my $nulls = "\0" x $space;

my $mask = "\xff" . ($nulls . "\xff") x $nm1; # vert

my $gap = qr/.{$space}/s;

while( /(?=(.(?:$gap.){$nm1}))/g )

{

my $pat = ($1 & $mask) =~ tr/\0//dr;

$pat =~ tr/.// or next;

my $pos = "$-[1] $+[1]";

$word =~ /$pat/ or reverse($word) =~ /$pat/ or next;

push @{ $pats{$pat} }, "$pos $mask $nulls";

}

}

for my $key ( sort keys %pats )

{

if( $word =~ /^$key$/ )

{

my @all = @{ $pats{$key} };

return $key, split ' ', $all[ rand @all ];

}

elsif( (reverse $word) =~ /^$key$/ )

{

my @all = @{ $pats{$key} };

my @parts = split ' ', $all[ rand @all ];

return $key, @parts[ 1, 0, 2, 3]

}

}

return undef;

}</lang>

{{out}}

<pre>

0 1 2 3 4 5 6 7 8 9

0 b s g b n R t p r y

1 t u k c r o O i p n

2 t u t y h e d S p a

3 r j m s i i a a E g

4 T e a g a n p d l T

5 m A l i y p g p s b

6 c i C o l e l m y a

7 b o n O r i l e a w

8 w e p i D u n l s l

9 c a l m s E b g s s

Number of words: 26

alb (8,7)->(6,9) anyone (6,3)->(1,8) bawl (9,5)->(9,8)

breads (3,0)->(8,5) but (0,0)->(2,2) calms (0,9)->(4,9)

chippy (3,1)->(8,6) cop (0,6)->(2,8) elm (5,6)->(7,6)

glib (3,4)->(0,7) gut (2,0)->(0,2) jailing (1,3)->(7,9)

mini (0,5)->(3,8) nag (9,1)->(9,3) nodal (4,0)->(8,4)

pew (2,8)->(0,8) ppr (8,2)->(8,0) pry (7,0)->(9,0)

rel (0,3)->(2,5) role (4,7)->(1,4) rub (4,7)->(6,9)

sapless (3,3)->(9,9) skying (1,0)->(6,5) tip (6,0)->(8,2)

tum (0,1)->(2,3) yells (4,5)->(8,9)