You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
109 lines
3.0 KiB
Clojure
109 lines
3.0 KiB
Clojure
3 years ago
|
;
|
||
|
|
; Place in new leiningen 'app' template project
|
||
|
|
;
|
||
|
|
; Run with `java -Xmx8G -jar ...`
|
||
|
|
;
|
||
|
|
|
||
|
|
(ns hah.core
|
||
|
|
(:gen-class))
|
||
|
|
|
||
|
|
(require '[clojure.core.reducers :as r])
|
||
|
|
|
||
|
|
(def init-field
|
||
|
|
[nil
|
||
|
|
nil
|
||
|
|
(seq [:b :d :d :d])
|
||
|
|
nil
|
||
|
|
(seq [:b :c :b :a])
|
||
|
|
nil
|
||
|
|
(seq [:c :b :a :a])
|
||
|
|
nil
|
||
|
|
(seq [:d :a :c :c])
|
||
|
|
nil
|
||
|
|
nil])
|
||
|
|
|
||
|
|
(defn do-slot [[field q s] idx]
|
||
|
|
(let [slot (get field idx)]
|
||
|
|
(cond
|
||
|
|
; Moving value out of a room
|
||
|
|
(and (seq? slot) (not (empty? slot)) (not (every? #(= % ({2 :a 4 :b 6 :c 8 :d} idx)) slot)))
|
||
|
|
(let [open-slots
|
||
|
|
(filterv
|
||
|
|
#(contains? #{0 1 3 5 7 9 10} %)
|
||
|
|
(concat
|
||
|
|
(for [i (reverse (range 0 idx)) :while (or (nil? (get field i)) (seq? (get field i)))] i)
|
||
|
|
(for [i (range idx (count field)) :while (or (nil? (get field i)) (seq? (get field i)))] i)))]
|
||
|
|
(when-not (empty? open-slots)
|
||
|
|
(map
|
||
|
|
(fn [os]
|
||
|
|
[(-> field
|
||
|
|
(assoc os (first slot))
|
||
|
|
(update idx rest))
|
||
|
|
(conj q [idx os])
|
||
|
|
(+ s (* ({:a 1 :b 10 :c 100 :d 1000} (first slot)) (+ (inc (- 4 (count slot))) (Math/abs (- os idx)))))])
|
||
|
|
open-slots)))
|
||
|
|
; Moving value into a room
|
||
|
|
(and (not (seq? slot)) (some? slot))
|
||
|
|
(let [our-room ({:a 2 :b 4 :c 6 :d 8} slot)]
|
||
|
|
(if (every? #(or (nil? (get field %)) (seq? (get field %)))
|
||
|
|
(range (inc (min our-room idx)) (max our-room idx)))
|
||
|
|
(let [room (get field our-room)]
|
||
|
|
(when (or (empty? room) (every? #(= slot %) room))
|
||
|
|
[(-> field
|
||
|
|
(assoc idx nil)
|
||
|
|
(update our-room conj slot))
|
||
|
|
(conj q [idx our-room])
|
||
|
|
(+ s (* ({:a 1 :b 10 :c 100 :d 1000} slot) (+ (Math/abs (- idx our-room)) (- 4 (count room)))))])))))))
|
||
|
|
|
||
|
|
(defn winner? [[field q s]]
|
||
|
|
(= field
|
||
|
|
[nil
|
||
|
|
nil
|
||
|
|
(seq [:a :a :a :a])
|
||
|
|
nil
|
||
|
|
(seq [:b :b :b :b])
|
||
|
|
nil
|
||
|
|
(seq [:c :c :c :c])
|
||
|
|
nil
|
||
|
|
(seq [:d :d :d :d])
|
||
|
|
nil
|
||
|
|
nil]))
|
||
|
|
|
||
|
|
(defn do-turns [fields]
|
||
|
|
(into []
|
||
|
|
(r/fold
|
||
|
|
1024
|
||
|
|
r/cat
|
||
|
|
#(if-let [t (apply do-slot %2)]
|
||
|
|
(if (seq? t)
|
||
|
|
(reduce r/append! %1 t)
|
||
|
|
(r/append! %1 t))
|
||
|
|
%1)
|
||
|
|
(into [] (for [f fields i (range 0 11)] [f i])))))
|
||
|
|
|
||
|
|
(def wins (atom #{}))
|
||
|
|
|
||
|
|
(defn play-games [turns tc]
|
||
|
|
(println "Games:" (count turns) "Turn:" tc)
|
||
|
|
(if (< 500000 (count turns))
|
||
|
|
(do
|
||
|
|
(println "Splitting...")
|
||
|
|
(doseq [p (partition 100000 turns)
|
||
|
|
:let [r (play-games (into [] p) tc)]] nil))
|
||
|
|
(do
|
||
|
|
(let [new-turns (do-turns turns)
|
||
|
|
winners (filter winner? new-turns)]
|
||
|
|
(if (pos? (count winners))
|
||
|
|
(do
|
||
|
|
(println "Winner! Turns:" tc)
|
||
|
|
(swap! wins #(reduce conj % (map last winners))))
|
||
|
|
(when (pos? (count new-turns))
|
||
|
|
(recur new-turns (inc tc))))))))
|
||
|
|
|
||
|
|
(defn -main
|
||
|
|
"I don't do a whole lot ... yet."
|
||
|
|
[& args]
|
||
|
|
(play-games [[init-field [] 0]] 0)
|
||
|
|
(println (first (sort @wins))))
|
||
|
|
|