## Squaring The Bishop

### May 3, 2011

Among the many other works of Charles Babbage is the game of word squares. A word square consists of a set of words written in a square grid in such a way that the same words can be read both horizontally and vertically. Some sample word squares are shown below; the one on the left, in Latin, was found in the ruins of Pompeii, the one in the middle is due to Doug McIlroy, and the one on the right is due to Babbage:

```S A T O R    W A S S A I L    D E A N A R E P O    A N T E N N A    E A S E T E N E T    S T R I N G Y    A S K S O P E R A    S E I Z U R E    N E S T R O T A S    A N N U L A R              I N G R A T E              L A Y E R E D```

Babbage, in his memoirs, proposed to find a word square based on BISHOP, but was unable to do so.

Your task is to write a program that, given a single word, creates a word square using that word in its top row, then use that program to find a word square for the starting word BISHOP. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.

Pages: 1 2

### 14 Responses to “Squaring The Bishop”

1. […] today’s Programming Praxis exercise, our goal is to write a program that can create word squares. […]

```import qualified Data.ByteString.Char8 as B
import qualified Data.List.Key as K
import qualified Data.Map as M
import qualified Data.Trie as T

loadWords :: IO (M.Map Int (T.Trie Int))
loadWords = fmap (M.fromList . map (\(w:ws) -> (snd w, T.fromList (w:ws))) .
K.group snd . K.sort snd . map (\w -> (w, B.length w)) .

findWords :: Int -> String -> M.Map Int (T.Trie a) -> [B.ByteString]
findWords l prefix = T.keys . T.submap (B.pack prefix) . (M.! l)

square :: String -> M.Map Int (T.Trie a) -> [[B.ByteString]]
square word ds = f 1 [B.pack word] where
f n ws = if n == length word then [ws] else
(\w -> f (n + 1) (ws ++ [w])) =<<
findWords (length word) (map (`B.index` n) ws) ds

main :: IO ()
main = do print . square "bonsai" =<< loadWords
print . (== 122) . length . square "bishop" =<< loadWords
```
3. arturasl said

Solution in java: github.
Simple run (squares for word “arthur” :D ):

```[[ ARTHUR, REWIRE, TWINGE, HINGES, URGENT, REESTS ], [ ARTHUR, REZONE, TZURIS, HORSTE, UNITED, RESEDA ]]
2
```
4. Graham said

My Python solution.
It’s not quite as quick as I might like, and I could do without the overloading of
`+` via `sum`… Also, I wanted to make sure my solutions
were correct without going through them by hand, so I wrote a recursive check
at the end.

5. Graham said

Apologies for messing up the linebreaks in my comment

6. Rainer said

My try in REXX:

/* Datei von http://icon.shef.ac.uk/Moby/mwords.html */
file = ‘354984si.ngl.txt’

list. = ”
llen. = 0
solno = 0
print = ‘0’
call word_square ‘DEAN’
say solno ‘Solutions for DEAN’

list. = ”
llen. = 0
solno = 0
print = ‘1’
call word_square ‘BISHOP’
say solno ‘Solutions for BISHOP’

exit

word_square:
parse arg wort
wl = length(wort)
do while lines(file)
data = strip(upper(linein(file)))
if length(data) \= 4 then iterate
first = substr(data,1,1)
p = pos(first,substr(wort,2))
if p == 0 then iterate
list.p = list.p data
llen.p = llen.p + 1
end
do a = 1 to llen.1
worta = word(list.1,a)
do b = 1 to llen.2
wortb = word(list.2,b)
do c = 1 to llen.3
wortc = word(list.3,c)
do d = 1 to max(llen.4,1)
wortd = word(list.4,d)
do e = 1 to max(llen.5,1)
worte = word(list.5,e)
call check_worte wort worta wortb wortc wortd worte
end
end
end
end
end
return

check_worte: procedure expose solno print
parse arg w1 w2 w3 w4 w5 w6
wl = length(w1)
w.1 = w1; w.2 = w2; w.3 = w3; w.4 = w4; w.5 = w5; w.6 = w6
m. = ”
do i = 1 to 6
do j = 1 to 6
m.i.j = substr(w.i,j,1)
end
end
do i = 1 to 6
do j = 1 to 6
if m.i.j \= m.j.i then return
end
end
solno = solno + 1
if print == ‘1’ then do
say ‘Solution #’solno
do i = 1 to 6
if strip(w.i) \= ” then,
say m.i.1 m.i.2 m.i.3 m.i.4 m.i.5 m.i.6
end
say copies(‘-‘,50)
end
return

