主要改进:
1、转换节点数据结构,list =>clsss node
2、添加节点父元素
(in-package :cl-user)
(defun reload ()(load "h:/lisptool/btree.lsp"))
(defclass node ()
((node-value
:initarg :value
:accessor node-value
:initform nil)
(node-left
:initarg :left
:accessor node-left
:initform nil)
(node-right
:initarg :right
:accessor node-right
:initform nil)
(node-level
:initarg :level
:accessor node-level
:initform nil)
(node-parent ;可递归,list不能递归
:initarg :parent
:accessor node-parent
:initform nil)))
(defun make-treenode (val &key level)
(make-instance 'node :value val :level level))
(defun make-btree ()
(make-treenode nil :level 1))
;添加数据
(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)
(when rootnode
(if (= (node-value rootnode) val)
(return-from tree-find-val rootnode);返回结果
(return-from tree-find-val
(or (tree-find-val val (node-left rootnode))
(tree-find-val val (node-right 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)
(let ((tmp-node-list (list rootnode)))
(do* ((tmp-node (pop tmp-node-list) (pop tmp-node-list))
(tmp-level (node-level tmp-node) (if tmp-node (node-level tmp-node) nil))
(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 tmp-node-list (append tmp-node-list (list left-node))))
(when right-node
(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))))
;插入节点
(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-parent newNode) parentNode
(node-level newNode) (1+ (node-level parentNode))))
(if right-node
(tree-insert-value newNode right-node)
(setf
(node-right parentNode) newNode
(node-parent newNode) parentNode
(node-level newNode) (1+ (node-level parentNode)))))))
;数据修改
(defun tree-replace-val (old-val new-val rootnode)
(let ((tmp-node (tree-find-val old-val rootnode)))
(when tmp-node
(setf (node-value tmp-node) new-val))))
(defun left-node-p (node)
(eq (node-left (node-parent node)) node))
;psetq 的设置位置必须为符号,不能为表达式:不合法表达式=>(psetq (node-left tmp-node-parent) nil)
;返回一个元素,返回 (true/false rootnode)
(defun tree-remove-val (val rootnode)
(let* ((tmp-node (tree-find-val val rootnode))
(tmp-node-parent (node-parent tmp-node)))
(if tmp-node-parent
(progn
(setf
(if (left-node-p tmp-node)
(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 99)))
(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))))))