-
Notifications
You must be signed in to change notification settings - Fork 0
/
cl-search.lisp
50 lines (40 loc) · 1.38 KB
/
cl-search.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
;;; This file was autogenerated using org-babel-tangle
;;; on the literate programming document located in the
;;; root directory of the git repository.
(defun tree-search (states goal-p successors combiner)
"Find a state that satisfies goal-p. Start with states.
and search according to successors and combiner."
(dbg :search "~&;; Search: ~a" states)
(cond
((null states) ;nothing left to search
fail)
((funcall goal-p (first-states)) ;found a goal state
(first states))
(t
(tree-search
(funcall combiner
(funcall successors (first states))
(rest states))
goal-p successors combiner))))
;;;;;;;;;;;;;;;;
;; SUCCESSORS ;;
;;;;;;;;;;;;;;;;
(defun finite-binary-tree (n)
"Return a successor function that generates a binary tree with n nodes."
#'(lambda (x)
(remove-if #'(lambda (child) (> child n))
(binary-tree x))))
(defun depth-first-search (start goal-p successors)
"Search new states first until goal is reached."
(tree-search (list start) goal-p successors #'append))
(defun breadth-first-search (start goal-p successors)
"Search oldest states first until goal is reached."
(tree-search (list start) goal-p successors #'prepend))
;;;;;;;;;;;;;
;; HELPERS ;;
;;;;;;;;;;;;;
(defun is (value)
#'(lambda (x) (eql x value)))
(defun prepend (x y)
"Prepend y to the start of x."
(append y x))