tree-search (defun (states goal-p successors combiner path time space) (format t "~%Search: ~S" states) (cond ;; Case 1: Search space is exhausted ((null states) (report-results (reverse path) time space)) ;; Case 2: Check if we have reached the goal state ((funcall goal-p (first states)) (report-results (reverse (cons (first states) path)) time space)) ;; Case 3: If not, continue the search (t (let* ((children (funcall successors (first states))) (queue (funcall combiner children (rest states)))) (tree-search queue goal-p successors combiner (cons (first states) path) (+ time (length children)) (max space (length queue)))))) ) (defun depth-first-search (start goal-p successors) "Search new states first until goal is reached." (tree-search (list start) goal-p successors #'append nil 0 0)) (defun breadth-first-search (start goal-p successors) "Search old states first until goal is reached." (tree-search (list start) goal-p successors #'prepend nil 0 0)) (defun best-first-search (start goal-p successors cost-fn) "Search lowest cost states first until goal is reached." (tree-search (list start) goal-p successors (sorter cost-fn) nil 0 0)) (defun a*-search (start goal-p successors cost-fn) "A*-search using bfs by giving it an admissible cost-fn. not returned." (best-first-search start goal-p successors cost-fn) ) Solution path is
(defun beam-search (start goal-p successors cost-fn beam-width) "Search highest scoring states first until goal is reached, but never consider more than beam-width states at a time." (tree-search (list start) goal-p successors #'(lambda (old new) (let ((sorted (funcall (sorter cost-fn) old new))) (if (> beam-width (length sorted)) sorted (subseq sorted 0 beam-width)))) nil 0 0) ) ;;; Goal functions testing (defun is (value) #'(lambda (x) (eql x value))) ;;; Successor generation functions (defun binary-tree (x) (list (* 2 x) (+ 1 (* 2 x)))) ;;; Heuristic functions (defun diff (num) "Return the function that finds the difference from num." #'(lambda (x) (abs (- x num))))
(defun sorter (cost-fn) "Return a combiner function that sorts according to cost-fn." #'(lambda (new old) (sort (append new old) #'< :key cost-fn))) (defun price-is-right (price) "Return a function that measures the difference from price, but gives a big penalty for going over price." #'(lambda (x) (if (> x price) most-positive-fixnum (- price x)))) (defun odd-p (n) (eq (mod n 2) 1)) (defun even-p (n) (eq (mod n 2) 0)) (defun left-or-right (n) (cond ((= n 2) 0) ((= n 3) 1) ((odd-p n) (left-or-right (/ (1- n) 2))) ((even-p n) (left-or-right (/ n 2)))) ) (defun same-level (x y) (eq (g x) (g y)) ) (defun b (n z) (if (same-level n z) (abs (- z n)) 0) ) (defun same-side (x y) (if (eq (left-or-right x) (left-or-right y)) -1 1) ) (defun g (n) (floor (log n...