/*
3633 Solutions for DEAN
0 Solutions for BISHOP
*/

7. Rainer said

Sorry, missed the formatting

```file = '354984si.ngl.txt'

list. = ''
llen. = 0
solno = 0
print = '0'
call word_square 'DEAN'
say solno 'Solutions for DEAN'

list. = ''
llen. = 0
solno = 0
print = '1'
call word_square 'BISHOP'
say solno 'Solutions for BISHOP'

exit

word_square:
parse arg wort
wl = length(wort)
do while lines(file)
data = strip(upper(linein(file)))
if length(data) \= 4 then iterate
first = substr(data,1,1)
p = pos(first,substr(wort,2))
if p == 0 then iterate
list.p = list.p data
llen.p = llen.p + 1
end
do a = 1 to llen.1
worta = word(list.1,a)
do b = 1 to llen.2
wortb = word(list.2,b)
do c = 1 to llen.3
wortc = word(list.3,c)
do d = 1 to max(llen.4,1)
wortd = word(list.4,d)
do e = 1 to max(llen.5,1)
worte = word(list.5,e)
call check_worte wort worta wortb wortc wortd worte
end
end
end
end
end
return

check_worte: procedure expose solno
parse arg w1 w2 w3 w4 w5 w6
wl = length(w1)
w.1 = w1; w.2 = w2; w.3 = w3; w.4 = w4; w.5 = w5; w.6 = w6
m. = ''
do i = 1 to 6
do j = 1 to 6
m.i.j = substr(w.i,j,1)
end
end
do i = 1 to 6
do j = 1 to 6
if m.i.j \= m.j.i then return
end
end
solno = solno + 1
if print == '1' then do
say 'Solution #'solno
do i = 1 to 6
if strip(w.i) \= '' then,
say m.i.1 m.i.2 m.i.3 m.i.4 m.i.5 m.i.6
end
say copies('-',50)
end
return
```
8. Axio said

The latin one is very interesting: it is also a palindrome when lines are concatenated.
It’s an easy constraint though, as far as solving algorithmics is concerned: each word and its reverse just have in the dictionary…

9. I began by compiling a file with all the six letter words (ignoring anything that wasn’t A-Z) from the dictionary in /usr/share/dict/words. I then spent five minutes writing the first version of this which was brute force, set it running, and then revised it to create and use a prefix table. The second version was completed five minutes later, while the first was still struggling in finding the tenth or so match. This program identifies 15,533 valid squares in about six and a half seconds on my (pretty fast) HP workstation.

```#!/usr/bin/env python

start = "BISHOP"

words = map(lambda x : x.strip(), open("6words").readlines())

ptab = { }

for w in words:
for x in range(1, len(w)):
ptab[w[:x]] = ptab.get(w[0:x], []) + [w]

def check(good, n, new):
for i in range(n):
if good[i][n] != new[i]:
return False
return True

def search(start, n):
if n == 6:
print start
return
prefix = ''.join([start[i][n] for i in range(n)])
for w in ptab.get(prefix, []):
if check(start, n, w):
search (start + [w], n+1)

def findsquare(start):
good = [ start ]
search(good, 1)

findsquare(start)
```
10. Jussi Piitulainen said

