This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/library/avl.yap
vsc e5f4633c39 This commit was generated by cvs2svn to compensate for changes in r4,
which included commits to RCS files with non-trunk default branches.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2001-04-09 19:54:03 +00:00

81 lines
2.9 KiB
Prolog

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: regexp.yap *
* Last rev: 5/15/2000 *
* mods: *
* comments: AVL trees in YAP (from code by M. van Emden, P. Vasey) *
* *
*************************************************************************/
:- module(avl, [
avl_insert/4,
avl_lookup/3
]).
avl_insert(Key, Value, T0, TF) :-
insert(T0, Key, Value, TF, _).
insert([], Key, Value, avl([],Key,Value,-,[]), yes).
insert(avl(L,Root,RVal,Bl,R), E, Value, NewTree, WhatHasChanged) :-
E @< Root, !,
insert(L, E, Value, NewL, LeftHasChanged),
adjust(avl(NewL,Root,RVal,Bl,R), LeftHasChanged, left, NewTree, WhatHasChanged).
insert(avl(L,Root,RVal,Bl,R), E, Val, NewTree, WhatHasChanged) :-
% E @>= Root, currently we allow duplicated values, although
% lookup will only fetch the first.
insert(R, E, Val,NewR, RightHasChanged),
adjust(avl(L,Root,RVal,Bl,NewR), RightHasChanged, right, NewTree, WhatHasChanged).
adjust(Oldtree, no, _, Oldtree, no).
adjust(avl(L,Root,RVal,Bl,R), yes, Lor, NewTree, WhatHasChanged) :-
table(Bl, Lor, Bl1, WhatHasChanged, ToBeRebalanced),
rebalance(avl(L, Root, RVal, Bl, R), Bl1, ToBeRebalanced, NewTree).
% balance where balance whole tree to be
% before inserted after increased rebalanced
table(- , left , < , yes , no ).
table(- , right , > , yes , no ).
table(< , left , - , no , yes ).
table(< , right , - , no , no ).
table(> , left , - , no , no ).
table(> , right , - , no , yes ).
rebalance(avl(Lst, Root, RVal, _Bl, Rst), Bl1, no, avl(Lst, Root, RVal, Bl1,Rst)).
rebalance(OldTree, _, yes, NewTree) :-
avl_geq(OldTree,NewTree).
avl_geq(avl(Alpha,A,VA,>,avl(Beta,B,VB,>,Gamma)),
avl(avl(Alpha,A,VA,-,Beta),B,VB,-,Gamma)).
avl_geq(avl(avl(Alpha,A,VA,<,Beta),B,VB,<,Gamma),
avl(Alpha,A,VA,-,avl(Beta,B,VB,-,Gamma))).
avl_geq(avl(Alpha,A,VA,>,avl(avl(Beta,X,VX,Bl1,Gamma),B,VB,<,Delta)),
avl(avl(Alpha,A,VA,Bl2,Beta),X,VX,-,avl(Gamma,B,VB,Bl3,Delta))) :-
table2(Bl1,Bl2,Bl3).
avl_geq(avl(avl(Alpha,A,VA,>,avl(Beta,X,VX,Bl1,Gamma)),B,VB,<,Delta),
avl(avl(Alpha,A,VA,Bl2,Beta),X,VX,-,avl(Gamma,B,VB,Bl3,Delta))) :-
table2(Bl1,Bl2,Bl3).
table2(< ,- ,> ).
table2(> ,< ,- ).
table2(- ,- ,- ).
avl_lookup(Key, Value, avl(L,Key0,KVal,_,R)) :-
compare(Cmp, Key, Key0),
avl_lookup(Cmp, Value, L, R, Key, KVal).
avl_lookup(=, Value, _, _, _, Value).
avl_lookup(<, Value, L, _, Key, _) :-
avl_lookup(Key, Value, L).
avl_lookup(>, Value, _, R, Key, _) :-
avl_lookup(Key, Value, R).