Mercurial > coderloop

comparison src/find_words.clj @ 0:307a81e46071 tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
initial committ
author Robert McIntyre <rlm@mit.edu>
date Tue, 18 Oct 2011 01:17:49 -0700
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:307a81e46071
1 (ns coderloop.find-words
2 (:use [clojure.contrib def
3 [seq :only [indexed]]
4 [duck-streams :only [read-lines file-str]]]
5 [clojure.java io]
6 [rlm shell-inspect]))
7
8
9
10 "I'm going to solve this using convolution because I like how the kernel
11 looks for this problem. For each word, we build up an asterisk kernel
12 like so:
13
14 {:word \"Robert\"}
15 kernel:
16
17 t t t
18 r r r
19 e e e
20 b b b
21 ooo
22 treboRobert
23 ooo
24 b b b
25 e e e
26 r r r
27 t t t
28
29 isn't it really cute-looking?
30
31 Anyways, I'll drag these asterisks along the word-matrix via convolution
32 and use them to build up a transient structure that contains only the matches.
33
34 Then, I'll use that transitnt structure to remove all matches from the original
35 grid.
36
37 I need stuff to do convolutions, to make kernels given a word, to create the
38 transient structure, and to remove the entries in the transient structure
39 from the original word-grid. I also need a way to represent a word grid."
40
41 (defvar strcat (partial apply str)
42 "flattens a list by glomming everything together in a string.")
43
44 (defn word-grid
45 "create a mapping from elements in R^2 to chars"
46 [words]
47 (reduce
48 merge
49 (map (fn [[idx s]]
50 (zipmap
51 (map #(vector (first %) idx) (indexed s))
52 (seq s)))
53 (indexed words))))
54
55
56 (defn bounding-square
57 "finds the minimal square it takes to bound the grid. works for all
58 geometries."
59 [grid]
60 (let [coords (keys grid)
61 xs (sort (map first coords))
62 ys (sort (map second coords))]
63 [(first xs) (last xs) (first ys) (last ys)]))
64
65 ;;I have no compunctinos with using mutable state in printing
66 (defn print-grid* [grid]
67 (let [[x-min x-max y-min y-max] (bounding-square grid)
68 canvas (atom
69 (vec (for [y (range (inc (- y-max y-min)))]
70 (vec (repeat (inc (- x-max x-min)) ".")))))]
71 (dorun (map (fn [[[x y] c]]
72 (swap! canvas #(assoc-in % [ (- y y-min) (- x x-min)] c))) grid))
73 @canvas))
74
75 (defn print-grid
76 "nice for debugging but irrelevant for the rest of the problem"
77 [grid]
78 (dorun
79 (for [line (print-grid* grid)]
80 (do (dorun (map print line))
81 (println)))))
82
83 (defn asterisk-kernel [word]
84 (let [span (range (inc (count word)))]
85 (vector
86 (zipmap (map #(vector 0 %) span) word)
87 (zipmap (map #(vector 0 (- %)) span) word)
88 (zipmap (map #(vector % %) span) word)
89 (zipmap (map #(vector % (- %)) span) word)
90 (zipmap (map #(vector % 0) span) word)
91 (zipmap (map #(vector (- %) 0) span) word)
92 (zipmap (map #(vector (- %) %) span) word)
93 (zipmap (map #(vector (- %) (- %)) span) word))))
94
95 ;;this is not lazy :(
96 (defn search-grid-at-point [kernel grid [point-x point-y]]
97 (let [shift-kernel
98 (zipmap
99 (map (fn [[x y]]
100 [(+ x point-x)
101 (+ y point-y)])
102 (keys kernel))
103 (vals kernel))]
104 (if (= (select-keys grid (keys shift-kernel))
105 shift-kernel)
106 shift-kernel nil)))
107
108 (defn search-word-kernel
109 "search the grid for a particular kernel and store the reusult in the
110 atom (matches)"
111 [grid kernel]
112 (reduce merge (map (fn [point]
113 (search-grid-at-point kernel grid point))
114 (keys grid))))
115
116 (defn search-word [grid word]
117 (let [kernels (asterisk-kernel word)]
118 (reduce merge (map #(search-word-kernel grid %) kernels))))
119
120 (defn search-words [grid words]
121 (reduce merge (map #(search-word grid %) words)))
122
123 (defn remove-matches [grid matches]
124 (apply (partial dissoc grid) (keys matches)))
125
126 (defn grid->str [grid]
127 (strcat (vals (apply sorted-map
128 (interleave (map (comp vec reverse) (keys grid)) (vals grid))))))
129
130 (defn read-wordsearch [#^java.io.File input]
131 (let [[crossword words] (split-with (comp not (partial = "")) (read-lines input))
132 words (rest words)]
133 [crossword words]))
134
135 (defn process-wordsearch [[crossword words]]
136 (let [grid (word-grid crossword)]
137 (grid->str (remove-matches grid (search-words grid words)))))
138
139 (defn doit [args]
140 (println
141 (process-wordsearch
142 (read-wordsearch
143 (file-str (first args))))))
144
145 ;;********************************************************************************
146 (if (command-line?)
147 (doit *command-line-args*))
148
149
150 (def input (file-str "/home/r/coderloop-test/input.txt"))
151 (def a (file-str "/home/r/coderloop-test/findwords-a.in"))
152 (def d (file-str "/home/r/coderloop-test/findwords-d.in"))
153 (def c (file-str "/home/r/coderloop-test/findwords-c.in"))
154 (def e (file-str "/home/r/coderloop-test/findwords-e.in"))
155
156 (def test-grid
157 ["ELGOOGWWW"
158 "TIRXMAHIR"
159 "BATMANZNC"
160 "CMRVLTOLD"])
161
162 (def test-words
163 ["MAIL"
164 "WIN"
165 "GOOGLE"
166 "TAR"
167 "BATMAN"
168 "CAR"
169 "WWW"
170 "TOLD"
171 "CD"])
172
173
174