(ns coderloop.find-words

   (:use [clojure.contrib def

 	 [seq :only [indexed]]

 	 [duck-streams :only [read-lines file-str]]]

 	[clojure.java io]

 	[rlm shell-inspect]))

 

 

 

 "I'm going to solve this using convolution because I like how the kernel

  looks for this problem.  For each word, we build up an asterisk kernel

  like so:

 

  {:word \"Robert\"}

  kernel:

 

               t    t    t

                r   r   r

                 e  e  e

                  b b b

                   ooo 

               treboRobert       

                   ooo           

                  b b b          

                 e  e  e         

                r   r   r   

               t    t    t

 

 isn't it really cute-looking?

 

 Anyways,  I'll drag these asterisks along the word-matrix via convolution

 and use them to build up a transient structure that contains only the matches.

 

 Then, I'll use that transitnt structure to remove all matches from the original

 grid.

 

 I need stuff to do convolutions, to make kernels given a word, to create the

 transient structure, and to remove the entries in the transient structure

 from the original word-grid.  I also need a way to represent a word grid."

 

 (defvar strcat (partial apply str)

   "flattens a list by glomming everything together in a string.")

 

 (defn word-grid

   "create a mapping from elements in R^2 to chars"

   [words]

   (reduce

    merge

    (map (fn [[idx s]]

 	  (zipmap 

 	   (map #(vector (first %) idx) (indexed s))

 	   (seq s)))

 	(indexed words))))

 

 

 (defn bounding-square

   "finds the minimal square it takes to bound the grid. works for all

    geometries."

   [grid]

   (let [coords (keys grid)

 	xs (sort (map first coords))

 	ys (sort (map second coords))]

     [(first xs) (last xs) (first ys) (last ys)]))

 

 ;;I have no compunctinos with using mutable state in printing

 (defn print-grid* [grid]

   (let [[x-min x-max y-min y-max] (bounding-square grid)

 	canvas (atom

 		(vec  (for [y  (range  (inc (- y-max y-min)))]

 			(vec  (repeat (inc (- x-max x-min))  ".")))))]

     (dorun (map (fn [[[x y] c]]

 		  (swap! canvas #(assoc-in % [ (- y y-min) (- x x-min)] c))) grid))

     @canvas))

 	

 (defn print-grid

   "nice for debugging but irrelevant for the rest of the problem"

   [grid]

   (dorun

    (for [line (print-grid* grid)]

      (do (dorun (map print line))

 	 (println)))))

 

 (defn asterisk-kernel [word]

   (let [span (range (inc (count word)))]

     (vector

      (zipmap (map #(vector 0 %)     span) word)

      (zipmap (map #(vector 0 (- %)) span) word)

      (zipmap (map #(vector % %)     span) word)

      (zipmap (map #(vector % (- %)) span) word)

      (zipmap (map #(vector % 0)     span) word)

      (zipmap (map #(vector (- %) 0) span) word)

      (zipmap (map #(vector (- %) %)     span) word)

      (zipmap (map #(vector (- %)  (- %))     span) word))))

 

 ;;this is not lazy :(

 (defn search-grid-at-point [kernel grid [point-x point-y]]

   (let [shift-kernel

 	(zipmap 

 	 (map (fn [[x y]]

 		[(+ x point-x)

 		 (+ y point-y)])

 	      (keys kernel))

 	 (vals kernel))]

     (if (= (select-keys grid (keys shift-kernel))

 	   shift-kernel)

       shift-kernel nil)))

     

 (defn search-word-kernel

   "search the grid for a particular kernel and store the reusult in the

    atom (matches)"

   [grid kernel]

   (reduce merge (map (fn [point]

 		       (search-grid-at-point kernel grid point))

 		     (keys grid))))

 

 (defn search-word [grid word]

   (let [kernels (asterisk-kernel word)]

     (reduce merge (map #(search-word-kernel grid %) kernels))))

 

 (defn search-words [grid words]

   (reduce merge (map #(search-word grid %) words)))

 

 (defn remove-matches [grid matches]

   (apply (partial dissoc grid) (keys matches)))

 

 (defn grid->str [grid]

   (strcat (vals (apply sorted-map

 		       (interleave (map (comp vec reverse) (keys grid)) (vals grid))))))

 

 (defn read-wordsearch [#^java.io.File input]

   (let [[crossword words] (split-with (comp not (partial = "")) (read-lines input)) 

 	words (rest words)]

     [crossword words]))

 

 (defn process-wordsearch [[crossword words]]

   (let [grid (word-grid crossword)]

     (grid->str (remove-matches grid (search-words grid words)))))

 

 (defn doit [args]

   (println

    (process-wordsearch

     (read-wordsearch

      (file-str (first args))))))

 

 ;;********************************************************************************

 (if (command-line?)

   (doit *command-line-args*))

 

 

 (def input (file-str "/home/r/coderloop-test/input.txt"))

 (def a (file-str "/home/r/coderloop-test/findwords-a.in"))

 (def d (file-str "/home/r/coderloop-test/findwords-d.in"))

 (def c (file-str "/home/r/coderloop-test/findwords-c.in"))

 (def e (file-str "/home/r/coderloop-test/findwords-e.in"))

 

 (def test-grid

       ["ELGOOGWWW"

        "TIRXMAHIR"

        "BATMANZNC"

        "CMRVLTOLD"])

 

 (def test-words

      ["MAIL"

       "WIN"

       "GOOGLE"

       "TAR"

       "BATMAN"

       "CAR"

       "WWW"

       "TOLD"

       "CD"])