1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
(defun group (list key &optional (test #'eql))
  (let ((tbl (make-hash-table :test test)))
    (dolist (x list) (push x (gethash (funcall key x) tbl)))
    tbl))

(defun make-puzzle (words)
  (let ((tbl1 (group words (lambda (s) (elt s 0)))))
    (loop for grp1 being each hash-value of tbl1 nconc
      (loop for a in grp1 and rest1 on (cdr grp1) nconc
        (loop for b in rest1
          if (char/= (elt a 3) (elt b 3)) nconc
          (loop for c in (gethash (elt a 3) tbl1) nconc
            (loop for d in (gethash (elt b 3) tbl1)
              if (char= (elt c 3) (elt d 3))
              collect (list a b c d))))))))

;;; test
(compile 'make-puzzle)

(let ((words (with-open-file (s "words.txt" :direction :input)
               (loop for x = (read-line s nil) while x collect x))))
  (print (time (make-puzzle words))))