APL WikiFun With Word Search
Contents
In the village where I live we get a free magazine each month with news of what's happening locally (My favourite column is the one which tells you what the weather has been in the previous month!).
There also usually a Word Search puzzle. Sounds like a great job for APL!
Here's one from last month's magazine (Horam Village Diary, March 2009):
Constructing the test data
First the easy bit. Here are two functions to use when testing the solution...
∇R←MakePuzzle
[1] R←⊃'AATNEMNREVOGSLAOG' 'NSISEHTOPYHEWFHGR' 'OGGENERICIENJLCEM' 'INOITALFNIREPYHAB'
[2] R←R⍪⊃'TIVBHXJEUISTVSHRE' 'AKIMGVHTMDWIHUZIM' 'SRXVADDANAPCARUNQ' 'IOGGULSMOFRAPEYGQ'
[3] R←R⍪⊃'LWLRZAGIRHCLLTUMW' 'AEOONROTYRILLNGAS' 'BMBSZEPSUTFYIUNDX' 'OOASTNUSUPWRWHISH'
[4] R←R⍪⊃'LHLNCEOEQHWEDDGTH' 'GOAYEGRUEGEOOADLM' 'HREPTTGGCBBCOEEIU' 'GHOMOGENEOUSGHHGU'
[5] R←R⍪⊃'JPLTMIVVDCBBFRFOG'
∇
∇R←MakeWordList
[1] R←'GEARING' 'GENERAL' 'GENERIC' 'GENETICALLY' 'GILTS' 'GLOBAL'
[2] R←R,'GLOBALISATION' 'GOALS' 'GOODWILL' 'GOVERNMENT' 'GRANT'
[3] R←R,'GROSS' 'GROUP' 'GUESSTIMATE' 'HEADHUNTER' 'HEDGING' 'HOMEWORKING'
[4] R←R,'HOMOGENEOUS' 'HYPERINFLATION' 'HYPOTHESIS'
∇
Searching from left to right
APL has a very useful primitive function called Find (⍷) which lets you search for instances of the left argument in the right argument. It's used in the following function (explained below):
∇R←puzzle SearchAcross word;numSquares
[1]
[2] ⍝ Find all the squares where the word occurs
[3] ⍝ (May be more than one)
[4]
[5] numSquares←×/⍴puzzle
[6] R←(,word⍷puzzle)/⍳numSquares
[7]
[8] ⍝ Return result showing word in otherwise blank array
[9] ⍝ (More than one array if word found more than once,
[10] ⍝ or entirely blank if not found at all)
[11]
[12] R←,(⊂⍴puzzle)⍴¨(⊂numSquares)↑¨(-(R+⍴word))↑¨⊂word
∇Here's an example of the function being used to search the rows of the puzzle for 'GENERIC'. (I've used DISPLAY to make the shape of the result clearer. DISPLAY is available in Dyalog. other APLs usually have also have a DISPLAY function but you may need to copy it into your workspace).
⎕DISPLAY MakePuzzle SearchAcross 'GENERIC' ┌→────────────────────┐ │ ┌→────────────────┐ │ │ ↓ │ │ │ │ │ │ │ │ GENERIC │ │ │ │ │ │ ... ...[snip] │ └─────────────────┘ │ └∊────────────────────┘
Line [6] of the function first looks for the word in the puzzle (word⍷puzzle). This will produce an array the same shape as the puzzle, with a '1' in each location where the word starts. This array is then used to produce a list of the square-numbers of the squares where the word begins.
To understand Line [12], first consider the following simplified form, which will only work if the word was only found once:
(⍴puzzle)⍴numSquares↑(-(R+⍴word))↑word
This starts by doing a take (↑) on the word using a negative number, to put spaces at the start of the word. It then does a second ↑ to put more spaces on the end, and finally does a reshape to convert the result into an array of the same shape as the puzzle.
The actual Line [12] is just a generalisation of this to handle the fact that the word might occur more than once, so that R is a vector of the numbers of all the squares where the word starts. The Each operator (¨) is used to apply the logic to each number in the list.
Searching in other directions
We can use the SearchAcross function as the building block for our complete solution:
∇R←puzzle SearchAll wordList;numWords;shift;shape;idx;word;where;
modifiedPuzzle;found;wordMasks;overlap;badMatches;⎕IO
[1]
[2] ⎕IO←0
[3] R←found←⍬
[4]
[5] ⍝ If we're given a single word, make it a one-element list
[6] :If 1=≡wordList ⋄ wordList←,⊂wordList ⋄ :EndIf
[7]
[8] numWords←⍴wordList
[9] shift←⍳1↑⍴puzzle
[10] shape←⍴puzzle
[11]
[12] :For idx :In ⍳numWords
[13] word←⊃wordList[idx]
[14]
[15] ⍝ Search from left to right
[16] where←puzzle SearchAcross word
[17]
[18] ⍝ Right to left
[19] modifiedPuzzle←⌽puzzle
[20] where←where,⌽¨modifiedPuzzle SearchAcross word
[21]
[22] ⍝ Down
[23] modifiedPuzzle←⍉puzzle
[24] where←where,⍉¨modifiedPuzzle SearchAcross word
[25]
[26] ⍝ Up
[27] modifiedPuzzle←⌽⍉puzzle
[28] where←where,⍉¨⌽¨modifiedPuzzle SearchAcross word
[29]
[30] ⍝ Diagonal top left to bottom right
[31] modifiedPuzzle←shift⊖(2 1×shape)↑puzzle
[32] where←where,(⊂shape)⍴¨(⊂-shift)⊖¨modifiedPuzzle SearchAcross word
[33]
[34] ⍝ Diagonal bottom left to top right
[35] modifiedPuzzle←(-shift)⊖(2 1×shape)↑puzzle
[36] where←where,(⊂shape)⍴¨(⊂shift)⊖¨modifiedPuzzle SearchAcross word
[37]
[38] ⍝ Diagonal top right to bottom left
[39] modifiedPuzzle←⌽shift⊖(2 1×shape)↑puzzle
[40] where←where,(⊂shape)⍴¨(⊂-shift)⊖¨⌽¨modifiedPuzzle SearchAcross word
[41]
[42] ⍝ Diagonal bottom right to top left
[43] modifiedPuzzle←⌽(-shift)⊖(2 1×shape)↑puzzle
[44] where←where,(⊂shape)⍴¨(⊂shift)⊖¨⌽¨modifiedPuzzle SearchAcross word
[45]
[46] ⍝ Did we find the word somewhere? (Maybe more than once, maybe not at all)
[47] R←R,where
[48] found←found,(⍴where)/idx
[49] :EndFor
[50]
[51] ⍝ Now eliminate words which were found entirely within
[52] ⍝ longer words, e.g. GLOBAL in GLOBALISATION
[53] :If 0≠⍴R
[54] wordMasks←R≠' '
[55] overlap←wordMasks∘.^wordMasks ⍝ Every mask ANDed with every other mask
[56] (0 0⍉overlap)←0 ⍝ Set diagonal to 0
[57] badMatches←((,overlap)⍳wordMasks)<(⍴,overlap) ⍝ If mask still found, word contained within another
[58] R←(~badMatches)/R ⍝ Strip out the bad matches
[59] found←(~badMatches)/found
[60] :EndIf
[61]
[62] ⍝ Now include list of what was not found, and format results for display
[63] R←(R,⊂'***NOT FOUND***')[found⍳⍳numWords]
[64] R←⍉wordList,[¯0.5]R
∇ The heart of this routine is a loop which considers one word at a time, searching for it in all directions (left, right, down, up and diagonally).
It's easy to see how the code searches from right to left (Lines [19] and [20]). It just flips the puzzle using the Reverse function (⌽), searches the modified puzzle from left to right, and flips the answer(s) back again. Similarly, searching downwards can be achieved using Transpose (⍉) to exchange rows with columns, and searching upwards can be done with ⍉ followed by ⌽.
Searching diagonally is only a little trickier. The First-axis Rotate function (⊖) is used, but with a left argument which specifies how much to rotate each column by:
⎕IO←0
TEST←3 3⍴'DAEXODBAG'
TEST
DAE
XOD
BAG
0 1 2⊖TEST
DOG
XAE
BADHere you can see that the word DOG on the diagonal has been transformed into DOG on the first row. However, we need to be careful about BAD on the third row. It's not in the original TEST array: the problem is that the columns have wrapped around. The solution is to tack spaces onto the bottom before doing the rotate:
0 1 2⊖6 3↑TEST DOG XA B E AD
Line [32] might be easier to understand by first considering the following simplified form. The actual version used in the function listing above is the same except that it can handle cases where the word was found more than once.
shape ⍴ (-shift) ⊖ ↑modifiedPuzzle SearchAcross word
After the main loop completes and we've found all the words, we need to take care of one last problem. The word GLOBAL has been found twice, once in its correct location and once at the start of GLOBALISATION. The solution used in shown in Lines [53] to [60].
At the start of Line [53], R is a nested vector in which each element is an array the same size and shape as the puzzle, but containing blanks except where the word occurs (i.e. the format returned by the SearchAcross function).
We first convert each element into a boolean mask with a '1' in every non-blank position (Line [54]).
If you were to AND two masks together you would get a '1' only where the two words crossed or overlapped. If one word is completely contained within another, like GLOBAL in GLOBALISATION, then AND-ing with the longer mask will have no effect on the shorter mask.
Line [55] uses APL's Outer Product operator to compute the AND of each mask with every other mask (∘.^) and put the result in overlap. Line [56] then sets the diagonal of overlap to zero, since we know that a word completely overlaps with itself! Finally, Line [57] checks whether any words completely overlap with any other: If they do, the overlap array will still contain the mask for the word and so the Index (⍳) function will find it. Lines [58] and [59] strip out the unwanted words, and the function finishes by tidying up the result and reshaping it for easy display.
Displaying the result in a GUI
Finally, here's a little pair of functions to display the result in a GUI window. You can see a screen snapshot at the start of this page. When you click on a word on the left, the word is shown in the grid on the right.
Up until now all the code listed above should work in any APL2-compatible APL interpreter, but this function requires APLX (not under development any more).
The main function ShowResults creates a window with a list box on the left and a grid on the right. It puts the word list in the list box, fills the grid with the letters of the puzzle, and then sets up a callback function ShowWord which executes each time a new word in the list is selected.
ShowWord just recolours the backgrounds of the squares to show the selected word in red.
∇puzzle ShowResults res;black;white;red;numRows;numCols;cellSize;win;squares;⎕IO
[1] ⎕IO←1
[2]
[3] ⍝ Set up some useful colours
[4] (black white red)←256⊥¨(0 0 0)(255 255 255)(0 0 255)
[5]
[6] ⍝ Create the window
[7] (numRows numCols)←⍴puzzle
[8] cellSize←30
[9] '⎕' ⎕wi 'scale' 5
[10] win←'⎕' ⎕new 'window' ⋄ win.title←'Word Search'
[11] win.doubleBuffered←1
[12]
[13] ⍝ Create the list used to select words
[14] win.list.New 'List' ⋄ win.list.where←0 0 50 200 ⋄ win.list.align←2
[15] win.list.font←'Helvetica' 15
[16] win.list.List←⊃res[;1]
[17]
[18] ⍝ Add a splitter to allow the word list to be resize
[19] win.splitter.New 'Splitter' ⋄ win.splitter.where←0 200 50 5 ⋄ win.splitter.align←2
[20]
[21] ⍝ Create the grid used to show the puzzle
[22] win.grid.New 'Grid' ⋄ win.grid.align←¯1
[23] win.grid.autoeditstart←0 ⋄ win.grid.style←16+64
[24] win.grid.rowsize←(0)(,cellSize) ⋄ win.grid.colsize←(0)(,cellSize)
[25] win.grid.rows←numRows ⋄ win.grid.cols←numCols
[26]
[27] win.grid.headcols←win.grid.headrows←0
[28] win.grid.textalign(⍳numRows)(⍳numCols)(4+32)
[29] win.grid.text←(⍳numRows)(⍳numCols)puzzle
[30] win.grid.font←'Helvetica' 24
[31]
[32] ⍝ Resize window to fit
[33] win.where←40 40,(20 25)+(0 win.list.size[2])+cellSize×⍴puzzle
[34]
[35] ⍝ Set function to run when word list clicked...
[36] squares←⍬
[37] win.list.onChange←'ShowWord'
[38]
[39] ⍝ Show first word in list
[40] win.list.value←1
[41]
[42] ⍝ Add one extra very thin row to hide selection
[43] win.grid.rows←win.grid.rows+1
[44] win.grid.rowsize←(,win.grid.rows)(,0)
[45] win.grid.selection←win.grid.rows,1 1 1
[46]
[47] ⍝ Process events until window closes
[48] 0 0⍴⎕WE win
∇
∇ShowWord;found;idx
[1] ⍝ Erase last word shown (if any)
[2] :For idx :In ⍳¯1↑⍴squares
[3] win.grid.colorback←(,squares[1;idx])(,squares[2;idx])white
[4] :EndFor
[5]
[6] ⍝ Where was the new word found?
[7] found←↑res[win.list.value;2]
[8] squares←(1 1)+[1](⍴found)⊤¯1+(,found≠' ')/⍳×/⍴found
[9]
[10] ⍝ Show the new word by colouring the squares red
[11] :For idx :In ⍳¯1↑⍴squares
[12] win.grid.colorback←(,squares[1;idx])(,squares[2;idx])red
[13] :EndFor
∇Author: SimonMarsden