diff options
| author | Stefan Monnier | 2007-08-31 20:15:34 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2007-08-31 20:15:34 +0000 |
| commit | afdd184ca8b15525b1830dd0431126ff2528fc55 (patch) | |
| tree | b3b33f6fa4f275e8afa38aa0ffb20fa23104f3c3 | |
| parent | e35a28cda61cf91d1135468816c0d765670ec9d0 (diff) | |
| download | emacs-afdd184ca8b15525b1830dd0431126ff2528fc55.tar.gz emacs-afdd184ca8b15525b1830dd0431126ff2528fc55.zip | |
Use defstruct rather than macros.
Change naming to use "avl-tree--" for internal functions.
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/emacs-lisp/avl-tree.el | 526 |
2 files changed, 237 insertions, 294 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 84fca465933..901ded2ee39 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2007-08-31 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/avl-tree.el: Use defstruct rather than macros. | ||
| 4 | Change naming to use "avl-tree--" for internal functions. | ||
| 5 | |||
| 1 | 2007-08-31 Dan Nicolaescu <dann@ics.uci.edu> | 6 | 2007-08-31 Dan Nicolaescu <dann@ics.uci.edu> |
| 2 | 7 | ||
| 3 | * term/x-win.el (x-menu-bar-open): Delete duplicated function from | 8 | * term/x-win.el (x-menu-bar-open): Delete duplicated function from |
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index ffac825acac..b8cf8362386 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el | |||
| @@ -28,345 +28,306 @@ | |||
| 28 | 28 | ||
| 29 | ;;; Commentary: | 29 | ;;; Commentary: |
| 30 | 30 | ||
| 31 | ;; An AVL tree is a nearly-perfect balanced binary tree. A tree | 31 | ;; An AVL tree is a nearly-perfect balanced binary tree. A tree consists of |
| 32 | ;; consists of two cons cells, the first one holding the tag | 32 | ;; two elements, the root node and the compare function. The actual tree |
| 33 | ;; 'AVL-TREE in the car cell, and the second one having the tree | 33 | ;; has a dummy node as its root with the real root in the left pointer. |
| 34 | ;; in the car and the compare function in the cdr cell. The tree has | ||
| 35 | ;; a dummy node as its root with the real tree in the left pointer. | ||
| 36 | ;; | 34 | ;; |
| 37 | ;; Each node of the tree consists of one data element, one left | 35 | ;; Each node of the tree consists of one data element, one left |
| 38 | ;; sub-tree and one right sub-tree. Each node also has a balance | 36 | ;; sub-tree and one right sub-tree. Each node also has a balance |
| 39 | ;; count, which is the difference in depth of the left and right | 37 | ;; count, which is the difference in depth of the left and right |
| 40 | ;; sub-trees. | 38 | ;; sub-trees. |
| 41 | ;; | 39 | ;; |
| 42 | ;; The "public" functions (prefixed with "avl-tree") are: | 40 | ;; The functions with names of the form "avl-tree--" are intended for |
| 43 | ;; -create, -p, -compare-function, -empty, -enter, -delete, | 41 | ;; internal use only. |
| 44 | ;; -member, -map, -first, -last, -copy, -flatten, -size, -clear. | ||
| 45 | 42 | ||
| 46 | ;;; Code: | 43 | ;;; Code: |
| 47 | 44 | ||
| 48 | ;;; ================================================================ | 45 | (eval-when-compile (require 'cl)) |
| 49 | ;;; Functions and macros handling an AVL tree node. | 46 | |
| 50 | 47 | ;; ================================================================ | |
| 51 | (defmacro avl-tree-node-create (left right data balance) | 48 | ;;; Functions and macros handling an AVL tree node. |
| 52 | ;; Create and return an avl-tree node. | 49 | |
| 53 | `(vector ,left ,right ,data ,balance)) | 50 | (defstruct (avl-tree--node |
| 54 | 51 | ;; We force a representation without tag so it matches the | |
| 55 | (defmacro avl-tree-node-left (node) | 52 | ;; pre-defstruct representation. Also we use the underlying |
| 56 | ;; Return the left pointer of NODE. | 53 | ;; representation in the implementation of avl-tree--node-branch. |
| 57 | `(aref ,node 0)) | 54 | (:type vector) |
| 58 | 55 | (:constructor nil) | |
| 59 | (defmacro avl-tree-node-right (node) | 56 | (:constructor avl-tree--node-create (left right data balance)) |
| 60 | ;; Return the right pointer of NODE. | 57 | (:copier nil)) |
| 61 | `(aref ,node 1)) | 58 | left right data balance) |
| 62 | 59 | ||
| 63 | (defmacro avl-tree-node-data (node) | 60 | (defalias 'avl-tree--node-branch 'aref |
| 64 | ;; Return the data of NODE. | 61 | ;; This implementation is efficient but breaks the defstruct abstraction. |
| 65 | `(aref ,node 2)) | 62 | ;; An alternative could be |
| 66 | 63 | ;; (funcall (aref [avl-tree-left avl-tree-right avl-tree-data] branch) node) | |
| 67 | (defmacro avl-tree-node-set-left (node newleft) | ||
| 68 | ;; Set the left pointer of NODE to NEWLEFT. | ||
| 69 | `(aset ,node 0 ,newleft)) | ||
| 70 | |||
| 71 | (defmacro avl-tree-node-set-right (node newright) | ||
| 72 | ;; Set the right pointer of NODE to NEWRIGHT. | ||
| 73 | `(aset ,node 1 ,newright)) | ||
| 74 | |||
| 75 | (defmacro avl-tree-node-set-data (node newdata) | ||
| 76 | ;; Set the data of NODE to NEWDATA. | ||
| 77 | `(aset ,node 2 ,newdata)) | ||
| 78 | |||
| 79 | (defmacro avl-tree-node-branch (node branch) | ||
| 80 | "Get value of a branch of a node. | 64 | "Get value of a branch of a node. |
| 81 | 65 | ||
| 82 | NODE is the node, and BRANCH is the branch. | 66 | NODE is the node, and BRANCH is the branch. |
| 83 | 0 for left pointer, 1 for right pointer and 2 for the data.\"" | 67 | 0 for left pointer, 1 for right pointer and 2 for the data.\" |
| 84 | `(aref ,node ,branch)) | 68 | \(fn node branch)") |
| 85 | 69 | ;; The funcall/aref trick doesn't work for the setf method, unless we try | |
| 86 | (defmacro avl-tree-node-set-branch (node branch newval) | 70 | ;; and access the underlying setter function, but this wouldn't be |
| 87 | "Set value of a branch of a node. | 71 | ;; portable either. |
| 88 | 72 | (defsetf avl-tree--node-branch aset) | |
| 89 | NODE is the node, and BRANCH is the branch. | ||
| 90 | 0 for left pointer, 1 for the right pointer and 2 for the data. | ||
| 91 | NEWVAL is new value of the branch.\"" | ||
| 92 | `(aset ,node ,branch ,newval)) | ||
| 93 | |||
| 94 | (defmacro avl-tree-node-balance (node) | ||
| 95 | ;; Return the balance field of a node. | ||
| 96 | `(aref ,node 3)) | ||
| 97 | |||
| 98 | (defmacro avl-tree-node-set-balance (node newbal) | ||
| 99 | ;; Set the balance field of a node. | ||
| 100 | `(aset ,node 3 ,newbal)) | ||
| 101 | 73 | ||
| 102 | 74 | ||
| 103 | ;;; ================================================================ | 75 | ;; ================================================================ |
| 104 | ;;; Internal functions for use in the AVL tree package | 76 | ;;; Internal functions for use in the AVL tree package |
| 105 | 77 | ||
| 106 | (defmacro avl-tree-root (tree) | 78 | (defstruct (avl-tree- |
| 79 | ;; A tagged list is the pre-defstruct representation. | ||
| 80 | ;; (:type list) | ||
| 81 | :named | ||
| 82 | (:constructor nil) | ||
| 83 | (:constructor avl-tree-create (cmpfun)) | ||
| 84 | (:predicate avl-tree-p) | ||
| 85 | (:copier nil)) | ||
| 86 | (dummyroot (avl-tree--node-create nil nil nil 0)) | ||
| 87 | cmpfun) | ||
| 88 | |||
| 89 | (defmacro avl-tree--root (tree) | ||
| 107 | ;; Return the root node for an avl-tree. INTERNAL USE ONLY. | 90 | ;; Return the root node for an avl-tree. INTERNAL USE ONLY. |
| 108 | `(avl-tree-node-left (car (cdr ,tree)))) | 91 | `(avl-tree--node-left (avl-tree--dummyroot tree))) |
| 109 | 92 | (defsetf avl-tree--root (tree) (node) | |
| 110 | (defmacro avl-tree-dummyroot (tree) | 93 | `(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node)) |
| 111 | ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY. | ||
| 112 | `(car (cdr ,tree))) | ||
| 113 | |||
| 114 | (defmacro avl-tree-cmpfun (tree) | ||
| 115 | ;; Return the compare function of AVL tree TREE. INTERNAL USE ONLY. | ||
| 116 | `(cdr (cdr ,tree))) | ||
| 117 | 94 | ||
| 118 | ;; ---------------------------------------------------------------- | 95 | ;; ---------------------------------------------------------------- |
| 119 | ;; Deleting data | 96 | ;; Deleting data |
| 120 | 97 | ||
| 121 | (defun avl-tree-del-balance1 (node branch) | 98 | (defun avl-tree--del-balance1 (node branch) |
| 122 | ;; Rebalance a tree and return t if the height of the tree has shrunk. | 99 | ;; Rebalance a tree and return t if the height of the tree has shrunk. |
| 123 | (let ((br (avl-tree-node-branch node branch)) | 100 | (let ((br (avl-tree--node-branch node branch)) |
| 124 | p1 b1 p2 b2 result) | 101 | p1 b1 p2 b2 result) |
| 125 | (cond | 102 | (cond |
| 126 | ((< (avl-tree-node-balance br) 0) | 103 | ((< (avl-tree--node-balance br) 0) |
| 127 | (avl-tree-node-set-balance br 0) | 104 | (setf (avl-tree--node-balance br) 0) |
| 128 | t) | 105 | t) |
| 129 | 106 | ||
| 130 | ((= (avl-tree-node-balance br) 0) | 107 | ((= (avl-tree--node-balance br) 0) |
| 131 | (avl-tree-node-set-balance br +1) | 108 | (setf (avl-tree--node-balance br) +1) |
| 132 | nil) | 109 | nil) |
| 133 | 110 | ||
| 134 | (t | 111 | (t |
| 135 | ;; Rebalance. | 112 | ;; Rebalance. |
| 136 | (setq p1 (avl-tree-node-right br) | 113 | (setq p1 (avl-tree--node-right br) |
| 137 | b1 (avl-tree-node-balance p1)) | 114 | b1 (avl-tree--node-balance p1)) |
| 138 | (if (>= b1 0) | 115 | (if (>= b1 0) |
| 139 | ;; Single RR rotation. | 116 | ;; Single RR rotation. |
| 140 | (progn | 117 | (progn |
| 141 | (avl-tree-node-set-right br (avl-tree-node-left p1)) | 118 | (setf (avl-tree--node-right br) (avl-tree--node-left p1)) |
| 142 | (avl-tree-node-set-left p1 br) | 119 | (setf (avl-tree--node-left p1) br) |
| 143 | (if (= 0 b1) | 120 | (if (= 0 b1) |
| 144 | (progn | 121 | (progn |
| 145 | (avl-tree-node-set-balance br +1) | 122 | (setf (avl-tree--node-balance br) +1) |
| 146 | (avl-tree-node-set-balance p1 -1) | 123 | (setf (avl-tree--node-balance p1) -1) |
| 147 | (setq result nil)) | 124 | (setq result nil)) |
| 148 | (avl-tree-node-set-balance br 0) | 125 | (setf (avl-tree--node-balance br) 0) |
| 149 | (avl-tree-node-set-balance p1 0) | 126 | (setf (avl-tree--node-balance p1) 0) |
| 150 | (setq result t)) | 127 | (setq result t)) |
| 151 | (avl-tree-node-set-branch node branch p1) | 128 | (setf (avl-tree--node-branch node branch) p1) |
| 152 | result) | 129 | result) |
| 153 | 130 | ||
| 154 | ;; Double RL rotation. | 131 | ;; Double RL rotation. |
| 155 | (setq p2 (avl-tree-node-left p1) | 132 | (setq p2 (avl-tree--node-left p1) |
| 156 | b2 (avl-tree-node-balance p2)) | 133 | b2 (avl-tree--node-balance p2)) |
| 157 | (avl-tree-node-set-left p1 (avl-tree-node-right p2)) | 134 | (setf (avl-tree--node-left p1) (avl-tree--node-right p2)) |
| 158 | (avl-tree-node-set-right p2 p1) | 135 | (setf (avl-tree--node-right p2) p1) |
| 159 | (avl-tree-node-set-right br (avl-tree-node-left p2)) | 136 | (setf (avl-tree--node-right br) (avl-tree--node-left p2)) |
| 160 | (avl-tree-node-set-left p2 br) | 137 | (setf (avl-tree--node-left p2) br) |
| 161 | (if (> b2 0) | 138 | (setf (avl-tree--node-balance br) (if (> b2 0) -1 0)) |
| 162 | (avl-tree-node-set-balance br -1) | 139 | (setf (avl-tree--node-balance p1) (if (< b2 0) +1 0)) |
| 163 | (avl-tree-node-set-balance br 0)) | 140 | (setf (avl-tree--node-branch node branch) p2) |
| 164 | (if (< b2 0) | 141 | (setf (avl-tree--node-balance p2) 0) |
| 165 | (avl-tree-node-set-balance p1 +1) | ||
| 166 | (avl-tree-node-set-balance p1 0)) | ||
| 167 | (avl-tree-node-set-branch node branch p2) | ||
| 168 | (avl-tree-node-set-balance p2 0) | ||
| 169 | t))))) | 142 | t))))) |
| 170 | 143 | ||
| 171 | (defun avl-tree-del-balance2 (node branch) | 144 | (defun avl-tree--del-balance2 (node branch) |
| 172 | (let ((br (avl-tree-node-branch node branch)) | 145 | (let ((br (avl-tree--node-branch node branch)) |
| 173 | p1 b1 p2 b2 result) | 146 | p1 b1 p2 b2 result) |
| 174 | (cond | 147 | (cond |
| 175 | ((> (avl-tree-node-balance br) 0) | 148 | ((> (avl-tree--node-balance br) 0) |
| 176 | (avl-tree-node-set-balance br 0) | 149 | (setf (avl-tree--node-balance br) 0) |
| 177 | t) | 150 | t) |
| 178 | 151 | ||
| 179 | ((= (avl-tree-node-balance br) 0) | 152 | ((= (avl-tree--node-balance br) 0) |
| 180 | (avl-tree-node-set-balance br -1) | 153 | (setf (avl-tree--node-balance br) -1) |
| 181 | nil) | 154 | nil) |
| 182 | 155 | ||
| 183 | (t | 156 | (t |
| 184 | ;; Rebalance. | 157 | ;; Rebalance. |
| 185 | (setq p1 (avl-tree-node-left br) | 158 | (setq p1 (avl-tree--node-left br) |
| 186 | b1 (avl-tree-node-balance p1)) | 159 | b1 (avl-tree--node-balance p1)) |
| 187 | (if (<= b1 0) | 160 | (if (<= b1 0) |
| 188 | ;; Single LL rotation. | 161 | ;; Single LL rotation. |
| 189 | (progn | 162 | (progn |
| 190 | (avl-tree-node-set-left br (avl-tree-node-right p1)) | 163 | (setf (avl-tree--node-left br) (avl-tree--node-right p1)) |
| 191 | (avl-tree-node-set-right p1 br) | 164 | (setf (avl-tree--node-right p1) br) |
| 192 | (if (= 0 b1) | 165 | (if (= 0 b1) |
| 193 | (progn | 166 | (progn |
| 194 | (avl-tree-node-set-balance br -1) | 167 | (setf (avl-tree--node-balance br) -1) |
| 195 | (avl-tree-node-set-balance p1 +1) | 168 | (setf (avl-tree--node-balance p1) +1) |
| 196 | (setq result nil)) | 169 | (setq result nil)) |
| 197 | (avl-tree-node-set-balance br 0) | 170 | (setf (avl-tree--node-balance br) 0) |
| 198 | (avl-tree-node-set-balance p1 0) | 171 | (setf (avl-tree--node-balance p1) 0) |
| 199 | (setq result t)) | 172 | (setq result t)) |
| 200 | (avl-tree-node-set-branch node branch p1) | 173 | (setf (avl-tree--node-branch node branch) p1) |
| 201 | result) | 174 | result) |
| 202 | 175 | ||
| 203 | ;; Double LR rotation. | 176 | ;; Double LR rotation. |
| 204 | (setq p2 (avl-tree-node-right p1) | 177 | (setq p2 (avl-tree--node-right p1) |
| 205 | b2 (avl-tree-node-balance p2)) | 178 | b2 (avl-tree--node-balance p2)) |
| 206 | (avl-tree-node-set-right p1 (avl-tree-node-left p2)) | 179 | (setf (avl-tree--node-right p1) (avl-tree--node-left p2)) |
| 207 | (avl-tree-node-set-left p2 p1) | 180 | (setf (avl-tree--node-left p2) p1) |
| 208 | (avl-tree-node-set-left br (avl-tree-node-right p2)) | 181 | (setf (avl-tree--node-left br) (avl-tree--node-right p2)) |
| 209 | (avl-tree-node-set-right p2 br) | 182 | (setf (avl-tree--node-right p2) br) |
| 210 | (if (< b2 0) | 183 | (setf (avl-tree--node-balance br) (if (< b2 0) +1 0)) |
| 211 | (avl-tree-node-set-balance br +1) | 184 | (setf (avl-tree--node-balance p1) (if (> b2 0) -1 0)) |
| 212 | (avl-tree-node-set-balance br 0)) | 185 | (setf (avl-tree--node-branch node branch) p2) |
| 213 | (if (> b2 0) | 186 | (setf (avl-tree--node-balance p2) 0) |
| 214 | (avl-tree-node-set-balance p1 -1) | ||
| 215 | (avl-tree-node-set-balance p1 0)) | ||
| 216 | (avl-tree-node-set-branch node branch p2) | ||
| 217 | (avl-tree-node-set-balance p2 0) | ||
| 218 | t))))) | 187 | t))))) |
| 219 | 188 | ||
| 220 | (defun avl-tree-do-del-internal (node branch q) | 189 | (defun avl-tree--do-del-internal (node branch q) |
| 221 | (let ((br (avl-tree-node-branch node branch))) | 190 | (let ((br (avl-tree--node-branch node branch))) |
| 222 | (if (avl-tree-node-right br) | 191 | (if (avl-tree--node-right br) |
| 223 | (if (avl-tree-do-del-internal br +1 q) | 192 | (if (avl-tree--do-del-internal br +1 q) |
| 224 | (avl-tree-del-balance2 node branch)) | 193 | (avl-tree--del-balance2 node branch)) |
| 225 | (avl-tree-node-set-data q (avl-tree-node-data br)) | 194 | (setf (avl-tree--node-data q) (avl-tree--node-data br)) |
| 226 | (avl-tree-node-set-branch node branch | 195 | (setf (avl-tree--node-branch node branch) |
| 227 | (avl-tree-node-left br)) | 196 | (avl-tree--node-left br)) |
| 228 | t))) | 197 | t))) |
| 229 | 198 | ||
| 230 | (defun avl-tree-do-delete (cmpfun root branch data) | 199 | (defun avl-tree--do-delete (cmpfun root branch data) |
| 231 | ;; Return t if the height of the tree has shrunk. | 200 | ;; Return t if the height of the tree has shrunk. |
| 232 | (let ((br (avl-tree-node-branch root branch))) | 201 | (let ((br (avl-tree--node-branch root branch))) |
| 233 | (cond | 202 | (cond |
| 234 | ((null br) | 203 | ((null br) |
| 235 | nil) | 204 | nil) |
| 236 | 205 | ||
| 237 | ((funcall cmpfun data (avl-tree-node-data br)) | 206 | ((funcall cmpfun data (avl-tree--node-data br)) |
| 238 | (if (avl-tree-do-delete cmpfun br 0 data) | 207 | (if (avl-tree--do-delete cmpfun br 0 data) |
| 239 | (avl-tree-del-balance1 root branch))) | 208 | (avl-tree--del-balance1 root branch))) |
| 240 | 209 | ||
| 241 | ((funcall cmpfun (avl-tree-node-data br) data) | 210 | ((funcall cmpfun (avl-tree--node-data br) data) |
| 242 | (if (avl-tree-do-delete cmpfun br 1 data) | 211 | (if (avl-tree--do-delete cmpfun br 1 data) |
| 243 | (avl-tree-del-balance2 root branch))) | 212 | (avl-tree--del-balance2 root branch))) |
| 244 | 213 | ||
| 245 | (t | 214 | (t |
| 246 | ;; Found it. Let's delete it. | 215 | ;; Found it. Let's delete it. |
| 247 | (cond | 216 | (cond |
| 248 | ((null (avl-tree-node-right br)) | 217 | ((null (avl-tree--node-right br)) |
| 249 | (avl-tree-node-set-branch root branch (avl-tree-node-left br)) | 218 | (setf (avl-tree--node-branch root branch) (avl-tree--node-left br)) |
| 250 | t) | 219 | t) |
| 251 | 220 | ||
| 252 | ((null (avl-tree-node-left br)) | 221 | ((null (avl-tree--node-left br)) |
| 253 | (avl-tree-node-set-branch root branch (avl-tree-node-right br)) | 222 | (setf (avl-tree--node-branch root branch) (avl-tree--node-right br)) |
| 254 | t) | 223 | t) |
| 255 | 224 | ||
| 256 | (t | 225 | (t |
| 257 | (if (avl-tree-do-del-internal br 0 br) | 226 | (if (avl-tree--do-del-internal br 0 br) |
| 258 | (avl-tree-del-balance1 root branch)))))))) | 227 | (avl-tree--del-balance1 root branch)))))))) |
| 259 | 228 | ||
| 260 | ;; ---------------------------------------------------------------- | 229 | ;; ---------------------------------------------------------------- |
| 261 | ;; Entering data | 230 | ;; Entering data |
| 262 | 231 | ||
| 263 | (defun avl-tree-enter-balance1 (node branch) | 232 | (defun avl-tree--enter-balance1 (node branch) |
| 264 | ;; Rebalance a tree and return t if the height of the tree has grown. | 233 | ;; Rebalance a tree and return t if the height of the tree has grown. |
| 265 | (let ((br (avl-tree-node-branch node branch)) | 234 | (let ((br (avl-tree--node-branch node branch)) |
| 266 | p1 p2 b2 result) | 235 | p1 p2 b2 result) |
| 267 | (cond | 236 | (cond |
| 268 | ((< (avl-tree-node-balance br) 0) | 237 | ((< (avl-tree--node-balance br) 0) |
| 269 | (avl-tree-node-set-balance br 0) | 238 | (setf (avl-tree--node-balance br) 0) |
| 270 | nil) | 239 | nil) |
| 271 | 240 | ||
| 272 | ((= (avl-tree-node-balance br) 0) | 241 | ((= (avl-tree--node-balance br) 0) |
| 273 | (avl-tree-node-set-balance br +1) | 242 | (setf (avl-tree--node-balance br) +1) |
| 274 | t) | 243 | t) |
| 275 | 244 | ||
| 276 | (t | 245 | (t |
| 277 | ;; Tree has grown => Rebalance. | 246 | ;; Tree has grown => Rebalance. |
| 278 | (setq p1 (avl-tree-node-right br)) | 247 | (setq p1 (avl-tree--node-right br)) |
| 279 | (if (> (avl-tree-node-balance p1) 0) | 248 | (if (> (avl-tree--node-balance p1) 0) |
| 280 | ;; Single RR rotation. | 249 | ;; Single RR rotation. |
| 281 | (progn | 250 | (progn |
| 282 | (avl-tree-node-set-right br (avl-tree-node-left p1)) | 251 | (setf (avl-tree--node-right br) (avl-tree--node-left p1)) |
| 283 | (avl-tree-node-set-left p1 br) | 252 | (setf (avl-tree--node-left p1) br) |
| 284 | (avl-tree-node-set-balance br 0) | 253 | (setf (avl-tree--node-balance br) 0) |
| 285 | (avl-tree-node-set-branch node branch p1)) | 254 | (setf (avl-tree--node-branch node branch) p1)) |
| 286 | 255 | ||
| 287 | ;; Double RL rotation. | 256 | ;; Double RL rotation. |
| 288 | (setq p2 (avl-tree-node-left p1) | 257 | (setq p2 (avl-tree--node-left p1) |
| 289 | b2 (avl-tree-node-balance p2)) | 258 | b2 (avl-tree--node-balance p2)) |
| 290 | (avl-tree-node-set-left p1 (avl-tree-node-right p2)) | 259 | (setf (avl-tree--node-left p1) (avl-tree--node-right p2)) |
| 291 | (avl-tree-node-set-right p2 p1) | 260 | (setf (avl-tree--node-right p2) p1) |
| 292 | (avl-tree-node-set-right br (avl-tree-node-left p2)) | 261 | (setf (avl-tree--node-right br) (avl-tree--node-left p2)) |
| 293 | (avl-tree-node-set-left p2 br) | 262 | (setf (avl-tree--node-left p2) br) |
| 294 | (if (> b2 0) | 263 | (setf (avl-tree--node-balance br) (if (> b2 0) -1 0)) |
| 295 | (avl-tree-node-set-balance br -1) | 264 | (setf (avl-tree--node-balance p1) (if (< b2 0) +1 0)) |
| 296 | (avl-tree-node-set-balance br 0)) | 265 | (setf (avl-tree--node-branch node branch) p2)) |
| 297 | (if (< b2 0) | 266 | (setf (avl-tree--node-balance (avl-tree--node-branch node branch)) 0) |
| 298 | (avl-tree-node-set-balance p1 +1) | ||
| 299 | (avl-tree-node-set-balance p1 0)) | ||
| 300 | (avl-tree-node-set-branch node branch p2)) | ||
| 301 | (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0) | ||
| 302 | nil)))) | 267 | nil)))) |
| 303 | 268 | ||
| 304 | (defun avl-tree-enter-balance2 (node branch) | 269 | (defun avl-tree--enter-balance2 (node branch) |
| 305 | ;; Return t if the tree has grown. | 270 | ;; Return t if the tree has grown. |
| 306 | (let ((br (avl-tree-node-branch node branch)) | 271 | (let ((br (avl-tree--node-branch node branch)) |
| 307 | p1 p2 b2) | 272 | p1 p2 b2) |
| 308 | (cond | 273 | (cond |
| 309 | ((> (avl-tree-node-balance br) 0) | 274 | ((> (avl-tree--node-balance br) 0) |
| 310 | (avl-tree-node-set-balance br 0) | 275 | (setf (avl-tree--node-balance br) 0) |
| 311 | nil) | 276 | nil) |
| 312 | 277 | ||
| 313 | ((= (avl-tree-node-balance br) 0) | 278 | ((= (avl-tree--node-balance br) 0) |
| 314 | (avl-tree-node-set-balance br -1) | 279 | (setf (avl-tree--node-balance br) -1) |
| 315 | t) | 280 | t) |
| 316 | 281 | ||
| 317 | (t | 282 | (t |
| 318 | ;; Balance was -1 => Rebalance. | 283 | ;; Balance was -1 => Rebalance. |
| 319 | (setq p1 (avl-tree-node-left br)) | 284 | (setq p1 (avl-tree--node-left br)) |
| 320 | (if (< (avl-tree-node-balance p1) 0) | 285 | (if (< (avl-tree--node-balance p1) 0) |
| 321 | ;; Single LL rotation. | 286 | ;; Single LL rotation. |
| 322 | (progn | 287 | (progn |
| 323 | (avl-tree-node-set-left br (avl-tree-node-right p1)) | 288 | (setf (avl-tree--node-left br) (avl-tree--node-right p1)) |
| 324 | (avl-tree-node-set-right p1 br) | 289 | (setf (avl-tree--node-right p1) br) |
| 325 | (avl-tree-node-set-balance br 0) | 290 | (setf (avl-tree--node-balance br) 0) |
| 326 | (avl-tree-node-set-branch node branch p1)) | 291 | (setf (avl-tree--node-branch node branch) p1)) |
| 327 | 292 | ||
| 328 | ;; Double LR rotation. | 293 | ;; Double LR rotation. |
| 329 | (setq p2 (avl-tree-node-right p1) | 294 | (setq p2 (avl-tree--node-right p1) |
| 330 | b2 (avl-tree-node-balance p2)) | 295 | b2 (avl-tree--node-balance p2)) |
| 331 | (avl-tree-node-set-right p1 (avl-tree-node-left p2)) | 296 | (setf (avl-tree--node-right p1) (avl-tree--node-left p2)) |
| 332 | (avl-tree-node-set-left p2 p1) | 297 | (setf (avl-tree--node-left p2) p1) |
| 333 | (avl-tree-node-set-left br (avl-tree-node-right p2)) | 298 | (setf (avl-tree--node-left br) (avl-tree--node-right p2)) |
| 334 | (avl-tree-node-set-right p2 br) | 299 | (setf (avl-tree--node-right p2) br) |
| 335 | (if (< b2 0) | 300 | (setf (avl-tree--node-balance br) (if (< b2 0) +1 0)) |
| 336 | (avl-tree-node-set-balance br +1) | 301 | (setf (avl-tree--node-balance p1) (if (> b2 0) -1 0)) |
| 337 | (avl-tree-node-set-balance br 0)) | 302 | (setf (avl-tree--node-branch node branch) p2)) |
| 338 | (if (> b2 0) | 303 | (setf (avl-tree--node-balance (avl-tree--node-branch node branch)) 0) |
| 339 | (avl-tree-node-set-balance p1 -1) | ||
| 340 | (avl-tree-node-set-balance p1 0)) | ||
| 341 | (avl-tree-node-set-branch node branch p2)) | ||
| 342 | (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0) | ||
| 343 | nil)))) | 304 | nil)))) |
| 344 | 305 | ||
| 345 | (defun avl-tree-do-enter (cmpfun root branch data) | 306 | (defun avl-tree--do-enter (cmpfun root branch data) |
| 346 | ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. | 307 | ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. |
| 347 | (let ((br (avl-tree-node-branch root branch))) | 308 | (let ((br (avl-tree--node-branch root branch))) |
| 348 | (cond | 309 | (cond |
| 349 | ((null br) | 310 | ((null br) |
| 350 | ;; Data not in tree, insert it. | 311 | ;; Data not in tree, insert it. |
| 351 | (avl-tree-node-set-branch | 312 | (setf (avl-tree--node-branch root branch) |
| 352 | root branch (avl-tree-node-create nil nil data 0)) | 313 | (avl-tree--node-create nil nil data 0)) |
| 353 | t) | 314 | t) |
| 354 | 315 | ||
| 355 | ((funcall cmpfun data (avl-tree-node-data br)) | 316 | ((funcall cmpfun data (avl-tree--node-data br)) |
| 356 | (and (avl-tree-do-enter cmpfun br 0 data) | 317 | (and (avl-tree--do-enter cmpfun br 0 data) |
| 357 | (avl-tree-enter-balance2 root branch))) | 318 | (avl-tree--enter-balance2 root branch))) |
| 358 | 319 | ||
| 359 | ((funcall cmpfun (avl-tree-node-data br) data) | 320 | ((funcall cmpfun (avl-tree--node-data br) data) |
| 360 | (and (avl-tree-do-enter cmpfun br 1 data) | 321 | (and (avl-tree--do-enter cmpfun br 1 data) |
| 361 | (avl-tree-enter-balance1 root branch))) | 322 | (avl-tree--enter-balance1 root branch))) |
| 362 | 323 | ||
| 363 | (t | 324 | (t |
| 364 | (avl-tree-node-set-data br data) | 325 | (setf (avl-tree--node-data br) data) |
| 365 | nil)))) | 326 | nil)))) |
| 366 | 327 | ||
| 367 | ;; ---------------------------------------------------------------- | 328 | ;; ---------------------------------------------------------------- |
| 368 | 329 | ||
| 369 | (defun avl-tree-mapc (map-function root) | 330 | (defun avl-tree--mapc (map-function root) |
| 370 | ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT. | 331 | ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT. |
| 371 | ;; The function is applied in-order. | 332 | ;; The function is applied in-order. |
| 372 | ;; | 333 | ;; |
| @@ -378,72 +339,59 @@ NEWVAL is new value of the branch.\"" | |||
| 378 | (push nil stack) | 339 | (push nil stack) |
| 379 | (while node | 340 | (while node |
| 380 | (if (and go-left | 341 | (if (and go-left |
| 381 | (avl-tree-node-left node)) | 342 | (avl-tree--node-left node)) |
| 382 | ;; Do the left subtree first. | 343 | ;; Do the left subtree first. |
| 383 | (progn | 344 | (progn |
| 384 | (push node stack) | 345 | (push node stack) |
| 385 | (setq node (avl-tree-node-left node))) | 346 | (setq node (avl-tree--node-left node))) |
| 386 | ;; Apply the function... | 347 | ;; Apply the function... |
| 387 | (funcall map-function node) | 348 | (funcall map-function node) |
| 388 | ;; and do the right subtree. | 349 | ;; and do the right subtree. |
| 389 | (if (avl-tree-node-right node) | 350 | (setq node (if (setq go-left (avl-tree--node-right node)) |
| 390 | (setq node (avl-tree-node-right node) | 351 | (avl-tree--node-right node) |
| 391 | go-left t) | 352 | (pop stack))))))) |
| 392 | (setq node (pop stack) | ||
| 393 | go-left nil)))))) | ||
| 394 | 353 | ||
| 395 | (defun avl-tree-do-copy (root) | 354 | (defun avl-tree--do-copy (root) |
| 396 | ;; Copy the avl tree with ROOT as root. | 355 | ;; Copy the avl tree with ROOT as root. |
| 397 | ;; Highly recursive. INTERNAL USE ONLY. | 356 | ;; Highly recursive. INTERNAL USE ONLY. |
| 398 | (if (null root) | 357 | (if (null root) |
| 399 | nil | 358 | nil |
| 400 | (avl-tree-node-create | 359 | (avl-tree--node-create |
| 401 | (avl-tree-do-copy (avl-tree-node-left root)) | 360 | (avl-tree--do-copy (avl-tree--node-left root)) |
| 402 | (avl-tree-do-copy (avl-tree-node-right root)) | 361 | (avl-tree--do-copy (avl-tree--node-right root)) |
| 403 | (avl-tree-node-data root) | 362 | (avl-tree--node-data root) |
| 404 | (avl-tree-node-balance root)))) | 363 | (avl-tree--node-balance root)))) |
| 405 | 364 | ||
| 406 | 365 | ||
| 407 | ;;; ================================================================ | 366 | ;; ================================================================ |
| 408 | ;;; The public functions which operate on AVL trees. | 367 | ;;; The public functions which operate on AVL trees. |
| 409 | |||
| 410 | (defun avl-tree-create (compare-function) | ||
| 411 | "Create a new empty avl tree and return it. | ||
| 412 | COMPARE-FUNCTION is a function which takes two arguments, A and B, | ||
| 413 | and returns non-nil if A is less than B, and nil otherwise." | ||
| 414 | (cons 'AVL-TREE | ||
| 415 | (cons (avl-tree-node-create nil nil nil 0) | ||
| 416 | compare-function))) | ||
| 417 | 368 | ||
| 418 | (defun avl-tree-p (obj) | 369 | (defalias 'avl-tree-compare-function 'avl-tree--cmpfun |
| 419 | "Return t if OBJ is an avl tree, nil otherwise." | 370 | "Return the comparison function for the avl tree TREE. |
| 420 | (eq (car-safe obj) 'AVL-TREE)) | ||
| 421 | 371 | ||
| 422 | (defun avl-tree-compare-function (tree) | 372 | \(fn TREE)") |
| 423 | "Return the comparison function for the avl tree TREE." | ||
| 424 | (avl-tree-cmpfun tree)) | ||
| 425 | 373 | ||
| 426 | (defun avl-tree-empty (tree) | 374 | (defun avl-tree-empty (tree) |
| 427 | "Return t if avl tree TREE is emtpy, otherwise return nil." | 375 | "Return t if avl tree TREE is emtpy, otherwise return nil." |
| 428 | (null (avl-tree-root tree))) | 376 | (null (avl-tree--root tree))) |
| 429 | 377 | ||
| 430 | (defun avl-tree-enter (tree data) | 378 | (defun avl-tree-enter (tree data) |
| 431 | "In the avl tree TREE insert DATA. | 379 | "In the avl tree TREE insert DATA. |
| 432 | Return DATA." | 380 | Return DATA." |
| 433 | (avl-tree-do-enter (avl-tree-cmpfun tree) | 381 | (avl-tree--do-enter (avl-tree--cmpfun tree) |
| 434 | (avl-tree-dummyroot tree) | 382 | (avl-tree--dummyroot tree) |
| 435 | 0 | 383 | 0 |
| 436 | data) | 384 | data) |
| 437 | data) | 385 | data) |
| 438 | 386 | ||
| 439 | (defun avl-tree-delete (tree data) | 387 | (defun avl-tree-delete (tree data) |
| 440 | "From the avl tree TREE, delete DATA. | 388 | "From the avl tree TREE, delete DATA. |
| 441 | Return the element in TREE which matched DATA, | 389 | Return the element in TREE which matched DATA, |
| 442 | nil if no element matched." | 390 | nil if no element matched." |
| 443 | (avl-tree-do-delete (avl-tree-cmpfun tree) | 391 | (avl-tree--do-delete (avl-tree--cmpfun tree) |
| 444 | (avl-tree-dummyroot tree) | 392 | (avl-tree--dummyroot tree) |
| 445 | 0 | 393 | 0 |
| 446 | data)) | 394 | data)) |
| 447 | 395 | ||
| 448 | (defun avl-tree-member (tree data) | 396 | (defun avl-tree-member (tree data) |
| 449 | "Return the element in the avl tree TREE which matches DATA. | 397 | "Return the element in the avl tree TREE which matches DATA. |
| @@ -451,82 +399,72 @@ Matching uses the compare function previously specified in | |||
| 451 | `avl-tree-create' when TREE was created. | 399 | `avl-tree-create' when TREE was created. |
| 452 | 400 | ||
| 453 | If there is no such element in the tree, the value is nil." | 401 | If there is no such element in the tree, the value is nil." |
| 454 | (let ((node (avl-tree-root tree)) | 402 | (let ((node (avl-tree--root tree)) |
| 455 | (compare-function (avl-tree-cmpfun tree)) | 403 | (compare-function (avl-tree--cmpfun tree)) |
| 456 | found) | 404 | found) |
| 457 | (while (and node | 405 | (while (and node |
| 458 | (not found)) | 406 | (not found)) |
| 459 | (cond | 407 | (cond |
| 460 | ((funcall compare-function data (avl-tree-node-data node)) | 408 | ((funcall compare-function data (avl-tree--node-data node)) |
| 461 | (setq node (avl-tree-node-left node))) | 409 | (setq node (avl-tree--node-left node))) |
| 462 | ((funcall compare-function (avl-tree-node-data node) data) | 410 | ((funcall compare-function (avl-tree--node-data node) data) |
| 463 | (setq node (avl-tree-node-right node))) | 411 | (setq node (avl-tree--node-right node))) |
| 464 | (t | 412 | (t |
| 465 | (setq found t)))) | 413 | (setq found t)))) |
| 466 | (if node | 414 | (if node |
| 467 | (avl-tree-node-data node) | 415 | (avl-tree--node-data node) |
| 468 | nil))) | 416 | nil))) |
| 469 | 417 | ||
| 470 | (defun avl-tree-map (__map-function__ tree) | 418 | (defun avl-tree-map (__map-function__ tree) |
| 471 | "Apply __MAP-FUNCTION__ to all elements in the avl tree TREE." | 419 | "Apply __MAP-FUNCTION__ to all elements in the avl tree TREE." |
| 472 | (avl-tree-mapc | 420 | (avl-tree--mapc |
| 473 | (function (lambda (node) | 421 | (lambda (node) |
| 474 | (avl-tree-node-set-data | 422 | (setf (avl-tree--node-data node) |
| 475 | node (funcall __map-function__ | 423 | (funcall __map-function__ (avl-tree--node-data node)))) |
| 476 | (avl-tree-node-data node))))) | 424 | (avl-tree--root tree))) |
| 477 | (avl-tree-root tree))) | ||
| 478 | 425 | ||
| 479 | (defun avl-tree-first (tree) | 426 | (defun avl-tree-first (tree) |
| 480 | "Return the first element in TREE, or nil if TREE is empty." | 427 | "Return the first element in TREE, or nil if TREE is empty." |
| 481 | (let ((node (avl-tree-root tree))) | 428 | (let ((node (avl-tree--root tree))) |
| 482 | (if node | 429 | (when node |
| 483 | (progn | 430 | (while (avl-tree--node-left node) |
| 484 | (while (avl-tree-node-left node) | 431 | (setq node (avl-tree--node-left node))) |
| 485 | (setq node (avl-tree-node-left node))) | 432 | (avl-tree--node-data node)))) |
| 486 | (avl-tree-node-data node)) | ||
| 487 | nil))) | ||
| 488 | 433 | ||
| 489 | (defun avl-tree-last (tree) | 434 | (defun avl-tree-last (tree) |
| 490 | "Return the last element in TREE, or nil if TREE is empty." | 435 | "Return the last element in TREE, or nil if TREE is empty." |
| 491 | (let ((node (avl-tree-root tree))) | 436 | (let ((node (avl-tree--root tree))) |
| 492 | (if node | 437 | (when node |
| 493 | (progn | 438 | (while (avl-tree--node-right node) |
| 494 | (while (avl-tree-node-right node) | 439 | (setq node (avl-tree--node-right node))) |
| 495 | (setq node (avl-tree-node-right node))) | 440 | (avl-tree--node-data node)))) |
| 496 | (avl-tree-node-data node)) | ||
| 497 | nil))) | ||
| 498 | 441 | ||
| 499 | (defun avl-tree-copy (tree) | 442 | (defun avl-tree-copy (tree) |
| 500 | "Return a copy of the avl tree TREE." | 443 | "Return a copy of the avl tree TREE." |
| 501 | (let ((new-tree (avl-tree-create (avl-tree-cmpfun tree)))) | 444 | (let ((new-tree (avl-tree-create (avl-tree--cmpfun tree)))) |
| 502 | (avl-tree-node-set-left (avl-tree-dummyroot new-tree) | 445 | (setf (avl-tree--root new-tree) (avl-tree--do-copy (avl-tree--root tree))) |
| 503 | (avl-tree-do-copy (avl-tree-root tree))) | ||
| 504 | new-tree)) | 446 | new-tree)) |
| 505 | 447 | ||
| 506 | (defun avl-tree-flatten (tree) | 448 | (defun avl-tree-flatten (tree) |
| 507 | "Return a sorted list containing all elements of TREE." | 449 | "Return a sorted list containing all elements of TREE." |
| 508 | (nreverse | 450 | (nreverse |
| 509 | (let ((treelist nil)) | 451 | (let ((treelist nil)) |
| 510 | (avl-tree-mapc | 452 | (avl-tree--mapc |
| 511 | (function (lambda (node) | 453 | (lambda (node) (push (avl-tree--node-data node) treelist)) |
| 512 | (setq treelist (cons (avl-tree-node-data node) | 454 | (avl-tree--root tree)) |
| 513 | treelist)))) | ||
| 514 | (avl-tree-root tree)) | ||
| 515 | treelist))) | 455 | treelist))) |
| 516 | 456 | ||
| 517 | (defun avl-tree-size (tree) | 457 | (defun avl-tree-size (tree) |
| 518 | "Return the number of elements in TREE." | 458 | "Return the number of elements in TREE." |
| 519 | (let ((treesize 0)) | 459 | (let ((treesize 0)) |
| 520 | (avl-tree-mapc | 460 | (avl-tree--mapc |
| 521 | (function (lambda (data) | 461 | (lambda (data) (setq treesize (1+ treesize))) |
| 522 | (setq treesize (1+ treesize)) | 462 | (avl-tree--root tree)) |
| 523 | data)) | ||
| 524 | (avl-tree-root tree)) | ||
| 525 | treesize)) | 463 | treesize)) |
| 526 | 464 | ||
| 527 | (defun avl-tree-clear (tree) | 465 | (defun avl-tree-clear (tree) |
| 528 | "Clear the avl tree TREE." | 466 | "Clear the avl tree TREE." |
| 529 | (avl-tree-node-set-left (avl-tree-dummyroot tree) nil)) | 467 | (setf (avl-tree--root tree) nil)) |
| 530 | 468 | ||
| 531 | (provide 'avl-tree) | 469 | (provide 'avl-tree) |
| 532 | 470 | ||