Word cubes

Continuing in my recent set of Word Games from Programming Praxis, today we're tasked with finding all words made from a grid of letters. So for example if we have this grid:


We want words like COIN, CONCUBINE, CUBIC, ICON, and NINE. (There are two additional constraints that each word must have at least 4 letters and must contain the middle letter of the grid--I in this case.)

To start with, we're going to need the dictionary library I previously posted.

With that, her is the code to solve a word cube:

; given a gride of letters, find all words of at least length 4 with the center
; example:
;   NCB
;   CIO
;   UNE
; I is required
(define (word-cube dict letters)
  ; setup, sort the list descending so we end up in alphabetical order
  ; assume the 'required' letter is at the midpoint
  (let ([letters (sort (string->list (string-upcase letters)) char>?)]
        [required (char-upcase (string-ref
                                (quotient (string-length letters) 2)))])
    ; return strings
     ; filter out words that are too short or don't contain the middle letter
      (lambda (word) (and (>= (length word) 4) (member required word)))
      ; recursively build all words using only the letters given
      (let loop ([letters letters]
                 [word '()]
                 [node (:dictionary:-value dict)])
         ; loop over the letters
         (let ([r (for/list ([l (unique letters)] #:when (lookup node l))
                    (loop (remv l letters) (cons l word) (lookup node l)))])
           ; return this word if it's an endpoint
           (if (lookup node 'word)
               (cons (list (reverse word)) r)

There are a few interesting points, all commented above. Essentially, I'm finding *all* words made from the letters in the puzzle first and only then filtering out words shorter than 4 characters or words that don't contain the required central letter. The main loop starts with all of the words and the root node and then recurs down every valid tree.

(for/list ([l (unique letters)] #:when (lookup node l))
  (loop (remv l letters) (cons l word) (lookup node l)))

This controls the recursion, looping across the letters (I used unique to avoid duplicates in the final solution) but only on letters that could be next (the #:when (lookup node k)). Then recur, removing the letter we used, adding it to the word, and recurring down the dictionary.

So does it work?

> (word-cube dict "ncbcioune")
  "CUBIC" "CUNNI"  "ENNUI"     "ICON"   "NICE"

Yup. Works great. It's fun when previous work takes the lion's share of the workout of a problem. They say that it's the mark of a successful mathematician when always try to reduce a problem to previous work, but I'd say that it applies to computer science just as well.

You can download the entire source here: word-cube source code. Like yesterday, it's designed to work in Racket 5.3+.

    comments powered by Disqus