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
Vítor Santos Costa 3164ed2d61 doc support
2015-01-04 23:58:23 +00:00

133 lines
4.0 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) *
* *
*************************************************************************/
/** @defgroup AVL_Trees AVL Trees
@ingroup library
@{
AVL trees are balanced search binary trees. They are named after their
inventors, Adelson-Velskii and Landis, and they were the first
dynamically balanced trees to be proposed. The YAP AVL tree manipulation
predicates library uses code originally written by Martin van Emdem and
published in the Logic Programming Newsletter, Autumn 1981. A bug in
this code was fixed by Philip Vasey, in the Logic Programming
Newsletter, Summer 1982. The library currently only includes routines to
insert and lookup elements in the tree. Please try red-black trees if
you need deletion.
*/
/** @pred avl_insert(+ _Key_,? _Value_,+ _T0_,- _TF_)
Add an element with key _Key_ and _Value_ to the AVL tree
_T0_ creating a new AVL tree _TF_. Duplicated elements are
allowed.
*/
/** @pred avl_lookup(+ _Key_,- _Value_,+ _T_)
Lookup an element with key _Key_ in the AVL tree
_T_, returning the value _Value_.
*/
/** @pred avl_new(+ _T_)
Create a new tree.
*/
:- module(avl, [
avl_new/1,
avl_insert/4,
avl_lookup/3
]).
avl_new([]).
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).
/**
@}
*/