Adam Richardson's Site

Generating Word Search Puzzles

Table of Contents

Introduction

I recently got an idea to use the SVG DSL I had recently worked on to generate a printable word search puzzle. I wanted the user to only supply a list of words and the program would randomly arrange the words in a grid and fill in the gaps with random letters. I had previously done a similar project like this ages ago back in college and I no longer have the code I used to create it.

Word Search

  • The word search generation function will create a string that represents a word search puzzle
  • The function takes two arguments:
    • words - A list of words to be used in the puzzle
    • rowstride - The size of the puzzle in both the length and height, the represents how many columns are in a single row

Word Arrangements

  • This word search generator only provides 4 arrangements of letters:
    • Horizontal (h-step) - Horizontally left to right
    • Verical (v-step) - Vertically top to bottom
    • Diagonal Down (dd-step) - Diagonally from top to bottom vertically
    • Diagonal Up (du-step) - Diagonally from bottom to top vertically

Helper Functions

  • The word search generation function makes use of several helper functions that are detailed below

Calculate Index

  • This returns the linear index of a row column in the word search
(calc-index (col row offset)
            (+ (* row rowstride) col offset))

Word Can Fit Predicate

  • This predicate returns true if a word starting at a given row and column fits within the grid
  • Fitting in this case means there are no occupied spaces and the word doesn't fall off the edge
  • The step in this context represents the arrangement of the word
