AI search code

search.clj

(ns search.core)

;; Lecture notes on AI search algorithms.
;; Lee Spector, lspector@hampshire.edu, 20141015

#_(defn is-5 [n]
   (= n 5))

#_(filter is-5 [1 2 3 4 5 6 7 8 9 8 7 6 5 4 3 2 1])

#_(first (filter is-5 [1 2 3 4 5 6 7 8 9 8 7 6 5 4 3 2 1]))

#_(first (filter (fn [n] (= n 5)) [1 2 3 4 5 6 7 8 9 8 7 6 5 4 3 2 1]))

#_(first (filter #(= % 5) [1 2 3 4 5 6 7 8 9 8 7 6 5 4 3 2 1]))

#_(first (filter #{5} [1 2 3 4 5 6 7 8 9 10]))

#_(first (filter #{15} [1 2 3 4 5 6 7 8 9 10]))

#_(defn search
   [sequence]
   (loop [remaining sequence]
     (if (empty? remaining) 
       false
       (if (= (first remaining) 5) 
         5
         (recur (rest remaining))))))

#_(search [1 2 3 4 5 6 7 8 9 10])

#_(search [1 2 3])

#_(first (filter even? [1 2 3 4 5 6 7 8 9 10]))

#_(defn search
   [sequence]
   (loop [remaining sequence]
     (if (empty? remaining) 
       false
       (if (even? (first remaining)) ;;***
         (first remaining)
         (recur (rest remaining))))))

#_(search [1 2 3 4 5 6 7 8 9 10])

#_(defn search
   [goal sequence] ;;***
   (loop [remaining sequence]
     (if (empty? remaining) 
       false
       (if (goal (first remaining)) ;;***
         (first remaining)
         (recur (rest remaining))))))

#_(search even? [1 2 3 4 5 6 7 8 9 10])

#_(defn depth-search ;;***
   [goal tree]      ;;***
   (loop [remaining tree]
     (if (empty? remaining) 
       false
       (if (sequential? (first remaining)) ;;***
         (recur (concat (first remaining) (rest remaining))) ;;***
         (if (goal (first remaining)) 
           (first remaining)
           (recur (rest remaining)))))))

#_(depth-search even? [1 [3 5 7 8] [[[4 5] 6] 7]])

#_(defn depth-search
   [goal tree]
   (loop [remaining tree]
     (if (empty? remaining) 
       false
       (let [f (first remaining) ;;***
             r (rest remaining)] ;;***
         (if (sequential? f) 
           (recur (concat f r))
           (if (goal f) 
             f 
             (recur r)))))))

#_(depth-search even? [1 [3 5 7 8] [[[4 5] 6] 7]])

#_(defn depth-search
    [goal tree]
    (loop [remaining tree]
      (if (empty? remaining) 
        false
        (let [f (first remaining)
              r (rest remaining)]
          (println "checking:" f) ;; ***
          (if (sequential? f) 
            (recur (concat f r))
            (if (goal f) 
              f 
              (recur r)))))))

#_(depth-search even? [1 [3 5 7 8] [[[4 5] 6] 7]])

#_(defn breadth-search ;;***
   [goal tree]
   (loop [remaining tree]
     (if (empty? remaining) 
       false
       (let [f (first remaining)
             r (rest remaining)]
         (println "checking:" f)
         (if (sequential? f) 
           (recur (concat r f)) ;;***
           (if (goal f) 
             f 
             (recur r)))))))

#_(breadth-search even? [1 [3 5 7 8] [[[4 5] 6] 7]])

#_(breadth-search even? [1 [3 5 7 8] [[[4 5] 6] 7] 10])

#_(defn search
   [goal tree combiner] ;;***
   (loop [remaining tree]
     (if (empty? remaining) 
       false
       (let [f (first remaining)
             r (rest remaining)]
         (println "checking:" f)
         (if (sequential? f) 
           (recur (combiner f r)) ;;***
           (if (goal f) 
             f 
             (recur r)))))))

#_(defn depth-search
   [goal tree]
   (search goal tree concat))

