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