二叉排序树算法练手之CLISP实现

(in-package :cl-user)

(defun reload ()
(load "h:/lisptool/btree.lsp"))


(defvar *rootnode* nil)


(defmacro node-level (node)
`(getf ,node :level))
(defmacro node-left (node)
`(getf ,node :left))
(defmacro node-right (node)
`(getf ,node :right))
(defmacro node-value (node)
`(getf ,node :value))

;树中的数据转换为列表;有序
(defun tree-value-list (&optional (parentNode *rootnode*))
(if parentNode
(append 
(tree-value-list (node-left parentNode)) 
(if (node-value parentNode) (list (node-value parentNode)) nil)
(tree-value-list (node-right parentNode)))))


;树深度
(defun tree-height (&optional (tree-node *rootnode*))
(if tree-node
(1+ (max 
(tree-height (node-left tree-node)) 
(tree-height (node-right tree-node))))
0))


;层次遍历
(defun tree-print-level ()
(setf (node-level *rootnode*) 1)
(let ((tmp-node-list (list *rootnode*)))
(do* ((tmp-node (pop tmp-node-list) (pop tmp-node-list))
 (tmp-level (node-level tmp-node) (node-level tmp-node))
 (pre-level 0))
 
((null tmp-node))

(unless (= pre-level tmp-level)
(terpri)
(psetq pre-level tmp-level)
(format t "level=~a    " tmp-level))

(format t "~a " (node-value tmp-node))


(let ((left-node (node-left tmp-node)) (right-node (node-right tmp-node)))
(when left-node
 (setf (node-level left-node) (1+ tmp-level))
 (setf tmp-node-list (append tmp-node-list (list left-node))))
(when right-node
 (setf (node-level right-node) (1+ tmp-level))
 (setf tmp-node-list (append tmp-node-list (list right-node))))))))
 
;先序遍历
(defun tree-print-pre (&optional (tmp-node *rootnode*))
(when tmp-node
(tree-print-pre (node-left tmp-node))
(format t "level:~a value=~a~%" (node-level tmp-node) (node-value tmp-node))
(tree-print-pre (node-right tmp-node))))

;后序遍历
(defun tree-print-tail (&optional (tmp-node *rootnode*))
(when tmp-node
(tree-print-pre (node-right tmp-node))
(format t "level:~a value=~a~%" (node-level tmp-node) (node-value tmp-node))
(tree-print-pre (node-left tmp-node))))



; 注 (list :value val :left nil :right nil) 与 ·(:value ,val :left nil :right nil) 的区别在于后者会重用之前的回收节点
;插入节点
(defun tree-insert-value (newNode parentNode)
(let ((left-node (node-left parentNode)) (right-node (node-right parentNode)))
(if (< (node-value newNode) (node-value parentNode))
(if left-node
(tree-insert-value newNode left-node)
(setf 
(node-left parentNode) newNode 
(node-level newNode) (1+ (node-level parentNode))))
(if right-node
(tree-insert-value newNode right-node)
(setf 
(node-right parentNode) newNode
(node-level newNode) (1+ (node-level parentNode)))))))
;添加数据
(defun tree-add-val (val)
(let ((tmp-node (list :value val :left nil :right nil)))
(if (null *rootnode*)
(setf 
*rootnode* tmp-node 
(node-level *rootnode*) 1)
(tree-insert-value tmp-node *rootnode*))))
;查找数据
(defun tree-find-val (val  &optional (node *rootnode*) (node-parent nil))
(when node
(if (= (node-value node) val)
(return-from tree-find-val (list :node node :parent node-parent));返回结果
(return-from tree-find-val 
(or (tree-find-val val (node-left node) node)
(tree-find-val val (node-right node) node))))))

;数据修改
(defun tree-replace-val (old-val new-val &optional (node *rootnode*))
(let ((result (tree-find-val old-val node)))
(when result
(setf  (node-value (getf result :node)) new-val))))

(defun left-node-p (node parent-node)
(eq (node-left parent-node) node))

;psetq 的设置位置必须为符号，不能为表达式:不合法表达式=>(psetq (node-left tmp-node-parent) nil)
(defun tree-remove-val (val &optional (node *rootnode*))
(let* ((result (tree-find-val val node))
(tmp-node (getf result :node))
(tmp-node-parent (getf result :parent)))

(if tmp-node-parent
(progn
(setf 
(if (left-node-p tmp-node tmp-node-parent)
(node-left tmp-node-parent)
(node-right tmp-node-parent))
(node-left tmp-node))
(when (node-right tmp-node)
 (tree-insert-value (node-right tmp-node) tmp-node-parent))
t)
(progn ;为父节点时
(if (node-left tmp-node)
(progn
(setf *rootnode* (node-left tmp-node))
(when (node-right tmp-node) (tree-insert-value (node-right tmp-node) (node-left tmp-node)))
t)
(if (node-right tmp-node)
(progn
(setf *rootnode* (node-right tmp-node))
t)
(progn
(setf *rootnode* nil)
t)))))))


; for test
(defun make-tree ()
(psetq *rootnode* nil)
(dotimes (i 10)
(let ((x (random 99)))
(format t "~a~t" x)
(tree-add-val x)))
(terpri)
*rootnode*)