【lisp】Interval Tree 区间树

admin1

区间树

考虑这样一种情况，我们有一组间隔，并且我们需要有效地执行以下操作。
1） 加一个间隔
2） 取消间隔
3） 给定一个区间x，查找x是否与任何现有区间重叠。


[code];;;http://www.theswamp.org/index.php?topic=49783.msg549758#msg549758
(defun c:tt()

(setq startIntervalLst
  '(
    ((0)     (15 20) 40)
    ((0 0)   (10 30) 30)
    ((0 0 0) ( 5 20) 20)
    ((0 0 1) (12 15) 15)
    ((0 1)   (17 19) 40)
    ((0 1 1) (30 40) 40)
  )
)
(setq intervalLst startIntervalLst)
(setq intervalLst (IntervalTreeAdd intervalLst '(3 8) '(0)))
  )

;;;(
;;;  ((0 0 0 0) (3 8) 8)
;;;  ((0) (15 20) 40)
;;;  ((0 0) (10 30) 30)
;;;  ((0 0 0) (5 20) 20)
;;;  ((0 0 1) (12 15) 15)
;;;  ((0 1) (17 19) 40)
;;;  ((0 1 1) (30 40) 40)
;;;  )

  

; (setq intervalLst startIntervalLst)
; (setq intervalLst (IntervalTreeAdd intervalLst '(3 8) '(0)))
(defun IntervalTreeAdd (intervalLst interval node / nodeLst)
  (if (setq nodeLst (assoc node intervalLst))
    (progn
      (if (< (caddr nodeLst) (cadr interval))
        (setq intervalLst
          (subst
            (list node (cadr nodeLst) (cadr interval)) ; New max value.
            nodeLst
            intervalLst
          )
        )
      )
      (IntervalTreeAdd
        intervalLst
        interval
        (append node (if (<= (car interval) (caadr nodeLst)) '(0) '(1))) ; Left or right branch.
      )
    )
    (cons
      (list node interval (cadr interval))
      intervalLst
    )
  )
)

; (IntervalTreeOverlap intervalLst '(3 8) '(0)) nil
; Return value: first overlap found.
(defun IntervalTreeOverlap (intervalLst interval node / nodeLst)
  (if (setq nodeLst (assoc node intervalLst))
    (cond
      ((> (car interval) (caddr nodeLst))
        nil
      )
      ((IntervalOverlap_P interval (cadr nodeLst))
        (cadr nodeLst)
      )
      ((IntervalTreeOverlap intervalLst interval (append node '(0)))
      )
      ((IntervalTreeOverlap intervalLst interval (append node '(1)))
      )
    )
  )
)

; (IntervalOverlap_P '(1 5) '(3 8)) T
(defun IntervalOverlap_P (intervalA intervalB / staA endA staB endB)
  (setq staA (car intervalA))
  (setq endA (cadr intervalA))
  (setq staB (car intervalB))
  (setq endB (cadr intervalB))
  (or
    (<= staA staB endA)
    (<= staA endB endA)
    (<= staB staA endB)
    (<= staB endA endB)
  )
)[/code]