tests/avltree.pure.lisp

   1 (load "bbtree-test-util.lisp")
   2 (use-package "SB-INT")
   3
   4 #-sb-thread (invoke-restart 'run-tests::skip-file) ;; some of the symbols below disappear
   5
   6 (import 'sb-thread::(avlnode-key avlnode-data avlnode-left avlnode-right
   7                      avl-find<= avl-find>=
   8                      avl-insert avl-delete avl-find
   9                      avl-balance-factor avl-count))
  10
  11 (defun tree-to-dot (tree output)
  12   (with-open-file (stream output :direction :output :if-exists :supersede)
  13     (format stream "digraph G {
  14 node [shape=record];~%")
  15     (named-let recurse ((node tree))
  16       (when node
  17         (let ((key (avlnode-key node)))
  18           (format stream "node~d [label=\"~d\"];~%" key key)
  19           (awhen (avlnode-left node)
  20             (format stream "node~d:sw -> node~d;~%" key (avlnode-key it))
  21             (recurse it))
  22           (awhen (avlnode-right node)
  23             (format stream "node~d:se -> node~d;~%" key (avlnode-key it))
  24             (recurse it)))))
  25     (format stream "}~%"))
  26   tree)
  27
  28 (defun avl-verify-invariants (tree)
  29   ;; ensure that it's a search tree
  30   (named-let recurse ((node tree) (min most-negative-fixnum) (max most-positive-fixnum))
  31     (when node
  32       (let ((key (avlnode-key node)))
  33         (assert (<= min key max))
  34         (recurse (avlnode-left node) min (1- key))
  35         (recurse (avlnode-right node) (1+ key) max))))
  36   ;; and as balanced as required
  37   (named-let recurse ((node tree))
  38     (when node
  39       (unless (<= -1 (avl-balance-factor node) +1)
  40         (error "balance invariant failed on node ~d. b=~d~%"
  41                (avlnode-key node) (avl-balance-factor node)))
  42       (recurse (avlnode-left node))
  43       (recurse (avlnode-right node)))))
  44
  45 (defun random-operations (n-trials n-ops print
  46                           &aux (keys (make-array 5000 :fill-pointer 0))
  47                                events)
  48   (dotimes (iter n-trials)
  49     (when print
  50       (format t "Trial ~d " iter)
  51       (force-output))
  52     (let (tree (prev-op :delete))
  53       (setf (fill-pointer keys) 0)
  54       (loop
  55        for event from 0 repeat n-ops do
  56        (assert (= (avl-count tree) (length keys)))
  57        (let ((op
  58               (if (< (random 10) 5)
  59                   prev-op
  60                   (if (or (null tree)
  61                           (< (random 10)
  62                              (let ((ct (length keys)))
  63                                (cond ((< ct  100) 8)
  64                                      ((< ct  500) 7)
  65                                      ((< ct 1000) 6)
  66                                      (t 1)))))
  67                       :insert
  68                       :delete))))
  69          (when (and (eq op :delete) (zerop (length keys)))
  70            (setq op :insert))
  71          (setq prev-op op)
  72          (when print
  73            (write-char (if (eq op :insert) #\+ #\-)))
  74          (ecase op
  75           (:insert
  76            (flet ((new-key () (random most-positive-fixnum)))
  77              (let ((key (new-key)))
  78                (loop while (avl-find key tree)
  79                      do (setq key (new-key)))
  80                (push `(:insert . ,key) events)
  81                (setq tree (avl-insert tree key (- key)))
  82                (vector-push-extend key keys))))
  83           (:delete
  84            (let* ((i (random (length keys)))
  85                   (key (aref keys i)))
  86              (push `(:delete . ,key) events)
  87              (setq tree (avl-delete key tree))
  88              (assert (not (avl-find key tree)))
  89              (setf (aref keys i) (aref keys (1- (length keys))))
  90              (decf (fill-pointer keys)))))
  91          (avl-verify-invariants tree)
  92          (dotimes (i (length keys))
  93            (let* ((key (aref keys i))
  94                   (node (avl-find key tree)))
  95              (unless (and node (= (avlnode-data node) (- key)))
  96                (error "failed to find ~s~%" key)))))))
  97     (when print
  98       (format t " ~d keys~%" (length keys)))))
  99
 100 (test-util:with-test (:name :avltree-random-tester)
 101   (random-operations 10 10 nil)
 102   (random-operations 10 200 nil))
 103
 104 (defun test-avlfind-inexact (n-nodes n-iterations)
 105   (bbtree-test:test-find-inexact-macro avl-insert avl-find<= avl-find>= avlnode-key))
 106
 107 (test-util:with-test (:name :avl-find-inexact)
 108   (bbtree-test:exercise-find-inexact 'test-avlfind-inexact))