dependencies

org.clojure/clojure		1.3.0
org.clojure/core.logic		0.7.5

(this space intentionally left almost blank)

namespaces

crossword.crossword

crossword.crossword

toc

Tiny library using logit programming to put words into a crossword/wordsearch style board (or vice versa) There are lots of things it currently doesn't do such as revers or diagonal words. Reverse words would be trivial to add. Diagonals would be harder.

(ns ^{:doc 
       :author "Zachary Miller"}
  crossword.crossword
  (:refer-clojure :exclude [==])
  (:use clojure.core.logic))

a board will be a 2 dimensional sequence of characters

(comment " Some of the \"relations\" like mapo, and someo are written clarity"
         "For instance a better definition for mapo may look like"
         (defn mapo [relation]
           (fn m [collection result]
             (matche [collection result]
                     ([[] []])
                     ([[c . cs] [r . rs]]
                        (relation c r)
                        (m cs rs))))))

mapping the relation over collection is result

(defne mapo
  [relation collection result]
  ([_ [] []])
  ([_ [c . cs] [r . rs]]
     (relation c r)
     (mapo relation cs rs)))

(relation x) holds for some x in coll

(defne someo
  [relation coll]
  ([_ [c . _]] (relation c))
  ([_ [_ . cs]] (someo relation cs)))

(relation x) holds for every x in coll

(defne everyo
  [relation coll]
  ([_ []])
  ([_ [c . cs]] (relation c) (everyo relation cs)))

pre is a prefix of coll

(defn prefixo
  [coll pre]
  (fresh [e]
         (appendo pre e coll)))

the line contains the word

(defne line-wordo
  [line word]
  ([_ _] (prefixo line word))
  ([[_ . ls] _] (line-wordo ls word)))

the first column of matrix is coll

(defn first-columno
  [matrix column]
  (mapo firsto matrix column))

The transpose of matrix-1 is matrix-2. This is NOT symetric in the empty case. Should probably find a way to make it symetric

(defn transposeo
  [matrix-1 matrix-2]
  (conde
   [(emptyo matrix-1) (everyo emptyo matrix-2)]
   [(fresh [m1-row m2-col m1-rest-rows m2-rest-cols] 
           (== m1-row m2-col)
           (firsto matrix-1 m1-row)
           (first-columno matrix-2 m2-col)
           (resto matrix-1 m1-rest-rows)
           (mapo resto matrix-2 m2-rest-cols)
           (transposeo m1-rest-rows m2-rest-cols))]))

board contains word horizontally

(defn horizontalo
  [board word]
  (someo (fn [line]
           (line-wordo line word)) board))

board contains word vertically

(defn verticalo
  [board word]
  (fresh [transposed]
         (transposeo transposed board)
         (horizontalo transposed word)))

board contains word vertically or horizontally

(defn board-containso
  [board word]
  (conde [(horizontalo board word)]
         [(verticalo board word)]))

board contains all the words

(defn word-searcho
  [board words]
  (everyo (fn [word]
            (board-containso board word))
          words))

We're done with the logic part. Now we just need to do some formatting for input/output

converts a board with reified symbols and chars into a sequence of strings

(defn prettify-board
  [board]
  (map (fn [row]
         (->> row
              (map (fn [char]
                     (if (char? char)
                       char
                       \space)))
              (apply str))) board))

neatly print a sequence of strings

(defn to-string
  [board]
  (clojure.pprint/cl-format nil "~%~{~a~%~}" board))

makes a 2-dimensional matrix of lvars

(defn generate-matrix
  [width height]
  (partition width (repeatedly (* width height) lvar)))

Now actually solve some problems

convenience function for generating the boards given the words

(defn find-boards
  [width height words]
  (->> (run* [q]
             (== q (generate-matrix width height))
             (word-searcho q (map seq words)))
       (map prettify-board)
       (map to-string)))

The next 2 problems find the ways to put words into a blank board

(->> (find-boards 4 3 (map seq ["dog" "food" "rod" "fad"]))
     (map print)
     dorun)

(->> (find-boards 3 4 (map seq ["eft" "food" "rod" "add" "err"]))
     (map print)
     dorun)

This problem finds out how to put words into a partially filled board

(let 
    [words ["car" "can" "arc"]
     board (->> ["---"
                 "---"
                 "-.."]
                (map (fn [string]
                       (map (fn [char]
                              (if (= \- char)
                                (lvar)
                                \space))
                            string))))]
  (->> (run 4 [q]
            (== q board)
            (word-searcho q (map seq words)))
       (map prettify-board)
       (map to-string)
       (map print)
       dorun))

crossword

1.0.0-SNAPSHOT

dependencies

namespaces

crossword.crossword