1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/find_words.clj	Tue Oct 18 01:17:49 2011 -0700
     1.3 @@ -0,0 +1,174 @@
     1.4 +(ns coderloop.find-words
     1.5 +  (:use [clojure.contrib def
     1.6 +	 [seq :only [indexed]]
     1.7 +	 [duck-streams :only [read-lines file-str]]]
     1.8 +	[clojure.java io]
     1.9 +	[rlm shell-inspect]))
    1.10 +
    1.11 +
    1.12 +
    1.13 +"I'm going to solve this using convolution because I like how the kernel
    1.14 + looks for this problem.  For each word, we build up an asterisk kernel
    1.15 + like so:
    1.16 +
    1.17 + {:word \"Robert\"}
    1.18 + kernel:
    1.19 +
    1.20 +              t    t    t
    1.21 +               r   r   r
    1.22 +                e  e  e
    1.23 +                 b b b
    1.24 +                  ooo 
    1.25 +              treboRobert       
    1.26 +                  ooo           
    1.27 +                 b b b          
    1.28 +                e  e  e         
    1.29 +               r   r   r   
    1.30 +              t    t    t
    1.31 +
    1.32 +isn't it really cute-looking?
    1.33 +
    1.34 +Anyways,  I'll drag these asterisks along the word-matrix via convolution
    1.35 +and use them to build up a transient structure that contains only the matches.
    1.36 +
    1.37 +Then, I'll use that transitnt structure to remove all matches from the original
    1.38 +grid.
    1.39 +
    1.40 +I need stuff to do convolutions, to make kernels given a word, to create the
    1.41 +transient structure, and to remove the entries in the transient structure
    1.42 +from the original word-grid.  I also need a way to represent a word grid."
    1.43 +
    1.44 +(defvar strcat (partial apply str)
    1.45 +  "flattens a list by glomming everything together in a string.")
    1.46 +
    1.47 +(defn word-grid
    1.48 +  "create a mapping from elements in R^2 to chars"
    1.49 +  [words]
    1.50 +  (reduce
    1.51 +   merge
    1.52 +   (map (fn [[idx s]]
    1.53 +	  (zipmap 
    1.54 +	   (map #(vector (first %) idx) (indexed s))
    1.55 +	   (seq s)))
    1.56 +	(indexed words))))
    1.57 +
    1.58 +
    1.59 +(defn bounding-square
    1.60 +  "finds the minimal square it takes to bound the grid. works for all
    1.61 +   geometries."
    1.62 +  [grid]
    1.63 +  (let [coords (keys grid)
    1.64 +	xs (sort (map first coords))
    1.65 +	ys (sort (map second coords))]
    1.66 +    [(first xs) (last xs) (first ys) (last ys)]))
    1.67 +
    1.68 +;;I have no compunctinos with using mutable state in printing
    1.69 +(defn print-grid* [grid]
    1.70 +  (let [[x-min x-max y-min y-max] (bounding-square grid)
    1.71 +	canvas (atom
    1.72 +		(vec  (for [y  (range  (inc (- y-max y-min)))]
    1.73 +			(vec  (repeat (inc (- x-max x-min))  ".")))))]
    1.74 +    (dorun (map (fn [[[x y] c]]
    1.75 +		  (swap! canvas #(assoc-in % [ (- y y-min) (- x x-min)] c))) grid))
    1.76 +    @canvas))
    1.77 +	
    1.78 +(defn print-grid
    1.79 +  "nice for debugging but irrelevant for the rest of the problem"
    1.80 +  [grid]
    1.81 +  (dorun
    1.82 +   (for [line (print-grid* grid)]
    1.83 +     (do (dorun (map print line))
    1.84 +	 (println)))))
    1.85 +
    1.86 +(defn asterisk-kernel [word]
    1.87 +  (let [span (range (inc (count word)))]
    1.88 +    (vector
    1.89 +     (zipmap (map #(vector 0 %)     span) word)
    1.90 +     (zipmap (map #(vector 0 (- %)) span) word)
    1.91 +     (zipmap (map #(vector % %)     span) word)
    1.92 +     (zipmap (map #(vector % (- %)) span) word)
    1.93 +     (zipmap (map #(vector % 0)     span) word)
    1.94 +     (zipmap (map #(vector (- %) 0) span) word)
    1.95 +     (zipmap (map #(vector (- %) %)     span) word)
    1.96 +     (zipmap (map #(vector (- %)  (- %))     span) word))))
    1.97 +
    1.98 +;;this is not lazy :(
    1.99 +(defn search-grid-at-point [kernel grid [point-x point-y]]
   1.100 +  (let [shift-kernel
   1.101 +	(zipmap 
   1.102 +	 (map (fn [[x y]]
   1.103 +		[(+ x point-x)
   1.104 +		 (+ y point-y)])
   1.105 +	      (keys kernel))
   1.106 +	 (vals kernel))]
   1.107 +    (if (= (select-keys grid (keys shift-kernel))
   1.108 +	   shift-kernel)
   1.109 +      shift-kernel nil)))
   1.110 +    
   1.111 +(defn search-word-kernel
   1.112 +  "search the grid for a particular kernel and store the reusult in the
   1.113 +   atom (matches)"
   1.114 +  [grid kernel]
   1.115 +  (reduce merge (map (fn [point]
   1.116 +		       (search-grid-at-point kernel grid point))
   1.117 +		     (keys grid))))
   1.118 +
   1.119 +(defn search-word [grid word]
   1.120 +  (let [kernels (asterisk-kernel word)]
   1.121 +    (reduce merge (map #(search-word-kernel grid %) kernels))))
   1.122 +
   1.123 +(defn search-words [grid words]
   1.124 +  (reduce merge (map #(search-word grid %) words)))
   1.125 +
   1.126 +(defn remove-matches [grid matches]
   1.127 +  (apply (partial dissoc grid) (keys matches)))
   1.128 +
   1.129 +(defn grid->str [grid]
   1.130 +  (strcat (vals (apply sorted-map
   1.131 +		       (interleave (map (comp vec reverse) (keys grid)) (vals grid))))))
   1.132 +
   1.133 +(defn read-wordsearch [#^java.io.File input]
   1.134 +  (let [[crossword words] (split-with (comp not (partial = "")) (read-lines input)) 
   1.135 +	words (rest words)]
   1.136 +    [crossword words]))
   1.137 +
   1.138 +(defn process-wordsearch [[crossword words]]
   1.139 +  (let [grid (word-grid crossword)]
   1.140 +    (grid->str (remove-matches grid (search-words grid words)))))
   1.141 +
   1.142 +(defn doit [args]
   1.143 +  (println
   1.144 +   (process-wordsearch
   1.145 +    (read-wordsearch
   1.146 +     (file-str (first args))))))
   1.147 +
   1.148 +;;********************************************************************************
   1.149 +(if (command-line?)
   1.150 +  (doit *command-line-args*))
   1.151 +
   1.152 +
   1.153 +(def input (file-str "/home/r/coderloop-test/input.txt"))
   1.154 +(def a (file-str "/home/r/coderloop-test/findwords-a.in"))
   1.155 +(def d (file-str "/home/r/coderloop-test/findwords-d.in"))
   1.156 +(def c (file-str "/home/r/coderloop-test/findwords-c.in"))
   1.157 +(def e (file-str "/home/r/coderloop-test/findwords-e.in"))
   1.158 +
   1.159 +(def test-grid
   1.160 +      ["ELGOOGWWW"
   1.161 +       "TIRXMAHIR"
   1.162 +       "BATMANZNC"
   1.163 +       "CMRVLTOLD"])
   1.164 +
   1.165 +(def test-words
   1.166 +     ["MAIL"
   1.167 +      "WIN"
   1.168 +      "GOOGLE"
   1.169 +      "TAR"
   1.170 +      "BATMAN"
   1.171 +      "CAR"
   1.172 +      "WWW"
   1.173 +      "TOLD"
   1.174 +      "CD"])
   1.175 +
   1.176 +
   1.177 +