I wrote a Python3 script to write me the source code for the Prolog database of
the words – trie(C, W) to get words that begin with C. This is ./dictate.py (sans #!):

```from sys import stdin

def select(word):
for k in range(len(word)):
yield word[:k], word[k:k + 1], word[k + 1:]

nodes = dict()

for word in stdin:
word = word.strip()
for before, at, after in select(word):
if before not in nodes: nodes[before] = set()

for before in nodes:
for at, end in nodes[before]:
print(('trie{b}({a},[{a}]).' if end
else 'trie{b}({a},[{a}|T]) :- trie{b}{a}(_,T).')
.format(b=before, a=at))
```

Then I used it with SCOWL-7.1 word lists in Bash like this, taking only six letter words
for this task, though a variable length trie should work all right:

```./mk-list british 60 | grep -Ex '[a-z]{6}' | ./dictate.py | LC_ALL sort > british60.pl
```

The resulting trie source code has a little over 22k lines like so:

```trie(a,[a|T]) :- triea(_,T).
trie(b,[b|T]) :- trieb(_,T).
...
triezygo(t,[t|T]) :- triezygot(_,T).
triezygot(e,[e]).
```

The Prolog program to check or fill in a square represents the square as a list of lists,
and it just says that the square is its own transpose and each row is in the trie.

```square(Words) :- transpose(Words, Words), words(Words).

transpose([R|Rs], [C|Cs]) :- slice([R|Rs], C, Ts), transpose(Ts, Cs).
transpose([[]|_], []).
transpose([], []).

slice([[A|As]|Rs], [A|Hs], [As|Ts]) :- slice(Rs, Hs, Ts).
slice([], [], []).

words([W|Ws]) :- word(W), words(Ws).   words([]).

word([C|Cs]) :- trie(C, [C|Cs]).
```

The transpose/2 predicate works properly when the square (it can be oblong) has a definite size, which is a nuisance to write by hand every time, so I wrote an auxiliary to establish the size, and another to display the results nicely:

```size(Words, Ht, Wd) :- length(Words, Ht), lengths(Words, Wd).

lengths([Word|Words], Wd) :- length(Word, Wd), lengths(Words, Wd).
lengths([], Wd).

display([Word|Words]) :- write(Word), nl, display(Words).
display([]) :- nl.
```

Then the solutions (none of them in this word list) having [b,i,s,h,o,p] as the first row
can be found and displayed so:

```?- size(A,6,6), nth0(0,A,[b,i,s,h,o,p]), square(A), display(A), fail.
```

This does more. It can be asked for squares that contain a word as any row. Still none for [b,i,s,h,o,p] in this list (plenty in a larger list) but there are two for [d,i,s,p,e,l]:

```?- size(A,6,6), member([d,i,s,p,e,l],A), square(A), display(A), fail.
[d, i, s, p, e, l]
[i, m, p, a, l, a]
[s, p, i, r, i, t]
[p, a, r, a, d, e]
[e, l, i, d, e, s]
[l, a, t, e, s, t]

[m, a, d, r, a, s]
[a, p, i, e, c, e]
[d, i, s, p, e, l]
[r, e, p, u, t, e]
[a, c, e, t, i, c]
[s, e, l, e, c, t]

false.
```

I don’t know what [m,a,d,r,a,s] and [a,c,e,t,i,c] mean, but then I didn’t know
[o,s,t,e,a,l] either. And I wonder if this problem could be done nicely in SQL.

11. Jussi Piitulainen said

Sorry. Typo in the command line that sorted the trie source code. The last command should, of course, be:

```LC_ALL=C sort
```

The setting of LC_ALL to C is so that it does not ignore parentheses or anything like that. Prolog wants the clauses of a predicate together by default. Sorry again. As if the entry was not long enough already.

12. Mike said

Here’s my first take. Basically, does a bread-first search of the solution space.

Note: I couldn’t open the moby word list from the link in the problem. But I was able to get it from Project Gutenberg.

```from collections import defaultdict

def wordsquare(first_word):
size = len(first_word)

prefix_table = defaultdict(list)
first_letters = set(first_word)
with open("mword10/single.txt", "rt") as f:
for line in f:
word = line.strip().strip('%')

if len(word) == size and word[0] in first_letters:
for n in range(1, size):
prefix_table[word[:n]].append(word)

candidates = [[first_word]]
for ndx in range(1, size):
tmp = []
for square in candidates:
prefix = ''.join(w[ndx] for w in square)
tmp.extend(square + [word] for word in prefix_table[prefix])

candidates = tmp

return candidates
```
13. […] this one was just neat. Based on an older post from Programming Praxis filed under Word Games, the idea is to find a set of words with very […]

14. JP said

That was fun. :) I wrote up my solution in Racket, making sure to take advantage of the excellent `for/list`macro. For the dictionary, I implemented a trie structure based on hashtables, which was really useful also (and particularly useful for working with prefixes).