|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hasht.el
|
|
|
4 ;; SUMMARY: Create hash tables from lists and operate on them.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: extensions, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
100
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 16-Mar-90 at 03:38:48
|
|
100
|
12 ;; LAST-MOD: 20-Feb-97 at 07:04:56 by Bob Weiner
|
|
0
|
13 ;;
|
|
100
|
14 ;; Copyright (C) 1990-1995, 1997 Free Software Foundation, Inc.
|
|
0
|
15 ;; See the file BR-COPY for license information.
|
|
|
16 ;;
|
|
|
17 ;; This file is part of the OO-Browser.
|
|
|
18 ;;
|
|
|
19 ;; DESCRIPTION:
|
|
|
20 ;;
|
|
|
21 ;; Featureful set of hash table operators for use in personal programs.
|
|
|
22 ;;
|
|
100
|
23 ;; `hash-make' creates a hash table from an association list, `hash-add'
|
|
|
24 ;; adds a value-key pair to a hash table, and `hash-lookup' finds the value
|
|
0
|
25 ;; associated with a given key in a hash table, if any.
|
|
|
26 ;;
|
|
100
|
27 ;; `hash-map' does the same thing as `mapcar' but operates on hash tables
|
|
0
|
28 ;; instead.
|
|
|
29 ;;
|
|
|
30 ;; For a list of 300 items, these hash tables improve lookup times by a
|
|
|
31 ;; factor of between 8 and 10 to 1 over those for an unsorted list.
|
|
|
32 ;;
|
|
|
33 ;; Public and private function names are alphabetized for easy location.
|
|
|
34 ;;
|
|
|
35 ;; DESCRIP-END.
|
|
|
36
|
|
|
37 ;;; ************************************************************************
|
|
|
38 ;;; Public variables
|
|
|
39 ;;; ************************************************************************
|
|
|
40
|
|
|
41 (defvar hash-merge-values-function 'hash-merge-values
|
|
|
42 "*Function to call in hash-merge to merge the values from 2 hash tables that contain the same key.
|
|
|
43 It is sent the two values as arguments.")
|
|
|
44
|
|
|
45 ;;; ************************************************************************
|
|
|
46 ;;; Public functions
|
|
|
47 ;;; ************************************************************************
|
|
|
48
|
|
|
49 (defun hash-add (value key hash-table)
|
|
|
50 "Add VALUE, any lisp object, referenced by KEY, a string, to HASH-TABLE.
|
|
|
51 Replaces any VALUE previously referenced by KEY."
|
|
|
52 (if (hashp hash-table)
|
|
|
53 (let* ((obarray (hash-obarray hash-table))
|
|
|
54 (sym (intern key obarray)))
|
|
|
55 (if sym (set sym value)))))
|
|
|
56
|
|
|
57 (defun hash-copy (hash-table)
|
|
|
58 "Return a copy of HASH-TABLE, list and vector elements are shared across both tables."
|
|
|
59 (if (not (hashp hash-table))
|
|
100
|
60 (error "(hash-copy): Invalid hash-table: `%s'" hash-table))
|
|
0
|
61 (let ((htable-copy (hash-make (length (hash-obarray hash-table)))))
|
|
|
62 (hash-map
|
|
|
63 (function (lambda (elt) (hash-add (car elt) (cdr elt) htable-copy)))
|
|
|
64 hash-table)
|
|
|
65 htable-copy))
|
|
|
66
|
|
|
67 (defun hash-count (hash-table)
|
|
|
68 "Return number of elements stored in HASH-TABLE or nil if not a valid hash table."
|
|
|
69 (if (hashp hash-table)
|
|
|
70 (let ((obarray (hash-obarray hash-table))
|
|
|
71 (count 0))
|
|
|
72 (mapatoms (function
|
|
|
73 (lambda (sym)
|
|
|
74 (and (boundp sym) sym (setq count (1+ count)))))
|
|
|
75 obarray)
|
|
|
76 count)))
|
|
|
77
|
|
|
78 (defun hash-delete (key hash-table)
|
|
|
79 "Delete element referenced by KEY, a string, from HASH-TABLE.
|
|
|
80 Return nil if KEY is not in HASH-TABLE or non-nil otherwise."
|
|
|
81 (if (hashp hash-table)
|
|
|
82 (let* ((obarray (hash-obarray hash-table))
|
|
|
83 (sym (intern-soft key obarray)))
|
|
|
84 (and sym (boundp sym) (makunbound sym)))))
|
|
|
85
|
|
|
86 (defun hash-deep-copy (obj)
|
|
|
87 "Return a copy of OBJ with new copies of all elements, except symbols."
|
|
|
88 (cond ((null obj) nil)
|
|
|
89 ((stringp obj)
|
|
|
90 (copy-sequence obj))
|
|
|
91 ((hashp obj)
|
|
|
92 (let ((htable-copy (hash-make (length (hash-obarray obj)))))
|
|
|
93 (mapcar
|
|
|
94 (function
|
|
|
95 (lambda (elt) (hash-add (car elt) (cdr elt) htable-copy)))
|
|
|
96 (hash-map 'hash-deep-copy obj))
|
|
|
97 htable-copy))
|
|
|
98 ((vectorp obj)
|
|
|
99 ;; convert to list for mapping
|
|
|
100 (setq obj (append obj nil))
|
|
|
101 ;; Return as a vector
|
|
|
102 (vconcat (mapcar 'hash-deep-copy obj)))
|
|
|
103 ((atom obj) obj)
|
|
|
104 ((nlistp obj)
|
|
100
|
105 (error "(hash-deep-copy): Invalid type, `%s'" obj))
|
|
0
|
106 (t ;; list
|
|
|
107 (cons (hash-deep-copy (car obj)) (hash-deep-copy (cdr obj))))))
|
|
|
108
|
|
|
109 (fset 'hash-get 'hash-lookup)
|
|
|
110 (defun hash-key-p (key hash-table)
|
|
|
111 "Return non-nil iff KEY is in HASH-TABLE. KEY's hash table symbol is returned."
|
|
|
112 (if (hashp hash-table)
|
|
|
113 (let* ((obarray (hash-obarray hash-table))
|
|
|
114 (sym (intern-soft key obarray)))
|
|
|
115 (if (boundp sym) sym))))
|
|
|
116
|
|
|
117 (defun hash-lookup (key hash-table)
|
|
|
118 "Lookup KEY in HASH-TABLE and return associated value.
|
|
|
119 If value is nil, this function does not tell you whether or not KEY is in the
|
|
100
|
120 hash table. Use `hash-key-p' instead for that function."
|
|
0
|
121 (if (hashp hash-table)
|
|
|
122 (let* ((obarray (hash-obarray hash-table))
|
|
|
123 (sym (intern-soft key obarray)))
|
|
|
124 (if (boundp sym) (symbol-value sym)))))
|
|
|
125
|
|
|
126 (defun hash-make (initializer &optional reverse)
|
|
|
127 "Create a hash table from INITIALIZER.
|
|
|
128 INITIALIZER may be an alist with elements of the form (<value> . <key>) from
|
|
|
129 which the hash table is built. Alternatively, it may be a non-negative
|
|
|
130 integer which is used as the minimum size of a new, empty hash table.
|
|
|
131 Optional non-nil second argument REVERSE means INITIALIZER has elements of
|
|
|
132 form (<key> . <value>)."
|
|
|
133 (if (integerp initializer)
|
|
|
134 (if (>= initializer 0)
|
|
|
135 (cons 'hasht (make-vector (hash-next-prime initializer) 0))
|
|
100
|
136 (error "(hash-make): Initializer must be >= 0, not `%s'"
|
|
0
|
137 initializer))
|
|
|
138 (let* ((vlen (hash-next-prime (length initializer)))
|
|
|
139 (obarray (make-vector vlen 0))
|
|
|
140 sym)
|
|
|
141 (mapcar
|
|
|
142 (function
|
|
|
143 (lambda (cns)
|
|
|
144 (let ((key) (value))
|
|
|
145 (if (consp cns)
|
|
|
146 (if reverse
|
|
|
147 (setq key (car cns) value (cdr cns))
|
|
|
148 (setq key (cdr cns) value (car cns))))
|
|
|
149 (if (setq sym (intern key))
|
|
|
150 (set sym value)))))
|
|
|
151 initializer)
|
|
|
152 (cons 'hasht obarray))))
|
|
|
153
|
|
|
154 (defun hash-map (func hash-table)
|
|
|
155 "Return result of application of FUNC to each (<value> . <key>) element of HASH-TABLE."
|
|
|
156 (if (not (hashp hash-table))
|
|
100
|
157 (error "(hash-map): Invalid hash-table: `%s'" hash-table))
|
|
0
|
158 (let ((result))
|
|
|
159 (mapatoms (function
|
|
|
160 (lambda (sym)
|
|
|
161 (and (boundp sym)
|
|
|
162 sym
|
|
|
163 (setq result (cons (funcall
|
|
|
164 func
|
|
|
165 (cons (symbol-value sym)
|
|
|
166 (symbol-name sym)))
|
|
|
167 result)))))
|
|
|
168 (hash-obarray hash-table))
|
|
|
169 result))
|
|
|
170
|
|
|
171 (defun hash-merge (&rest hash-tables)
|
|
|
172 "Merge any number of HASH-TABLES. Return resultant hash table.
|
|
|
173 A single argument consisting of a list of hash tables may also be given.
|
|
|
174 Return an empty hash table if any argument from the merge list is other
|
|
|
175 than nil or a hash table."
|
|
|
176 (let ((empty-ht (hash-make 1)))
|
|
|
177 (and (not (hashp (car hash-tables)))
|
|
|
178 (listp (car hash-tables))
|
|
|
179 ;; Handle situation where a list of hash-tables is passed in as a
|
|
|
180 ;; single argument, rather than as multiple arguments.
|
|
|
181 (setq hash-tables (car hash-tables)))
|
|
|
182 (if (memq nil (mapcar (function (lambda (ht) (or (null ht) (hashp ht))))
|
|
|
183 hash-tables))
|
|
|
184 empty-ht
|
|
|
185 (setq hash-tables
|
|
|
186 (delq nil (mapcar (function (lambda (ht)
|
|
|
187 (if (equal ht empty-ht)
|
|
|
188 nil ht)))
|
|
|
189 hash-tables)))
|
|
|
190 (let ((len (length hash-tables)))
|
|
|
191 (cond ((= len 0) empty-ht)
|
|
|
192 ((= len 1) (car hash-tables))
|
|
|
193 (t (let ((htable (hash-make
|
|
|
194 (apply '+ (mapcar 'hash-count hash-tables))))
|
|
|
195 key value)
|
|
|
196 (mapcar
|
|
|
197 (function
|
|
|
198 (lambda (ht)
|
|
|
199 (hash-map (function
|
|
|
200 (lambda (val-key-cons)
|
|
|
201 (setq value (car val-key-cons)
|
|
|
202 key (cdr val-key-cons))
|
|
|
203 (if (not (hash-key-p key htable))
|
|
|
204 (hash-add value key htable)
|
|
|
205 ;; Merge values
|
|
|
206 (hash-add
|
|
|
207 (funcall hash-merge-values-function
|
|
|
208 (hash-get key htable)
|
|
|
209 value)
|
|
|
210 key htable))))
|
|
|
211 ht)))
|
|
|
212 hash-tables)
|
|
|
213 htable)))))))
|
|
|
214
|
|
|
215 (defun hash-merge-values (value1 value2)
|
|
|
216 "Return a list from merging VALUE1 and VALUE2 or creating a new list.
|
|
|
217 Nil values are thrown away. If both arguments are lists, their elements are
|
|
|
218 assumed to be strings and the result is a set of ordered strings."
|
|
|
219 (cond ((and (listp value1) (listp value2))
|
|
|
220 ;; Assume desired result is a set of strings.
|
|
|
221 (br-set-of-strings (sort (append value1 value2) 'string<)))
|
|
|
222 ((null value1)
|
|
|
223 value2)
|
|
|
224 ((null value2)
|
|
|
225 value1)
|
|
|
226 ((listp value1)
|
|
|
227 (cons value2 value1))
|
|
|
228 ((listp value2)
|
|
|
229 (cons value1 value2))
|
|
|
230 (t (list value1 value2))))
|
|
|
231
|
|
|
232 (make-obsolete 'hash-new 'hash-make)
|
|
|
233 (defun hash-new (size)
|
|
|
234 "Return a new hash table of SIZE elements.
|
|
100
|
235 This is obsolete. Use `hash-make' instead."
|
|
0
|
236 (hash-make size))
|
|
|
237
|
|
|
238 (defun hash-prin1 (hash-table &optional stream)
|
|
|
239 "Output the printed representation of HASH-TABLE.
|
|
|
240 Quoting characters are printed when needed to make output that `read'
|
|
|
241 can handle, whenever this is possible.
|
|
|
242 Output stream is STREAM, or value of `standard-output'."
|
|
|
243 (if (not (hashp hash-table))
|
|
|
244 (progn (prin1 hash-table stream)
|
|
|
245 (princ "\n" stream))
|
|
|
246 (princ "\(\n" stream)
|
|
|
247 (hash-map
|
|
|
248 (function (lambda (val-key-cons)
|
|
|
249 (prin1 val-key-cons stream)
|
|
|
250 (princ "\n" stream)))
|
|
|
251 hash-table)
|
|
|
252 (princ "\)\n" stream)))
|
|
|
253
|
|
|
254 (defun hash-replace (value key hash-table)
|
|
|
255 "Replace VALUE referenced by KEY, a string, in HASH-TABLE.
|
|
|
256 An error will occur if KEY is not found in HASH-TABLE."
|
|
|
257 (if (hashp hash-table)
|
|
|
258 (let* ((obarray (hash-obarray hash-table))
|
|
|
259 (sym (intern-soft key obarray)))
|
|
|
260 (if (and (boundp sym) sym)
|
|
|
261 (set sym value)
|
|
100
|
262 (error "(hash-replace): `%s' key not found in hash table." key)))))
|
|
0
|
263
|
|
|
264 (defun hash-resize (hash-table new-size)
|
|
|
265 "Resize HASH-TABLE to NEW-SIZE without losing any elements and return new table.
|
|
|
266 NEW-SIZE must be greater than 0. Hashing works best if NEW-SIZE is a prime
|
|
100
|
267 number. See also `hash-next-prime'."
|
|
0
|
268 (if (< new-size 1)
|
|
|
269 (error "(hash-resize): Cannot resize hash table to size %d" new-size))
|
|
|
270 (let ((htable (hash-make new-size)))
|
|
|
271 (hash-map (function
|
|
|
272 (lambda (elt)
|
|
|
273 (hash-add (car elt) (cdr elt) htable)))
|
|
|
274 hash-table)
|
|
|
275 htable))
|
|
|
276
|
|
|
277 (defun hash-resize-p (hash-table)
|
|
|
278 "Resizes HASH-TABLE to 1.5 times its size if above 80% full.
|
|
|
279 Returns new hash table when resized, else nil."
|
|
|
280 (if (hashp hash-table)
|
|
|
281 (let ((count (hash-count hash-table))
|
|
|
282 (size (length (hash-obarray hash-table))))
|
|
|
283 (if (> (* count (/ count 5)) size)
|
|
|
284 (hash-resize hash-table (hash-next-prime (+ size (/ size 2))))))))
|
|
|
285
|
|
|
286 (defun hash-size (hash-table)
|
|
|
287 "Return size of HASH-TABLE which is >= number of elements in the table.
|
|
|
288 Return nil if not a valid hash table."
|
|
|
289 (if (hashp hash-table)
|
|
|
290 (length (hash-obarray hash-table))))
|
|
|
291 (fset 'hash-length 'hash-size)
|
|
|
292
|
|
|
293 (defun hashp (object)
|
|
|
294 "Return non-nil if OBJECT is a hash-table."
|
|
|
295 (and (listp object) (eq (car object) 'hasht)
|
|
|
296 (vectorp (cdr object))))
|
|
|
297
|
|
|
298 ;;; ************************************************************************
|
|
|
299 ;;; Private functions
|
|
|
300 ;;; ************************************************************************
|
|
|
301
|
|
|
302 (defun hash-next-prime (n)
|
|
|
303 "Return next prime number >= N."
|
|
|
304 (if (<= n 2)
|
|
|
305 2
|
|
|
306 (and (= (% n 2) 0) (setq n (1+ n)))
|
|
|
307 (while (not (hash-prime-p n))
|
|
|
308 (setq n (+ n 2)))
|
|
|
309 n))
|
|
|
310
|
|
|
311 (defun hash-obarray (hash-table)
|
|
|
312 "Return symbol table (object array) portion of HASH-TABLE."
|
|
|
313 (cdr hash-table))
|
|
|
314
|
|
|
315 (defun hash-prime-p (n)
|
|
|
316 "Return non-nil iff N is prime."
|
|
|
317 (if (< n 0) (setq n (- n)))
|
|
|
318 (let ((small-primes '(1 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67
|
|
|
319 71 73 79 83 89)))
|
|
|
320 (cond ((< n 91) (memq n small-primes))
|
|
|
321 ((< n 7921) ;; 89, max small-prime, squared
|
|
|
322 (let ((prime t)
|
|
|
323 (pr-list small-primes))
|
|
|
324 (while (and (setq pr-list (cdr pr-list))
|
|
|
325 (setq prime (/= (% n (car pr-list)) 0))))
|
|
|
326 prime))
|
|
|
327 ((or (= (% n 3) 0) (= (% n 2) 0)) nil)
|
|
|
328 ((let ((factor1 5)
|
|
|
329 (factor2 7)
|
|
|
330 (is-prime))
|
|
|
331 (while (and (<= (* factor1 factor1) n)
|
|
|
332 (setq is-prime (and (/= (% n factor1) 0)
|
|
|
333 (/= (% n factor2) 0))))
|
|
|
334 (setq factor1 (+ factor1 6)
|
|
|
335 factor2 (+ factor2 6)))
|
|
|
336 is-prime)))))
|
|
|
337
|
|
|
338 (provide 'hasht)
|
