二叉树

;;;=============================================================
;;;用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)
)