comparison lisp/emacs-lisp/avl-tree.el @ 82901:18391b91e11f

Move things around; munge whitespace, indentation; nfc.

82900:0ff5cfe89663

;; count, which is the difference in depth of the left and right
;; sub-trees.

;;; Code:

(defmacro avl-tree-node-left (node)
  ;; Return the left pointer of NODE.
  `(aref ,node 0))

(defmacro avl-tree-node-right (node)

  ;; NODE is the node, and BRANCH is the branch.
  ;; 0 for left pointer, 1 for the right pointer and 2 for the data.
  ;; NEWVAL is new value of the branch."
  `(aset ,node ,branch ,newval))

;;; ================================================================
;;;        Functions and macros handling an AVL tree node.

(defmacro avl-tree-node-create (left right data balance)
  ;; Create and return an avl-tree node.
  `(vector ,left ,right ,data ,balance))

(defmacro avl-tree-node-balance (node)
  ;; Return the balance field of a node.
  `(aref ,node 3))

(defmacro avl-tree-node-set-balance (node newbal)

;;                          Deleting data

(defun avl-tree-del-balance1 (node branch)
  ;; Rebalance a tree and return t if the height of the tree has shrunk.
  (let* ((br (avl-tree-node-branch node branch))
         p1
         b1
         p2
         b2
         result)
    (cond
     ((< (avl-tree-node-balance br) 0)
      (avl-tree-node-set-balance br 0)
      t)

        (avl-tree-node-set-balance p2 0)
        t)))))

(defun avl-tree-del-balance2 (node branch)
  (let* ((br (avl-tree-node-branch node branch))
         p1
         b1
         p2
         b2
         result)
    (cond
     ((> (avl-tree-node-balance br) 0)
      (avl-tree-node-set-balance br 0)
      t)

        (avl-tree-node-set-branch node branch p2)
        (avl-tree-node-set-balance p2 0)
        t)))))

(defun avl-tree-do-del-internal (node branch q)

  (let* ((br (avl-tree-node-branch node branch)))
    (if (avl-tree-node-right br)
        (if (avl-tree-do-del-internal br +1 q)
            (avl-tree-del-balance2 node branch))
      (avl-tree-node-set-data q (avl-tree-node-data br))
      (avl-tree-node-set-branch node branch
                            (avl-tree-node-left br))
      t)))

(defun avl-tree-do-delete (cmpfun root branch data)
  ;; Return t if the height of the tree has shrunk.
  (let* ((br (avl-tree-node-branch root branch)))

;;                           Entering data

(defun avl-tree-enter-balance1 (node branch)
  ;; Rebalance a tree and return t if the height of the tree has grown.
  (let* ((br (avl-tree-node-branch node branch))
         p1
         p2
         b2
         result)
    (cond
     ((< (avl-tree-node-balance br) 0)
      (avl-tree-node-set-balance br 0)
      nil)

      nil))))

(defun avl-tree-enter-balance2 (node branch)
  ;; Return t if the tree has grown.
  (let* ((br (avl-tree-node-branch node branch))
         p1
         p2
         b2)
    (cond
     ((> (avl-tree-node-balance br) 0)
      (avl-tree-node-set-balance br 0)
      nil)

  ;; Return t if height of tree ROOT has grown.  INTERNAL USE ONLY.
  (let ((br (avl-tree-node-branch root branch)))
    (cond
     ((null br)
      ;; Data not in tree, insert it.
      (avl-tree-node-set-branch root branch
                            (avl-tree-node-create nil nil data 0))
      t)

     ((funcall cmpfun data (avl-tree-node-data br))
      (and (avl-tree-do-enter cmpfun
                              br
                              0 data)
           (avl-tree-enter-balance2 root branch)))

     ((funcall cmpfun (avl-tree-node-data br) data)
      (and (avl-tree-do-enter cmpfun
                              br
                              1 data)
           (avl-tree-enter-balance1 root branch)))

     (t
      (avl-tree-node-set-data br data)
      nil))))

(defun avl-tree-do-copy (root)
  ;; Copy the tree with ROOT as root.
  ;; Highly recursive. INTERNAL USE ONLY.
  (if (null root)
      nil
    (avl-tree-node-create (avl-tree-do-copy (avl-tree-node-left root))
                          (avl-tree-do-copy (avl-tree-node-right root))
                          (avl-tree-node-data root)
                          (avl-tree-node-balance root))))


;;; ================================================================
;;;       The public functions which operate on AVL trees.

        (setq node (avl-tree-node-left node)))
       ((funcall compare-function (avl-tree-node-data node) data)
        (setq node (avl-tree-node-right node)))
       (t
        (setq found t))))

    (if node
        (avl-tree-node-data node)
      nil)))

