二叉树

用Lisp构建二叉树： 呵呵，权当玩玩。

;;;=============================================================
;;;用AutoLISP构建一个二叉树(Construct a Binary Search tree)     
;;;从中间分开，直到分得只是剩下两个元素或者一个                 
;;;此结构用于查找一个元素，使得单次查找的时间为O(n) = log(n)    
;;;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) 
;;;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)
  (defun Print-Beginning ()
    (princ "\nStatement                         Times    Elapse(ms)    Average(ms/time)")
    (princ "\n-------------------------------------------------------------------------")
    (princ)
  )
  (defun Print-Result (lst)
    (defun Princ-Column (str value / s)
      (setq s (vl-princ-to-string value))
      (princ s)
      (repeat (- (strlen str) (strlen s))
        (princ " ")
      )
    )
    (princ "\n")
    (princ-Column "Statement                         " (car lst)) 
    (princ-Column "Times    " (cadr lst)) 
    (princ-Column "Elapse(ms)    " (caddr lst))
    (princ-Column "Average(ms/time)" (cadddr lst))
  )
  
  (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))
  (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 (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更快。                  
;;;然后从中间找起，如果大于中间，就找右边，小于则找左边，直到找
;;;找完。这个没用递归，在内存上可能会稍微有优势，但是对于速度，
;;;其实跟二叉树相差不大。                                      
;;;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))
  )
)


;;;============================================================
;;;测试用函数(benchMark function)                              
;;;============================================================
(defun Benchmark (func funName times / t0 t1 Speed res)
  (setq t0 (getvar "TDUSRTIMER"))
  (repeat times
    (setq res (eval func))
  )
  (setq t1 (* (- (getvar "TDUSRTIMER") t0) 86400000))
  (setq speed (/ t1 times))
  ;(princ (strcat "\nIt takes: " (rtos t1 2 6) " Seconds by " funName))
  ;(princ (strcat ".\nTotal times: " (itoa times)))
  ;(princ (strcat ".\nAverage performance: " (rtos speed 2 6) " Seconds/time.\n"))
  (list func times t1 Speed)
)