Some algorithm implemented in lisp

Common-Lisp-Persecode.md

Common Lisp Persecode

Shortest Path(最短路径)

BFS(广度优先算法)

1. 遍历当前节点距离为1的邻接节点
2. 存在目的节点，搜索结束
3. 如果不为目的节点，将邻接节点周围距离为1的节点加入带检查的节点队列中
4. 对待检查节点中的节点运用重复步骤1

(defun shortest-path (start end net)
  (labels ((next-level-nodes (path node net)
             (mapcar #'(lambda (x)
                         (cons x path))
                     (cdr (assoc node net))))
           (bfs (end queue net)
             (if (null queue)
                 nil
                 (let* ((path (car queue))
                        (node (car path)))
                   (if (eql end node)
                       (reverse path)
                       (bfs end
                            (append (cdr queue)
                                    (next-level-nodes path node net))
                            net))))))
     (bfs end (list (list start)) net)))

Binary Search(二分查找)

(defun bin-search (obj vector)
  (labels ((search (start end obj vec)
             (if (> start end)
                 nil
                 (let* ((mid (+ start (round (/ (- end start) 2))))
                        (val (svref vec mid)))
                   (cond ((< obj val) (search start (1- mid) obj vec))
                         ((> obj val) (search (1+ mid) end obj vec))
                         (t mid))))))
    (search 0 (1- (length vector)) obj vector)))

Binary Search Tree(二叉搜索树)

(defstruct (node (:print-function
                  (lambda (n s d)
                    (format s "#<~A>" (node-elt n)))))
  elt (l nil) (r nil))

(defun bst-insert (obj bst <)
  (if (null bst)
      (make-node :elt obj)
      (let ((elt (node-elt bst)))
        (if (eql obj elt)
            bst
            (if (funcall < obj elt)
                (make-node
                 :elt elt
                 :l (bst-insert obj (node-l bst) <)
                 :r (node-r bst))
                (make-node
                 :elt elt
                 :l (node-l bst)
                 :r (bst-insert obj (node-r bst) <)))))))
 
(defun bst-find (obj bst <)
  (if (null bst)
      nil
      (let ((elt (node-elt bst)))
        (if (eql elt obj)
            bst
            (if (funcall < obj elt)
                (bst-find obj (node-l bst) <)
                (bst-find obj (node-r bst) <))))))

(defun bst-min (bst)
  (and bst (or (bst-min (node-l bst)) bst)))

(defun bst-max (bst)
  (and bst (or (bst-max (node-r bst)) bst)))