#_(depth-search even? [1 [3 5 7 8] [[[4 5] 6] 7] 10])

#_(defn breadth-search
   [goal tree]
   (search goal tree #(concat %2 %1)))

#_(breadth-search even? [1 [3 5 7 8] [[[4 5] 6] 7] 10])

#_(defn search
   [goal tree combiner]
   (loop [remaining (map #(hash-map :contents % :history []) tree)] ;;***
     (if (empty? remaining)
       false
       (let [f (first remaining)
             r (rest remaining)]
         (if (sequential? (:contents f))
           (recur 
             (combiner 
               (map #(hash-map :contents % 
                               :history (conj (:history f) (:contents f))) ;;***
                    (:contents f))
               r))
           (if (goal (:contents f)) 
             f 
             (recur r)))))))

#_(defn depth-search
   [goal tree]
   (search goal tree concat))

#_(depth-search even? [1 [3 5 7 8] [[[4 5] 6] 7] 10])

#_(depth-search even? [1 [3 5 7] [[[4 5] 6] 7] 10])

#_(defn breadth-search
   [goal tree]
   (search goal tree #(concat %2 %1)))

#_(breadth-search even? [1 [3 5 7 8] [[[4 5] 6] 7] 10])

#_(breadth-search even? [1 [3 5 7] [[[4 5] 6] 7]])

#_(defn search
   [goal start combiner successors] ;;***
   (loop [frontier [(hash-map :contents start :history [])]]
     (if (empty? frontier)
       false
       (let [f (first frontier)
             r (rest frontier)]
         (println "Frontier:" (map :contents frontier) "Checking:" (:contents f))
         (if (goal (:contents f)) 
           f
           (recur 
             (combiner 
               (map #(hash-map :contents % 
                               :history (conj (:history f) (:contents f))) 
                    (successors (:contents f)))
               r)))))))
  
#_(defn binary-tree [x] 
   [(* 2 x) (inc (* 2 x))])

#_(binary-tree 23)

#_(search #(> % 20) 1 concat binary-tree)

#_(search #(> % 20) 1 #(concat %2 %1) binary-tree)

; 8 puzzle
;
; goal:
;[1 2 3
; 4 5 6
; 7 8 0]

#_(defn slide
   [from-index to-index board]
   (-> board
     (assoc from-index (get board to-index))
     (assoc to-index (get board from-index))))

#_(defn eight-puzzle-moves
   "Returns a vector of all of the eight-puzzle boards reachable by sliding a 
tile into the empty (zero) space in board b. Note that the indices of positions
in boards are as follows:
[0 1 2
 3 4 5
 6 7 8]"
   [b]
   (case (count (take-while pos? b))
     0 [(slide 1 0 b) (slide 3 0 b)]
     1 [(slide 0 1 b) (slide 2 1 b) (slide 4 1 b)]
     2 [(slide 1 2 b) (slide 5 2 b)]
     3 [(slide 0 3 b) (slide 4 3 b) (slide 6 3 b)]
     4 [(slide 1 4 b) (slide 3 4 b) (slide 5 4 b) (slide 7 4 b)]
     5 [(slide 2 5 b) (slide 4 5 b) (slide 8 5 b)]
     6 [(slide 3 6 b) (slide 7 6 b)]
     7 [(slide 4 7 b) (slide 6 7 b) (slide 8 7 b)]
     8 [(slide 5 8 b) (slide 7 8 b)]))

#_(search #(= % [1 2 3 4 5 6 7 8 0])
         [1 2 3 4 5 6 0 7 8]
         #(concat %2 %1)
         eight-puzzle-moves)

;; Many other starting points take too long. We'll make several improvements
;; before trying them.

#_(defn search
   [goal start combiner successors]
   (loop [frontier [(hash-map :contents start :history [])]
          seen #{start} ;;***
          steps 0]      ;;***
     (if (empty? frontier)
       false
       (let [f (first frontier)
             r (rest frontier)]
         (if (goal (:contents f)) 
           [f {:seen (count seen) :steps steps}]
           (let [unseen-successors (clojure.set/difference ;;***
                                     (set (successors (:contents f)))
                                     seen)]
             (recur 
               (combiner 
                 (map #(hash-map :contents % 
                                 :history (conj (:history f) (:contents f))) 
                      unseen-successors)                   ;;***
                 r)
               (clojure.set/union seen unseen-successors)  ;;***
               (inc steps))))))))                          ;;***

