(ns us.menzies.ai.search)

(def *most-positive-fixnum* 536870911)

(defn tree-search [states goal? successors combiner]
  (println "Search: " states)
  (cond (or (nil? states) (= (count states) 0)) nil
		(goal? (first states)) (first states)
		true (tree-search
			   (combiner
				 (successors (first states))
				 (rest states))
			   goal? successors combiner)))

(defn- append [x y] (concat x y))

(defn- prepend [x y] (concat y x))

(defn binary-tree [x]
  (let [retlist (list (* 2 x) (+ 1 (* 2 x)))]
	(println x)
	(println retlist)
	retlist))

(defn depth-first-search [start goal? successors]
  (tree-search (list start) goal? successors #'append))

(defn is [value] #(= %1 value))

(defn demo-dfs []
  (depth-first-search 1 (is 12) binary-tree))

(defn breadth-first-search [start goal? successors]
  (tree-search (list start) goal? successors #'prepend))

(defn demo-bfs []
  (breadth-first-search 1 (is 12) binary-tree))

(defn log [n base]
  (/ (Math/log n) (Math/log base)))

(defn finite-binary-tree [n]
  #(remove (fn [x] (> (log x 2) n)) (binary-tree %1)))

(defn dfid-search
  ([start goal? successors max] (dfid-search start goal? successors max 1))
  ([start goal? successors max now]
   (when (<= now max)
	 (or (depth-first-search start goal? (successors now))
		 (dfid-search start goal? successors max (inc now))))))

(defn demo-dfid
  ([] (demo-dfid 5))
  ([max] (dfid-search 1 (is 12) #'finite-binary-tree max)))

(defn diff [n] #(Math/abs (- %1 n)))

(defn sorter [cost-fn]
  #(sort-by cost-fn (append %1 %2)))

(defn best-first-search [start goal? successors cost-fn]
  (tree-search (list start) goal? successors (sorter cost-fn)))

(defn demo-bestfs1
  ([] (demo-bestfs1 12))
  ([goal]
   (best-first-search 1 (is goal) #'binary-tree (diff goal))))

(defn price-is-right [price]
  #(if (> %1 price)
	 *most-positive-fixnum*
	 (- price %1)))

(defn demo-bestfs2
  ([] (demo-bestfs2 12))
  ([goal]
   (best-first-search 1 (is goal) #'binary-tree (price-is-right goal))))

(defn beam-search [start goal? successors cost-fn beam-width]
  (tree-search (vector start) goal? successors
			   #(let [sortedvec (vec ((sorter cost-fn) %1 %2))]
				  (if (> beam-width (count sortedvec))
					sortedvec
					(subvec sortedvec 0 beam-width)))))

(defstruct city :name :long :lat)

(defonce *cities*
  `(~(struct-map city :name 'Atlanta       :long 84.23  :lat 33.45)
	 ~(struct-map city :name 'Los-Angeles   :long 118.15 :lat 34.03)
	 ~(struct-map city :name 'Boston        :long 71.05  :lat 42.21)
	 ~(struct-map city :name 'Memphis       :long 90.03  :lat 35.09)  
	 ~(struct-map city :name 'Chicago       :long 87.37  :lat 41.50)
	 ~(struct-map city :name 'New-York      :long 73.58  :lat 40.47) 
	 ~(struct-map city :name 'Denver        :long 105.00 :lat 39.45)
	 ~(struct-map city :name 'Oklahoma-City :long 97.28  :lat 35.26)
	 ~(struct-map city :name 'Eugene        :long 123.05 :lat 44.03)
	 ~(struct-map city :name 'Pittsburgh    :long 79.57  :lat 40.27) 
	 ~(struct-map city :name 'Flagstaff     :long 111.41 :lat 35.13)
	 ~(struct-map city :name 'Quebec        :long 71.11  :lat 46.49)
	 ~(struct-map city :name 'Grand-Jct     :long 108.37 :lat 39.05)
	 ~(struct-map city :name 'Reno          :long 119.49 :lat 39.30)
	 ~(struct-map city :name 'Houston       :long 105.00 :lat 34.00)
	 ~(struct-map city :name 'San-Francisco :long 122.26 :lat 37.47)
	 ~(struct-map city :name 'Indianapolis  :long 86.10  :lat 39.46)
	 ~(struct-map city :name 'Tampa         :long 82.27  :lat 27.57)
	 ~(struct-map city :name 'Jacksonville  :long 81.40  :lat 30.22)
	 ~(struct-map city :name 'Victoria      :long 123.21 :lat 48.25)
	 ~(struct-map city :name 'Kansas-City   :long 94.35  :lat 39.06)
	 ~(struct-map city :name 'Wilmington    :long 77.57  :lat 34.14)))

(defn get-city
  ([name] (get-city name *cities*))
  ([name citylist]
   (if (or (nil? citylist) (= (count citylist) 0))
	 nil
	 (if (= (:name (first citylist)) name)
	   (first citylist)
	   (get-city name (rest citylist))))))

(def *earth-diameter* 12765.0)

(defn xyz-coords [thecity]
  (let [psi (Math/toRadians (thecity :lat))
		phi (Math/toRadians (thecity :long))]
	(list (* (Math/cos psi) (Math/cos phi))
		  (* (Math/cos psi) (Math/sin phi))
		  (Math/sin psi))))

(defn distance [point1 point2]
  (Math/sqrt (reduce + (map #(Math/pow (- %1 %2) 2) point1 point2))))

(defn air-distance [city1 city2]
  (let [d (distance (xyz-coords city1) (xyz-coords city2))]
	(* *earth-diameter* (Math/asin (/ d 2)))))

(defn city-neighbors [thecity]
  (remove #(or (= %1 thecity)
			   (>= (air-distance %1 thecity) 1000.0))
		  *cities*))

(defn trip [start dest]
  (beam-search start (is dest) #'city-neighbors #(air-distance %1 dest) 1))

(defn demo-trip []
  (println "one way...")
  (trip (get-city 'San-Francisco) (get-city 'Boston))
  (println "and the other way...")
  (trip (get-city 'Boston) (get-city 'San-Francisco)))