computer 版 (精华区)

发信人: wizard (Python), 信区: computer       
标  题: 闲着没事作了一个搜索用的lisp程序
发信站: BBS 听涛站 (Thu Mar 25 15:28:24 2004), 站内

;; search.lisp
;; 22 March 2004

(defpackage search-base
  (:export BFS DFS)
  (:use common-lisp))
(in-package search-base)

(defvar finish-status '()
  "The finished status set")
(defvar rules-set '())
(defvar expand-func #'(lambda () ()))
(defvar update-open-lst #'(lambda () ()))

(defun search-init (K rules delta lstop)
  "initialize the global values used by search base"
  (setq finish-status K)
  (setq rules-set rules)
  (setq expand-func delta)
  (setq update-open-lst lstop)
  t)

(defun search-start (open closed)
  (let ((q (first open))
        (seq (rest open)))
    (cond ((null open) nil)
          ((find q finish-status :test 'equal) (list seq (cons q closed)))
          (t (search-start (funcall
                            update-open-lst
                            seq
                            (expand-vertex q rules-set expand-func (cons q closed))
                            )
                           (cons q closed))))))

(defun BFS (s K rules delta)
  "Breadth first search"
  (let ((lstop #'(lambda (lst1 lst2)
                   (append lst1 lst2)))
        )
    (search-init K rules delta lstop)
    (search-start (list s) nil)))

(defun DFS (s K rules delta)
  "Deep first search"
  (let ((lstop #'(lambda (lst1 lst2)
                  (append lst2 lst1)))
        )
    (search-init K rules delta lstop)
    (search-start (list s) nil)))

(defun expand-vertex (vertex rules delta closed)
  (let ((lst (mapcar
              #'(lambda (r)
                  (let ((v (funcall delta vertex r))
                        )
                    (cond ((find v closed :test 'equal) nil)
                          (t v))))
              rules))
        )
    (remove nil lst)))

(defun test-delta (v r)
  (+ v r))

--
(defun power-set (set)
  (if (null set) '(())
    (let ((pset-of-rest (power-set (cdr set))))
      (append
      (mapcar #'(lambda (subset) (cons (car set) subset))
              pset-of-rest) pset-of-rest))))


※ 来源:·BBS 听涛站 tingtao.net·[FROM: 219.224.175.139]