#_(search #(= % [1 2 3 4 5 6 7 8 0])
         [1 2 3 4 5 6 7 0 8]
         #(concat %2 %1)
         eight-puzzle-moves)

#_(search #(= % [1 2 3 4 5 6 7 8 0])
         [1 2 3 4 0 5 6 7 8]
         #(concat %2 %1)
         eight-puzzle-moves)

#_(search #(= % [1 2 3 4 5 6 7 8 0])
         [0 1 2 3 4 5 6 7 8]
         concat
         eight-puzzle-moves)

;; Some are still too hard.

#_(search #(= % [1 2 3 4 5 6 7 8 0])
         [0 1 2 3 4 5 6 7 8]
         (fn [new-nodes old-nodes]
           (take 10 (sort #(< (count (:history %1))
                              (count (:history %2)))
                          (concat new-nodes old-nodes))))
         eight-puzzle-moves)

#_(defn xcoord
   "The x coordinate into an index into
   [0 1 2
    3 4 5
    6 7 8]"
   [index]
   (case index
     (0 3 6) 0
     (1 4 7) 1
     (2 5 8) 2))

#_(defn ycoord
   "The y coordinate into an index into
   [0 1 2
    3 4 5
    6 7 8]"
   [index]
   (case index
     (0 1 2) 0
     (3 4 5) 1
     (6 7 8) 2))

#_(defn index-distance
   [index1 index2]
   (+ (Math/abs (- (xcoord index1) (xcoord index2)))
      (Math/abs (- (ycoord index1) (ycoord index2)))))

#_(defn index-in-board
   [tile board]
   (count (take-while #(not (= % tile)) board)))

#_(index-in-board 3 [8 7 6 5 4 3 2 1 0])

#_(defn manhattan-distance
   [board1 board2]
   (reduce + (for [tile (range 9)]
               (index-distance (index-in-board tile board1)
                               (index-in-board tile board2)))))

#_(manhattan-distance [0 1 2 3 4 5 6 7 8]
                     [8 1 2 3 4 5 6 7 0])

#_(manhattan-distance [0 1 2 3 4 5 6 7 8]
                     [1 2 3 4 5 6 7 8 0])

#_(defn solution-distance
   [board]
   (manhattan-distance board
                       [1 2 3 4 5 6 7 8 0]))

#_(search #(= % [1 2 3 4 5 6 7 8 0])
         [0 1 2 3 4 5 6 7 8] 
         (fn [new-nodes old-nodes]
           (take 10 (sort #(< (+ (count (:history %1))
                                 (solution-distance (:contents %1)))
                              (+ (count (:history %2))
                                 (solution-distance (:contents %2))))
                          (concat new-nodes old-nodes))))
         eight-puzzle-moves)

;; it will work without the reduction to frontier of size 10, but it will take a long time

#_(search #(= % [1 2 3 4 5 6 7 8 0])
         [0 1 2 3 4 5 6 7 8] 
         (fn [new-nodes old-nodes]
           (sort #(< (+ (count (:history %1))
                        (solution-distance (:contents %1)))
                     (+ (count (:history %2))
                        (solution-distance (:contents %2))))
                 (concat new-nodes old-nodes)))
         eight-puzzle-moves)

;; this will make it a lot faster

#_(def solution-distance (memoize solution-distance))

#_(search #(= % [1 2 3 4 5 6 7 8 0])
          [0 1 2 3 4 5 6 7 8] 
          (fn [new-nodes old-nodes]
            (sort #(< (+ (count (:history %1))
                         (solution-distance (:contents %1)))
                      (+ (count (:history %2))
                         (solution-distance (:contents %2))))
                  (concat new-nodes old-nodes)))
          eight-puzzle-moves)

;; note also that sorting is not strictly necessary, as we only need to find
;; the most promising node to expand next