Lisp, One ( At a Time

Some small programs in Lisp.

The Idea

I've be on and off Lisp for more than two decades now, and it is perhaps time that I grow up :-) This page documents my re-learning steps through a non trivial example.

Crosswords generator

You're given a 100,000 words dictionary, as a sorted text file of ASCII characters, a grid from 15x15 to 25x25, and it is up to you now to fill the grid with existing words. Finding suitable definitions is left as an exercise for the reader.

The Arc Consistency Crossword Compiler is a good source to get a few sample grids and an initial dictionary to play with. ArCCC is a C program whose author claims that it solves any grid in his example in less than a minute. My experience tells me otherwise.

My first attempt at a solution is in Java. There I provided all the debugging infrastructure that I needed to see how the various algorithms that I had or would come up with would be performing. I'm glad to report that I can solve a 15 x 15 grid at about 92% in less than 30 seconds. I'm very sad however, to have to acknowledge that hours after having reached the 92% mark, my best algorithm seems to be stuck in some local optimum it can't break away from.

On To Lisp

While Richard Gabriel argues that objects have failed, even though Guy Steele seems to disagree, I'm willing, at least as a first experiment, to not replicate either ArCCC procedural design, nor my own Object Oriented Java design. After all if Paul Graham seems to side with Peter Gabriel, then there surely must be some other alternative to object orientedness, and so I'm going to avoid CLOS.

Problem's Scope

At least for now, the program will not attempt to provide any user interface other than the traditional Lisp REPL, and will have to store each solved grid as a file, in a format similar to that of an input grid.

Some degree of randomness is expected of the solver, simply because we want to be able to offer more than one solution for any given grid. There might be other ways than pure randomness to choose a particular solution, though.

Needed Libraries

I'm using Peter Siebel excellent Unit Test Framework that must be loaded first.

I have also borrowed the ppmx macro from David S. Touretzky Common Lisp: A Gentle Introduction to Symbolic Computation

Bottom Up Design

Even though, I'm not going to use any "oo-ness", I still must define the bits that I want to operate on.
I will need to manipulate a grid, a dictionary, and will need a solver to apply a subset of the dictionary to the grid.

Since the idiomatic way to program in Lisp (and in Forth, BTW :-) is to use Lisp to create a language in which the application will be expressed, I'm going to try to respect this, as much as I can.

But there's probably no way around the facts that the "program" will need to access the grid to

Likewise, the "program" will need to access the dictionary to

  • create it first, from some input file
  • populate it, in a way that will make it easy (and preferably efficient) for the solver to ask questions such as

    So, shamelessly forging ahead, I'm defining four global (Yuck!) variables: 

    ;;; The four main pieces of data the crossword solver is composed of  
(defvar *io-handler*)
(defvar *grid*)
(defvar *dict*)
(defvar *solver*)

    The Input Output Handler

    (to be filled as the design progresses)

    The Grid

    (to be filled as the design progresses)

    The Dictionary

    I'm finally able to read the dictionary from the file system

      20051204
    (defstruct dict
      "Holds the dictionary"
      (words (make-array 0
                         :element-type 'character
                         :adjustable t
                         :fill-pointer 0    )    )
      ;; We decide to waste the first element of the index. It cannot
      ;; possibly be anything but zero, but having it that way simplifies
      ;; all index calculations.
      (index (make-array 1
                         :element-type 'integer
                         :adjustable t
                         :fill-pointer 1
                         :initial-element 0    )    )    )


    (defun reset-dict (dict)
      (adjust-array (dict-words dict) 0)
      (adjust-array (dict-index dict) 1)    )

    (defun trim-dict (dict)
      (let ((wlen (length (dict-words dict)))
            (ilen (length (dict-index dict)))    )
        (adjust-array (dict-words dict) wlen)
        (adjust-array (dict-index dict) ilen)    )    )

    (defun append-dict (dict word)
      (let*
          ((word-length (length word))
           (next-offset (+ word-length (length (dict-words dict))))    )
        ;; adjust the index
        (vector-push-extend next-offset (dict-index dict))
        ;; store the new word
        (dotimes (i word-length (= i word-length))
          (vector-push-extend (aref word i) (dict-words dict))    )    )    )

    (defun get-word-start (dict index)
      "Returns the offset of the given word in the dictionary"
      (if (>= index (length (dict-index dict)))
          (length (dict-store dict))
        (aref (dict-index dict) index)    )    )

    (defun get-word-end (dict index)
      "Returns the offset of the given word in the dictionary"
      (if (>= index (length (dict-words dict)))
          (length (dict-words dict))
        (aref (dict-index dict) (1+ index))    )    )

    (defun get-word-at (dict index)
      "Returns the i'th word, or errors it index is out of bounds"
      (if (or
           (>= index (length (dict-words dict)))
           (< index 0)    )
          (error "index value ~A is out of range; limit is ~A"
                 index
                 (length (dict-words dict))    )
        (let
            ((start (get-word-start dict index))
             (end (get-word-end dict index))    )
          (subseq (dict-words dict) start end)    )    )    )

    (defun length-dict (dict)
      ;; subtract one because of the zeroth slot
      (1- (length (dict-index dict)))    )
      20051204
    (defun read-dict (file-name)
      "Reads the specified file and returns the corresponding dictionary"
      (with-open-file (s file-name)
        (do
            ((dict (make-dict))
             (line (read-line s)
                   (read-line s nil 'eof)    )    )
            ((eq line 'eof) dict)
          (append-dict dict line)    )    )    )
      20051204
    (eval-when (:load-toplevel :compile-toplevel :execute)
      (unless (find-package :crosswords)
        (make-package :crosswords
                      :use (list (or (find-package :common-lisp)
                                     (find-package :lisp)    )    )    )    )    )

    (in-package :crosswords)

    ;;; Just because I'm Oh, so tired of having Lisp shouting at me ...
    (setf *print-case* :downcase)

    (defparameter +dict-name+ "/Users/verec/workspace/data/wlist100.txt")
    (defparameter +grid-name+ "/Users/verec/workspace/data/metro6.grid")


    #+nil (export '(crosswords make-dict))

    (load "/Users/verec/workspace/utils/lisp-unit.lisp")

    (load "/Users/verec/workspace/crosswords/dict.lisp")
    (load "/Users/verec/workspace/crosswords/dict-test.lisp")

    (load "/Users/verec/workspace/crosswords/reader.lisp")
    #+nil (load "/Users/verec/workspace/crosswords/reader-test.lisp")

    (lisp-unit:run-tests)

    (defvar *dict*)

    (setf *dict* (read-dict +dict-name+))

    Here are the tests

    (use-package :lisp-unit)

    (remove-all-tests)

    (defvar *test-dict* nil) ; for testing purposes only

    (define-test test-00-basic
      (assert-true t)
      (assert-false nil)    )

    (defun fresh-dict ()
      (setf *test-dict* (make-dict))
      #+nil  (format t "fresh-dict: *test-dict* ~S~%" *test-dict*)
      *test-dict*    )

    (define-test test-01-array-create
      (let
          ((dict (fresh-dict)))
        (assert-true (dict-words dict))
        (assert-true (dict-index dict))
        (assert-true (= (length (dict-words dict)) 0))
        (assert-true (= (length (dict-index dict)) 1))    )    )

    (define-test test-02-array-reset
      (let
          ((dict (fresh-dict)))
        (reset-dict dict)
        (assert-true (= (length (dict-words dict)) 0))
        (assert-true (= (length (dict-index dict)) 1))    )    )

    (define-test test-03-append-one
      (let
          ((dict (fresh-dict))
           (word "four")    )
        (append-dict dict word)
        #+nil    (format t "append-one: *test-dict* ~S~%" *test-dict*)
        (assert-true (= (length (dict-words dict)) (length word)))
        (assert-true (= (length (dict-index dict)) 2))    )    )

    (define-test test-04-append-list
      (let ((dict (fresh-dict))
            (count 1)
            (offset 0)    )
        (dolist (w '("one" "two" "three" "four"))
          (append-dict dict w)
          (setf offset (+ offset (length w)))
          (assert-true (= offset (length (dict-words dict))))
          (setf count (+ 1 count))
          (assert-true (= count (length (dict-index dict))))    )    )    )

    (define-test test-05-get-words
      (let ((dict (fresh-dict))
            (word nil)    )                
        (dolist (w '("one" "two" "three" "four"))
          (append-dict dict w)    )
        (dotimes (i 4 (= i 4))
          (setf word (get-word-at dict i))
          (format t "~&word #~A: ~A~%" i word)
          (assert-true word)    )    )    )
                  
    (define-test test-06-get-length
      (let ((dict (fresh-dict))
            (word nil)    )                
        (dolist (w '("one" "two" "three" "four" "five" "six" "seven"))
          (append-dict dict w)    )
        (assert-true (= (length-dict dict) 7))    )    )

    and the results

    test-00-basic: 2 assertions passed, 0 failed.
test-01-array-create: 4 assertions passed, 0 failed.
test-02-array-reset: 2 assertions passed, 0 failed.
test-03-append-one: 2 assertions passed, 0 failed.
test-04-append-list: 8 assertions passed, 0 failed.
word #0: one
word #1: two
word #2: three
word #3: four
test-05-get-words: 4 assertions passed, 0 failed.
test-06-get-length: 1 assertions passed, 0 failed.
total: 23 assertions passed, 0 failed, 0 execution errors.

    The Solver

    (to be filled as the design progresses)

    To Do List

    Various "nice to have" that I will consider adding, as time allows

    About This Site

    Acknowledgement

    Web site layout and css shamelessly copied and pasted from Tim Bradshaw's excellent Lisp Hacks pages.

    I'm using lisp-unit for the unit tests, and colorize to pretty print to HTML.

    Release History

        20051204    JFB     reading words from the file system.
    20051127    JFB     rewrite through advice of some common lisp community members.
    20051120    JFB     the appender side works
    20051120    JFB     added link to the archive, improved version of the dictionary appender, though still not complete
    20051113    JFB     added link to the From Java to Lisp page
    20051112    JFB     first cut of half finished and buggy dictionary building code
    20051030    JFB     setting the stage
    20051029    JFB     first release

    Providing feed back

    The main reason for this site

    I would love to hear from you!