(defun avl-tree-map (__map-function__ tree)
  "Apply MAP-FUNCTION to all elements in the avl tree TREE."
  (avl-tree-mapc
   (function (lambda (node)
               (avl-tree-node-set-data node
                                   (funcall __map-function__
                                            (avl-tree-node-data node)))))
   (avl-tree-root tree)))

(defun avl-tree-first (tree)
  "Return the first element in TREE, or nil if TREE is empty."
  (let ((node (avl-tree-root tree)))

          (avl-tree-node-data node))
      nil)))

(defun avl-tree-copy (tree)
  "Return a copy of the avl tree TREE."
  (let ((new-tree (avl-tree-create
                   (avl-tree-cmpfun tree))))
    (avl-tree-node-set-left (avl-tree-dummyroot new-tree)
                        (avl-tree-do-copy (avl-tree-root tree)))
    new-tree))

(defun avl-tree-flatten (tree)
  "Return a sorted list containing all elements of TREE."
  (nreverse
   (let ((treelist nil))
     (avl-tree-mapc (function (lambda (node)
                                (setq treelist (cons (avl-tree-node-data node)
                                                     treelist))))
                    (avl-tree-root tree))
     treelist)))

(defun avl-tree-size (tree)
  "Return the number of elements in TREE."
  (let ((treesize 0))
    (avl-tree-mapc (function (lambda (data)
                               (setq treesize (1+ treesize))
                               data))
                   (avl-tree-root tree))
    treesize))

(defun avl-tree-clear (tree)
  "Clear the avl tree TREE."
  (avl-tree-node-set-left (avl-tree-dummyroot tree) nil))

82901:18391b91e11f

;; count, which is the difference in depth of the left and right
;; sub-trees.

;;; Code:

;;; ================================================================
;;;        Functions and macros handling an AVL tree node.

(defmacro avl-tree-node-create (left right data balance)
  ;; Create and return an avl-tree node.
  `(vector ,left ,right ,data ,balance))

(defmacro avl-tree-node-left (node)
  ;; Return the left pointer of NODE.
  `(aref ,node 0))

(defmacro avl-tree-node-right (node)

  ;; NODE is the node, and BRANCH is the branch.
  ;; 0 for left pointer, 1 for the right pointer and 2 for the data.
  ;; NEWVAL is new value of the branch."
  `(aset ,node ,branch ,newval))

(defmacro avl-tree-node-balance (node)
  ;; Return the balance field of a node.
  `(aref ,node 3))

(defmacro avl-tree-node-set-balance (node newbal)

;;                          Deleting data

(defun avl-tree-del-balance1 (node branch)
  ;; Rebalance a tree and return t if the height of the tree has shrunk.
  (let* ((br (avl-tree-node-branch node branch))
         p1 b1 p2 b2 result)
    (cond
     ((< (avl-tree-node-balance br) 0)
      (avl-tree-node-set-balance br 0)
      t)

        (avl-tree-node-set-balance p2 0)
        t)))))

(defun avl-tree-del-balance2 (node branch)
  (let* ((br (avl-tree-node-branch node branch))
         p1 b1 p2 b2 result)
    (cond
     ((> (avl-tree-node-balance br) 0)
      (avl-tree-node-set-balance br 0)
      t)

        (avl-tree-node-set-branch node branch p2)
        (avl-tree-node-set-balance p2 0)
        t)))))

(defun avl-tree-do-del-internal (node branch q)
  (let* ((br (avl-tree-node-branch node branch)))
    (if (avl-tree-node-right br)
        (if (avl-tree-do-del-internal br +1 q)
            (avl-tree-del-balance2 node branch))
      (avl-tree-node-set-data q (avl-tree-node-data br))
      (avl-tree-node-set-branch node branch
                                (avl-tree-node-left br))
      t)))

