1 ;;; radix-tree.el --- A simple library of radix trees -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2016 Free Software Foundation, Inc.
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; There are many different options for how to represent radix trees
26 ;; in Elisp. Here I chose a very simple one. A radix-tree can be either:
27 ;; - a node, of the form ((PREFIX . PTREE) . RTREE) where PREFIX is a string
28 ;; meaning that everything that starts with PREFIX is in PTREE,
29 ;; and everything else in RTREE. It also has the property that
30 ;; everything that starts with the first letter of PREFIX but not with
31 ;; that whole PREFIX is not in RTREE (i.e. is not in the tree at all).
32 ;; - anything else is taken as the value to associate with the empty string.
33 ;; So every node is basically an (improper) alist where each mapping applies
34 ;; to a different leading letter.
36 ;; The main downside of this representation is that the lookup operation
37 ;; is slower because each level of the tree is an alist rather than some kind
38 ;; of array, so every level's lookup is O(N) rather than O(1). We could easily
39 ;; solve this by using char-tables instead of alists, but that would make every
40 ;; level take up a lot more memory, and it would make the resulting
41 ;; datastructure harder to read (by a human) when printed out.
45 (defun radix-tree--insert (tree key val i
)
47 (`((,prefix .
,ptree
) .
,rtree
)
48 (let* ((ni (+ i
(length prefix
)))
49 (cmp (compare-strings prefix nil nil key i ni
)))
51 (let ((nptree (radix-tree--insert ptree key val ni
)))
52 `((,prefix .
,nptree
) .
,rtree
))
53 (let ((n (if (< cmp
0) (- -
1 cmp
) (- cmp
1))))
55 (let ((nrtree (radix-tree--insert rtree key val i
)))
56 `((,prefix .
,ptree
) .
,nrtree
))
57 (let* ((nprefix (substring prefix
0 n
))
58 (kprefix (substring key
(+ i n
)))
59 (pprefix (substring prefix n
))
60 (ktree (if (equal kprefix
"") val
61 `((,kprefix .
,val
)))))
63 .
((,pprefix .
,ptree
) .
,ktree
))
66 (if (= (length key
) i
) val
67 (let ((prefix (substring key i
)))
68 `((,prefix .
,val
) .
,tree
))))))
70 (defun radix-tree--remove (tree key i
)
72 (`((,prefix .
,ptree
) .
,rtree
)
73 (let* ((ni (+ i
(length prefix
)))
74 (cmp (compare-strings prefix nil nil key i ni
)))
76 (pcase (radix-tree--remove ptree key ni
)
78 (`((,pprefix .
,pptree
))
79 `((,(concat prefix pprefix
) .
,pptree
) .
,rtree
))
80 (nptree `((,prefix .
,nptree
) .
,rtree
)))
81 (let ((n (if (< cmp
0) (- -
1 cmp
) (- cmp
1))))
83 (let ((nrtree (radix-tree--remove rtree key i
)))
84 `((,prefix .
,ptree
) .
,nrtree
))
87 (if (= (length key
) i
) nil tree
))))
90 (defun radix-tree--lookup (tree string i
)
92 (`((,prefix .
,ptree
) .
,rtree
)
93 (let* ((ni (+ i
(length prefix
)))
94 (cmp (compare-strings prefix nil nil string i ni
)))
96 (radix-tree--lookup ptree string ni
)
97 (let ((n (if (< cmp
0) (- -
1 cmp
) (- cmp
1))))
99 (radix-tree--lookup rtree string i
)
102 (if (and val
(equal (length string
) i
))
103 (if (integerp val
) `(t .
,val
) val
)
106 (defun radix-tree--subtree (tree string i
)
107 (if (equal (length string
) i
) tree
109 (`((,prefix .
,ptree
) .
,rtree
)
110 (let* ((ni (+ i
(length prefix
)))
111 (cmp (compare-strings prefix nil nil string i ni
)))
113 (radix-tree--subtree ptree string ni
)
114 (let ((n (if (< cmp
0) (- -
1 cmp
) (- cmp
1))))
116 ((zerop n
) (radix-tree--subtree rtree string i
))
117 ((equal (+ n i
) (length string
))
118 (let ((nprefix (substring prefix n
)))
119 `((,nprefix .
,ptree
))))
125 (defconst radix-tree-empty nil
126 "The empty radix-tree.")
128 (defun radix-tree-insert (tree key val
)
129 "Insert a mapping from KEY to VAL in radix TREE."
130 (when (consp val
) (setq val
`(t .
,val
)))
131 (if val
(radix-tree--insert tree key val
0)
132 (radix-tree--remove tree key
0)))
134 (defun radix-tree-lookup (tree key
)
135 "Return the value associated to KEY in radix TREE.
136 If not found, return nil."
137 (pcase (radix-tree--lookup tree key
0)
142 (defun radix-tree-subtree (tree string
)
143 "Return the subtree of TREE rooted at the prefix STRING."
144 (radix-tree--subtree tree string
0))
147 (pcase-defmacro radix-tree-leaf
(vpat)
148 ;; FIXME: We'd like to use a negative pattern (not consp), but pcase
149 ;; doesn't support it. Using `atom' works but generates sub-optimal code.
150 `(or `(t .
,,vpat
) (and (pred atom
) ,vpat
))))
152 (defun radix-tree-iter-subtrees (tree fun
)
153 "Apply FUN to every immediate subtree of radix TREE.
154 FUN is called with two arguments: PREFIX and SUBTREE.
155 You can test if SUBTREE is a leaf (and extract its value) with the
156 pcase pattern (radix-tree-leaf PAT)."
159 (`((,prefix .
,ptree
) .
,rtree
)
160 (funcall fun prefix ptree
)
162 (_ (funcall fun
"" tree
)
165 (defun radix-tree-iter-mappings (tree fun
&optional prefix
)
166 "Apply FUN to every mapping in TREE.
167 FUN is called with two arguments: KEY and VAL.
168 PREFIX is only used internally."
169 (radix-tree-iter-subtrees
172 (let ((nprefix (concat prefix p
)))
174 ((radix-tree-leaf v
) (funcall fun nprefix v
))
175 (_ (radix-tree-iter-mappings s fun nprefix
)))))))
177 ;; (defun radix-tree->alist (tree)
179 ;; (radix-tree-iter-mappings tree (lambda (p v) (push (cons p v) al)))
182 (defun radix-tree-count (tree)
184 (radix-tree-iter-mappings tree
(lambda (_ _
) (setq i
(1+ i
))))
187 (provide 'radix-tree
)
188 ;;; radix-tree.el ends here