(ns rlm.light-bot

   (:refer-clojure :only [])

   (:require rlm.ns-rlm mobius.base))

 (rlm.ns-rlm/ns-clone mobius.base)

 ;(use 'clojure.contrib.combinatorics)

 (use 'sunil.curry)

 

 

 {:loc '[x y]

  :rot '[c]}

 

 (defrecord tile [height lit?])

 

 

 

 	      

 

 ;;; Robot Actions

 (def cycle-right 

      {:N :E

       :E :S

       :S :W

       :W :N})

 (def  cycle-left 

       {:N :W

        :W :S

        :S :E

        :E :N})

 

 (defn turn-left [game]

   (update-in game [:pos :rot] cycle-left))

 

 (defn turn-right [game]

     (update-in game [:pos :rot] cycle-right))

 	

 (def light* {nil nil

 	     true false

 	     false true})

   

 (defn light [{:keys [map pos] :as game}]

   (update-in game [:map (:loc pos) :lit?] light*))

 

 (def move

   {:N [0,1]

    :E [1,0]

    :S [0,-1]

    :W [-1,0]})

 

 (defn-decorated

   advance

   [(curry 2)]

   [action {:keys [pos] :as game}]

   (let [proposed (vec (map + (move (:rot pos)) (:loc pos)))]

     (if (get (:map game) proposed false)

       (assoc-in game [:pos :loc] (action proposed game))

       game)))

 

 (defn jump-gaurd [proposed {:keys [pos] :as game}]

   (if (= (.height ((:map game) proposed)) (inc (.height ((:map game) (:loc pos)))))

     proposed

     (:loc pos)))

 (def jump (advance jump-gaurd))

 

 (defn forward-gaurd [proposed {:keys [map pos] :as game}]

   (if (= (.height ((:map game) proposed)) (.height ((:map game) (:loc pos))))

     proposed

     (:loc pos)))

 (def forward (advance forward-gaurd));;heehee :)

 

   

 (declare commands)

 

 (defn expand [game moves]

   (reduce (fn [game move] ((commands move) game)) game moves))

 

 (defn function-1 [{{f1 :f1} :stragety :as game}]

   (expand game f1))

 

 (defn function-2 [{{f2 :f2} :stragety :as game}]

   (expand game f2))

 

 

 

 (defn all-lit? [game]

   (not (some false? (map #(.lit? %) (vals (:map game))))))

 

 

 (defn solves? [game]

   (all-lit? (expand game (:main (:stragety game)))))

 

 

   

 (def commands

      {:jump jump

       :light light

       :turn-left turn-left

       :turn-right turn-right

       :function-1 function-1

       :function-2 function-2

       :forward forward})

 

 

 ;;; End game implementation

 

 

 

 

 ;;; Find linear solutions

 

 (def naturals (iterate inc 1))

 

 (defvar linear-commands

   (remove #(or (= % :function-2) (= % :function-1)) (keys commands))

   "all the commands ignoring function calls. Branching factor 5.")

 

 (decorate selections (curry 2))

 (defn breadth-first

   "iterate through the search space in breadth-first-order"

   [coll]

   (mapcat (selections coll) naturals))

 

 (defn solutions

   "find solutions via breadth first search and returns as a lazy seq"

   [{level-map :map init-pos :pos :as level}]

   (filter #(solves? (assoc-in level [:stragety :main] %)) (breadth-first linear-commands)))

 

 ;;(decorate selections [(curry 2) memoize])

 

 

 

 

 

 

 

 

 

 

 

 ;;;

 

 

 

 

 

 

 

 

 

 

 ;;;Level One

 (defn level-one-gen [[x y]]

   (cond (= x 0) (tile. 2 nil)

 	(= x 7) (tile. 2 nil)

 	(= [x y] [3 4]) (tile. 0 false)

 	true (tile. 0 nil)))

 

 (def level-one-map

      (let [domain (selections (range 8) 2)]

        (zipmap (map vec domain) (map level-one-gen domain))))

 

 (def level-one-solution

      {:main [:forward :forward :light]

       :f1 []

       :f2 []})

 

 (def level-one-init-pos {:loc [3 2] :rot :N})

 (def game-1

      {:map level-one-map

       :stragety level-one-solution

       :pos level-one-init-pos})

 

 (def level-1 {:map level-one-map

 	      :pos level-one-init-pos})