(defun avl-tree-do-delete (cmpfun root branch data)
  ;; Return t if the height of the tree has shrunk.
  (let* ((br (avl-tree-node-branch root branch)))

;;                           Entering data

(defun avl-tree-enter-balance1 (node branch)
  ;; Rebalance a tree and return t if the height of the tree has grown.
  (let* ((br (avl-tree-node-branch node branch))
         p1 p2 b2 result)
    (cond
     ((< (avl-tree-node-balance br) 0)
      (avl-tree-node-set-balance br 0)
      nil)

      nil))))

(defun avl-tree-enter-balance2 (node branch)
  ;; Return t if the tree has grown.
  (let* ((br (avl-tree-node-branch node branch))
         p1 p2 b2)
    (cond
     ((> (avl-tree-node-balance br) 0)
      (avl-tree-node-set-balance br 0)
      nil)

  ;; Return t if height of tree ROOT has grown.  INTERNAL USE ONLY.
  (let ((br (avl-tree-node-branch root branch)))
    (cond
     ((null br)
      ;; Data not in tree, insert it.
      (avl-tree-node-set-branch
       root branch (avl-tree-node-create nil nil data 0))
      t)

     ((funcall cmpfun data (avl-tree-node-data br))
      (and (avl-tree-do-enter cmpfun br 0 data)
           (avl-tree-enter-balance2 root branch)))

     ((funcall cmpfun (avl-tree-node-data br) data)
      (and (avl-tree-do-enter cmpfun br 1 data)
           (avl-tree-enter-balance1 root branch)))

     (t
      (avl-tree-node-set-data br data)
      nil))))

(defun avl-tree-do-copy (root)
  ;; Copy the tree with ROOT as root.
  ;; Highly recursive. INTERNAL USE ONLY.
  (if (null root)
      nil
    (avl-tree-node-create
     (avl-tree-do-copy (avl-tree-node-left root))
     (avl-tree-do-copy (avl-tree-node-right root))
     (avl-tree-node-data root)
     (avl-tree-node-balance root))))


;;; ================================================================
;;;       The public functions which operate on AVL trees.

        (setq node (avl-tree-node-left node)))
       ((funcall compare-function (avl-tree-node-data node) data)
        (setq node (avl-tree-node-right node)))
       (t
        (setq found t))))
    (if node
        (avl-tree-node-data node)
      nil)))

(defun avl-tree-map (__map-function__ tree)
  "Apply MAP-FUNCTION to all elements in the avl tree TREE."
  (avl-tree-mapc
   (function (lambda (node)
               (avl-tree-node-set-data
                node (funcall __map-function__
                              (avl-tree-node-data node)))))
   (avl-tree-root tree)))

(defun avl-tree-first (tree)
  "Return the first element in TREE, or nil if TREE is empty."
  (let ((node (avl-tree-root tree)))

          (avl-tree-node-data node))
      nil)))

(defun avl-tree-copy (tree)
  "Return a copy of the avl tree TREE."
  (let ((new-tree (avl-tree-create (avl-tree-cmpfun tree))))
    (avl-tree-node-set-left (avl-tree-dummyroot new-tree)
                            (avl-tree-do-copy (avl-tree-root tree)))
    new-tree))

(defun avl-tree-flatten (tree)
  "Return a sorted list containing all elements of TREE."
  (nreverse
   (let ((treelist nil))
     (avl-tree-mapc
      (function (lambda (node)
                  (setq treelist (cons (avl-tree-node-data node)
                                       treelist))))
      (avl-tree-root tree))
     treelist)))

(defun avl-tree-size (tree)
  "Return the number of elements in TREE."
  (let ((treesize 0))
    (avl-tree-mapc
     (function (lambda (data)
                 (setq treesize (1+ treesize))
                 data))
     (avl-tree-root tree))
    treesize))

(defun avl-tree-clear (tree)
  "Clear the avl tree TREE."
  (avl-tree-node-set-left (avl-tree-dummyroot tree) nil))