Word search
You are encouraged to solve this task according to the task description, using any language you may know.
A word search puzzle typically consists of a grid of letters in which words are hidden.
There are many varieties of word search puzzles. For the task at hand we will use a rectangular grid in which the words may be placed horizontally, vertically, or diagonally. The words may also be spelled backwards.
The words may overlap but are not allowed to zigzag, or wrap around.
- Task
Create a 10 by 10 word search and fill it using words from the unixdict. Use only words that are longer than 2, and contain no non-alphabetic characters.
The cells not used by the hidden words should contain the message: Rosetta Code, read from left to right, top to bottom. These letters should be somewhat evenly distributed over the grid, not clumped together. The message should be in upper case, the hidden words in lower case. All cells should either contain letters from the hidden words or from the message.
Pack a minimum of 25 words into the grid.
Print the resulting grid and the solutions.
- Example
0 1 2 3 4 5 6 7 8 9 0 n a y r y R e l m f 1 y O r e t s g n a g 2 t n e d i S k y h E 3 n o t n c p c w t T 4 a l s u u n T m a x 5 r o k p a r i s h h 6 a A c f p a e a c C 7 u b u t t t O l u n 8 g y h w a D h p m u 9 m i r p E h o g a n parish (3,5)(8,5) gangster (9,1)(2,1) paucity (4,6)(4,0) guaranty (0,8)(0,1) prim (3,9)(0,9) huckster (2,8)(2,1) plasm (7,8)(7,4) fancy (3,6)(7,2) hogan (5,9)(9,9) nolo (1,2)(1,5) under (3,4)(3,0) chatham (8,6)(8,0) ate (4,8)(6,6) nun (9,7)(9,9) butt (1,7)(4,7) hawk (9,5)(6,2) why (3,8)(1,8) ryan (3,0)(0,0) fay (9,0)(7,2) much (8,8)(8,5) tar (5,7)(5,5) elm (6,0)(8,0) max (7,4)(9,4) pup (5,3)(3,5) mph (8,8)(6,8)
- Metrics
- Counting
- Word frequency
- Letter frequency
- Jewels and stones
- I before E except after C
- Bioinformatics/base count
- Count occurrences of a substring
- Count how many vowels and consonants occur in a string
- Remove/replace
- XXXX redacted
- Conjugate a Latin verb
- Remove vowels from a string
- String interpolation (included)
- Strip block comments
- Strip comments from a string
- Strip a set of characters from a string
- Strip whitespace from a string -- top and tail
- Strip control codes and extended characters from a string
- Anagrams/Derangements/shuffling
- Word wheel
- ABC problem
- Sattolo cycle
- Knuth shuffle
- Ordered words
- Superpermutation minimisation
- Textonyms (using a phone text pad)
- Anagrams
- Anagrams/Deranged anagrams
- Permutations/Derangements
- Find/Search/Determine
- ABC words
- Odd words
- Word ladder
- Semordnilap
- Word search
- Wordiff (game)
- String matching
- Tea cup rim text
- Alternade words
- Changeable words
- State name puzzle
- String comparison
- Unique characters
- Unique characters in each string
- Extract file extension
- Levenshtein distance
- Palindrome detection
- Common list elements
- Longest common suffix
- Longest common prefix
- Compare a list of strings
- Longest common substring
- Find common directory path
- Words from neighbour ones
- Change e letters to i in words
- Non-continuous subsequences
- Longest common subsequence
- Longest palindromic substrings
- Longest increasing subsequence
- Words containing "the" substring
- Sum of the digits of n is substring of n
- Determine if a string is numeric
- Determine if a string is collapsible
- Determine if a string is squeezable
- Determine if a string has all unique characters
- Determine if a string has all the same characters
- Longest substrings without repeating characters
- Find words which contains all the vowels
- Find words which contain the most consonants
- Find words which contains more than 3 vowels
- Find words whose first and last three letters are equal
- Find words with alternating vowels and consonants
- Formatting
- Substring
- Rep-string
- Word wrap
- String case
- Align columns
- Literals/String
- Repeat a string
- Brace expansion
- Brace expansion using ranges
- Reverse a string
- Phrase reversals
- Comma quibbling
- Special characters
- String concatenation
- Substring/Top and tail
- Commatizing numbers
- Reverse words in a string
- Suffixation of decimal numbers
- Long literals, with continuations
- Numerical and alphabetical suffixes
- Abbreviations, easy
- Abbreviations, simple
- Abbreviations, automatic
- Song lyrics/poems/Mad Libs/phrases
- Mad Libs
- Magic 8-ball
- 99 bottles of beer
- The Name Game (a song)
- The Old lady swallowed a fly
- The Twelve Days of Christmas
- Tokenize
- Text between
- Tokenize a string
- Word break problem
- Tokenize a string with escaping
- Split a character string based on change of character
- Sequences
11l
<lang 11l>-V
dirs = [[1, 0], [ 0, 1], [ 1, 1], [1, -1], [-1, 0], [0, -1], [-1, -1], [-1, 1]] n_rows = 10 n_cols = 10 grid_size = n_rows * n_cols min_words = 25
T Grid
num_attempts = 0 String cells = [[‘’] * :n_cols] * :n_rows [String] solutions
F read_words(filename)
[String] words L(line) File(filename).read_lines() V s = line.lowercase() I re:‘^[a-z]{3,10}’.match(s) words.append(s) R words
F place_message(Grid &grid; =msg)
msg = msg.uppercase().replace(re:‘[^A-Z]’, ‘’) V message_len = msg.len I message_len C 0 <.< :grid_size V gap_size = :grid_size I/ message_len
L(i) 0 .< message_len V pos = i * gap_size + random:(0 .. gap_size) grid.cells[pos I/ :n_cols][pos % :n_cols] = msg[i]
R message_len R 0
F try_location(Grid &grid; word, direction, pos)
V r = pos I/ :n_cols V c = pos % :n_cols V length = word.len
I (:dirs[direction][0] == 1 & (length + c) > :n_cols) | (:dirs[direction][0] == -1 & (length - 1) > c) | (:dirs[direction][1] == 1 & (length + r) > :n_rows) | (:dirs[direction][1] == -1 & (length - 1) > r) R 0
V rr = r V cc = c V i = 0 V overlaps = 0
L i < length I grid.cells[rr][cc] != ‘’ & grid.cells[rr][cc] != word[i] R 0 cc += :dirs[direction][0] rr += :dirs[direction][1] i++
rr = r cc = c i = 0
L i < length I grid.cells[rr][cc] == word[i] overlaps++ E grid.cells[rr][cc] = word[i]
I i < length - 1 cc += :dirs[direction][0] rr += :dirs[direction][1] i++
V letters_placed = length - overlaps I letters_placed > 0 grid.solutions.append(‘#<10 (#.,#.)(#.,#.)’.format(word, c, r, cc, rr))
R letters_placed
F try_place_word(Grid &grid; word)
V rand_dir = random:(0 .. :dirs.len) V rand_pos = random:(0 .. :grid_size)
L(=direction) 0 .< :dirs.len direction = (direction + rand_dir) % :dirs.len
L(=pos) 0 .< :grid_size pos = (pos + rand_pos) % :grid_size V letters_placed = try_location(&grid, word, direction, pos) I letters_placed > 0 R letters_placed R 0
F create_word_search(&words)
V grid = Grid() V num_attempts = 0
L num_attempts < 100 num_attempts++ random:shuffle(&words) grid = Grid() V message_len = place_message(&grid, ‘Rosetta Code’) V target = :grid_size - message_len V cells_filled = 0 L(word) words cells_filled += try_place_word(&grid, word) I cells_filled == target I grid.solutions.len >= :min_words grid.num_attempts = num_attempts R grid E L.break R grid
F print_result(grid)
I grid.num_attempts == 0 print(‘No grid to display’) R
V size = grid.solutions.len
print(‘Attempts: #.’.format(grid.num_attempts)) print(‘Number of words: #.’.format(size))
print("\n 0 1 2 3 4 5 6 7 8 9\n") L(r) 0 .< :n_rows print(‘#. ’.format(r), end' ‘’) L(c) 0 .< :n_cols print(‘ #. ’.format(grid.cells[r][c]), end' ‘’) print() print()
L(i) (0 .< size - 1).step(2) print(‘#. #.’.format(grid.solutions[i], grid.solutions[i + 1]))
I size % 2 == 1 print(grid.solutions[size - 1])
print_result(create_word_search(&read_words(‘unixdict.txt’)))</lang>
- Output:
Attempts: 2 Number of words: 26 0 1 2 3 4 5 6 7 8 9 0 a s i a t i c R w t 1 O n o i l l i t o c 2 a a r o n a S r k e 3 d a l y h E i n r v 4 t T n t u T i o d e 5 d e l a y t c n w n 6 d r A n s a C o a t 7 t c o O b c d g o f 8 s w e l l n i r D u 9 s h a l e E w a c l deny (0,6)(3,3) tan (3,4)(3,6) cotillion (9,1)(1,1) aaron (0,2)(4,2) albacore (2,9)(9,2) eventful (9,2)(9,9) stink (4,6)(8,2) endow (4,9)(8,5) asiatic (0,0)(6,0) daly (0,3)(3,3) swell (0,8)(4,8) delay (0,5)(4,5) shale (0,9)(4,9) argon (7,9)(7,5) tori (9,0)(6,3) oct (2,7)(0,7) yuh (4,5)(4,3) sci (4,6)(6,8) tor (9,6)(7,8) wac (6,9)(8,9) lord (3,8)(0,5) rat (2,2)(0,4) ode (7,4)(9,4) fan (9,7)(7,5) ala (5,2)(3,0) wok (8,0)(8,2)
C#
<lang csharp>using System; using System.Collections.Generic; using System.Linq; using System.Text.RegularExpressions;
namespace Wordseach {
static class Program { readonly static int[,] dirs = {{1, 0}, {0, 1}, {1, 1}, {1, -1}, {-1, 0}, {0, -1}, {-1, -1}, {-1, 1}};
class Grid { public char[,] Cells = new char[nRows, nCols]; public List<string> Solutions = new List<string>(); public int NumAttempts; }
readonly static int nRows = 10; readonly static int nCols = 10; readonly static int gridSize = nRows * nCols; readonly static int minWords = 25;
readonly static Random rand = new Random();
static void Main(string[] args) { PrintResult(CreateWordSearch(ReadWords("unixdict.txt"))); }
private static List<string> ReadWords(string filename) { int maxLen = Math.Max(nRows, nCols);
return System.IO.File.ReadAllLines(filename) .Select(s => s.Trim().ToLower()) .Where(s => Regex.IsMatch(s, "^[a-z]{3," + maxLen + "}$")) .ToList(); }
private static Grid CreateWordSearch(List<string> words) { int numAttempts = 0;
while (++numAttempts < 100) { words.Shuffle();
var grid = new Grid(); int messageLen = PlaceMessage(grid, "Rosetta Code"); int target = gridSize - messageLen;
int cellsFilled = 0; foreach (var word in words) { cellsFilled += TryPlaceWord(grid, word); if (cellsFilled == target) { if (grid.Solutions.Count >= minWords) { grid.NumAttempts = numAttempts; return grid; } else break; // grid is full but we didn't pack enough words, start over } } } return null; }
private static int TryPlaceWord(Grid grid, string word) { int randDir = rand.Next(dirs.GetLength(0)); int randPos = rand.Next(gridSize);
for (int dir = 0; dir < dirs.GetLength(0); dir++) { dir = (dir + randDir) % dirs.GetLength(0);
for (int pos = 0; pos < gridSize; pos++) { pos = (pos + randPos) % gridSize;
int lettersPlaced = TryLocation(grid, word, dir, pos); if (lettersPlaced > 0) return lettersPlaced; } } return 0; }
private static int TryLocation(Grid grid, string word, int dir, int pos) { int r = pos / nCols; int c = pos % nCols; int len = word.Length;
// check bounds if ((dirs[dir, 0] == 1 && (len + c) > nCols) || (dirs[dir, 0] == -1 && (len - 1) > c) || (dirs[dir, 1] == 1 && (len + r) > nRows) || (dirs[dir, 1] == -1 && (len - 1) > r)) return 0;
int rr, cc, i, overlaps = 0;
// check cells for (i = 0, rr = r, cc = c; i < len; i++) { if (grid.Cells[rr, cc] != 0 && grid.Cells[rr, cc] != word[i]) { return 0; }
cc += dirs[dir, 0]; rr += dirs[dir, 1]; }
// place for (i = 0, rr = r, cc = c; i < len; i++) { if (grid.Cells[rr, cc] == word[i]) overlaps++; else grid.Cells[rr, cc] = word[i];
if (i < len - 1) { cc += dirs[dir, 0]; rr += dirs[dir, 1]; } }
int lettersPlaced = len - overlaps; if (lettersPlaced > 0) { grid.Solutions.Add($"{word,-10} ({c},{r})({cc},{rr})"); }
return lettersPlaced; }
private static int PlaceMessage(Grid grid, string msg) { msg = Regex.Replace(msg.ToUpper(), "[^A-Z]", "");
int messageLen = msg.Length; if (messageLen > 0 && messageLen < gridSize) { int gapSize = gridSize / messageLen;
for (int i = 0; i < messageLen; i++) { int pos = i * gapSize + rand.Next(gapSize); grid.Cells[pos / nCols, pos % nCols] = msg[i]; } return messageLen; } return 0; }
public static void Shuffle<T>(this IList<T> list) { int n = list.Count; while (n > 1) { n--; int k = rand.Next(n + 1); T value = list[k]; list[k] = list[n]; list[n] = value; } }
private static void PrintResult(Grid grid) { if (grid == null || grid.NumAttempts == 0) { Console.WriteLine("No grid to display"); return; } int size = grid.Solutions.Count;
Console.WriteLine("Attempts: " + grid.NumAttempts); Console.WriteLine("Number of words: " + size);
Console.WriteLine("\n 0 1 2 3 4 5 6 7 8 9"); for (int r = 0; r < nRows; r++) { Console.Write("\n{0} ", r); for (int c = 0; c < nCols; c++) Console.Write(" {0} ", grid.Cells[r, c]); }
Console.WriteLine("\n");
for (int i = 0; i < size - 1; i += 2) { Console.WriteLine("{0} {1}", grid.Solutions[i], grid.Solutions[i + 1]); } if (size % 2 == 1) Console.WriteLine(grid.Solutions[size - 1]);
Console.ReadLine(); } }
}</lang>
Attempts: 1 Number of words: 28 0 1 2 3 4 5 6 7 8 9 0 i m n e p o R p i d 1 s u r O e l d n i b 2 n e S b a n d y a E 3 a s d i t h y t T b 4 m u a r n s a u d r 5 s m h T o s o i h o 6 d A c r t C p c r t 7 a y p e p a n O c h 8 e o D o r u x g s a 9 l b E w l a k n o h rapid (4,8)(8,4) bindle (9,1)(4,1) bandy (3,2)(7,2) leadsman (0,9)(0,2) accost (9,8)(4,3) museum (1,5)(1,0) taste (7,3)(3,7) broth (9,3)(9,7) rosy (3,6)(6,3) honk (9,9)(6,9) chad (2,6)(2,3) lunch (4,9)(8,5) open (5,0)(2,0) gsa (7,8)(9,8) dip (9,0)(7,0) ansi (0,3)(0,0) pol (2,7)(0,9) boy (1,9)(1,7) woe (3,9)(3,7) tax (4,6)(6,8) rib (3,4)(3,2) not (4,4)(4,6) hair (5,3)(8,6) bat (9,1)(7,3) nyu (5,2)(7,4) ape (5,7)(3,7) era (3,7)(5,9) ere (1,2)(3,0)
C++
<lang cpp>
- include <iomanip>
- include <ctime>
- include <iostream>
- include <vector>
- include <string>
- include <algorithm>
- include <fstream>
const int WID = 10, HEI = 10, MIN_WORD_LEN = 3, MIN_WORD_CNT = 25;
class Cell { public:
Cell() : val( 0 ), cntOverlap( 0 ) {} char val; int cntOverlap;
}; class Word { public:
Word( std::string s, int cs, int rs, int ce, int re, int dc, int dr ) : word( s ), cols( cs ), rows( rs ), cole( ce ), rowe( re ), dx( dc ), dy( dr ) {} bool operator ==( const std::string& s ) { return 0 == word.compare( s ); } std::string word; int cols, rows, cole, rowe, dx, dy;
}; class words { public:
void create( std::string& file ) { std::ifstream f( file.c_str(), std::ios_base::in ); std::string word; while( f >> word ) { if( word.length() < MIN_WORD_LEN || word.length() > WID || word.length() > HEI ) continue; if( word.find_first_not_of( "abcdefghijklmnopqrstuvwxyz" ) != word.npos ) continue; dictionary.push_back( word ); } f.close(); std::random_shuffle( dictionary.begin(), dictionary.end() ); buildPuzzle(); }
void printOut() { std::cout << "\t"; for( int x = 0; x < WID; x++ ) std::cout << x << " "; std::cout << "\n\n"; for( int y = 0; y < HEI; y++ ) { std::cout << y << "\t"; for( int x = 0; x < WID; x++ ) std::cout << puzzle[x][y].val << " "; std::cout << "\n"; } size_t wid1 = 0, wid2 = 0; for( size_t x = 0; x < used.size(); x++ ) { if( x & 1 ) { if( used[x].word.length() > wid1 ) wid1 = used[x].word.length(); } else { if( used[x].word.length() > wid2 ) wid2 = used[x].word.length(); } } std::cout << "\n"; std::vector<Word>::iterator w = used.begin(); while( w != used.end() ) { std::cout << std::right << std::setw( wid1 ) << ( *w ).word << " (" << ( *w ).cols << ", " << ( *w ).rows << ") (" << ( *w ).cole << ", " << ( *w ).rowe << ")\t"; w++; if( w == used.end() ) break; std::cout << std::setw( wid2 ) << ( *w ).word << " (" << ( *w ).cols << ", " << ( *w ).rows << ") (" << ( *w ).cole << ", " << ( *w ).rowe << ")\n"; w++; } std::cout << "\n\n"; }
private:
void addMsg() { std::string msg = "ROSETTACODE"; int stp = 9, p = rand() % stp; for( size_t x = 0; x < msg.length(); x++ ) { puzzle[p % WID][p / HEI].val = msg.at( x ); p += rand() % stp + 4; } } int getEmptySpaces() { int es = 0; for( int y = 0; y < HEI; y++ ) { for( int x = 0; x < WID; x++ ) { if( !puzzle[x][y].val ) es++; } } return es; } bool check( std::string word, int c, int r, int dc, int dr ) { for( size_t a = 0; a < word.length(); a++ ) { if( c < 0 || r < 0 || c >= WID || r >= HEI ) return false; if( puzzle[c][r].val && puzzle[c][r].val != word.at( a ) ) return false; c += dc; r += dr; } return true; } bool setWord( std::string word, int c, int r, int dc, int dr ) { if( !check( word, c, r, dc, dr ) ) return false; int sx = c, sy = r; for( size_t a = 0; a < word.length(); a++ ) { if( !puzzle[c][r].val ) puzzle[c][r].val = word.at( a ); else puzzle[c][r].cntOverlap++; c += dc; r += dr; } used.push_back( Word( word, sx, sy, c - dc, r - dr, dc, dr ) ); return true; } bool add2Puzzle( std::string word ) { int x = rand() % WID, y = rand() % HEI, z = rand() % 8; for( int d = z; d < z + 8; d++ ) { switch( d % 8 ) { case 0: if( setWord( word, x, y, 1, 0 ) ) return true; break; case 1: if( setWord( word, x, y, -1, -1 ) ) return true; break; case 2: if( setWord( word, x, y, 0, 1 ) ) return true; break; case 3: if( setWord( word, x, y, 1, -1 ) ) return true; break; case 4: if( setWord( word, x, y, -1, 0 ) ) return true; break; case 5: if( setWord( word, x, y, -1, 1 ) ) return true; break; case 6: if( setWord( word, x, y, 0, -1 ) ) return true; break; case 7: if( setWord( word, x, y, 1, 1 ) ) return true; break; } } return false; } void clearWord() { if( used.size() ) { Word lastW = used.back(); used.pop_back();
for( size_t a = 0; a < lastW.word.length(); a++ ) { if( puzzle[lastW.cols][lastW.rows].cntOverlap == 0 ) { puzzle[lastW.cols][lastW.rows].val = 0; } if( puzzle[lastW.cols][lastW.rows].cntOverlap > 0 ) { puzzle[lastW.cols][lastW.rows].cntOverlap--; } lastW.cols += lastW.dx; lastW.rows += lastW.dy; } } } void buildPuzzle() { addMsg(); int es = 0, cnt = 0; size_t idx = 0; do { for( std::vector<std::string>::iterator w = dictionary.begin(); w != dictionary.end(); w++ ) { if( std::find( used.begin(), used.end(), *w ) != used.end() ) continue; if( add2Puzzle( *w ) ) { es = getEmptySpaces(); if( !es && used.size() >= MIN_WORD_CNT ) return; } } clearWord(); std::random_shuffle( dictionary.begin(), dictionary.end() );
} while( ++cnt < 100 ); } std::vector<Word> used; std::vector<std::string> dictionary; Cell puzzle[WID][HEI];
}; int main( int argc, char* argv[] ) {
unsigned s = unsigned( time( 0 ) ); srand( s ); words w; w.create( std::string( "unixdict.txt" ) ); w.printOut(); return 0;
} </lang>
- Output:
0 1 2 3 4 5 6 7 8 9 0 d b R f t a u n p w 1 O i l o b h a m a o 2 S r e e r p E t r h 3 e c o r a T l i e T 4 f a m e w A e n t s 5 l n C h u y p g o l 6 o n p t O n s e o D 7 w e u b e f i a c b 8 E i n e m a d a m e 9 e s s k a p l a n e thereof (3, 6) (3, 0) seen (2, 9) (5, 6) pareto (8, 0) (8, 5) wolf (0, 7) (0, 4) crib (1, 3) (1, 0) tinge (7, 2) (7, 6) sienna (1, 9) (1, 4) war (4, 4) (4, 2) dispel (6, 8) (6, 3) kaplan (3, 9) (8, 9) tau (4, 0) (6, 0) lob (2, 1) (4, 1) how (9, 2) (9, 0) same (6, 6) (9, 9) men (4, 8) (2, 8) feb (5, 7) (3, 7) ham (5, 1) (7, 1) moe (2, 4) (2, 2) pan (5, 2) (7, 0) yuh (5, 5) (3, 5) pun (2, 6) (2, 8) load (9, 5) (6, 8) can (1, 3) (1, 5) madame (4, 8) (9, 8) gob (7, 5) (9, 7) rib (1, 2) (1, 0) nee (5, 6) (3, 8) set (9, 4) (7, 2) alp (7, 9) (5, 9) wolfe (0, 7) (0, 3) the (3, 6) (3, 4) low (0, 5) (0, 7) tea (3, 6) (5, 8) era (8, 3) (8, 1) nne (1, 5) (1, 7) amen (5, 8) (2, 8) coot (8, 7) (8, 4) anne (1, 4) (1, 7) reid (3, 3) (0, 0) sse (2, 9) (0, 9)
D
<lang D>import std.random : Random, uniform, randomShuffle; import std.stdio;
immutable int[][] dirs = [
[1, 0], [ 0, 1], [ 1, 1], [1, -1], [-1, 0], [0, -1], [-1, -1], [-1, 1]
];
enum nRows = 10; enum nCols = 10; enum gridSize = nRows * nCols; enum minWords = 25;
auto rnd = Random();
class Grid {
int numAttempts; char[nRows][nCols] cells; string[] solutions;
this() { for(int row=0; row<nRows; ++row) { cells[row] = 0; } }
}
void main() {
printResult(createWordSearch(readWords("unixdict.txt")));
}
string[] readWords(string filename) {
import std.algorithm : all, max; import std.ascii : isAlpha; import std.string : chomp, toLower;
auto maxlen = max(nRows, nCols);
string[] words; auto source = File(filename); foreach(line; source.byLine) { chomp(line); if (line.length >= 3 && line.length <= maxlen) { if (all!isAlpha(line)) { words ~= line.toLower.idup; } } }
return words;
}
Grid createWordSearch(string[] words) {
Grid grid; int numAttempts;
outer: while(++numAttempts < 100) { randomShuffle(words);
grid = new Grid(); int messageLen = placeMessage(grid, "Rosetta Code"); int target = gridSize - messageLen;
int cellsFilled; foreach (string word; words) { cellsFilled += tryPlaceWord(grid, word); if (cellsFilled == target) { if (grid.solutions.length >= minWords) { grid.numAttempts = numAttempts; break outer; } else break; // grid is full but we didn't pack enough words, start over } } } return grid;
}
int placeMessage(Grid grid, string msg) {
import std.algorithm : filter; import std.ascii : isUpper; import std.conv : to; import std.string : toUpper;
msg = to!string(msg.toUpper.filter!isUpper);
if (msg.length > 0 && msg.length < gridSize) { int gapSize = gridSize / msg.length;
for (int i=0; i<msg.length; i++) { int pos = i * gapSize + uniform(0, gapSize, rnd); grid.cells[pos / nCols][pos % nCols] = msg[i]; } return msg.length; } return 0;
}
int tryPlaceWord(Grid grid, string word) {
int randDir = uniform(0, dirs.length, rnd); int randPos = uniform(0, gridSize, rnd);
for (int dir=0; dir<dirs.length; dir++) { dir = (dir + randDir) % dirs.length;
for (int pos=0; pos<gridSize; pos++) { pos = (pos + randPos) % gridSize;
int lettersPlaced = tryLocation(grid, word, dir, pos); if (lettersPlaced > 0) { return lettersPlaced; } } } return 0;
}
int tryLocation(Grid grid, string word, int dir, int pos) {
import std.format;
int r = pos / nCols; int c = pos % nCols; int len = word.length;
// check bounds if ((dirs[dir][0] == 1 && (len + c) > nCols) || (dirs[dir][0] == -1 && (len - 1) > c) || (dirs[dir][1] == 1 && (len + r) > nRows) || (dirs[dir][1] == -1 && (len - 1) > r)) { return 0; }
int i, rr, cc, overlaps = 0;
// check cells for (i=0, rr=r, cc=c; i<len; i++) { if (grid.cells[rr][cc] != 0 && grid.cells[rr][cc] != word[i]) { return 0; } cc += dirs[dir][0]; rr += dirs[dir][1]; }
// place for (i=0, rr=r, cc=c; i<len; i++) { if (grid.cells[rr][cc] == word[i]) { overlaps++; } else { grid.cells[rr][cc] = word[i]; }
if (i < len - 1) { cc += dirs[dir][0]; rr += dirs[dir][1]; } }
int lettersPlaced = len - overlaps; if (lettersPlaced > 0) { grid.solutions ~= format("%-10s (%d,%d)(%d,%d)", word, c, r, cc, rr); }
return lettersPlaced;
}
void printResult(Grid grid) {
if (grid is null || grid.numAttempts == 0) { writeln("No grid to display"); return; } int size = grid.solutions.length;
writeln("Attempts: ", grid.numAttempts); writeln("Number of words: ", size);
writeln("\n 0 1 2 3 4 5 6 7 8 9"); for (int r=0; r<nRows; r++) { writef("\n%d ", r); for (int c=0; c<nCols; c++) { writef(" %c ", grid.cells[r][c]); } }
writeln; writeln;
for (int i=0; i<size-1; i+=2) { writef("%s %s\n", grid.solutions[i], grid.solutions[i + 1]); } if (size % 2 == 1) { writeln(grid.solutions[size - 1]); }
}</lang>
- Output:
Attempts: 1 Number of words: 30 0 1 2 3 4 5 6 7 8 9 0 e w R m p u n i s h 1 y e a g h O a s r r 2 S c g y i p r p i a 3 h v E c s g e T c b 4 t o f c m w T s o n 5 o n o t e h a i o A 6 t n g e u l s g n j 7 o C y l l e u i O w 8 e o k f a l l d D o 9 n m i l l i e E e o etc (3,6)(3,4) boise (9,3)(5,7) joseph (9,6)(4,1) von (1,3)(1,5) elude (4,5)(8,9) toe (0,6)(0,8) swag (4,3)(7,6) hulk (5,5)(2,8) psi (7,2)(7,0) millie (1,9)(6,9) mcgee (4,4)(0,0) mach (3,0)(0,3) yip (3,2)(5,2) fall (3,8)(6,8) punish (4,0)(9,0) fogy (2,4)(2,7) rico (8,1)(8,4) woo (9,7)(9,9) gmt (5,3)(3,5) tot (0,6)(0,4) lin (6,8)(8,6) bar (9,3)(9,1) era (6,3)(6,1) son (7,4)(9,4) way (1,0)(3,2) con (3,4)(1,6) yon (2,7)(0,9) ell (6,9)(4,7) gig (5,3)(3,1) yea (0,1)(2,1)
FreeBASIC
<lang freebasic> Randomize Timer ' OK getting a good puzzle every time
'overhauled Dim Shared As Byte LengthLimit(3 To 10) 'reset in Initialize, track and limit longer words
'LoadWords opens file of words and sets Dim Shared As Integer NWORDS 'set in LoadWords, number of words with length: > 2 and < 11 and just letters
' word file words (shuffled) to be fit into puzzle and index position Dim Shared As String WORDSSS(1 To 24945), CWORDSSS(1 To 24945) Dim Shared As Integer WORDSINDEX 'the file has 24945 words but many are unsuitable
'words placed in Letters grid, word itself (WSS) x, y head (WX, WY) and direction (WD), WI is the index to all these Dim Shared As String WSS(1 To 100) Dim Shared As Byte WX(1 To 100), WY(1 To 100), WD(1 To 100), WI
' letters grid and direction arrays Dim Shared As String LSS(0 To 9, 0 To 9) Dim Shared As Byte DX(0 To 7), DY(0 To 7) DX(0) = 1: DY(0) = 0 DX(1) = 1: DY(1) = 1 DX(2) = 0: DY(2) = 1 DX(3) = -1: DY(3) = 1 DX(4) = -1: DY(4) = 0 DX(5) = -1: DY(5) = -1 DX(6) = 0: DY(6) = -1 DX(7) = 1: DY(7) = -1
'to store all the words found embedded in the grid LSS() Dim Shared As String ALLSS(1 To 200) Dim Shared As Byte AllX(1 To 200), AllY(1 To 200), AllD(1 To 200) 'to store all the words found embedded in the grid LSS() Dim Shared As Integer ALLindex
' signal successful fill of puzzle Dim Shared FILLED As Boolean FILLED = 0 Dim As Byte try try = 1
Sub LoadWords
Dim As String wdSS Dim As Integer i, m Dim ok As Boolean Open "unixdict.txt" For Input As #1 While Eof(1) = 0 Input #1, wdSS If Len(wdSS) > 2 And Len(wdSS) < 11 Then ok = -1 For m = 1 To Len(wdSS) If Asc(wdSS, m) < 97 Or Asc(wdSS, m) > 122 Then ok = 0: Exit For Next If ok Then i += 1: WORDSSS(i) = wdSS: CWORDSSS(i) = wdSS End If Wend Close #1 NWORDS = i
End Sub
Sub Shuffle
Dim As Integer i, r For i = NWORDS To 2 Step -1 r = Int(Rnd * i) + 1 Swap WORDSSS(i), WORDSSS(r) Next i
End Sub
Sub Initialize
Dim As Byte r, c, x, y, d Dim As String wdSS For r = 0 To 9 For c = 0 To 9 LSS(c, r) = " " Next c Next r 'reset word arrays by resetting the word index back to zero WI = 0 'fun stuff for me but doubt others would like that much fun! 'pluggin "basic", 0, 0, 2 'pluggin "plus", 1, 0, 0 'to assure the spreading of ROSETTA CODE LSS(Int(Rnd * 5) + 5, 0) = "R": LSS(Int(Rnd * 9) + 1, 1) = "O" LSS(Int(Rnd * 9) + 1, 2) = "S": LSS(Int(Rnd * 9) + 1, 3) = "E" LSS(1, 4) = "T": LSS(9, 4) = "T": LSS(Int(10 * Rnd), 5) = "A" LSS(Int(10 * Rnd), 6) = "C": LSS(Int(10 * Rnd), 7) = "O" LSS(Int(10 * Rnd), 8) = "D": LSS(Int(10 * Rnd), 9) = "E" 'reset limits LengthLimit(3) = 200 LengthLimit(4) = 6 LengthLimit(5) = 3 LengthLimit(6) = 2 LengthLimit(7) = 1 LengthLimit(8) = 0 LengthLimit(9) = 0 LengthLimit(10) = 0 'reset word order Shuffle
End Sub
'for fun plug-in of words Sub pluggin (wdSS As String, x As Integer, y As Integer, d As Integer)
For i As Byte = 0 To Len(wdSS) - 1 LSS(x + i * DX(d), y + i * DY(d)) = Mid(wdSS, i + 1, 1) Next i WI += WI WSS(WI) = wdSS: WX(WI) = x: WY(WI) = y: WD(WI) = d
End Sub
Function TrmSS (n As Integer) As String
TrmSS = Rtrim(Ltrim(Str(n)))
End Function
'used in PlaceWord Function CountSpaces () As Integer
Dim As Byte x, y Dim count As Integer For y = 0 To 9 For x = 0 To 9 If LSS(x, y) = " " Then count += 1 Next x Next y CountSpaces = count
End Function
Sub ShowPuzzle
Dim As Byte i, x, y Dim As String wateSS Cls Print " 0 1 2 3 4 5 6 7 8 9" Locate 3, 1 For i = 0 To 9 Print TrmSS(i) Next i For y = 0 To 9 For x = 0 To 9 Locate y + 3, 2 * x + 5: Print LSS(x, y) Next x Next y For i = 1 To WI If i < 20 Then Locate i + 1, 30: Print TrmSS(i); " "; WSS(i) Elseif i < 40 Then Locate i - 20 + 1, 45: Print TrmSS(i); " "; WSS(i) Elseif i < 60 Then Locate i - 40 + 1, 60: Print TrmSS(i); " "; WSS(i) End If Next i Locate 18, 1: Print "Spaces left:"; CountSpaces Locate 19, 1: Print NWORDS Locate 20, 1: Print Space(16) If WORDSINDEX Then Locate 20, 1: Print TrmSS(WORDSINDEX); " "; WORDSSS(WORDSINDEX) 'LOCATE 15, 1: INPUT "OK, press enter... "; wateSS
End Sub
'used in PlaceWord Function Match (word As String, template As String) As Integer
Dim i As Integer Dim c As String Match = 0 If Len(word) <> Len(template) Then Exit Function For i = 1 To Len(template) If Asc(template, i) <> 32 And (Asc(word, i) <> Asc(template, i)) Then Exit Function Next Match = -1
End Function
'heart of puzzle builder Sub PlaceWord
' place the words randomly in the grid ' start at random spot and work forward or back 100 times = all the squares ' for each open square try the 8 directions for placing the word ' even if word fits Rossetta Challenge task requires leaving 11 openings to insert ROSETTA CODE, ' exactly 11 spaces needs to be left, if/when this occurs FILLED will be set true to signal finished to main loop ' if place a word update LSS, WI, WSS(WI), WX(WI), WY(WI), WD(WI) Dim As String wdSS, templateSS, wateSS Dim As Byte wLen, spot, testNum, rdir Dim As Byte x, y, d, dNum, rdd, i, j Dim As Boolean b1, b2 wdSS = WORDSSS(WORDSINDEX) 'the right side is all shared 'skip too many long words If LengthLimit(Len(wdSS)) Then LengthLimit(Len(wdSS)) += 1 Else Exit Sub 'skip long ones wLen = Len(wdSS) - 1 ' from the spot there are this many letters to check spot = Int(Rnd * 100) ' a random spot on grid testNum = 1 ' when this hits 100 we've tested all possible spots on grid If Rnd < .5 Then rdir = -1 Else rdir = 1 ' go forward or back from spot for next test While testNum < 101 y = Int(spot / 10) x = spot Mod 10 If LSS(x, y) = Mid(wdSS, 1, 1) Or LSS(x, y) = " " Then d = Int(8 * Rnd) If Rnd < .5 Then rdd = -1 Else rdd = 1 dNum = 1 While dNum < 9 'will wdSS fit? from at x, y templateSS = "" b1 = wLen * DX(d) + x >= 0 And wLen * DX(d) + x <= 9 b2 = wLen * DY(d) + y >= 0 And wLen * DY(d) + y <= 9 If b1 And b2 Then 'build the template of letters and spaces from Letter grid For i = 0 To wLen templateSS += LSS(x + i * DX(d), y + i * DY(d)) Next If Match(wdSS, templateSS) Then 'the word will fit but does it fill anything? For j = 1 To Len(templateSS) If Asc(templateSS, j) = 32 Then 'yes a space to fill For i = 0 To wLen LSS(x + i * DX(d), y + i * DY(d)) = Mid(wdSS, i + 1, 1) Next WI += 1 WSS(WI) = wdSS: WX(WI) = x: WY(WI) = y: WD(WI) = d If CountSpaces = 0 Then FILLED = -1 Exit Sub 'get out now that word is loaded End If Next 'if still here keep looking End If End If d = (d + 8 + rdd) Mod 8 dNum += 1 Wend End If spot = (spot + 100 + rdir) Mod 100 testNum += 1 Wend
End Sub
Sub FindAllWords
Dim As String wdSS, templateSS, wateSS Dim As Byte wLen, x, y, d, j Dim As Boolean b1, b2 For i As Integer = 1 To NWORDS wdSS = CWORDSSS(i) wLen = Len(wdSS) - 1 For y = 0 To 9 For x = 0 To 9 If LSS(x, y) = Mid(wdSS, 1, 1) Then For d = 0 To 7 b1 = wLen * DX(d) + x >= 0 And wLen * DX(d) + x <= 9 b2 = wLen * DY(d) + y >= 0 And wLen * DY(d) + y <= 9 If b1 And b2 Then 'build the template of letters and spaces from Letter grid templateSS = "" For j = 0 To wLen templateSS += LSS(x + j * DX(d), y + j * DY(d)) Next j If templateSS = wdSS Then 'founda word 'store it ALLindex += 1 ALLSS(ALLindex) = wdSS: AllX(ALLindex) = x: AllY(ALLindex) = y: AllD(ALLindex) = d 'report it Locate 22, 1: Print Space(50) Locate 22, 1: Print "Found: "; wdSS; " ("; TrmSS(x); ", "; TrmSS(y); ") >>>---> "; TrmSS(d); Input " Press enter...", wateSS End If End If Next d End If Next x Next y Next i
End Sub
Sub FilePuzzle
Dim As Byte i, r, c Dim As String bSS Open "WS Puzzle.txt" For Output As #1 Print " 0 1 2 3 4 5 6 7 8 9" Print "" For r = 0 To 9 bSS = TrmSS(r) + " " For c = 0 To 9 bSS += LSS(c, r) + " " Next c Print bSS Next r Print "" Print "Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE" Print "" Print " These are the items from unixdict.txt used to build the puzzle:" Print "" For i = 1 To WI Step 2 Print Right(Space(7) + TrmSS(i), 7); ") "; Right(Space(7) + WSS(i), 10); " ("; TrmSS(WX(i)); ", "; TrmSS(WY(i)); ") >>>---> "; TrmSS(WD(i)); If i + 1 <= WI Then Print Right(Space(7) + TrmSS(i + 1), 7); ") "; Right(Space(7) + WSS(i + 1), 10); " ("; TrmSS(WX(i + 1)); ", "; TrmSS(WY(i + 1)); ") >>>---> "; TrmSS(WD(i + 1)) Else Print "" End If Next Print "" Print " These are the items from unixdict.txt found embedded in the puzzle:" Print "" For i = 1 To ALLindex Step 2 Print Right(Space(7) + TrmSS(i), 7); ") "; Right(Space(7) + ALLSS(i), 10); " ("; TrmSS(AllX(i)); ", "; TrmSS(AllY(i)); ") >>>---> "; TrmSS(AllD(i)); If i + 1 <= ALLindex Then Print Right(Space(7) + TrmSS(i + 1), 7); ") "; Right(Space(7) + ALLSS(i + 1), 10); " ("; TrmSS(AllX(i + 1)); ", "; TrmSS(AllY(i + 1)); ") >>>---> "; TrmSS(AllD(i + 1)) Else Print "" End If Next i Close #1
End Sub
LoadWords 'this sets NWORDS count to work with
While try < 11
Initialize ShowPuzzle For WORDSINDEX = 1 To NWORDS PlaceWord ShowPuzzle If FILLED Then Exit For Next WORDSINDEX If FILLED And WI > 24 Then FindAllWords FilePuzzle Locate 23, 1: Print "On try #"; TrmSS(try); " a successful puzzle was built and filed." Exit While Else try += 1 End If
Wend If FILLED = 0 Then Locate 23, 1: Print "Sorry, 10 tries and no success." End </lang>
- Output:
Igual que la entrada de QB64.
Go
The link to "unixdict" appears to be broken so I've used instead the dictionary at "/usr/share/dict/words" which came pre-installed with my Ubuntu 16.04 distribution. I've no idea whether these dictionaries are the same or not.
<lang go>package main
import (
"bufio" "fmt" "log" "math/rand" "os" "regexp" "strings" "time"
)
var dirs = [][]int{{1, 0}, {0, 1}, {1, 1}, {1, -1}, {-1, 0}, {0, -1}, {-1, -1}, {-1, 1}}
const (
nRows = 10 nCols = nRows gridSize = nRows * nCols minWords = 25
)
var (
re1 = regexp.MustCompile(fmt.Sprintf("^[a-z]{3,%d}$", nRows)) re2 = regexp.MustCompile("[^A-Z]")
)
type grid struct {
numAttempts int cells [nRows][nCols]byte solutions []string
}
func check(err error) {
if err != nil { log.Fatal(err) }
}
func readWords(fileName string) []string {
file, err := os.Open(fileName) check(err) defer file.Close() var words []string scanner := bufio.NewScanner(file) for scanner.Scan() { word := strings.ToLower(strings.TrimSpace(scanner.Text())) if re1.MatchString(word) { words = append(words, word) } } check(scanner.Err()) return words
}
func createWordSearch(words []string) *grid {
var gr *grid
outer:
for i := 1; i < 100; i++ { gr = new(grid) messageLen := gr.placeMessage("Rosetta Code") target := gridSize - messageLen cellsFilled := 0 rand.Shuffle(len(words), func(i, j int) { words[i], words[j] = words[j], words[i] }) for _, word := range words { cellsFilled += gr.tryPlaceWord(word) if cellsFilled == target { if len(gr.solutions) >= minWords { gr.numAttempts = i break outer } else { // grid is full but we didn't pack enough words, start over break } } } } return gr
}
func (gr *grid) placeMessage(msg string) int {
msg = strings.ToUpper(msg) msg = re2.ReplaceAllLiteralString(msg, "") messageLen := len(msg) if messageLen > 0 && messageLen < gridSize { gapSize := gridSize / messageLen for i := 0; i < messageLen; i++ { pos := i*gapSize + rand.Intn(gapSize) gr.cells[pos/nCols][pos%nCols] = msg[i] } return messageLen } return 0
}
func (gr *grid) tryPlaceWord(word string) int {
randDir := rand.Intn(len(dirs)) randPos := rand.Intn(gridSize) for dir := 0; dir < len(dirs); dir++ { dir = (dir + randDir) % len(dirs) for pos := 0; pos < gridSize; pos++ { pos = (pos + randPos) % gridSize lettersPlaced := gr.tryLocation(word, dir, pos) if lettersPlaced > 0 { return lettersPlaced } } } return 0
}
func (gr *grid) tryLocation(word string, dir, pos int) int {
r := pos / nCols c := pos % nCols le := len(word)
// check bounds if (dirs[dir][0] == 1 && (le+c) > nCols) || (dirs[dir][0] == -1 && (le-1) > c) || (dirs[dir][1] == 1 && (le+r) > nRows) || (dirs[dir][1] == -1 && (le-1) > r) { return 0 } overlaps := 0
// check cells rr := r cc := c for i := 0; i < le; i++ { if gr.cells[rr][cc] != 0 && gr.cells[rr][cc] != word[i] { return 0 } cc += dirs[dir][0] rr += dirs[dir][1] }
// place rr = r cc = c for i := 0; i < le; i++ { if gr.cells[rr][cc] == word[i] { overlaps++ } else { gr.cells[rr][cc] = word[i] } if i < le-1 { cc += dirs[dir][0] rr += dirs[dir][1] } }
lettersPlaced := le - overlaps if lettersPlaced > 0 { sol := fmt.Sprintf("%-10s (%d,%d)(%d,%d)", word, c, r, cc, rr) gr.solutions = append(gr.solutions, sol) } return lettersPlaced
}
func printResult(gr *grid) {
if gr.numAttempts == 0 { fmt.Println("No grid to display") return } size := len(gr.solutions) fmt.Println("Attempts:", gr.numAttempts) fmt.Println("Number of words:", size) fmt.Println("\n 0 1 2 3 4 5 6 7 8 9") for r := 0; r < nRows; r++ { fmt.Printf("\n%d ", r) for c := 0; c < nCols; c++ { fmt.Printf(" %c ", gr.cells[r][c]) } } fmt.Println("\n") for i := 0; i < size-1; i += 2 { fmt.Printf("%s %s\n", gr.solutions[i], gr.solutions[i+1]) } if size%2 == 1 { fmt.Println(gr.solutions[size-1]) }
}
func main() {
rand.Seed(time.Now().UnixNano()) unixDictPath := "/usr/share/dict/words" printResult(createWordSearch(readWords(unixDictPath)))
}</lang>
- Output:
Sample run:
Attempts: 2 Number of words: 28 0 1 2 3 4 5 6 7 8 9 0 d R g n i p l e h w 1 o O o e g n i h n u 2 r e b c p S o e r c 3 s l E g o j l e h s 4 T z e n i g m a h T 5 s z e i o a n o o p 6 n u A d e c C a e u 7 a p a r e l O n c t 8 o D c i m a t h e s 9 r a E b e r e s i r cognacs (3,2)(9,8) unhinge (9,1)(3,1) creamer (2,8)(8,2) whelping (9,0)(2,0) puzzle (1,7)(1,2) math (4,8)(7,8) birding (3,9)(3,3) roans (0,9)(0,5) riser (9,9)(5,9) pent (9,5)(6,8) chance (9,2)(4,7) poona (9,5)(5,5) enigma (2,4)(7,4) noes (3,0)(0,3) ogle (4,5)(7,2) puts (9,5)(9,8) rod (0,2)(0,0) sere (7,9)(4,9) ohs (7,5)(9,3) jog (5,3)(3,3) lei (5,7)(3,5) bog (2,2)(2,0) hes (7,8)(9,8) noe (5,1)(7,3) peg (4,2)(2,0) ado (2,7)(4,5) one (4,3)(2,5) acre (1,9)(4,6)
J
Implementation:
<lang J>require'web/gethttp'
unixdict=:verb define
if. _1 -: fread 'unixdict.txt' do. (gethttp 'http://www.puzzlers.org/pub/wordlists/unixdict.txt') fwrite 'unixdict.txt' end. fread 'unixdict.txt'
)
words=:verb define
(#~ 1 - 0&e.@e.&'abcdefghijklmnopqrstuvwxyz'@>) (#~ [: (2&< * 10&>:) #@>) <;._2 unixdict
)
dirs=: 10#.0 0-.~>,{,~<i:1 lims=: _10+,"2 +/&>/"1 (0~:i:4)#>,{,~<<"1]1 10 1 +i."0]10*i:_1 dnms=: ;:'nw north ne west east sw south se'
genpuz=:verb define
words=. words fill=. 'ROSETTACODE' grid=. ,10 10$' ' inds=. ,i.10 10 patience=. -:#words key=. i.0 0 inuse=. i.0 2 while. (26>#key)+.0<cap=. (+/' '=grid)-#fill do. word=. >({~ ?@#) words dir=. ?@#dirs offs=. (inds#~(#word)<:inds{dir{lims)+/(i.#word)*/dir{dirs cool=. ' '=offs{grid sel=. */"1 cool+.(offs{grid)="1 word offs=. (sel*cap>:+/"1 cool)#offs if. (#offs) do. off=. ({~ ?@#) offs loc=. ({.off),dir if. -. loc e. inuse do. inuse=. inuse,loc grid=. word off} grid patience=. patience+1 key=. /:~ key,' ',(10{.word),(3":1+10 10#:{.off),' ',dir{::dnms end. else. NB. grr... if. 0 > patience=. patience-1 do. inuse=.i.0 2 key=.i.0 0 grid=. ,10 10$' ' patience=. -:#words end. end. end. puz=. (_23{.":i.10),' ',1j1#"1(":i.10 1),.' ',.10 10$fill (I.grid=' ')} grid puz,' ',1 1}._1 _1}.":((</.~ <.) i.@# * 3%#)key
)</lang>
Notes:
While the result is square, we flatten our intermediate results to simplify the code.
dirs
are index offsets within the flattened grid for each of the eight cardinal directions.
lims
is, for each cardinal direction, and for each grid position, how long of a word can fit.
dnms
are names for each of the cardinal directions.
words
are the viable words from unixdict, and fill
is what we're going to leave in the puzzle for spaces not occupied by any of those words (and this could be made into a parameter).
grid
is our working copy of the text of the word search puzzle.
inds
are the indices into grid - we will use these as the starting positions when we place the words.
patience
is a guard variable, to avoid problems with infinite loops if we arbitrarily place words in a non-viable fashion.
key
lists the words we are placing, and where we placed them.
inuse
marks location+directions which already have a word (to prevent short words such as sal from being placed as prefixes of longer words such as sale).
Once we have these, we go into a loop where:
word
is picked arbitrarily from the viable words from unixdict.
dir
is picked arbitrarily from one of our eight cardinal directions.
offs
are places where we might place the word (initially limited only by geometry, but we then constrain this based on what's already been placed).
cool
marks where our word can be placed in unoccupied spaces (and also will be used later to count how many new spaces will be occupied by the word we pick.
sel
marks where our word can be placed such that it does not conflict with existing words.
If this leaves us with any way to place the word, we pick one of them as off
and combine the starting location with dir in loc
to see if a word has already been placed there and if we're good, we place the word and update our key. (It's extremely rare that loc matches an inuse location, so just ignoring that word works just fine).
Otherwise, we check if we're getting impatient (in which case we scrap the entire thing and start over).
Once we're done, we reshape our grid so it's square and attach the key. Here, puz
is the grid formatted for display (with a space between each column, and a numeric key for each row and column).
Example run:
<lang J> genpuz
0 1 2 3 4 5 6 7 8 9
0 y R p y r f O a p S 1 l o l s i f c c e a 2 l n v z i e n r n l 3 o p z s t e E i n l 4 h l s a v e r d a o 5 e a t a g r e e d y 6 m e m a g T f T A C 7 a y e r s p f z a p 8 O e c n a w o l l a 9 e s o p o r p c D E
acetate 1 8 sw │ gam 7 5 west │ pol 1 3 sw acrid 1 8 south│ holly 5 1 north│ propose 10 7 west agreed 6 4 east │ massif 7 1 ne │ rsvp 1 5 sw allowance 9 10 west │ neva 3 7 sw │ sao 8 5 south alloy 2 10 south│ offer 9 7 north│ save 5 3 east arm 9 5 nw │ only 4 1 ne │ sop 10 2 east ayers 8 1 east │ pap 10 4 ne │ tee 4 5 se cop 10 8 nw │ paz 8 10 west │ wan 9 6 west fizzle 1 6 sw │ penna 1 9 south│
</lang>
Java
<lang java>import java.io.*; import static java.lang.String.format; import java.util.*;
public class WordSearch {
static class Grid { int numAttempts; char[][] cells = new char[nRows][nCols]; List<String> solutions = new ArrayList<>(); }
final static int[][] dirs = {{1, 0}, {0, 1}, {1, 1}, {1, -1}, {-1, 0}, {0, -1}, {-1, -1}, {-1, 1}};
final static int nRows = 10; final static int nCols = 10; final static int gridSize = nRows * nCols; final static int minWords = 25;
final static Random rand = new Random();
public static void main(String[] args) { printResult(createWordSearch(readWords("unixdict.txt"))); }
static List<String> readWords(String filename) { int maxLen = Math.max(nRows, nCols);
List<String> words = new ArrayList<>(); try (Scanner sc = new Scanner(new FileReader(filename))) { while (sc.hasNext()) { String s = sc.next().trim().toLowerCase(); if (s.matches("^[a-z]{3," + maxLen + "}$")) words.add(s); } } catch (FileNotFoundException e) { System.out.println(e); } return words; }
static Grid createWordSearch(List<String> words) { Grid grid = null; int numAttempts = 0;
outer: while (++numAttempts < 100) { Collections.shuffle(words);
grid = new Grid(); int messageLen = placeMessage(grid, "Rosetta Code"); int target = gridSize - messageLen;
int cellsFilled = 0; for (String word : words) { cellsFilled += tryPlaceWord(grid, word); if (cellsFilled == target) { if (grid.solutions.size() >= minWords) { grid.numAttempts = numAttempts; break outer; } else break; // grid is full but we didn't pack enough words, start over } } }
return grid; }
static int placeMessage(Grid grid, String msg) { msg = msg.toUpperCase().replaceAll("[^A-Z]", "");
int messageLen = msg.length(); if (messageLen > 0 && messageLen < gridSize) { int gapSize = gridSize / messageLen;
for (int i = 0; i < messageLen; i++) { int pos = i * gapSize + rand.nextInt(gapSize); grid.cells[pos / nCols][pos % nCols] = msg.charAt(i); } return messageLen; } return 0; }
static int tryPlaceWord(Grid grid, String word) { int randDir = rand.nextInt(dirs.length); int randPos = rand.nextInt(gridSize);
for (int dir = 0; dir < dirs.length; dir++) { dir = (dir + randDir) % dirs.length;
for (int pos = 0; pos < gridSize; pos++) { pos = (pos + randPos) % gridSize;
int lettersPlaced = tryLocation(grid, word, dir, pos); if (lettersPlaced > 0) return lettersPlaced; } } return 0; }
static int tryLocation(Grid grid, String word, int dir, int pos) {
int r = pos / nCols; int c = pos % nCols; int len = word.length();
// check bounds if ((dirs[dir][0] == 1 && (len + c) > nCols) || (dirs[dir][0] == -1 && (len - 1) > c) || (dirs[dir][1] == 1 && (len + r) > nRows) || (dirs[dir][1] == -1 && (len - 1) > r)) return 0;
int rr, cc, i, overlaps = 0;
// check cells for (i = 0, rr = r, cc = c; i < len; i++) { if (grid.cells[rr][cc] != 0 && grid.cells[rr][cc] != word.charAt(i)) return 0; cc += dirs[dir][0]; rr += dirs[dir][1]; }
// place for (i = 0, rr = r, cc = c; i < len; i++) { if (grid.cells[rr][cc] == word.charAt(i)) overlaps++; else grid.cells[rr][cc] = word.charAt(i);
if (i < len - 1) { cc += dirs[dir][0]; rr += dirs[dir][1]; } }
int lettersPlaced = len - overlaps; if (lettersPlaced > 0) { grid.solutions.add(format("%-10s (%d,%d)(%d,%d)", word, c, r, cc, rr)); }
return lettersPlaced; }
static void printResult(Grid grid) { if (grid == null || grid.numAttempts == 0) { System.out.println("No grid to display"); return; } int size = grid.solutions.size();
System.out.println("Attempts: " + grid.numAttempts); System.out.println("Number of words: " + size);
System.out.println("\n 0 1 2 3 4 5 6 7 8 9"); for (int r = 0; r < nRows; r++) { System.out.printf("%n%d ", r); for (int c = 0; c < nCols; c++) System.out.printf(" %c ", grid.cells[r][c]); }
System.out.println("\n");
for (int i = 0; i < size - 1; i += 2) { System.out.printf("%s %s%n", grid.solutions.get(i), grid.solutions.get(i + 1)); } if (size % 2 == 1) System.out.println(grid.solutions.get(size - 1)); }
}</lang>
Attempts: 2 Number of words: 27 0 1 2 3 4 5 6 7 8 9 0 R p d i o r o t r a 1 O a o e s b l o c S 2 m s t l f e t l a y 3 E t e i y o t s T i 4 e y l b t g r s p l 5 r l T i A h o e e l 6 o e l h t j c n s C 7 z l o u a a O t a t 8 u k r g c n D z i l 9 o t r a v e l E v w rototill (8,0)(1,7) polygonal (1,0)(9,8) fill (4,2)(1,5) goer (3,8)(0,5) travel (1,9)(6,9) deforest (2,0)(9,7) toroid (7,0)(2,0) truth (1,9)(5,5) estes (8,5)(4,1) ipecac (9,3)(4,8) ouzo (0,9)(0,6) pasty (1,0)(1,4) dote (2,0)(2,3) lay (7,2)(9,2) witch (9,9)(5,5) han (3,6)(5,8) bloc (5,1)(8,1) ill (9,3)(9,5) slot (7,3)(7,0) art (9,0)(7,0) ore (0,6)(0,4) bye (3,4)(5,2) elk (1,6)(1,8) jan (5,6)(5,8) liz (9,8)(7,8) dam (2,0)(0,2) via (8,9)(8,7)
Julia
Modified from the Go version. The task listed word list is offline, so the Debian distribution file "words.txt" was used instead. <lang julia>using Random
const stepdirections = [[1, 0], [0, 1], [1, 1], [1, -1], [-1, 0], [0, -1], [-1, -1], [-1, 1]] const nrows = 10 const ncols = nrows const gridsize = nrows * ncols const minwords = 25 const minwordsize = 3
mutable struct LetterGrid
nattempts::Int nrows::Int ncols::Int cells::Matrix{Char} solutions::Vector{String} LetterGrid() = new(0, nrows, ncols, fill(' ', nrows, ncols), Vector{String}())
end
function wordmatrix(filename, usepropernames = true)
words = [lowercase(line) for line in readlines(filename) if match(r"^[a-zA-Z]+$", line) != nothing && (usepropernames || match(r"^[a-z]", line) != nothing) && length(line) >= minwordsize && length(line) <= ncols] n = 1000 for i in 1:n grid = LetterGrid() messagelen = placemessage(grid, "Rosetta Code") target = grid.nrows * grid.ncols - messagelen cellsfilled = 0 shuffle!(words) for word in words cellsfilled += tryplaceword(grid, word) if cellsfilled == target if length(grid.solutions) >= minwords grid.nattempts = i return grid else break end end end end throw("Failed to place words after $n attempts")
end
function placemessage(grid, msg)
msg = uppercase(msg) msg = replace(msg, r"[^A-Z]" => "") messagelen = length(msg) if messagelen > 0 && messagelen < gridsize p = Int.(floor.(LinRange(messagelen, gridsize, messagelen) .+ (rand(messagelen) .- 0.5) * messagelen / 3)) .- div(messagelen, 3) foreach(i -> grid.cells[div(p[i], nrows) + 1, p[i] % nrows + 1] = msg[i], 1:length(p)) return messagelen end return 0
end
function tryplaceword(grid, word)
for dir in shuffle(stepdirections) for pos in shuffle(1:length(grid.cells)) lettersplaced = trylocation(grid, word, dir, pos) if lettersplaced > 0 return lettersplaced end end end return 0
end
function trylocation(grid, word, dir, pos)
r, c = divrem(pos, nrows) .+ [1, 1] positions = [[r, c] .+ (dir .* i) for i in 1:length(word)] if !all(x -> 0 < x[1] <= nrows && 0 < x[2] <= ncols, positions) return 0 end for (i, p) in enumerate(positions) letter = grid.cells[p[1],p[2]] if letter != ' ' && letter != word[i] return 0 end end lettersplaced = 0 for (i, p) in enumerate(positions) if grid.cells[p[1], p[2]] == ' ' lettersplaced += 1 grid.cells[p[1],p[2]] = word[i] end end if lettersplaced > 0 push!(grid.solutions, lpad(word, 10) * " $(positions[1]) to $(positions[end])") end return lettersplaced
end
function printresult(grid)
if grid.nattempts == 0 println("No grid to display: no solution found.") return end size = length(grid.solutions) println("Attempts: ", grid.nattempts) println("Number of words: ", size) println("\n 0 1 2 3 4 5 6 7 8 9") for r in 1:nrows print("\n", rpad(r, 4)) for c in 1:ncols print(" $(grid.cells[r, c]) ") end end println() for i in 1:2:size println("$(grid.solutions[i]) $(i < size ? grid.solutions[i+1] : "")") end
end
printresult(wordmatrix("words.txt", false))
</lang>
- Output:
Attempts: 1 Number of words: 25 0 1 2 3 4 5 6 7 8 9 1 s l i a r t R r r r 2 n o i t c u a O e e 3 h s u t S f a o l d 4 e r y u k s E a w n 5 l d T c w d r y o a 6 l T i h b g w b h l 7 A s a d e p o m w i 8 C t w s r r n o O h 9 s e s a e l p D t p 10 t e i d t E b o d e moped [7, 8] to [7, 4] philander [9, 10] to [1, 10] largesse [3, 9] to [10, 2] yuks [4, 3] to [4, 6] auction [2, 7] to [2, 1] howler [6, 9] to [1, 9] beret [6, 5] to [10, 5] whats [5, 5] to [9, 1] trails [1, 6] to [1, 1] bode [10, 7] to [10, 10] tush [3, 4] to [3, 1] please [9, 7] to [9, 2] loaf [3, 9] to [3, 6] bored [6, 8] to [10, 4] hell [3, 1] to [6, 1] sick [7, 2] to [4, 5] now [8, 7] to [6, 7] dry [5, 6] to [5, 8] swat [7, 2] to [10, 5] diet [10, 4] to [10, 1] too [9, 9] to [7, 7] owl [8, 8] to [6, 10] did [7, 4] to [5, 2] rut [4, 2] to [2, 4] far [3, 6] to [1, 8]
Kotlin
<lang scala>// version 1.2.0
import java.util.Random import java.io.File
val dirs = listOf(
intArrayOf( 1, 0), intArrayOf(0, 1), intArrayOf( 1, 1), intArrayOf( 1, -1), intArrayOf(-1, 0), intArrayOf(0, -1), intArrayOf(-1, -1), intArrayOf(-1, 1)
)
val nRows = 10 val nCols = 10 val gridSize = nRows * nCols val minWords = 25 val rand = Random()
class Grid {
var numAttempts = 0 val cells = List(nRows) { CharArray(nCols) } val solutions = mutableListOf<String>()
}
fun readWords(fileName: String): List<String> {
val maxLen = maxOf(nRows, nCols) val rx = Regex("^[a-z]{3,$maxLen}$") val f = File(fileName) return f.readLines().map { it.trim().toLowerCase() } .filter { it.matches(rx) }
}
fun createWordSearch(words: List<String>): Grid {
var numAttempts = 0 lateinit var grid: Grid outer@ while (++numAttempts < 100) { grid = Grid() val messageLen = placeMessage(grid, "Rosetta Code") val target = gridSize - messageLen var cellsFilled = 0 for (word in words.shuffled()) { cellsFilled += tryPlaceWord(grid, word) if (cellsFilled == target) { if (grid.solutions.size >= minWords) { grid.numAttempts = numAttempts break@outer } else { // grid is full but we didn't pack enough words, start over break } } } } return grid
}
fun placeMessage(grid: Grid, msg: String): Int {
val rx = Regex("[^A-Z]") val msg2 = msg.toUpperCase().replace(rx, "") val messageLen = msg2.length if (messageLen in (1 until gridSize)) { val gapSize = gridSize / messageLen for (i in 0 until messageLen) { val pos = i * gapSize + rand.nextInt(gapSize) grid.cells[pos / nCols][pos % nCols] = msg2[i] } return messageLen } return 0
}
fun tryPlaceWord(grid: Grid, word: String): Int {
val randDir = rand.nextInt(dirs.size) val randPos = rand.nextInt(gridSize) for (d in 0 until dirs.size) { val dir = (d + randDir) % dirs.size for (p in 0 until gridSize) { val pos = (p + randPos) % gridSize val lettersPlaced = tryLocation(grid, word, dir, pos) if (lettersPlaced > 0) return lettersPlaced } } return 0
}
fun tryLocation(grid: Grid, word: String, dir: Int, pos: Int): Int {
val r = pos / nCols val c = pos % nCols val len = word.length
// check bounds if ((dirs[dir][0] == 1 && (len + c) > nCols) || (dirs[dir][0] == -1 && (len - 1) > c) || (dirs[dir][1] == 1 && (len + r) > nRows) || (dirs[dir][1] == -1 && (len - 1) > r)) return 0 var overlaps = 0
// check cells var rr = r var cc = c for (i in 0 until len) { if (grid.cells[rr][cc] != '\u0000' && grid.cells[rr][cc] != word[i]) return 0 cc += dirs[dir][0] rr += dirs[dir][1] }
// place rr = r cc = c for (i in 0 until len) { if (grid.cells[rr][cc] == word[i]) overlaps++ else grid.cells[rr][cc] = word[i]
if (i < len - 1) { cc += dirs[dir][0] rr += dirs[dir][1] } }
val lettersPlaced = len - overlaps if (lettersPlaced > 0) { grid.solutions.add(String.format("%-10s (%d,%d)(%d,%d)", word, c, r, cc, rr)) } return lettersPlaced
}
fun printResult(grid: Grid) {
if (grid.numAttempts == 0) { println("No grid to display") return } val size = grid.solutions.size println("Attempts: ${grid.numAttempts}") println("Number of words: $size") println("\n 0 1 2 3 4 5 6 7 8 9") for (r in 0 until nRows) { print("\n$r ") for (c in 0 until nCols) print(" ${grid.cells[r][c]} ") }
println("\n")
for (i in 0 until size - 1 step 2) { println("${grid.solutions[i]} ${grid.solutions[i + 1]}") } if (size % 2 == 1) println(grid.solutions[size - 1])
}
fun main(args: Array<String>) {
printResult(createWordSearch(readWords("unixdict.txt")))
}</lang>
Sample output:
Attempts: 1 Number of words: 27 0 1 2 3 4 5 6 7 8 9 0 R t a r a c h n e t 1 O c y r t s e c n a 2 t S w b a e m e y c 3 e r e u b E o m o e 4 r T a n a t r o j n 5 r g k T A o r t u t 6 a i g i w e h C l r 7 p k c e d f a O i o 8 i c D o i l g m o i 9 n g r i m e e d E d hemorrhage (6,0)(6,9) ancestry (9,1)(2,1) terrapin (0,2)(0,9) julio (8,4)(8,8) centroid (9,2)(9,9) weak (2,2)(2,5) egg (3,7)(1,5) toefl (5,4)(5,8) grime (1,9)(5,9) bun (3,2)(3,4) tome (7,5)(7,2) arachne (2,0)(8,0) deck (4,7)(1,7) rico (0,5)(3,8) been (4,3)(7,0) tara (1,0)(4,0) ana (2,4)(4,4) oil (3,8)(5,8) wormy (4,6)(8,2) tab (4,1)(4,3) icc (3,6)(1,8) coo (9,2)(7,4) reub (1,3)(4,3) deem (7,9)(4,9) rime (9,6)(6,9) cat (9,2)(9,0) act (2,0)(0,2)
Nim
<lang Nim>import random, sequtils, strformat, strutils
const
Dirs = [[1, 0], [ 0, 1], [ 1, 1], [1, -1], [-1, 0], [0, -1], [-1, -1], [-1, 1]]
NRows = 10 NCols = 10 GridSize = NRows * NCols MinWords = 25
type Grid = ref object
numAttempts: Natural cells: array[NRows, array[NCols, char]] solutions: seq[string]
proc readWords(filename: string): seq[string] =
const MaxLen = max(NRows, NCols)
for word in filename.lines(): if word.len in 3..MaxLen: if word.allCharsInSet(Letters): result.add word.toLowerAscii
proc placeMessage(grid: var Grid; msg: string): int =
let msg = msg.map(toUpperAscii).filter(isUpperAscii).join() if msg.len in 1..<GridSize: let gapSize = GridSize div msg.len for i in 0..msg.high: let pos = i * gapSize + rand(gapSize - 1) grid.cells[pos div NCols][pos mod NCols] = msg[i] result = msg.len
proc tryLocation(grid: var Grid; word: string; dir, pos: Natural): int =
let row = pos div NCols let col = pos mod NCols let length = word.len
# Check bounds. if (Dirs[dir][0] == 1 and (length + col) > NCols) or (Dirs[dir][0] == -1 and (length - 1) > col) or (Dirs[dir][1] == 1 and (length + row) > NRows) or (Dirs[dir][1] == -1 and (length - 1) > row): return 0
# Check cells. var r = row var c = col for ch in word: if grid.cells[r][c] != '\0' and grid.cells[r][c] != ch: return 0 c += Dirs[dir][0] r += Dirs[dir][1]
# Place. r = row c = col var overlaps = 0 for i, ch in word: if grid.cells[r][c] == ch: inc overlaps else: grid.cells[r][c] = ch if i < word.high: c += Dirs[dir][0] r += Dirs[dir][1]
let lettersPlaced = length - overlaps if lettersPlaced > 0: grid.solutions.add &"{word:<10} ({col}, {row}) ({c}, {r})"
result = lettersPlaced
proc tryPlaceWord(grid: var Grid; word: string): int =
let randDir = rand(Dirs.high) let randPos = rand(GridSize - 1)
for dir in 0..Dirs.high: let dir = (dir + randDir) mod Dirs.len for pos in 0..<GridSize: let pos = (pos + randPos) mod GridSize let lettersPlaced = grid.tryLocation(word, dir, pos) if lettersPlaced > 0: return lettersPlaced
proc initGrid(words: seq[string]): Grid =
var words = words for numAttempts in 1..100: words.shuffle() new(result) let messageLen = result.placeMessage("Rosetta Code") let target = GridSize - messageLen
var cellsFilled = 0 for word in words: cellsFilled += result.tryPlaceWord(word) if cellsFilled == target: if result.solutions.len >= MinWords: result.numAttempts = numAttempts return # Grid is full but we didn't pack enough words: start over. break
proc printResult(grid: Grid) =
if grid.isNil or grid.numAttempts == 0: echo "No grid to display." return
let size = grid.solutions.len echo "Attempts: ", grid.numAttempts echo "Number of words: ", size
echo "\n 0 1 2 3 4 5 6 7 8 9\n" for r in 0..<NRows: echo &"{r} ", grid.cells[r].join(" ") echo()
for i in countup(0, size - 2, 2): echo grid.solutions[i], " ", grid.solutions[i + 1] if (size and 1) == 1: echo grid.solutions[^1]
randomize()
let grid = initGrid("unixdict.txt".readWords())
grid.printResult()</lang>
- Output:
Attempts: 2 Number of words: 29 0 1 2 3 4 5 6 7 8 9 0 s i a b l R d a t d 1 u x i i m e O l b e 2 n o v i r w S l u j 3 k n l a E b z i b T 4 a k n y o y e e T e 5 y g t l e A a d d l 6 e f u l f i l l C d 7 r e g a y o v O l d 8 f o h s l e w D i a 9 f o g y r E p i n s derange (6, 0) (0, 6) fulfill (1, 6) (7, 6) frey (0, 8) (0, 5) allied (7, 0) (7, 5) sally (3, 8) (3, 4) anvil (0, 4) (4, 0) saddle (9, 9) (9, 4) voyage (6, 7) (1, 7) iii (3, 2) (1, 0) sunk (0, 0) (0, 3) bub (8, 1) (8, 3) fogy (0, 9) (3, 9) zeal (6, 3) (6, 6) milky (4, 1) (0, 5) welsh (6, 8) (2, 8) knox (1, 4) (1, 1) allay (9, 8) (5, 4) jed (9, 2) (9, 0) snip (9, 9) (6, 9) bed (5, 3) (7, 5) bmw (3, 0) (5, 2) gut (2, 7) (2, 5) rev (4, 9) (6, 7) tad (8, 0) (6, 0) via (2, 2) (2, 0) ogle (1, 8) (4, 5) add (6, 5) (8, 5) lob (3, 5) (5, 3) lin (8, 7) (8, 9)
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>
- Output:
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)
Phix
-- demo\rosetta\wordsearch.exw string message = "ROSETTACODE" sequence words, solution="", placed constant grid = split(""" X 0 1 2 3 4 5 6 7 8 9 X 0 X 1 X 2 X 3 X 4 X 5 X 6 X 7 X 8 X 9 X X X X X X X X X X X X X""",'\n') constant DX = {-1, 0,+1,+1,+1, 0,-1,-1}, DY = {-3,-3,-3, 0,+3,+3,+3, 0} procedure wordsearch(sequence grid, integer rqd, integer left, sequence done) sequence rw = shuffle(tagset(length(words))), rd = shuffle(tagset(8)), rs = shuffle(tagset(100)) for i=1 to length(rs) do integer sx = floor((rs[i]-1)/10)+2, sy = remainder(rs[i]-1,10)*3+4 for w=1 to length(rw) do string word = words[rw[w]] if not find(word,done[1]) then for d=1 to length(rd) do integer {dx,dy} = {DX[rd[d]],DY[rd[d]]}, {nx,ny} = {sx,sy}, chcount = length(word) sequence newgrid = grid for c=1 to length(word) do integer ch = grid[nx][ny] if ch!=' ' then if ch!=word[c] then chcount = -1 exit end if chcount -= 1 end if newgrid[nx][ny] = word[c] nx += dx ny += dy end for if chcount!=-1 then sequence posinfo = {sx-2,(sy-4)/3,nx-dx-2,(ny-dy-4)/3}, newdone = {append(done[1],word),append(done[2],posinfo)} if rqd<=1 and left-chcount=length(message) then {solution, placed} = {newgrid, newdone} return elsif left-chcount>length(message) then wordsearch(newgrid,rqd-1,left-chcount,newdone) if length(solution) then return end if end if end if end for end if end for end for end procedure function valid_word(string word) if length(word)<3 then return false end if for i=1 to length(word) do integer ch = word[i] if ch<'a' or ch>'z' then return false end if end for return true end function integer fn = open("..\\unixdict.txt","r") words = get_text(fn,GT_LF_STRIPPED) close(fn) for i=length(words) to 1 by -1 do if not valid_word(words[i]) then words[i] = words[$] words = words[1..$-1] end if end for printf(1,"%d words loaded\n",length(words)) wordsearch(grid,25,100,{{},{}}) for x=2 to 11 do for y=4 to 31 by 3 do if solution[x][y]=' ' then solution[x][y] = message[1] message = message[2..$] end if end for end for if length(message) then ?9/0 end if puts(1,substitute(join(solution,'\n'),"X"," ")) printf(1,"\n%d words\n",length(placed[1])) for i=1 to length(placed[1]) do printf(1,"%10s %10s ",{placed[1][i],sprint(placed[2][i])}) if mod(i,3)=0 then puts(1,"\n") end if end for
- Output:
24822 words loaded 0 1 2 3 4 5 6 7 8 9 0 R y g e r m a n y O 1 d r a g a v e S o E 2 c a t n w e w T l T 3 r t s e p h a o k A 4 a u e v p e d t k C 5 g l c a o l k O a e 6 n a t r h l c h o u 7 a s m p a c a d i a 8 v n r a d s j o i l 9 D y i p i E s a s h 42 words salutary {7,1,0,1} idaho {9,4,5,4} jackdaw {8,6,2,6} darn {8,4,8,1} avenge {5,3,0,3} van {8,0,6,0} war {2,4,0,4} crag {2,0,5,0} drag {1,0,1,3} gam {5,0,7,2} stag {3,2,0,2} crass {5,2,9,6} apr {8,3,6,3} staph {7,1,3,5} germany {0,2,0,8} laos {6,5,9,8} chou {6,6,6,9} hell {3,5,6,5} wee {2,4,4,2} acadia {7,4,7,9} yolk {0,8,3,8} pap {7,3,9,3} pry {7,3,9,1} usn {4,1,2,3} agave {1,2,1,6} nat {6,0,6,2} pee {3,4,1,6} sash {9,6,9,9} eel {3,3,5,1} hid {9,9,7,7} yip {9,1,9,3} wok {2,6,4,8} raw {0,4,2,4} rave {6,3,3,3} oak {6,8,4,8} oil {8,7,8,9} lao {6,5,8,7} pest {3,4,3,1} doe {7,7,5,9} pet {4,4,2,2} arc {4,0,2,0} tau {4,7,6,9}
Python
<lang python> import re from random import shuffle, randint
dirs = [[1, 0], [0, 1], [1, 1], [1, -1], [-1, 0], [0, -1], [-1, -1], [-1, 1]] n_rows = 10 n_cols = 10 grid_size = n_rows * n_cols min_words = 25
class Grid:
def __init__(self): self.num_attempts = 0 self.cells = [[ for _ in range(n_cols)] for _ in range(n_rows)] self.solutions = []
def read_words(filename):
max_len = max(n_rows, n_cols)
words = [] with open(filename, "r") as file: for line in file: s = line.strip().lower() if re.match(r'^[a-z]{3,' + re.escape(str(max_len)) + r'}$', s) is not None: words.append(s)
return words
def place_message(grid, msg):
msg = re.sub(r'[^A-Z]', "", msg.upper())
message_len = len(msg) if 0 < message_len < grid_size: gap_size = grid_size // message_len
for i in range(0, message_len): pos = i * gap_size + randint(0, gap_size) grid.cells[pos // n_cols][pos % n_cols] = msg[i]
return message_len
return 0
def try_location(grid, word, direction, pos):
r = pos // n_cols c = pos % n_cols length = len(word)
# check bounds if (dirs[direction][0] == 1 and (length + c) > n_cols) or \ (dirs[direction][0] == -1 and (length - 1) > c) or \ (dirs[direction][1] == 1 and (length + r) > n_rows) or \ (dirs[direction][1] == -1 and (length - 1) > r): return 0
rr = r cc = c i = 0 overlaps = 0
# check cells while i < length: if grid.cells[rr][cc] != and grid.cells[rr][cc] != word[i]: return 0 cc += dirs[direction][0] rr += dirs[direction][1] i += 1
rr = r cc = c i = 0 # place while i < length: if grid.cells[rr][cc] == word[i]: overlaps += 1 else: grid.cells[rr][cc] = word[i]
if i < length - 1: cc += dirs[direction][0] rr += dirs[direction][1]
i += 1
letters_placed = length - overlaps if letters_placed > 0: grid.solutions.append("{0:<10} ({1},{2})({3},{4})".format(word, c, r, cc, rr))
return letters_placed
def try_place_word(grid, word):
rand_dir = randint(0, len(dirs)) rand_pos = randint(0, grid_size)
for direction in range(0, len(dirs)): direction = (direction + rand_dir) % len(dirs)
for pos in range(0, grid_size): pos = (pos + rand_pos) % grid_size
letters_placed = try_location(grid, word, direction, pos) if letters_placed > 0: return letters_placed
return 0
def create_word_search(words):
grid = None num_attempts = 0
while num_attempts < 100: num_attempts += 1 shuffle(words)
grid = Grid() message_len = place_message(grid, "Rosetta Code") target = grid_size - message_len
cells_filled = 0 for word in words: cells_filled += try_place_word(grid, word) if cells_filled == target: if len(grid.solutions) >= min_words: grid.num_attempts = num_attempts return grid else: break # grid is full but we didn't pack enough words, start over
return grid
def print_result(grid):
if grid is None or grid.num_attempts == 0: print("No grid to display") return
size = len(grid.solutions)
print("Attempts: {0}".format(grid.num_attempts)) print("Number of words: {0}".format(size))
print("\n 0 1 2 3 4 5 6 7 8 9\n") for r in range(0, n_rows): print("{0} ".format(r), end=) for c in range(0, n_cols): print(" %c " % grid.cells[r][c], end=) print() print()
for i in range(0, size - 1, 2): print("{0} {1}".format(grid.solutions[i], grid.solutions[i+1]))
if size % 2 == 1: print(grid.solutions[size - 1])
if __name__ == "__main__":
print_result(create_word_search(read_words("unixdict.txt")))
</lang>
- Output:
Attempts: 1 Number of words: 25 0 1 2 3 4 5 6 7 8 9 0 f b R u e r u l t h 1 o n o t v O e r o p 2 a S a b a x o b E m 3 l e d s h w T p e u 4 w p v a n s u c k i 5 o T u r A t u t s r 6 n s o p u m y d i t 7 t h C j a c o b i O 8 t i r e h n i m D p 9 y n o l o c E s a c exhaust (6,1)(0,7) hornwort (1,7)(8,0) btu (3,2)(3,0) jacobi (3,7)(8,7) foal (0,0)(0,3) triumph (9,6)(9,0) inherit (6,8)(0,8) mecum (9,2)(5,6) colony (5,9)(0,9) curve (5,7)(1,3) wont (0,4)(0,7) lure (7,0)(4,0) hob (9,0)(7,2) tidy (9,6)(6,6) suck (5,4)(8,4) san (3,3)(1,1) sac (7,9)(9,9) put (7,3)(5,5) led (0,3)(2,3) stu (8,5)(6,5) have (4,3)(4,0) min (7,8)(5,8) bob (1,0)(3,2) pup (3,6)(1,4) dip (7,6)(9,8)
QB64
bplus: 2020/03/13
The following zip file is needed for the Unix dictionary and a QB64 words mod for fun! ...and some samples.
Rosetta Code Word Search Challenge.zip
<lang qbasic> OPTION _EXPLICIT
_TITLE "Puzzle Builder for Rosetta" 'by B+ started 2018-10-31 ' 2018-11-02 Now that puzzle is working with basic and plus starters remove them and make sure puzzle works as well. ' Added Direction legend to printout. ' OverHauled LengthLimit() ' Reorgnize this to try a couple of times at given Randomize number ' TODO create alphabetical copy of word list and check grid for all words embedded in it. ' LoadWords makes a copy of word list in alpha order ' FindAllWords finds all the items from the dictionary ' OK it all seems to be working OK RANDOMIZE TIMER ' OK getting a good puzzle every time 'overhauled DIM SHARED LengthLimit(3 TO 10) AS _BYTE 'reset in Initialize, track and limit longer words 'LoadWords opens file of words and sets DIM SHARED NWORDS 'set in LoadWords, number of words with length: > 2 and < 11 and just letters ' word file words (shuffled) to be fit into puzzle and index position DIM SHARED WORDS$(1 TO 24945), CWORDS$(1 TO 24945), WORDSINDEX AS INTEGER 'the file has 24945 words but many are unsuitable 'words placed in Letters grid, word itself (W$) x, y head (WX, WY) and direction (WD), WI is the index to all these DIM SHARED W$(1 TO 100), WX(1 TO 100) AS _BYTE, WY(1 TO 100) AS _BYTE, WD(1 TO 100) AS _BYTE, WI AS _BYTE ' letters grid and direction arrays DIM SHARED L$(0 TO 9, 0 TO 9), DX(0 TO 7) AS _BYTE, DY(0 TO 7) AS _BYTE DX(0) = 1: DY(0) = 0 DX(1) = 1: DY(1) = 1 DX(2) = 0: DY(2) = 1 DX(3) = -1: DY(3) = 1 DX(4) = -1: DY(4) = 0 DX(5) = -1: DY(5) = -1 DX(6) = 0: DY(6) = -1 DX(7) = 1: DY(7) = -1 'to store all the words found embedded in the grid L$() DIM SHARED ALL$(1 TO 200), AllX(1 TO 200) AS _BYTE, AllY(1 TO 200) AS _BYTE, AllD(1 TO 200) AS _BYTE 'to store all the words found embedded in the grid L$() DIM SHARED ALLindex AS INTEGER ' signal successful fill of puzzle DIM SHARED FILLED AS _BIT FILLED = 0 DIM try AS _BYTE try = 1 LoadWords 'this sets NWORDS count to work with WHILE try < 11 Initialize ShowPuzzle FOR WORDSINDEX = 1 TO NWORDS PlaceWord ShowPuzzle IF FILLED THEN EXIT FOR NEXT IF FILLED AND WI > 24 THEN FindAllWords FilePuzzle LOCATE 23, 1: PRINT "On try #"; Trm$(try); " a successful puzzle was built and filed." EXIT WHILE ELSE try = try + 1 END IF WEND IF FILLED = 0 THEN LOCATE 23, 1: PRINT "Sorry, 10 tries and no success." END SUB LoadWords DIM wd$, i AS INTEGER, m AS INTEGER, ok AS _BIT OPEN "unixdict.txt" FOR INPUT AS #1 WHILE EOF(1) = 0 INPUT #1, wd$ IF LEN(wd$) > 2 AND LEN(wd$) < 11 THEN ok = -1 FOR m = 1 TO LEN(wd$) IF ASC(wd$, m) < 97 OR ASC(wd$, m) > 122 THEN ok = 0: EXIT FOR NEXT IF ok THEN i = i + 1: WORDS$(i) = wd$: CWORDS$(i) = wd$ END IF WEND CLOSE #1 NWORDS = i END SUB SUB Shuffle DIM i AS INTEGER, r AS INTEGER FOR i = NWORDS TO 2 STEP -1 r = INT(RND * i) + 1 SWAP WORDS$(i), WORDS$(r) NEXT END SUB SUB Initialize DIM r AS _BYTE, c AS _BYTE, x AS _BYTE, y AS _BYTE, d AS _BYTE, wd$ FOR r = 0 TO 9 FOR c = 0 TO 9 L$(c, r) = " " NEXT NEXT 'reset word arrays by resetting the word index back to zero WI = 0 'fun stuff for me but doubt others would like that much fun! 'pluggin "basic", 0, 0, 2 'pluggin "plus", 1, 0, 0 'to assure the spreading of ROSETTA CODE L$(INT(RND * 5) + 5, 0) = "R": L$(INT(RND * 9) + 1, 1) = "O" L$(INT(RND * 9) + 1, 2) = "S": L$(INT(RND * 9) + 1, 3) = "E" L$(1, 4) = "T": L$(9, 4) = "T": L$(INT(10 * RND), 5) = "A" L$(INT(10 * RND), 6) = "C": L$(INT(10 * RND), 7) = "O" L$(INT(10 * RND), 8) = "D": L$(INT(10 * RND), 9) = "E" 'reset limits LengthLimit(3) = 200 LengthLimit(4) = 6 LengthLimit(5) = 3 LengthLimit(6) = 2 LengthLimit(7) = 1 LengthLimit(8) = 0 LengthLimit(9) = 0 LengthLimit(10) = 0 'reset word order Shuffle END SUB 'for fun plug-in of words SUB pluggin (wd$, x AS INTEGER, y AS INTEGER, d AS INTEGER) DIM i AS _BYTE FOR i = 0 TO LEN(wd$) - 1 L$(x + i * DX(d), y + i * DY(d)) = MID$(wd$, i + 1, 1) NEXT WI = WI + 1 W$(WI) = wd$: WX(WI) = x: WY(WI) = y: WD(WI) = d END SUB FUNCTION Trm$ (n AS INTEGER) Trm$ = RTRIM$(LTRIM$(STR$(n))) END FUNCTION SUB ShowPuzzle DIM i AS _BYTE, x AS _BYTE, y AS _BYTE, wate$ CLS PRINT " 0 1 2 3 4 5 6 7 8 9" LOCATE 3, 1 FOR i = 0 TO 9 PRINT Trm$(i) NEXT FOR y = 0 TO 9 FOR x = 0 TO 9 LOCATE y + 3, 2 * x + 5: PRINT L$(x, y) NEXT NEXT FOR i = 1 TO WI IF i < 20 THEN LOCATE i + 1, 30: PRINT Trm$(i); " "; W$(i) ELSEIF i < 40 THEN LOCATE i - 20 + 1, 45: PRINT Trm$(i); " "; W$(i) ELSEIF i < 60 THEN LOCATE i - 40 + 1, 60: PRINT Trm$(i); " "; W$(i) END IF NEXT LOCATE 18, 1: PRINT "Spaces left:"; CountSpaces% LOCATE 19, 1: PRINT NWORDS LOCATE 20, 1: PRINT SPACE$(16) IF WORDSINDEX THEN LOCATE 20, 1: PRINT Trm$(WORDSINDEX); " "; WORDS$(WORDSINDEX) 'LOCATE 15, 1: INPUT "OK, press enter... "; wate$ END SUB 'used in PlaceWord FUNCTION CountSpaces% () DIM x AS _BYTE, y AS _BYTE, count AS INTEGER FOR y = 0 TO 9 FOR x = 0 TO 9 IF L$(x, y) = " " THEN count = count + 1 NEXT NEXT CountSpaces% = count END FUNCTION 'used in PlaceWord FUNCTION Match% (word AS STRING, template AS STRING) DIM i AS INTEGER, c AS STRING Match% = 0 IF LEN(word) <> LEN(template) THEN EXIT FUNCTION FOR i = 1 TO LEN(template) IF ASC(template, i) <> 32 AND (ASC(word, i) <> ASC(template, i)) THEN EXIT FUNCTION NEXT Match% = -1 END FUNCTION 'heart of puzzle builder SUB PlaceWord ' place the words randomly in the grid ' start at random spot and work forward or back 100 times = all the squares ' for each open square try the 8 directions for placing the word ' even if word fits Rossetta Challenge task requires leaving 11 openings to insert ROSETTA CODE, ' exactly 11 spaces needs to be left, if/when this occurs FILLED will be set true to signal finished to main loop ' if place a word update L$, WI, W$(WI), WX(WI), WY(WI), WD(WI) DIM wd$, wLen AS _BYTE, spot AS _BYTE, testNum AS _BYTE, rdir AS _BYTE DIM x AS _BYTE, y AS _BYTE, d AS _BYTE, dNum AS _BYTE, rdd AS _BYTE DIM template$, b1 AS _BIT, b2 AS _BIT DIM i AS _BYTE, j AS _BYTE, wate$ wd$ = WORDS$(WORDSINDEX) 'the right side is all shared 'skip too many long words IF LengthLimit(LEN(wd$)) THEN LengthLimit(LEN(wd$)) = LengthLimit(LEN(wd$)) - 1 ELSE EXIT SUB 'skip long ones wLen = LEN(wd$) - 1 ' from the spot there are this many letters to check spot = INT(RND * 100) ' a random spot on grid testNum = 1 ' when this hits 100 we've tested all possible spots on grid IF RND < .5 THEN rdir = -1 ELSE rdir = 1 ' go forward or back from spot for next test WHILE testNum < 101 y = INT(spot / 10) x = spot MOD 10 IF L$(x, y) = MID$(wd$, 1, 1) OR L$(x, y) = " " THEN d = INT(8 * RND) IF RND < .5 THEN rdd = -1 ELSE rdd = 1 dNum = 1 WHILE dNum < 9 'will wd$ fit? from at x, y template$ = "" b1 = wLen * DX(d) + x >= 0 AND wLen * DX(d) + x <= 9 b2 = wLen * DY(d) + y >= 0 AND wLen * DY(d) + y <= 9 IF b1 AND b2 THEN 'build the template of letters and spaces from Letter grid FOR i = 0 TO wLen template$ = template$ + L$(x + i * DX(d), y + i * DY(d)) NEXT IF Match%(wd$, template$) THEN 'the word will fit but does it fill anything? FOR j = 1 TO LEN(template$) IF ASC(template$, j) = 32 THEN 'yes a space to fill FOR i = 0 TO wLen L$(x + i * DX(d), y + i * DY(d)) = MID$(wd$, i + 1, 1) NEXT WI = WI + 1 W$(WI) = wd$: WX(WI) = x: WY(WI) = y: WD(WI) = d IF CountSpaces% = 0 THEN FILLED = -1 EXIT SUB 'get out now that word is loaded END IF NEXT 'if still here keep looking END IF END IF d = (d + 8 + rdd) MOD 8 dNum = dNum + 1 WEND END IF spot = (spot + 100 + rdir) MOD 100 testNum = testNum + 1 WEND END SUB SUB FindAllWords DIM wd$, wLen AS _BYTE, i AS INTEGER, x AS _BYTE, y AS _BYTE, d AS _BYTE DIM template$, b1 AS _BIT, b2 AS _BIT, j AS _BYTE, wate$ FOR i = 1 TO NWORDS wd$ = CWORDS$(i) wLen = LEN(wd$) - 1 FOR y = 0 TO 9 FOR x = 0 TO 9 IF L$(x, y) = MID$(wd$, 1, 1) THEN FOR d = 0 TO 7 b1 = wLen * DX(d) + x >= 0 AND wLen * DX(d) + x <= 9 b2 = wLen * DY(d) + y >= 0 AND wLen * DY(d) + y <= 9 IF b1 AND b2 THEN 'build the template of letters and spaces from Letter grid template$ = "" FOR j = 0 TO wLen template$ = template$ + L$(x + j * DX(d), y + j * DY(d)) NEXT IF template$ = wd$ THEN 'founda word 'store it ALLindex = ALLindex + 1 ALL$(ALLindex) = wd$: AllX(ALLindex) = x: AllY(ALLindex) = y: AllD(ALLindex) = d 'report it LOCATE 22, 1: PRINT SPACE$(50) LOCATE 22, 1: PRINT "Found: "; wd$; " ("; Trm$(x); ", "; Trm$(y); ") >>>---> "; Trm$(d); INPUT " Press enter...", wate$ END IF END IF NEXT d END IF NEXT x NEXT y NEXT i END SUB SUB FilePuzzle DIM i AS _BYTE, r AS _BYTE, c AS _BYTE, b$ OPEN "WS Puzzle.txt" FOR OUTPUT AS #1 PRINT #1, " 0 1 2 3 4 5 6 7 8 9" PRINT #1, "" FOR r = 0 TO 9 b$ = Trm$(r) + " " FOR c = 0 TO 9 b$ = b$ + L$(c, r) + " " NEXT PRINT #1, b$ NEXT PRINT #1, "" PRINT #1, "Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE" PRINT #1, "" PRINT #1, " These are the items from unixdict.txt used to build the puzzle:" PRINT #1, "" FOR i = 1 TO WI STEP 2 PRINT #1, RIGHT$(SPACE$(7) + Trm$(i), 7); ") "; RIGHT$(SPACE$(7) + W$(i), 10); " ("; Trm$(WX(i)); ", "; Trm$(WY(i)); ") >>>---> "; Trm$(WD(i)); IF i + 1 <= WI THEN PRINT #1, RIGHT$(SPACE$(7) + Trm$(i + 1), 7); ") "; RIGHT$(SPACE$(7) + W$(i + 1), 10); " ("; Trm$(WX(i + 1)); ", "; Trm$(WY(i + 1)); ") >>>---> "; Trm$(WD(i + 1)) ELSE PRINT #1, "" END IF NEXT PRINT #1, "" PRINT #1, " These are the items from unixdict.txt found embedded in the puzzle:" PRINT #1, "" FOR i = 1 TO ALLindex STEP 2 PRINT #1, RIGHT$(SPACE$(7) + Trm$(i), 7); ") "; RIGHT$(SPACE$(7) + ALL$(i), 10); " ("; Trm$(AllX(i)); ", "; Trm$(AllY(i)); ") >>>---> "; Trm$(AllD(i)); IF i + 1 <= ALLindex THEN PRINT #1, RIGHT$(SPACE$(7) + Trm$(i + 1), 7); ") "; RIGHT$(SPACE$(7) + ALL$(i + 1), 10); " ("; Trm$(AllX(i + 1)); ", "; Trm$(AllY(i + 1)); ") >>>---> "; Trm$(AllD(i + 1)) ELSE PRINT #1, "" END IF NEXT CLOSE #1 END SUB</lang>
Sample Output:
0 1 2 3 4 5 6 7 8 9
0 t g a m m R l b a r
1 o e O k y u i l u b
2 l S e e n n i o a t
3 s a g d E u i d e w
4 k T c t e h g s a T
5 s e n o j b o A e r
6 C l g n c o a p g r
7 l i o d i u m u e O
8 k a e r f D d y c t
9 t j E a i d r a p h
Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE
These are the items from unixdict.txt used to build the puzzle:
1) odium (2, 7) >>>---> 0 2) resiny (9, 6) >>>---> 5 3) debauch (3, 3) >>>---> 1 4) freak (4, 8) >>>---> 4 5) jones (4, 5) >>>---> 4 6) radium (9, 5) >>>---> 5 7) hope (5, 4) >>>---> 1 8) coca (4, 6) >>>---> 5 9) slot (0, 3) >>>---> 6 10) aid (3, 9) >>>---> 0 11) gunk (6, 4) >>>---> 5 12) keg (0, 4) >>>---> 1 13) aile (1, 8) >>>---> 6 14) set (7, 4) >>>---> 7 15) wall (9, 3) >>>---> 5 16) rye (6, 9) >>>---> 7 17) our (7, 2) >>>---> 7 18) bar (7, 0) >>>---> 0 19) par (8, 9) >>>---> 4 20) gam (1, 0) >>>---> 0 21) dee (3, 3) >>>---> 5 22) ton (3, 4) >>>---> 2 23) dab (7, 3) >>>---> 7 24) jed (1, 9) >>>---> 7 25) bin (7, 0) >>>---> 3 26) pet (7, 6) >>>---> 1 27) sag (0, 3) >>>---> 0 28) nco (3, 6) >>>---> 0 29) dug (6, 8) >>>---> 7 30) oat (2, 7) >>>---> 3 31) oil (2, 7) >>>---> 4 32) nee (4, 2) >>>---> 4
These are the items from unixdict.txt found embedded in the puzzle:
1) abe (6, 6) >>>---> 5 2) abed (6, 6) >>>---> 5 3) aid (3, 9) >>>---> 0 4) ail (1, 8) >>>---> 6 5) aile (1, 8) >>>---> 6 6) ali (8, 0) >>>---> 3 7) all (8, 2) >>>---> 5 8) bad (9, 1) >>>---> 3 9) bar (7, 0) >>>---> 0 10) bed (5, 5) >>>---> 5 11) bin (7, 0) >>>---> 3 12) but (7, 0) >>>---> 1 13) cal (2, 4) >>>---> 5 14) coca (4, 6) >>>---> 5 15) cud (4, 6) >>>---> 1 16) dab (7, 3) >>>---> 7 17) dar (7, 3) >>>---> 1 18) debauch (3, 3) >>>---> 1 19) dee (3, 3) >>>---> 5 20) dew (7, 3) >>>---> 0 21) dug (6, 8) >>>---> 7 22) edt (3, 2) >>>---> 2 23) eli (1, 5) >>>---> 2 24) etc (4, 4) >>>---> 4 25) freak (4, 8) >>>---> 4 26) gam (1, 0) >>>---> 0 27) gas (2, 3) >>>---> 4 28) goa (6, 4) >>>---> 2 29) gsa (6, 4) >>>---> 0 30) gun (6, 4) >>>---> 5 31) gunk (6, 4) >>>---> 5 32) hop (5, 4) >>>---> 1 33) hope (5, 4) >>>---> 1 34) hun (5, 4) >>>---> 6 35) ida (6, 2) >>>---> 1 36) iii (6, 1) >>>---> 2 37) iii (6, 3) >>>---> 6 38) inn (6, 2) >>>---> 4 39) inn (4, 7) >>>---> 5 40) jail (1, 9) >>>---> 6 41) jed (1, 9) >>>---> 7 42) jon (4, 5) >>>---> 4 43) jones (4, 5) >>>---> 4 44) keg (0, 4) >>>---> 1 45) lac (0, 2) >>>---> 1 46) law (7, 1) >>>---> 1 47) lea (0, 2) >>>---> 7 48) lot (0, 2) >>>---> 6 49) lund (6, 0) >>>---> 3 50) mao (6, 7) >>>---> 6 51) nco (3, 6) >>>---> 0 52) nee (4, 2) >>>---> 4 53) nib (5, 2) >>>---> 7 54) nne (5, 2) >>>---> 4 55) not (3, 6) >>>---> 6 56) oat (7, 2) >>>---> 0 57) oat (2, 7) >>>---> 3 58) odium (2, 7) >>>---> 0 59) oil (2, 7) >>>---> 4 60) one (3, 5) >>>---> 4 61) our (7, 2) >>>---> 7 62) par (8, 9) >>>---> 4 63) pet (7, 6) >>>---> 1 64) radium (9, 5) >>>---> 5 65) rap (6, 9) >>>---> 0 66) resin (9, 6) >>>---> 5 67) resiny (9, 6) >>>---> 5 68) rio (3, 8) >>>---> 7 69) rye (6, 9) >>>---> 7 70) sag (0, 3) >>>---> 0 71) sen (0, 5) >>>---> 0 72) set (7, 4) >>>---> 7 73) sin (7, 4) >>>---> 5 74) slot (0, 3) >>>---> 6 75) tao (9, 2) >>>---> 4 76) tao (0, 9) >>>---> 7 77) tee (0, 0) >>>---> 1 78) ton (3, 4) >>>---> 2 79) tub (9, 2) >>>---> 5 80) wall (9, 3) >>>---> 5 81) wed (9, 3) >>>---> 4
Racket
(or at least it started out that way... so more "inspired by")
<lang racket>#lang racket
- ---------------------------------------------------------------------------------------------------
(module+ main
(display-puzzle (create-word-search)) (newline) (parameterize ((current-min-words 50)) (display-puzzle (create-word-search #:n-rows 20 #:n-cols 20))))
- ---------------------------------------------------------------------------------------------------
(define current-min-words (make-parameter 25))
- ---------------------------------------------------------------------------------------------------
(define (all-words pzl)
(filter-map (good-word? pzl) (file->lines "data/unixdict.txt")))
(define (good-word? pzl)
(let ((m (puzzle-max-word-size pzl))) (λ (w) (and (<= 3 (string-length w) m) (regexp-match #px"^[A-Za-z]*$" w) (string-downcase w)))))
(struct puzzle (n-rows n-cols cells solutions) #:transparent)
(define puzzle-max-word-size (match-lambda [(puzzle n-rows n-cols _ _) (max n-rows n-cols)]))
(define dirs '((-1 -1 ↖) (-1 0 ↑) (-1 1 ↗) (0 -1 ←) (0 1 →) (1 -1 ↙) (1 0 ↓) (1 1 ↘)))
- ---------------------------------------------------------------------------------------------------
(define (display-puzzle pzl) (displayln (puzzle->string pzl)))
(define (puzzle->string pzl)
(match-let* (((and pzl (puzzle n-rows n-cols cells (and solutions (app length size)))) pzl) (column-numbers (cons "" (range n-cols))) (render-row (λ (r) (cons r (map (λ (c) (hash-ref cells (cons r c) #\_)) (range n-cols))))) (the-grid (add-between (map (curry map (curry ~a #:width 3)) (cons column-numbers (map render-row (range n-rows)))) "\n")) (solutions§ (solutions->string (sort solutions string<? #:key car)))) (string-join (flatten (list the-grid "\n\n" solutions§)) "")))
(define (solutions->string solutions)
(let* ((l1 (compose string-length car)) (format-solution-to-max-word-size (format-solution (l1 (argmax l1 solutions))))) (let recur ((solutions solutions) (need-newline? #f) (acc null)) (if (null? solutions) (reverse (if need-newline? (cons "\n" acc) acc)) (let* ((spacer (if need-newline? "\n" " ")) (solution (format "~a~a" (format-solution-to-max-word-size (car solutions)) spacer))) (recur (cdr solutions) (not need-newline?) (cons solution acc)))))))
(define (format-solution max-word-size)
(match-lambda [(list word row col dir) (string-append (~a word #:width (+ max-word-size 1)) (~a (format "(~a,~a ~a)" row col dir) #:width 9))]))
- ---------------------------------------------------------------------------------------------------
(define (create-word-search #:msg (msg "Rosetta Code") #:n-rows (n-rows 10) #:n-cols (n-cols 10))
(let* ((pzl (puzzle n-rows n-cols (hash) null)) (MSG (sanitise-message msg)) (n-holes (- (* n-rows n-cols) (string-length MSG)))) (place-message (place-words pzl (shuffle (all-words pzl)) (current-min-words) n-holes) MSG)))
(define (sanitise-message msg) (regexp-replace* #rx"[^A-Z]" (string-upcase msg) ""))
(define (place-words pzl words needed-words holes)
(let inner ((pzl pzl) (words words) (needed-words needed-words) (holes holes)) (cond [(and (not (positive? needed-words)) (zero? holes)) pzl] [(null? words) (eprintf "no solution... retrying (~a words remaining)~%" needed-words) (inner pzl (shuffle words) needed-words)] [else (let/ec no-fit (let*-values (([word words...] (values (car words) (cdr words))) ([solution cells′ holes′] (fit-word word pzl holes (λ () (no-fit (inner pzl words... needed-words holes))))) ([solutions′] (cons solution (puzzle-solutions pzl))) ([pzl′] (struct-copy puzzle pzl (solutions solutions′) (cells cells′)))) (inner pzl′ words... (sub1 needed-words) holes′)))])))
(define (fit-word word pzl holes fail)
(match-let* (((puzzle n-rows n-cols cells _) pzl) (rows (shuffle (range n-rows))) (cols (shuffle (range n-cols))) (fits? (let ((l (string-length word))) (λ (maxz z0 dz) (< -1 (+ z0 (* dz l)) maxz))))) (let/ec return (for* ((dr-dc-↗ (shuffle dirs)) (r0 rows) (dr (in-value (car dr-dc-↗))) #:when (fits? n-rows r0 dr) (c0 cols) (dc (in-value (cadr dr-dc-↗))) #:when (fits? n-cols c0 dc) (↗ (in-value (caddr dr-dc-↗)))) (let/ec retry/ec (attempt-word-fit pzl word r0 c0 dr dc ↗ holes return retry/ec))) (fail))))
(define (attempt-word-fit pzl word r0 c0 dr dc ↗ holes return retry)
(let-values (([cells′ available-cells′] (for/fold ((cells′ (puzzle-cells pzl)) (holes′ holes)) ((w word) (i (in-naturals))) (define k (cons (+ r0 (* dr i)) (+ c0 (* dc i)))) (cond [(not (hash-has-key? cells′ k)) (if (zero? holes′) (retry) (values (hash-set cells′ k w) (sub1 holes′)))] [(char=? (hash-ref cells′ k) w) (values cells′ holes′)] [else (retry)])))) (return (list word r0 c0 ↗) cells′ available-cells′)))
- ---------------------------------------------------------------------------------------------------
(define (place-message pzl MSG)
(match-define (puzzle n-rows n-cols cells _) pzl) (struct-copy puzzle pzl (cells (let loop ((r 0) (c 0) (cells cells) (msg (string->list MSG))) (cond [(or (null? msg) (= r n-rows)) cells] [(= c n-cols) (loop (add1 r) 0 cells msg)] [(hash-has-key? cells (cons r c)) (loop r (add1 c) cells msg)] [else (loop r (add1 c) (hash-set cells (cons r c) (car msg)) (cdr msg))])))))
</lang>
- Output:
0 1 2 3 4 5 6 7 8 9 0 R s o y b e a n O p 1 r d h t a b e S e r 2 o e n a o h k n l u 3 t t y o r a i e i s 4 a e r u r n d g a s 5 r s E m s e n T l e 6 i t a u c i h T f l 7 a A l e l l o y l l 8 n a r s e r a l a C 9 O p D l u m e n c E ail (4,8 ↑) air (7,0 ↑) are (8,6 ←) aye (2,3 ↙) bath (1,5 ←) boor (1,5 ↙) calf (9,8 ↑) detest (1,1 ↓) est (4,1 ↓) flail (6,8 ↑) heron (6,6 ↖) karma (2,6 ↙) lares (8,7 ←) loy (7,5 →) lumen (9,3 →) nehru (0,7 ↙) peninsula (0,9 ↙) precede (9,1 ↗) rotarian (1,0 ↓) roy (3,4 ←) russell (1,9 ↓) sling (8,3 ↗) soybean (0,1 →) tab (1,3 →) tar (3,0 ↓) 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 0 e o w e d i r o u l f a r t e t n i u q 1 x R a i n o n i o k O y t n e l p o o p 2 i a l b a o h u n o i t a t r e s s i d 3 s r s u v u n g o d d e s s o b a S y r 4 t m e d r s h e g n a m i n o l y e r a 5 c o x t b o n E t c a t r r t o c a u n 6 n n y u a y o e i i n e p a y w n v b k 7 i k r r u p r f d a s h d m l b e e n c 8 t y d e e n i b r d i i e n n a g s a a 9 s T a t v t d g t c a n v r a c r d d t 10 i a a m a l n T h t e s f f o k u r A a 11 d b n e e w a n o i t a s r e v n o c l 12 a l b g r h s h n e s t h e r d d p a i 13 r a t t u a c o g e l g g o b e C p l n 14 t r e r n m d s l t n d d u r s a e c a 15 n r l a a a t n h i r o d b O t n d u v 16 o e c u m a t g a a d g l e x i c a l i 17 c f r m n l i t b g e y r u b n e s u d 18 o e i a s l a b y t i l a u q y a w s j 19 h r c a s s i l e m D l k c o b b u l E abate (12,0 ↗) alarm (8,15 ↖) alba (2,1 →) alma (18,6 ↖) amino (4,10 →) andean (9,14 ↖) andiron (11,6 ↑) ann (8,15 ←) armonk (2,1 ↓) balsa (18,7 ←) beatific (12,2 ↗) blowback (3,15 ↓) bock (19,15 ←) boggle (13,14 ←) bred (15,13 ↗) bud (2,3 ↓) budget (13,14 ↙) calculus (11,18 ↓) catalina (7,19 ↓) circlet (19,2 ↑) clot (5,16 ↖) contradistinct (17,0 ↑) conversation (11,18 ←) danbury (9,18 ↑) destiny (12,15 ↓) dissertation (2,19 ←) dodo (16,10 ↗) drab (14,11 ↙) drank (2,19 ↓) dusenbury (17,19 ←) eavesdropped (4,17 ↓) enemy (10,10 ↗) esther (12,9 →) exist (0,0 ↓) goddess (3,7 →) grant (9,7 ↗) halve (12,7 ↖) hero (7,11 ↘) hoard (4,6 ↙) hoc (19,0 ↑) hurty (2,6 ↙) ivan (16,19 ↑) juan (18,19 ↖) koinonia (1,9 ←) lexical (16,12 →) ligand (19,11 ↖) lone (16,12 ↖) lounsbury (0,9 ↙) lubbock (19,18 ←) mange (4,11 ←) manure (16,4 ↑) melissa (19,9 ←) natty (14,4 ↘) nib (8,5 →) nyu (5,6 ↙) offset (10,14 ←) orphic (4,14 ↙) owe (0,1 →) pay (6,12 →) plenty (1,16 ←) poop (1,19 ←) purr (7,5 ←) quality (18,14 ←) quintet (0,19 ←) rca (9,16 ←) read (12,14 ↘) referral (19,1 ↑) sadden (10,11 ↖) salt (2,17 ↙) sang (9,0 ↘) schema (14,7 ↖) sexy (3,2 ↓) slight (19,4 ↗) solid (12,6 ↘) stan (14,7 ↙) tern (5,8 ↙) tetrafluoride (0,15 ←) thong (9,8 ↓) trauma (13,3 ↓) urgency (10,16 ↑) visit (9,12 ↖) von (3,4 ↗) way (18,17 ←) wham (11,5 ↓)
Raku
(formerly Perl 6)
<lang perl6>my $rows = 10; my $cols = 10;
my $message = q:to/END/;
.....R.... ......O... .......S.. ........E. T........T .A........ ..C....... ...O...... ....D..... .....E.... END
my %dir =
'→' => (1,0), '↘' => (1,1), '↓' => (0,1), '↙' => (-1,1), '←' => (-1,0), '↖' => (-1,-1), '↑' => (0,-1), '↗' => (1,-1)
my @ws = $message.comb(/<print>/);
my $path = './unixdict.txt'; # or wherever
my @words = $path.IO.slurp.words.grep( { $_ !~~ /<-[a..z]>/ and 2 < .chars < 11 } ).pick(*); my %index; my %used;
while @ws.first( * eq '.') {
# find an unfilled cell my $i = @ws.grep( * eq '.', :k ).pick;
# translate the index to x / y coordinates my ($x, $y) = $i % $cols, floor($i / $rows);
# find a word that fits my $word = find($x, $y);
# Meh, reached an impasse, easier to just throw it all # away and start over rather than trying to backtrack. restart, next unless $word;
%used{"$word"}++;
# Keeps trying to place an already used word, choices # must be limited, start over restart, next if %used{$word} > 15;
# Already used this word, try again next if %index{$word.key};
# Add word to used word index %index ,= $word;
# place the word into the grid place($x, $y, $word);
}
display();
sub display {
put flat " ", 'ABCDEFGHIJ'.comb; .put for (^10).map: { ($_).fmt(" %2d"), @ws[$_ * $cols .. ($_ + 1) * $cols - 1] } put "\n Words used:"; my $max = 1 + %index.keys.max( *.chars ).chars; for %index.sort { printf "%{$max}s %4s %s ", .key, .value.key, .value.value; print "\n" if $++ % 2; } say "\n"
}
sub restart {
@ws = $message.comb(/<print>/); %index = (); %used = ();
}
sub place ($x is copy, $y is copy, $w) {
my @word = $w.key.comb; my $dir = %dir{$w.value.value}; @ws[$y * $rows + $x] = @word.shift; while @word { ($x, $y) »+=« $dir; @ws[$y * $rows + $x] = @word.shift; } }
sub find ($x, $y) {
my @trials = %dir.keys.map: -> $dir { my $space = '.'; my ($c, $r) = $x, $y; loop { ($c, $r) »+=« %dir{$dir}; last if 9 < $r|$c; last if 0 > $r|$c; my $l = @ws[$r * $rows + $c]; last if $l ~~ /<:Lu>/; $space ~= $l; } next if $space.chars < 3; [$space.trans( '.' => ' ' ), ("{'ABCDEFGHIJ'.comb[$x]} {$y}" => $dir)] };
for @words.pick(*) -> $word { for @trials -> $space { next if $word.chars > $space[0].chars; return ($word => $space[1]) if compare($space[0].comb, $word.comb) } }
}
sub compare (@s, @w) {
for ^@w { next if @s[$_] eq ' '; return False if @s[$_] ne @w[$_] } True
}</lang>
- Sample output:
A B C D E F G H I J 0 b y e e a R s w u k 1 r g e n p f O s e s 2 d i n l e i i S t i 3 r e b i l a c e E f 4 T g t a d a g n l T 5 d A a t d o w a i d 6 g i C n a n a l r c 7 a o g O p a l p r f 8 p g n p D d a i o a 9 c r u s h E s p t d Words used: aaa G 8 ↖ afield E 0 ↘ alley F 4 ↖ bye A 0 → caliber G 3 ← crush A 9 → dan F 8 ↑ dig A 5 ↘ epic D 0 ↘ fad J 7 ↓ fisk J 3 ↑ gap A 6 ↓ geigy B 4 ↑ get G 4 ↗ gnp B 8 → goa C 7 ← lane H 6 ↑ law G 7 ↑ nag D 6 ↖ nne D 1 ↙ odin F 5 ↖ orr I 8 ↑ paddle E 7 ↑ picnic E 1 ↘ pip H 9 ↑ rib A 1 ↘ sir G 9 ↗ sst G 0 ↘ tail D 5 ↑ ted C 4 ↖ tor I 9 ↑ usia I 0 ↙ wei H 0 ↘
Visual Basic .NET
<lang vbnet>Module Module1
ReadOnly Dirs As Integer(,) = { {1, 0}, {0, 1}, {1, 1}, {1, -1}, {-1, 0}, {0, -1}, {-1, -1}, {-1, 1} }
Const RowCount = 10 Const ColCount = 10 Const GridSize = RowCount * ColCount Const MinWords = 25
Class Grid Public cells(RowCount - 1, ColCount - 1) As Char Public solutions As New List(Of String) Public numAttempts As Integer
Sub New() For i = 0 To RowCount - 1 For j = 0 To ColCount - 1 cells(i, j) = ControlChars.NullChar Next Next End Sub End Class
Dim Rand As New Random()
Sub Main() PrintResult(CreateWordSearch(ReadWords("unixdict.txt"))) End Sub
Function ReadWords(filename As String) As List(Of String) Dim maxlen = Math.Max(RowCount, ColCount) Dim words As New List(Of String)
Dim objReader As New IO.StreamReader(filename) Dim line As String Do While objReader.Peek() <> -1 line = objReader.ReadLine() If line.Length > 3 And line.Length < maxlen Then If line.All(Function(c) Char.IsLetter(c)) Then words.Add(line) End If End If Loop
Return words End Function
Function CreateWordSearch(words As List(Of String)) As Grid For numAttempts = 1 To 1000 Shuffle(words)
Dim grid As New Grid() Dim messageLen = PlaceMessage(grid, "Rosetta Code") Dim target = GridSize - messageLen
Dim cellsFilled = 0 For Each word In words cellsFilled = cellsFilled + TryPlaceWord(grid, word) If cellsFilled = target Then If grid.solutions.Count >= MinWords Then grid.numAttempts = numAttempts Return grid Else 'grid is full but we didn't pack enough words, start over Exit For End If End If Next Next
Return Nothing End Function
Function PlaceMessage(grid As Grid, msg As String) As Integer msg = msg.ToUpper() msg = msg.Replace(" ", "")
If msg.Length > 0 And msg.Length < GridSize Then Dim gapSize As Integer = GridSize / msg.Length
Dim pos = 0 Dim lastPos = -1 For i = 0 To msg.Length - 1 If i = 0 Then pos = pos + Rand.Next(gapSize - 1) Else pos = pos + Rand.Next(2, gapSize - 1) End If Dim r As Integer = Math.Floor(pos / ColCount) Dim c = pos Mod ColCount
grid.cells(r, c) = msg(i)
lastPos = pos Next Return msg.Length End If
Return 0 End Function
Function TryPlaceWord(grid As Grid, word As String) As Integer Dim randDir = Rand.Next(Dirs.GetLength(0)) Dim randPos = Rand.Next(GridSize)
For d = 0 To Dirs.GetLength(0) - 1 Dim dd = (d + randDir) Mod Dirs.GetLength(0)
For p = 0 To GridSize - 1 Dim pp = (p + randPos) Mod GridSize
Dim lettersPLaced = TryLocation(grid, word, dd, pp) If lettersPLaced > 0 Then Return lettersPLaced End If Next Next
Return 0 End Function
Function TryLocation(grid As Grid, word As String, dir As Integer, pos As Integer) As Integer Dim r As Integer = pos / ColCount Dim c = pos Mod ColCount Dim len = word.Length
'check bounds If (Dirs(dir, 0) = 1 And len + c >= ColCount) Or (Dirs(dir, 0) = -1 And len - 1 > c) Or (Dirs(dir, 1) = 1 And len + r >= RowCount) Or (Dirs(dir, 1) = -1 And len - 1 > r) Then Return 0 End If If r = RowCount OrElse c = ColCount Then Return 0 End If
Dim rr = r Dim cc = c
'check cells For i = 0 To len - 1 If grid.cells(rr, cc) <> ControlChars.NullChar AndAlso grid.cells(rr, cc) <> word(i) Then Return 0 End If
cc = cc + Dirs(dir, 0) rr = rr + Dirs(dir, 1) Next
'place Dim overlaps = 0 rr = r cc = c For i = 0 To len - 1 If grid.cells(rr, cc) = word(i) Then overlaps = overlaps + 1 Else grid.cells(rr, cc) = word(i) End If
If i < len - 1 Then cc = cc + Dirs(dir, 0) rr = rr + Dirs(dir, 1) End If Next
Dim lettersPlaced = len - overlaps If lettersPlaced > 0 Then grid.solutions.Add(String.Format("{0,-10} ({1},{2})({3},{4})", word, c, r, cc, rr)) End If
Return lettersPlaced End Function
Sub PrintResult(grid As Grid) If IsNothing(grid) OrElse grid.numAttempts = 0 Then Console.WriteLine("No grid to display") Return End If
Console.WriteLine("Attempts: {0}", grid.numAttempts) Console.WriteLine("Number of words: {0}", GridSize) Console.WriteLine()
Console.WriteLine(" 0 1 2 3 4 5 6 7 8 9") For r = 0 To RowCount - 1 Console.WriteLine() Console.Write("{0} ", r) For c = 0 To ColCount - 1 Console.Write(" {0} ", grid.cells(r, c)) Next Next
Console.WriteLine() Console.WriteLine()
For i = 0 To grid.solutions.Count - 1 If i Mod 2 = 0 Then Console.Write("{0}", grid.solutions(i)) Else Console.WriteLine(" {0}", grid.solutions(i)) End If Next
Console.WriteLine() End Sub
'taken from https://stackoverflow.com/a/20449161 Sub Shuffle(Of T)(list As IList(Of T)) Dim r As Random = New Random() For i = 0 To list.Count - 1 Dim index As Integer = r.Next(i, list.Count) If i <> index Then ' swap list(i) and list(index) Dim temp As T = list(i) list(i) = list(index) list(index) = temp End If Next End Sub
End Module</lang>
- Output:
Attempts: 148 Number of words: 100 0 1 2 3 4 5 6 7 8 9 0 c d p R e c h a r e 1 O i u b a k e S l v 2 k n l E m c a c a i 3 T e s i T x A s n t 4 t C e s a l O a g a 5 a j D l l e E h l g 6 l u f e m a h s e r 7 l t c a r f e r y u 8 f e r r e i r a m p 9 f a m i l i s m i s refract (7,7)(1,7) shameful (7,6)(0,6) ferreira (0,8)(7,8) familism (0,9)(7,9) langley (8,1)(8,7) sake (7,3)(4,0) pulse (2,0)(2,4) purgative (9,8)(9,0) cacm (7,2)(4,2) enid (1,3)(1,0) char (5,0)(8,0) flax (2,6)(5,3) tall (0,4)(0,7) isle (3,3)(3,6) jute (1,5)(1,8) myel (8,8)(8,5) bake (3,1)(6,1) cell (2,7)(5,4) marsh (7,9)(7,5) keel (0,2)(3,5) spur (9,9)(9,6) leaf (5,4)(5,7) cilia (0,0)(4,4) sims (9,9)(6,9) marsha (7,9)(7,4)
Wren
<lang ecmascript>import "random" for Random import "/ioutil" for FileUtil import "/pattern" for Pattern import "/str" for Str import "/fmt" for Fmt
var dirs = [ [1, 0], [0, 1], [1, 1], [1, -1], [-1, 0], [0, -1], [-1, -1], [-1, 1] ] var Rows = 10 var Cols = 10 var gridSize = Rows * Cols var minWords = 25 var rand = Random.new()
class Grid {
construct new() { _numAttempts = 0 _cells = List.filled(Rows, null) for (i in 0...Rows) _cells[i] = List.filled(Cols, " ") _solutions = [] }
numAttempts { _numAttempts } numAttempts=(n) { _numAttempts = n } cells { _cells } solutions { _solutions }
}
var readWords = Fn.new { |fileName|
var maxLen = Rows.max(Cols) var p = Pattern.new("=3/l#0%(maxLen-3)/l", Pattern.whole) return FileUtil.readLines(fileName) .map { |l| Str.lower(l.trim()) } .where { |l| p.isMatch(l) }.toList
}
var placeMessage = Fn.new { |grid, msg|
var p = Pattern.new("/U") var msg2 = p.replaceAll(Str.upper(msg), "") var messageLen = msg2.count if (messageLen >= 1 && messageLen < gridSize) { var gapSize = (gridSize / messageLen).floor for (i in 0...messageLen) { var pos = i * gapSize + rand.int(gapSize) grid.cells[(pos / Cols).floor][pos % Cols] = msg2[i] } return messageLen } return 0
}
var tryLocation = Fn.new { |grid, word, dir, pos|
var r = (pos / Cols).floor var c = pos % Cols var len = word.count
// check bounds if ((dirs[dir][0] == 1 && (len + c) > Cols) || (dirs[dir][0] == -1 && (len - 1) > c) || (dirs[dir][1] == 1 && (len + r) > Rows) || (dirs[dir][1] == -1 && (len - 1) > r)) return 0 var overlaps = 0
// check cells var rr = r var cc = c for (i in 0...len) { if (grid.cells[rr][cc] != " " && grid.cells[rr][cc] != word[i]) return 0 cc = cc + dirs[dir][0] rr = rr + dirs[dir][1] }
// place rr = r cc = c for (i in 0...len) { if (grid.cells[rr][cc] == word[i]) { overlaps = overlaps + 1 } else { grid.cells[rr][cc] = word[i] } if (i < len - 1) { cc = cc + dirs[dir][0] rr = rr + dirs[dir][1] } }
var lettersPlaced = len - overlaps if (lettersPlaced > 0) { grid.solutions.add(Fmt.swrite("$-10s ($d,$d)($d,$d)", word, c, r, cc, rr)) } return lettersPlaced
}
var tryPlaceWord = Fn.new { |grid, word|
var randDir = rand.int(dirs.count) var randPos = rand.int(gridSize) for (d in 0...dirs.count) { var dir = (d + randDir) % dirs.count for (p in 0...gridSize) { var pos = (p + randPos) % gridSize var lettersPlaced = tryLocation.call(grid, word, dir, pos) if (lettersPlaced > 0) return lettersPlaced } } return 0
}
var createWordSearch = Fn.new { |words|
var numAttempts = 1 var grid while (numAttempts < 100) { var outer = false grid = Grid.new() var messageLen = placeMessage.call(grid, "Rosetta Code") var target = gridSize - messageLen var cellsFilled = 0 rand.shuffle(words) for (word in words) { cellsFilled = cellsFilled + tryPlaceWord.call(grid, word) if (cellsFilled == target) { if (grid.solutions.count >= minWords) { grid.numAttempts = numAttempts outer = true break } // grid is full but we didn't pack enough words, start over break } } if (outer) break numAttempts = numAttempts + 1 } return grid
}
var printResult = Fn.new { |grid|
if (grid.numAttempts == 0) { System.print("No grid to display") return } var size = grid.solutions.count System.print("Attempts: %(grid.numAttempts)") System.print("Number of words: %(size)") System.print("\n 0 1 2 3 4 5 6 7 8 9") for (r in 0...Rows) { System.write("\n%(r) ") for (c in 0...Cols) System.write(" %(grid.cells[r][c]) ") } System.print("\n") var i = 0 while (i < size - 1) { System.print("%(grid.solutions[i]) %(grid.solutions[i + 1])") i = i + 2 } if (size % 2 == 1) System.print(grid.solutions[size - 1])
}
printResult.call(createWordSearch.call(readWords.call("unixdict.txt")))</lang>
- Output:
Sample run:
Attempts: 2 Number of words: 29 0 1 2 3 4 5 6 7 8 9 0 s t u c c o R e e f 1 h c r e p O d r f k 2 x e t a l S o u r f 3 i E p e n g n u o b 4 m r n T l s m o u T 5 e i k i d a p h n e 6 A v k w y s h o C e 7 a e a b O k s o r b 8 n n i g u D c k n t 9 d a h E a t r i m k kilgore (2,6)(8,0) daphne (4,5)(9,5) agave (4,9)(0,5) tub (5,9)(3,7) transport (1,0)(9,8) perch (4,1)(0,1) snuff (5,4)(9,0) stucco (0,0)(5,0) icky (7,9)(4,6) murk (6,4)(9,1) honk (6,6)(9,9) irk (0,3)(2,5) spoof (5,6)(9,2) latex (4,2)(0,2) trim (5,9)(8,9) sorb (6,7)(9,7) len (4,2)(2,4) riven (1,4)(1,8) wand (3,6)(0,9) hub (7,5)(9,3) pap (4,1)(2,3) had (2,9)(0,9) ginn (3,8)(0,8) don (6,1)(6,3) fee (9,0)(7,0) none (6,3)(9,6) kim (2,6)(0,4) dna (0,9)(0,7) hook (7,5)(7,8)
zkl
Repeat words allowed. Rather brute force as I didn't realize that the message has to fit exactly. <lang zkl>fcn buildVectors(R,C){ //-->up to 8 vectors of wild card strings
var [const] dirs=T(T(1,0), T(0,1), T(1,1), T(1,-1), T(-1,0),T(0,-1), T(-1,-1), T(-1,1)); vs,v:=List(),List(); foreach dr,dc in (dirs){ v.clear(); r,c:=R,C; while( (0<=r<10) and (0<=c<10) ){ v.append(grid[r][c]); r+=dr; c+=dc; } vs.append(T(v.concat(), // eg "???e??????" would match "cohen" or "mineral" dr,dc)); } vs.filter(fcn(v){ v[0].len()>2 }).shuffle()
} fcn findFit(vs,words){ //-->(n, word) ie (nth vector,word), empty vs not seen
do(1000){ foreach n,v in (vs.enumerate()){ do(10){ // lots of ties word:=words[(0).random(nwds)]; if(word.matches(v[0][0,word.len()])) return(word,n); // "??" !match "abc" }}} False
} fcn pasteWord(r,c, dr,dc, word) // jam word into grid along vector
{ foreach char in (word){ grid[r][c]=char; r+=dr; c+=dc; } }
fcn printGrid{
println("\n 0 1 2 3 4 5 6 7 8 9"); foreach n,line in (grid.enumerate()){ println(n," ",line.concat(" ")) }
} fcn stuff(msg){ MSG:=msg.toUpper() : Utils.Helpers.cycle(_);
foreach r,c in (10,10){ if(grid[r][c]=="?") grid[r][c]=MSG.next() } MSG._n==msg.len() // use all of, not more, not less, of msg?
}</lang> <lang zkl>msg:="RosettaCode";
validWord:=RegExp("[A-Za-z]+\n$").matches; File("unixdict.txt").read(*) // dictionary file to blob, copied from web
// blob to list of valid words .filter('wrap(w){ (3<w.len()<=10) and validWord(w) }) // "word\n" .howza(11).pump(List,"toLower") // convert blob to list of words, removing \n : words:=(_);
reg fitted; do{
var nwds=words.len(), grid=(10).pump(List(),(10).pump(List(),"?".copy).copy); fitted=List(); do(100){ r,c:=(0).random(10), (0).random(10); if(grid[r][c]=="?"){
vs,wn:=buildVectors(r,c), findFit(vs,words); if(wn){ w,n:=wn; pasteWord(r,c,vs[n][1,*].xplode(),w); fitted.append(T(r,c,w)); }
}} print(".");
}while(fitted.len()<25 or not stuff(msg));
printGrid(); println(fitted.len()," words fitted"); fitted.pump(Console.println, T(Void.Read,3,False),
fcn{ vm.arglist.pump(String, fcn([(r,c,w)]){ "%-19s".fmt("[%d,%d]: %s ".fmt(r,c,w)) }) }
); fitted.apply(fcn(w){ w[2].len() }).sum(0).println();</lang>
- Output:
.................................. 0 1 2 3 4 5 6 7 8 9 0 s t b n i b s d R O 1 k y s u p i d a g w 2 i S a a r n E f a a 3 s T d w o n k l b m 4 u T s e t b c o h u 5 m e d e y A e p c p 6 y r e l x e b g a C 7 h o a g d i l l o n 8 t c f p O g u n r D 9 k b o l s h o i b E 26 words fitted [6,5]: eyed [7,4]: dillon [9,1]: bolshoi [6,1]: rap [9,8]: broach [4,6]: claw [0,2]: burn [3,3]: way [8,5]: gun [2,7]: fad [6,7]: gpo [6,6]: beck [8,0]: thymus [4,5]: boast [1,6]: dip [2,5]: nib [3,8]: bag [4,2]: sex [8,1]: core [0,3]: nibs [7,3]: gee [5,2]: deaf [4,4]: twa [5,9]: puma [0,0]: ski [6,3]: lack 102