(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))))))
(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))))))