langton.clj

(def -directions [:N :E :S :W :N])

(defn position [c h]
  {:co-ord c :heading h})

(def moves {:N [identity inc]
            :E [inc identity]
            :S [identity dec]
            :W [dec identity]})

(defn -next-heading [heading -directions]
  (let [-directions (vec -directions)]
        (-directions (inc (.indexOf -directions heading)))))

(defn left-of [heading]
  (-next-heading heading (rseq -directions)))

(defn right-of [heading]
  (-next-heading heading -directions))

(defn turn-left [curr-pos]
  (let [{:keys [co-ord heading]} curr-pos]
    (position co-ord (left-of heading))))

(defn turn-right [curr-pos]
  (let [{:keys [co-ord heading]} curr-pos]
    (position co-ord (right-of heading))))

(defn move [curr-pos]
  (let [{:keys [co-ord heading]} curr-pos
        new-coord (mapv #(%1 %2) (moves heading) co-ord)]
    (position new-coord heading)))

(def move-left (comp move turn-left))

(def move-right (comp move turn-right))

(defn flip-and-move-left [[black-co-ords ant-pos & remaining]]
  (let [new-ant-pos (move-left ant-pos)
        new-black-co-ords (disj black-co-ords (:co-ord ant-pos))]
    [new-black-co-ords new-ant-pos ant-pos :WHITE]))

(defn flip-and-move-right [[black-co-ords ant-pos & remaining]]
  (let [new-ant-pos (move-right ant-pos)
        new-black-co-ords (conj black-co-ords (:co-ord ant-pos))]
    [new-black-co-ords new-ant-pos ant-pos :BLACK]))

(defn langton-iteration [[black-co-ords ant-pos & remaining :as all]]
  (if (contains? black-co-ords (:co-ord ant-pos))
    (flip-and-move-left all)
    (flip-and-move-right all)))