这个是用lisp来构建二叉树。
对autolisp来说,构建二叉树是一个难题,因为lisp没有指针,所以比较困难。
下面是实现的代码。
;;;=============================================================
;;;用AutoLISP构建一个二叉树(Construct a Binary Search tree)
;;;从中间分开,直到分得只是剩下两个元素或者一个
;;;此结构用于查找一个元素,使得单次查找的时间为O(n) = log(n)
;;;-------------------------------------------------------------
;;;输入: Lst 一个已经排序的表,可以拓展此表为点表或其他表。
;;;输出: 一个二叉查找树
;;;Author:Highflybird in Shenzhen,China,2012-06-15
;;;=============================================================
(defun BTree (lst / L R)
(cond
( (cddr lst) ;the length of list > 2
(setq R lst)
(repeat (/ (length lst) 2) ;Split it
(setq L (cons (car R) L)) ;Left part of list
(setq R (cdr R)) ;Right part of list
)
(cons (car R) ;middle number as the first.
(cons (BTree (reverse L)) ;recurse Left part
(BTree (cdr R)) ;recurse Right part
)
)
)
( (cdr lst) ;just two elements
(cons (cadr lst) (car lst)) ;the right node is empty.
)
( lst
(car lst) ;if just one,the node is an element.
)
)
)
;;;=============================================================
;;;用AutoLISP从二叉树中查找一个元素(Search a key in binary tree)
;;;每次查找总是从中间开始,如果不是,大于中间的就查找右边,小于
;;;中间则查找左边,直到原子或者点对表。
;;;因为树的最大深度不超过log(n),故单次查找的时间为O(n)<=log(n)
;;;-------------------------------------------------------------
;;;输入: 要查找的Key,已经构建好的二叉查找树,n查询的最大节点数
;;;输出: 如果找到,返回找到的Key的位置。否则返回nil
;;;Author:Highflybird in Shenzhen,China,2012-06-15
;;;=============================================================
(defun BFind (key Tree n / L R i)
(if (atom Tree) ;if it's an atom,
(if (= key Tree) 0) ;set the index as 0
(if (= (setq L (car Tree)) key) ;if left node = key
(/ n 2) ;the index is the middle number.
(if (atom (setq R (cdr Tree))) ;if the right node is an atom
(if (= R key) 0) ;and right node = key, set the index as 0
(if (> L key) ;if left node > key
(BFind key (car R) (/ n 2)) ;recurse Left
(if (setq i (BFind key (cdr R) (/ (1- n) 2))) ;otherwise recurse right
(1+ (+ (/ n 2) i)) ;must add the index
)
)
)
)
)
)
;;;=============================================================
;;;以下用于测试,用了几种办法对一个有序的数组查找(For test)
;;;数组为等差数列,从2.5开始,差为1, 例如:(2.5 3.5 4.5 5.5 ....)
;;;查找方法:包括二叉树,折半查找,vl-position,member,assoc,直接查.
;;;如果此程序用优化编译,则是更能提高二叉树的查找和构建速度
;;;=============================================================
(defun c:test (/ e j k n lst lst1 Tree v x)
(initget 7)
(setq v (getvar "LOCALE"))
(if (= v "CHS")
(setq j (fix (getreal "n请输入一个数组大小(如果输入数组过大,可能会导致停止响应): ")))
(setq j (fix (getreal "nPlease enter the length of a list (a big number maybe cause nonresponse): ")))
)
(setq x (+ 1.5 j))
(setq k (1- j))
(setq lst nil)
(setq lst1 nil)
(repeat j
(setq lst (cons x lst))
(setq lst1 (cons (cons x k) lst1))
(setq x (1- x))
(setq k (1- k))
)
(Benchmark '(setq lst (vl-sort lst '<) N (length lst)) "Vl-sort" 1)
(Benchmark '(setq Tree (BTree lst) N N) "Construct Binary tree" 1)
(benchmark '(setq Array (makearr lst vlax-vbdouble)) "Construct Safearray" 1)
(setq k (/ N 10))
(princ (strcat "n以下对每个函数重复了" (itoa K) "次测试。"))
(setq x -7.5)
(Benchmark '(repeat k (setq e (BFind x Tree N)) (setq x (+ x 10))) "BinaryTree" 1)
(setq x -7.5)
(Benchmark '(repeat k (setq e (bfind1 x Tree N)) (setq x (+ x 10))) "BinaryTree1" 1)
(setq x -7.5)
(benchmark '(repeat k (setq e (HalfSeek x Array)) (setq x (+ x 10))) "HalfSeek" 1)
(setq x -7.5)
(Benchmark '(repeat k (vl-position x lst) (setq x (+ x 10))) "vl-position" 1)
(setq x -7.5)
(Benchmark '(repeat k (cdr (assoc x lst1)) (setq x (+ x 10))) "Assoc" 1)
(setq x -7.5)
(Benchmark '(repeat k (- N (length (member x lst))) (setq x (+ x 10))) "Member" 1)
;(setq x -2.5)
;(benchmark '(repeat N (Search x lst) (setq x (1+ x))) "Search Directly" 1) ;这个方法过慢
;;以下显示部分查找结果
(princ "n以下显示用二叉树对十个数字的查找结果。")
(setq x -2.5)
(repeat 20
(if (setq e (BFind x Tree j))
(princ (strcat "n发现在" (itoa e)))
(princ (strcat "n没发现" (rtos x)))
)
(setq x (1+ x))
)
(gc)
(princ)
)
;;;============================================================
;;;用AutoLISP折半法查找
;;;首先构造了一个安全数组,这样使得 nth更快。
;;;然后从中间找起,如果大于中间,就找右边,小于则找左边,直到找
;;;找完。这个没用递归,在内存上可能会稍微有优势,但是对于速度,
;;;其实跟二叉树相差不大。
;;;优点: 可以不用递归,效率可以更高。
;;;缺点: 是要构筑安全数组,不是所有的表都可以转化为安全数组.
;;;输入: 要查找的key,和安全数组L。
;;;输出: 如果找到,返回找到的Key的位置。否则返回nil
;;;Author:Highflybird in Shenzhen,China,2012-06-15
;;;============================================================
(defun MakeArr (L DataType / n a)
(setq n (length L))
(setq a (vlax-make-safearray DataType (cons 0 (1- n))))
(vlax-safearray-fill a L)
)
(defun HalfSeek (key L / Nmin Nlen Nmax Nmid Nval)
(setq Nmin 0)
(setq NLen (1+ (vlax-safearray-get-u-bound L 1)))
(setq Nmax (1- NLen))
(setq Nmid (/ Nlen 2))
(setq Nval (vlax-safearray-get-element L Nmid))
(while (and (/= Nval key) (<= Nmin Nmax))
(if (> Nval key)
(setq Nmax (1- Nmid))
(setq Nmin (1+ Nmid))
)
(setq Nmid (/ (+ Nmax Nmin) 2)
Nval (vlax-safearray-get-element L Nmid)
)
)
(if (= nval key)
Nmid
)
)
;;;============================================================
;;;简单的LISP搜寻,挨个地找,找到为止,对排序和未排序的均可用。
;;;但是单次查找平均时间为O(n)
;;;============================================================
(defun Search (key lst / i x)
(setq x lst)
(setq i -1)
(while (and x (/= (car x) key))
(setq x (cdr x))
(setq i (1+ i))
)
)
;;;============================================================
;;;测试用函数
;;;============================================================
(defun Benchmark (func funName times / t0 t1 res)
(setq t0 (getvar "TDUSRTIMER"))
(repeat times
(setq res (eval func))
)
(setq t1 (* (- (getvar "TDUSRTIMER") t0) 86400))
(princ (strcat "nnIt takes: " (rtos t1 2 6) " Seconds for " funName))
(princ (strcat ".nTotal times: " (itoa times)))
(princ (strcat ".nSpeed is: " (rtos (/ t1 times) 2 6) " Seconds/times."))
(princ "nThe result is: ")
(princ res)
)
;;;如果用cond函数,速度相差很少,故只做保留
(defun BFind1 (key lst n / x k)
(cond
( (atom lst)
(if (= key lst)
0
)
)
( (and (atom (car lst)) (atom (cdr lst)))
(cond
( (= key (car lst)) -1)
( (= key (cdr lst)) 1)
)
)
( (= (setq x (car lst)) key)
(/ n 2)
)
( (> x key)
(bfind1 key (cadr lst) (/ n 2))
)
( (setq k (bfind1 key (cddr lst) (/ (1- n) 2)))
(1+ (+ (/ n 2) k))
)
)
)
(defun c:ccc()
(setq n 0 )
(repeat 10
(princ "nN is :")
(princ (- n (/ n 2) 1))
(princ "na N is :")
(princ (/ (1- n) 2))
(setq n (1+ n))
)
(princ)
)