Skip to content

Instantly share code, notes, and snippets.

@TN1ck TN1ck/solver.clj
Last active Aug 29, 2015

Embed
What would you like to do?
(def start [1 2 3 4 5 6 7 8 9 1 1 1 2 1 3 1 4 1 5 1 6 1 7 1 8 1 9])
(def filter-not-nil (partial filter (comp not nil?)))
(defn match? [v1 v2]
(and v1 v2 (or (= v1 v2) (= 10 (+ v1 v2)))))
(defn find-match [tiles i1 incr]
(let [t1 (tiles i1)]
(loop [i2 (+ incr i1)]
(let [t2 (nth tiles i2 true)]
(if (true? t2)
nil
(if (nil? t2)
(recur (+ incr i2))
(if (match? t1 t2)
(if (neg? incr) [i2 i1] [i1 i2])
nil)))))))
(defn find-matches [tiles i]
(if (not (tiles i))
nil
(let [above (find-match tiles i -9)
below (find-match tiles i 9)
right (find-match tiles i 1)
left (find-match tiles i -1)]
(filter-not-nil [above below right left]))))
(defn remaining-matches [tiles]
(into #{} (mapcat #(find-matches tiles %) (range (count tiles)))))
(defn remove-tiles [tiles i1 i2]
(assoc tiles i1 nil i2 nil))
(defn update-board [tiles]
(let [matches (remaining-matches tiles)]
(if (empty? matches)
(into [] (concat tiles (filter (comp not nil?) tiles)))
tiles)))
(defn solve []
(loop [queue (sorted-set-by (fn [[a1 a2 a3 a4] [b1 b2 b3 b4]] (compare [a2 a3] [b2 b3]))
[(count start) 0 start []])
counter 0
solutions []]
(let [current (first queue)
[
active_tiles steps tiles history] current
matches (remaining-matches tiles)
new-boards (pmap (fn [[i1 i2]]
(let [board (update-board (remove-tiles tiles i1 i2))
count-active (count (filter-not-nil board))]
(vector count-active
(inc steps)
board
(conj history [i1 i2]))))
matches)
updated-boards (filter #(> 74 (count (% 2))) new-boards)
winner-boards (filter #(zero? (first %)) updated-boards)
solutions (doall (concat solutions winner-boards))
queue (disj (if (empty? updated-boards) queue (apply (partial conj queue) updated-boards)) current)
]
(if (zero? (count queue)) solutions (recur queue (inc counter) solutions)))))
(defn -main []
(println (solve)))
(defn play [steps board]
(loop [S steps B board]
(let [[i1 i2] (first S)
bla (println i1 i2 B)
new-board (update-board (remove-tiles B i1 i2))]
(if (empty? (rest S)) new-board (recur (rest S) new-board)))))
(-main)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.