fffej

(defn run-machine
  "Run the virtual machine with the decoded instructions.  
   Reset the program counter when complete"
  [vm ops update-input]
  (update-input vm)
  (doseq [[op args] ops]     
    (apply op (list vm args)) ;; dodgy side effect
    (swap! (:counter vm) inc))
  (swap! (:counter vm) (constantly 0))
  (swap! (:firstrun vm) (constantly false))

fffej

(defn depth-first-search
  "Search new states first until goal is reached."
  [start goal? successors]
  (tree-search (list start) goal? successors concat))

(defn reverse-concat
  "Prepend y to start of x"
  [x y]
  (concat y x))

fffej

(defn sorter
  "Return a combiner function that sorts according to cost-fn"
  [cost-fn]
  (fn [new old]
    (sort (fn [n o] (< (cost-fn n) (cost-fn o))) (concat new old))))

(defn best-first-search
  "Search lowest cost states first until goal is reached"
  [start goal? successors cost-fn]
  (tree-search (list start) goal? successors (sorter cost-fn)))

fffej

(defstruct game :current-score :throws)

(def darts
     (concat
      (range 1 21)
      (map (partial * 2) (range 1 21))
      (map (partial * 3) (range 1 21))
      '(25 50)))
      
(def finishes

fffej

(defn tree-search
  "Find a state that satisfies goal? Start with states, and search 
   according to successors and combiner"
  [states goal? successors combiner]
  (dbg :search "Search %s" states)
  (cond
    (empty? states) nil
    (goal? (first states)) (first states)
    :else (recur 
	   (combiner (successors (first states)) (rest states))

fffej

(defn beam-search
  "Search highest scoring states first until goal is reached"
  [start goal? successors cost-fn beam-width]
  (tree-search (list start) goal? successors
	       (fn [old new]
		 (let [sorted ((sorter cost-fn) old new)]
		   (if (> beam-width (count sorted))
		     sorted
		     (take beam-width sorted))))))

fffej

(defn solve-darts-depth-first
  [n]
  (depth-first-search 
   (struct game n []) 
   finished?
   next-dart))

(defn solve-darts-breadth-first
  [n]
  (breadth-first-search (struct game n []) finished? next-dart))

fffej

(defn solve-darts-beam-search
  [n]
  (beam-search
   (struct game n [])
   finished?
   next-dart
   (fn [d] (/ (- (:current-score d) n) (count (:throws d))))
   3))

fffej

(defn new-states
  "Generate successor states that have not been seen before."
  [states successors state-eq old-states]
  (remove
   (fn [state]
      (or (some (partial state-eq state) old-states)
	  (some (partial state-eq state) states)))
   (successors (first states))))

(defn graph-search

fffej

(defstruct path :state :previous :cost-so-far :total-cost)

(defn path-to-string
  [path]
  (format "Path to %s, cost %s" (:state path) (:total-cost path)))

(defn make-path
  "Create a new path object"
  [state previous cost-so-far total-cost]
  (struct path state previous cost-so-far total-cost))