二叉排序树算法练手之CLISP实现【通用版】

(in-package :cl-user)


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


(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 make-treenode (val)
(list :value val :left nil :right nil :level nil))

(defun make-btree ()
(let ((rootnode (make-treenode nil)))
(setf (node-level rootnode) 1)
rootnode))


;添加数据
(defun tree-add-val (val rootnode)
(if (node-value rootnode)
(tree-insert-value (make-treenode val) rootnode)
(progn
(setf (node-value rootnode) val)
rootnode)))
;查找数据
(defun tree-find-val (val rootnode &optional (node-parent nil))
(when rootnode
(if (= (node-value rootnode) val)
(return-from tree-find-val (list :node rootnode :parent node-parent));返回结果
(return-from tree-find-val 
(or (tree-find-val val (node-left rootnode) rootnode)
(tree-find-val val (node-right rootnode) rootnode))))))

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


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


;层次遍历
(defun tree-print-level (rootnode)
(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 (rootnode)
(when rootnode
(tree-print-pre (node-left rootnode))
(format t "level:~a value=~a~%" (node-level rootnode) (node-value rootnode))
(tree-print-pre (node-right rootnode))))

; 注 (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-replace-val (old-val new-val rootnode)
(let ((result (tree-find-val old-val rootnode)))
(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)


;返回一个元素，返回 (true/false rootnode)
(defun tree-remove-val (val rootnode)
(let* ((result (tree-find-val val rootnode))
(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))
(values t rootnode))
(progn ;为父节点时
(if (node-left tmp-node)
(progn
(when (node-right tmp-node) (tree-insert-value (node-right tmp-node) (node-left tmp-node)))
(values t (node-left tmp-node)))
(if (node-right tmp-node)
(values t (node-right tmp-node))
(values t nil)))))))


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



;test delele
(defun test-1 ()
(let* ((rootnode (make-tree))
(value-list (tree-value-list rootnode)))

(tree-print-level rootnode)
(terpri)

(print value-list)
(terpri)

;打乱次序
(dotimes (i (* 2 (length value-list)))
(rotatef 
(elt value-list (random (length value-list))) 
(elt value-list (random (length value-list)))))

(print value-list)
(terpri)

(dolist (n value-list)
(multiple-value-bind (flag tmp-rootnode) (tree-remove-val n rootnode)
(format t "flag:~a rootnode-value:~a remove-value:~a~%" 
flag 
(if tmp-rootnode (node-value tmp-rootnode) nil)
n)
(if (and flag (not (eq rootnode tmp-rootnode)))
(psetq rootnode tmp-rootnode))))))