(word-can-fit-p (word col row step)
                (cond ((>= (calc-index col row (* step (length word)))
                           (length letter-table))
                       nil)
                      ((< (calc-index col row (* step (length word)))
                          0)
                       nil)
                      ((and (not (equal step v-step))
                            (> (+ col (length word)) rowstride))
                       nil)
                      (t (every (lambda (c)
                                  (equal c #\Space))
                                (loop for c in (coerce word 'list)
                                      for i from 0
                                      collect (nth (calc-index col row (* i step)) letter-table))))))

Set Word

  • The set-word function copies a word into the grid with the first letter at row and column and step indicating the arrangement of the word
(set-word (word col row step)
          (let ((letters (coerce word 'list)))
            (loop for c in letters
                  for i from 0
                  do (setf (nth (calc-index col row (* i step)) letter-table) c))))

Available Locations

  • The available locations function takes a word and iterates through all spots in the grid
  • While visiting a given spot it checks to see if the word can fit there across all possible arrangments
  • The result of this function is a list of all the possible places a word can fit in the grid
(available-locations (word)
                     (remove-if #'null (loop for step in (list h-step v-step dd-step du-step)
                                             append (loop for c from 0 to rowstride
                                                          append (loop for r from 0 to rowstride
                                                                       collect (when (word-can-fit-p word c r step)
                                                                                 (list c r step)))))))

Random Letter

  • This function returns a random lower case letter
(random-letter ()
  (code-char (+ (char-code #\a) (random 26))))

Putting it All Together

  • To generate the word search I iterate through each word in the argument words list
  • For a given word I generate all the possible arrangements for that word
  • A random arrangement is selected and copied into the grid
  • Lastly the empty spaces in the grid are replaced with random letters
    • There is an optional keep-blanks boolean that prevents the random letters from being added
(defun word-search (words rowstride &optional keep-blanks)
  (let ((letter-table (loop for i below (* rowstride rowstride)
                            collect #\Space))
        (h-step 1)
        (v-step rowstride)
        (dd-step (+ rowstride 1))
        (du-step (* (- rowstride 1) -1)))
    (labels ( ;;New line to help org babel tangle
             (calc-index (col row offset)
                    (+ (* row rowstride) col offset))
             (word-can-fit-p (word col row step)
                        (cond ((>= (calc-index col row (* step (length word)))
                                   (length letter-table))
                               nil)
                              ((< (calc-index col row (* step (length word)))
                                  0)
                               nil)
                              ((and (not (equal step v-step))
                                    (> (+ col (length word)) rowstride))
                               nil)
                              (t (every (lambda (c)
                                          (equal c #\Space))
                                        (loop for c in (coerce word 'list)
                                              for i from 0
                                              collect (nth (calc-index col row (* i step)) letter-table))))))
             (set-word (word col row step)
                  (let ((letters (coerce word 'list)))
                    (loop for c in letters
                          for i from 0
                          do (setf (nth (calc-index col row (* i step)) letter-table) c))))
             (available-locations (word)
                             (remove-if #'null (loop for step in (list h-step v-step dd-step du-step)
                                                     append (loop for c from 0 to rowstride
                                                                  append (loop for r from 0 to rowstride
                                                                               collect (when (word-can-fit-p word c r step)
                                                                                         (list c r step)))))))
             (random-letter ()
               (code-char (+ (char-code #\a) (random 26)))))
      (loop for word in words
            do (let* ((locations (available-locations word))
                      (location (nth (random (length locations)) locations)))
                 (set-word word (car location) (cadr location) (caddr location))))
      (string-upcase (coerce (if keep-blanks
                                 letter-table
                                 (mapcar (lambda (c)
                                           (if (equal c #\Space)
                                               (random-letter)
                                               c))
                                         letter-table))
                             'string)))))

Printing Word Searches

  • Before I create the SVG I wrote a print function to display the word search in the terminal
(defun print-word-search (word-search rowstride)
  (let ((lines (loop for i from 0 to (length word-search) by rowstride
                     collect (subseq word-search i (min (+ i rowstride)
                                                        (length word-search))))))
    (format t "~{~a~%~}" lines)))

SVG Group

  • The group macro takes an x and y argument and sets them as the transform on the g tag
  • This allows you to have relative positioning
(defmacro group (x y &body body)
  `(xml-tag g `(("transform" . ,(format nil "translate(~d ~d)" ,x ,y)))
     ,@body)))

SVG Text Style

  • This macro inserts some basic text CSS into a style tag
  • I use this to set the font to monospace and a specific size in pixels
  • I multiply the overall *char-size* by a constant to give a little bit of extra spacing between the letters
(defparameter *char-size* 30)

(defun text-style ()
  (xml-tag style nil
    (format t "text { font: bold ~dpx monospace; }" (* *char-size* 0.9))))

(defmacro svg-text-style (w h &body body)
  `(svg ,w ,h
     (text-style)
     ,@body))

Text Element

(defun text (&key x y s)
  (let ((attributes nil))
    (setf attributes (append attributes `(("x" . ,x))))
    (setf attributes (append attributes `(("y" . ,y))))
    (xml-tag text attributes
      (princ s))))

Char Grid

(defun char-grid (chars rowstride x y)
  (group x y
    (loop for i from 0
          for c in chars
          do (let ((cx (* (mod i rowstride) *char-size*))
                   (cy (* (+ (floor (/ i rowstride)) 1) *char-size*)))
               (text :x cx :y cy :s (format nil "~c" c))))))

Word Grid

  • Multiplying the font size by 0.6 seemed to be the best approixmation of the text width
  • Rather than take an x position this just takes a y position and the total width of the svg
  • The x position is then calculated so that the word grid is centered
(defun word-grid (words rowstride w y)
  (let* ((max-word-length (reduce (lambda (acc x)
                                    (max acc (length x)))
                                  words :initial-value 0))
         (col-width (* max-word-length (+ (* 0.6 *char-size*) 5)))
         (x (/ (- w (* col-width rowstride)) 2.0)))
    (group x y
      (loop for i from 0
            for w in words
            do (let ((cx (* (mod i rowstride) col-width))
                     (cy (* (floor (/ i rowstride)) *char-size*)))
                 (text :x cx :y cy :s (string-capitalize w)))))))

Word Search SVG

  • There are a few magic numbers in here that are mostly padding and spacing related
(defun word-search-svg (words rowstride &optional keep-blanks)
  (let* ((chars (coerce (word-search words rowstride keep-blanks) 'list))
         (w (* rowstride *char-size*))
         (h (* (+ (ceiling (/ (length chars) rowstride)) 1) *char-size*)))
    (svg-text-style (* w 2) (* h 1.25)
      (char-grid chars rowstride (/ w 2.0) 0)
      (word-grid words 3 (* w 2) (+ h (* *char-size* 2))))))

Final Result

(with-open-file (*standard-output* "../assets/word_search.svg"
                                   :direction :output
                                   :if-exists :supersede)
  (word-search-svg '("tallahassee"
                     "chicago"
                     "indianapolis"
                     "dayton"
                     "cincinnati"
                     "frankfort"
                     "nashville"
                     "louisville"
                     "lexington")
                   20))
  • See if you can find all the words!

word_search.svg

Conclusion

I am really happy with how this turned out. I took a shortcut by eliminating word arrangments that are backwards and there are a few magic numbers when laying out the final puzzle.

I think adding the text and group SVG tags could be very useful if I do another Lisp SVG project.

I didn't use the most efficient algorithm for generating the puzzles but it should have deterministic performance. I am not sure why I continue to use rowstride rather than something more obvious like column-width.