35
36:- module(assoc,
37 [ empty_assoc/1, 38 is_assoc/1, 39 assoc_to_list/2, 40 assoc_to_keys/2, 41 assoc_to_values/2, 42 gen_assoc/3, 43 get_assoc/3, 44 get_assoc/5, 45 list_to_assoc/2, 46 map_assoc/2, 47 map_assoc/3, 48 max_assoc/3, 49 min_assoc/3, 50 ord_list_to_assoc/2, 51 put_assoc/4, 52 del_assoc/4, 53 del_min_assoc/4, 54 del_max_assoc/4 55 ]). 56:- autoload(library(error),[must_be/2,domain_error/2]). 57
58
82
83:- meta_predicate
84 map_assoc(1, ?),
85 map_assoc(2, ?, ?). 86
90
91empty_assoc(t).
92
97
98assoc_to_list(Assoc, List) :-
99 assoc_to_list(Assoc, List, []).
100
101assoc_to_list(t(Key,Val,_,L,R), List, Rest) :-
102 assoc_to_list(L, List, [Key-Val|More]),
103 assoc_to_list(R, More, Rest).
104assoc_to_list(t, List, List).
105
106
111
112assoc_to_keys(Assoc, List) :-
113 assoc_to_keys(Assoc, List, []).
114
115assoc_to_keys(t(Key,_,_,L,R), List, Rest) :-
116 assoc_to_keys(L, List, [Key|More]),
117 assoc_to_keys(R, More, Rest).
118assoc_to_keys(t, List, List).
119
120
126
127assoc_to_values(Assoc, List) :-
128 assoc_to_values(Assoc, List, []).
129
130assoc_to_values(t(_,Value,_,L,R), List, Rest) :-
131 assoc_to_values(L, List, [Value|More]),
132 assoc_to_values(R, More, Rest).
133assoc_to_values(t, List, List).
134
143
144is_assoc(Assoc) :-
145 nonvar(Assoc),
146 is_assoc(Assoc, _Min, _Max, _Depth).
147
148is_assoc(t,X,X,0) :- !.
149is_assoc(t(K,_,-,t,t),K,K,1) :- !.
150is_assoc(t(K,_,>,t,t(RK,_,-,t,t)),K,RK,2) :-
151 !, K @< RK.
152is_assoc(t(K,_,<,t(LK,_,-,t,t),t),LK,K,2) :-
153 !, LK @< K.
154is_assoc(t(K,_,B,L,R),Min,Max,Depth) :-
155 is_assoc(L,Min,LMax,LDepth),
156 is_assoc(R,RMin,Max,RDepth),
157 158 compare(Rel,RDepth,LDepth),
159 balance(Rel,B),
160 161 LMax @< K,
162 K @< RMin,
163 Depth is max(LDepth, RDepth)+1.
164
165balance(=,-).
166balance(<,<).
167balance(>,>).
168
169
176
177gen_assoc(Key, Assoc, Value) :-
178 ( ground(Key)
179 -> get_assoc(Key, Assoc, Value)
180 ; gen_assoc_(Key, Assoc, Value)
181 ).
182
183gen_assoc_(Key, t(Key0,Val0,_,L,R), Val) =>
184 gen_assoc_(Key, Key0,Val0,L,R, Val).
185gen_assoc_(_Key, t, _Val) =>
186 fail.
187
188gen_assoc_(Key, _,_,L,_, Val) :-
189 gen_assoc_(Key, L, Val).
190gen_assoc_(Key, Key,Val0,_,_, Val) :-
191 Val = Val0.
192gen_assoc_(Key, _,_,_,R, Val) :-
193 gen_assoc_(Key, R, Val).
194
195
199
200:- if(current_predicate('$btree_find_node'/5)). 201get_assoc(Key, Tree, Val) :-
202 Tree \== t,
203 '$btree_find_node'(Key, Tree, 0x010405, Node, =),
204 arg(2, Node, Val).
205:- else. 206get_assoc(Key, t(K,V,_,L,R), Val) =>
207 compare(Rel, Key, K),
208 get_assoc(Rel, Key, V, L, R, Val).
209get_assoc(_, t, _) =>
210 fail.
211
212get_assoc(=, _, Val, _, _, Val).
213get_assoc(<, Key, _, Tree, _, Val) :-
214 get_assoc(Key, Tree, Val).
215get_assoc(>, Key, _, _, Tree, Val) :-
216 get_assoc(Key, Tree, Val).
217:- endif. 218
219
223
224get_assoc(Key, t(K,V,B,L,R), Val, Assoc, NVal) =>
225 Assoc = t(K,NV,B,NL,NR),
226 compare(Rel, Key, K),
227 get_assoc(Rel, Key, V, L, R, Val, NV, NL, NR, NVal).
228get_assoc(_Key, t, _Val, _, _) =>
229 fail.
230
231get_assoc(=, _, Val, L, R, Val, NVal, L, R, NVal).
232get_assoc(<, Key, V, L, R, Val, V, NL, R, NVal) :-
233 get_assoc(Key, L, Val, NL, NVal).
234get_assoc(>, Key, V, L, R, Val, V, L, NR, NVal) :-
235 get_assoc(Key, R, Val, NR, NVal).
236
237
244
245list_to_assoc(List, Assoc) :-
246 ( List == []
247 -> Assoc = t
248 ; keysort(List, Sorted),
249 ( ord_pairs(Sorted)
250 -> length(Sorted, N),
251 list_to_assoc(N, Sorted, [], _, Assoc)
252 ; domain_error(unique_key_pairs, List)
253 )
254 ).
255
256list_to_assoc(1, [K-V|More], More, 1, t(K,V,-,t,t)) :- !.
257list_to_assoc(2, [K1-V1,K2-V2|More], More, 2, t(K2,V2,<,t(K1,V1,-,t,t),t)) :- !.
258list_to_assoc(N, List, More, Depth, t(K,V,Balance,L,R)) :-
259 N0 is N - 1,
260 RN is N0 div 2,
261 Rem is N0 mod 2,
262 LN is RN + Rem,
263 list_to_assoc(LN, List, [K-V|Upper], LDepth, L),
264 list_to_assoc(RN, Upper, More, RDepth, R),
265 Depth is LDepth + 1,
266 compare(B, RDepth, LDepth), balance(B, Balance).
267
274
275ord_list_to_assoc(Sorted, Assoc) :-
276 ( Sorted == []
277 -> Assoc = t
278 ; ( ord_pairs(Sorted)
279 -> length(Sorted, N),
280 list_to_assoc(N, Sorted, [], _, Assoc)
281 ; domain_error(key_ordered_pairs, Sorted)
282 )
283 ).
284
288
289ord_pairs([K-_V|Rest]) :-
290 ord_pairs(Rest, K).
291ord_pairs([], _K).
292ord_pairs([K-_V|Rest], K0) :-
293 K0 @< K,
294 ord_pairs(Rest, K).
295
299
300map_assoc(Pred, T) :-
301 map_assoc_(T, Pred).
302
303map_assoc_(t, _) =>
304 true.
305map_assoc_(t(_,Val,_,L,R), Pred) =>
306 map_assoc_(L, Pred),
307 call(Pred, Val),
308 map_assoc_(R, Pred).
309
314
315map_assoc(Pred, T0, T) :-
316 map_assoc_(T0, Pred, T).
317
318map_assoc_(t, _, Assoc) =>
319 Assoc = t.
320map_assoc_(t(Key,Val,B,L0,R0), Pred, Assoc) =>
321 Assoc = t(Key,Ans,B,L1,R1),
322 map_assoc_(L0, Pred, L1),
323 call(Pred, Val, Ans),
324 map_assoc_(R0, Pred, R1).
325
326
330
331max_assoc(t(K,V,_,_,R), Key, Val) =>
332 max_assoc(R, K, V, Key, Val).
333max_assoc(t, _, _) =>
334 fail.
335
336max_assoc(t, K, V, K, V).
337max_assoc(t(K,V,_,_,R), _, _, Key, Val) :-
338 max_assoc(R, K, V, Key, Val).
339
340
344
345min_assoc(t(K,V,_,L,_), Key, Val) =>
346 min_assoc(L, K, V, Key, Val).
347min_assoc(t, _, _) =>
348 fail.
349
350min_assoc(t, K, V, K, V).
351min_assoc(t(K,V,_,L,_), _, _, Key, Val) :-
352 min_assoc(L, K, V, Key, Val).
353
354
359
360put_assoc(Key, A0, Value, A) :-
361 insert(A0, Key, Value, A, _).
362
363insert(t, Key, Val, Assoc, Changed) =>
364 Assoc = t(Key,Val,-,t,t),
365 Changed = yes.
366insert(t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) =>
367 compare(Rel, K, Key),
368 insert(Rel, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged).
369
370insert(=, t(Key,_,B,L,R), _, V, t(Key,V,B,L,R), no).
371insert(<, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
372 insert(L, K, V, NewL, LeftHasChanged),
373 adjust(LeftHasChanged, t(Key,Val,B,NewL,R), left, NewTree, WhatHasChanged).
374insert(>, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
375 insert(R, K, V, NewR, RightHasChanged),
376 adjust(RightHasChanged, t(Key,Val,B,L,NewR), right, NewTree, WhatHasChanged).
377
378adjust(no, Oldree, _, Oldree, no).
379adjust(yes, t(Key,Val,B0,L,R), LoR, NewTree, WhatHasChanged) :-
380 table(B0, LoR, B1, WhatHasChanged, ToBeRebalanced),
381 rebalance(ToBeRebalanced, t(Key,Val,B0,L,R), B1, NewTree, _, _).
382
385table(- , left , < , yes , no ) :- !.
386table(- , right , > , yes , no ) :- !.
387table(< , left , - , no , yes ) :- !.
388table(< , right , - , no , no ) :- !.
389table(> , left , - , no , no ) :- !.
390table(> , right , - , no , yes ) :- !.
391
397
398del_min_assoc(Tree, Key, Val, NewTree) :-
399 del_min_assoc(Tree, Key, Val, NewTree, _DepthChanged).
400
401del_min_assoc(t(Key,Val,_B,t,R), Key, Val, R, yes) :- !.
402del_min_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
403 del_min_assoc(L, Key, Val, NewL, LeftChanged),
404 deladjust(LeftChanged, t(K,V,B,NewL,R), left, NewTree, Changed).
405
411
412del_max_assoc(Tree, Key, Val, NewTree) :-
413 del_max_assoc(Tree, Key, Val, NewTree, _DepthChanged).
414
415del_max_assoc(t(Key,Val,_B,L,t), Key, Val, L, yes) :- !.
416del_max_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
417 del_max_assoc(R, Key, Val, NewR, RightChanged),
418 deladjust(RightChanged, t(K,V,B,L,NewR), right, NewTree, Changed).
419
424
425del_assoc(Key, A0, Value, A) :-
426 delete(A0, Key, Value, A, _).
427
429delete(t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) =>
430 compare(Rel, K, Key),
431 delete(Rel, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged).
432delete(t, _, _, _, _) =>
433 fail.
434
438delete(=, t(Key,Val,_B,t,R), Key, Val, R, yes) :- !.
439delete(=, t(Key,Val,_B,L,t), Key, Val, L, yes) :- !.
440delete(=, t(Key,Val,>,L,R), Key, Val, NewTree, WhatHasChanged) :-
441 442 del_min_assoc(R, K, V, NewR, RightHasChanged),
443 deladjust(RightHasChanged, t(K,V,>,L,NewR), right, NewTree, WhatHasChanged),
444 !.
445delete(=, t(Key,Val,B,L,R), Key, Val, NewTree, WhatHasChanged) :-
446 447 del_max_assoc(L, K, V, NewL, LeftHasChanged),
448 deladjust(LeftHasChanged, t(K,V,B,NewL,R), left, NewTree, WhatHasChanged),
449 !.
450
451delete(<, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
452 delete(L, K, V, NewL, LeftHasChanged),
453 deladjust(LeftHasChanged, t(Key,Val,B,NewL,R), left, NewTree, WhatHasChanged).
454delete(>, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
455 delete(R, K, V, NewR, RightHasChanged),
456 deladjust(RightHasChanged, t(Key,Val,B,L,NewR), right, NewTree, WhatHasChanged).
457
458deladjust(no, OldTree, _, OldTree, no).
459deladjust(yes, t(Key,Val,B0,L,R), LoR, NewTree, RealChange) :-
460 deltable(B0, LoR, B1, WhatHasChanged, ToBeRebalanced),
461 rebalance(ToBeRebalanced, t(Key,Val,B0,L,R), B1, NewTree, WhatHasChanged, RealChange).
462
465deltable(- , right , < , no , no ) :- !.
466deltable(- , left , > , no , no ) :- !.
467deltable(< , right , - , yes , yes ) :- !.
468deltable(< , left , - , yes , no ) :- !.
469deltable(> , right , - , yes , no ) :- !.
470deltable(> , left , - , yes , yes ) :- !.
472
482
483
484rebalance(no, t(K,V,_,L,R), B, t(K,V,B,L,R), Changed, Changed).
485rebalance(yes, OldTree, _, NewTree, _, RealChange) :-
486 avl_geq(OldTree, NewTree, RealChange).
487
488avl_geq(t(A,VA,>,Alpha,t(B,VB,>,Beta,Gamma)),
489 t(B,VB,-,t(A,VA,-,Alpha,Beta),Gamma), yes) :- !.
490avl_geq(t(A,VA,>,Alpha,t(B,VB,-,Beta,Gamma)),
491 t(B,VB,<,t(A,VA,>,Alpha,Beta),Gamma), no) :- !.
492avl_geq(t(B,VB,<,t(A,VA,<,Alpha,Beta),Gamma),
493 t(A,VA,-,Alpha,t(B,VB,-,Beta,Gamma)), yes) :- !.
494avl_geq(t(B,VB,<,t(A,VA,-,Alpha,Beta),Gamma),
495 t(A,VA,>,Alpha,t(B,VB,<,Beta,Gamma)), no) :- !.
496avl_geq(t(A,VA,>,Alpha,t(B,VB,<,t(X,VX,B1,Beta,Gamma),Delta)),
497 t(X,VX,-,t(A,VA,B2,Alpha,Beta),t(B,VB,B3,Gamma,Delta)), yes) :-
498 !,
499 table2(B1, B2, B3).
500avl_geq(t(B,VB,<,t(A,VA,>,Alpha,t(X,VX,B1,Beta,Gamma)),Delta),
501 t(X,VX,-,t(A,VA,B2,Alpha,Beta),t(B,VB,B3,Gamma,Delta)), yes) :-
502 !,
503 table2(B1, B2, B3).
504
505table2(< ,- ,> ).
506table2(> ,< ,- ).
507table2(- ,- ,- ).
508
509
510 513
514:- multifile
515 error:has_type/2. 516
517error:has_type(assoc, X) :-
518 ( X == t
519 -> true
520 ; compound(X),
521 compound_name_arity(X, t, 5)
522 )