Lisp with Xgrid

In case you're interested, here's the Lisp program I wrote to search for 4 x 4 word squares. I developed it using LispWorks Common Lisp, and built it into a file that could be executed from the command line, but it should be compatible with any version of Common Lisp.

Complete listing

Word Squares in Lisp

A separate file defines the list of 2360 four-letter words:

(defparameter *words4* '("abed" "abet" "able" "ably" "abut" "aces" ... etc))

For efficiency I create two hash tables. The first one, words, is used to check whether a given string is a valid word:

CL-USER 9 > (gethash "aces" words)
T
T
CL-USER 10 > (gethash "xyzz" words)
NIL
NIL 

The second one, twins, returns a list of words starting with a specified pair of letters:

CL-USER 11 > (gethash "ac" twins)
("acts" "acre" "acne" "acme" "acid" "achy" "ache" "aces")
T
Next I use two functions to help in creating and looking up words[1]. The first one, make-word4, creates a string out of specified characters from five other strings:
(defun make-word4 (w0 c0 w1 c1 w2 c2 w3 c3)
  (let ((string (make-string 4)))
    (setf (char string 0) (char w0 c0)
          (char string 1) (char w1 c1)
          (char string 2) (char w2 c2)
          (char string 3) (char w3 c3))
    string))

The second one, lookup-prefix, looks up a two-character string in the twins table:

(defun lookup-prefix (w0 c0 w1 c1 table)
  (let ((prefix (make-string 2)))
    (setf (char prefix 0) (char w0 c0))
    (setf (char prefix 1) (char w1 c1))
    (gethash prefix table)))

The function check-distinct checks that all the words in a list are distinct:

(defun check-distinct (list)
  (= (length (remove-duplicates list :test #'string=)) (length list)))

Finally, here's the complete program doword. It takes two numeric parameters, and searches starting from the words in the corresponding subsequence of the full list of 2360 four-letter words, *words4*. For example, to test word squares with "able" in the leftmost vertical you would run:

(doword 2 3)

Here's the definition of doword:

(defun doword (from to)
  (let ((all *words4*)
        (words (make-hash-table :test #'string=))
        (twins (make-hash-table :test #'string=)))
    (map nil #'(lambda (word) (setf (gethash word words) t)) all)
    (map nil #'(lambda (word) 
                 (setf (gethash (subseq word 0 2) twins)
                       (cons word (gethash (subseq word 0 2) twins)))) all)
    ;;
    (dolist (v0 (subseq all from (min to (length all))))
      ;; (format t "~a, " v0)
      (dolist (v1 all)
        (let ((l0 (lookup-prefix v0 0 v1 0 twins))
              (l1 (lookup-prefix v0 1 v1 1 twins))
              (l2 (lookup-prefix v0 2 v1 2 twins))
              (l3 (lookup-prefix v0 3 v1 3 twins))
              ;; Diagonals
              (ld0 (lookup-prefix v0 0 v1 1 twins))
              (ld1 (lookup-prefix v0 3 v1 2 twins)))
          (when (and l0 l1 l2 l3 ld0 ld1)
            (dolist (h0 l0)
              (dolist (h1 l1)
                ;; Check first two letters of v2 and v3 are OK - divides time by 3
                (let ((ll2 (lookup-prefix h0 2 h1 2 twins))
                      (ll3 (lookup-prefix h0 3 h1 3 twins)))
                  (when (and ll2 ll3)
                    (dolist (h2 l2)
                      (dolist (h3 l3)
                        (let ((v2 (make-word4 h0 2 h1 2 h2 2 h3 2))
                              (v3 (make-word4 h0 3 h1 3 h2 3 h3 3))
                              (d0 (make-word4 h0 0 h1 1 h2 2 h3 3))
                              (d1 (make-word4 h3 0 h2 1 h1 2 h0 3)))
                          (when
                              (and 
                               (gethash v2 words)
                               (gethash v3 words)
                               ;; Diagonals
                               (gethash d0 words)
                               (gethash d1 words)
                               ;; All words distinct?
                               (check-distinct (list v0 v1 v2 v3 h0 h1 h2 h3 d0 d1)))
                            ;; Success! Print word square
                            (format t "~%~%~a~%~a~%~a~%~a~%~%" h0 h1 h2 h3)))))))))))))))

I call it from the command line using this helper function:

(defun squares4 ()
  (doword (parse-integer (second sys:*line-arguments-list*))
          (parse-integer (third sys:*line-arguments-list*))))

I built the program into an application that could be run from the command line using the LispWorks Application Builder, using this delivery script:

(in-package "CL-USER")
(load-all-patches)
(compile-file (current-pathname "words4") :output-file :temp :load t)
(compile-file (current-pathname "squares4") :output-file :temp :load t)
(deliver 'squares4 "~/squares4" 1)

Finally, the built application can be tested from the Terminal command line for the entire list of words by typing:

./squares4 0 2360

  1. ^ I am grateful to Rainer Joswig for suggesting these functions.

blog comments powered by Disqus