Home Page
Site Map
Login/out
Message Board
Download(c) 2005-2025 XLOG Technologies AG
/**
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
/**
* Compounds used:
* - 'V'(M): Value holder of a tree map M
* - 'T'(C,L,P,R): Tree non-terminal node with color C,
* left branch L, key value pair P and right branch R.
* - 'E': Tree terminal leaf
* - 'R': Color red
* - 'B': Color back
*/
/***************************************************************/
/* Pairs Access */
/***************************************************************/
/**
* tree_enum(T, P):
* The predicate succeeds in P with the key value pairs
* from the red-black tree T.
*/
% tree_enum(+Root, -Pair)
tree_enum('V'(T), P) :-
sys_tree_enum(T, P).
% sys_tree_enum(+Tree, -Pair)
sys_tree_enum('T'(_, L, _, _), Y) :-
sys_tree_enum(L, Y).
sys_tree_enum('T'(_, _, X, _), X).
sys_tree_enum('T'(_, _, _, R), Y) :-
sys_tree_enum(R, Y).
/**
* tree_pairs(T, L):
* The predicate succeeds in L with the key value pair
* list from the red-black tree T.
*/
% tree_pairs(+Root, -Pairs)
tree_pairs(H, L) :- var(H), !,
tree_new(H),
(member(K-V, L), tree_set(H, K, V), fail; true).
tree_pairs('V'(T), L) :-
sys_tree_pairs(T, L, []).
% sys_tree_pairs(+Tree, -Pairs, +Pairs)
sys_tree_pairs('E') --> !.
sys_tree_pairs('T'(_, L, X, R)) -->
sys_tree_pairs(L),
[X],
sys_tree_pairs(R).
/**
* tree_size(T, S):
* The predicate succeeds in S with the number of key value
* pairs of the red-black tree T.
*/
% tree_size(+Root, -Integer)
tree_size('V'(T), S) :-
sys_tree_size(T, 0, S).
% sys_tree_size(+Tree, +Integer, -Integer)
sys_tree_size('E', S, S).
sys_tree_size('T'(_, L, _, R), S, T) :-
H is S+1,
sys_tree_size(L, H, J),
sys_tree_size(R, J, T).
/***************************************************************/
/* Basic Access */
/***************************************************************/
/**
* tree_new(T):
* The predicate succeeds in R with a new red-black tree.
*/
% tree_new(-Root)
tree_new(T) :-
T = 'V'(_),
change_arg(1, T, 'E').
/**
* tree_current(T, K, V):
* The predicate succeeds in V with the value for the key K
* in the red-black tree T.
*/
% tree_current(+Root, +Term, -Term)
tree_current('V'(T), K, V) :-
sys_tree_current(T, K, V).
% sys_tree_current(+Tree, +Term, -Term)
sys_tree_current('T'(_, L, K2-_, _), K, V) :- K @< K2, !,
sys_tree_current(L, K, V).
sys_tree_current('T'(_, _, K2-V2, _), K, V) :- K == K2, !,
V = V2.
sys_tree_current('T'(_, _, _, R), K, V) :-
sys_tree_current(R, K, V).
/***************************************************************/
/* Non-Backtracking Modification */
/***************************************************************/
/**
* tree_set(T, K, V):
* The predicate succeeds. As a side effect the red-black tree T
* is extended by the key value pair K,V if the key is new or
* else the value for the K is replaced by V.
*/
% tree_set(+Root, +Term, +Term)
tree_set(U, K, V) :-
arg(1, U, T),
(T = 'E' ->
sys_node_make('B', K, V, T2),
change_arg(1, U, T2);
sys_tree_set(T, K, V),
change_arg(1, T, 'B')), !.
tree_set(_, _, _).
% sys_tree_set(+Tree, +Term, +Term)
sys_tree_set(T, K, V) :- T = 'T'(_, L, K2-_, _), K @< K2, !,
(L = 'E' ->
sys_node_make('R', K, V, L2),
change_arg(2, T, L2);
sys_tree_set(L, K, V),
sys_node_balance(T)).
sys_tree_set(T, K, V) :- T = 'T'(_, _, K2-_, _), K == K2, !,
arg(3, T, P),
change_arg(2, P, V),
fail.
sys_tree_set(T, K, V) :- T = 'T'(_, _, _, R),
(R = 'E' ->
sys_node_make('R', K, V, R2),
change_arg(4, T, R2);
sys_tree_set(R, K, V),
sys_node_balance(T)).
/**
* tree_add(T, K, V):
* The predicate succeeds if the key is new. As a side effect
* the red-black tree T is extended by the key value pair K,V.
*/
% tree_add(+Root, +Term, +Term)
tree_add(U, K, V) :-
arg(1, U, T),
(T = 'E' ->
sys_node_make('B', K, V, T2),
change_arg(1, U, T2);
sys_tree_add(T, K, V),
change_arg(1, T, 'B')).
% sys_tree_add(+Tree, +Term, +Term)
sys_tree_add(T, K, V) :- T = 'T'(_, L, K2-_, _), K @< K2, !,
(L = 'E' ->
sys_node_make('R', K, V, L2),
change_arg(2, T, L2);
sys_tree_add(L, K, V),
sys_node_balance(T)).
sys_tree_add(T, K, _) :- T = 'T'(_, _, K2-_, _), K == K2, !,
fail.
sys_tree_add(T, K, V) :- T = 'T'(_, _, _, R),
(R = 'E' ->
sys_node_make('R', K, V, R2),
change_arg(4, T, R2);
sys_tree_add(R, K, V),
sys_node_balance(T)).
/***************************************************************/
/* Non-Backtracking Node Helper */
/***************************************************************/
% sys_node_make(+Atom, +Term, +Term, -Tree)
sys_node_make(C, K, V, T) :-
copy_term(K, K2),
P = _-_,
change_arg(1, P, K2),
change_arg(2, P, V),
T = 'T'(_, _, _, _),
change_arg(1, T, C),
change_arg(2, T, 'E'),
change_arg(3, T, P),
change_arg(4, T, 'E').
/**
* sys_node_balance(T):
* The predicate succeeds. As a side effect the node is balanced.
* https://www.cs.tufts.edu/~nr/cs257/archive/chris-okasaki/redblack99.pdf
*/
% sys_node_balance(+Tree)
sys_node_balance(T) :- T = 'T'('B', P, U, Q),
(P = 'T'('R', M, V, N),
(M = 'T'('R', _, _, _), !,
change_arg(1, M, 'B'),
change_arg(1, P, 'B'),
change_arg(2, P, N),
change_arg(3, P, U),
change_arg(4, P, Q),
change_arg(1, T, 'R'),
change_arg(2, T, M),
change_arg(3, T, V),
change_arg(4, T, P);
N = 'T'('R', B, Y, C), !,
change_arg(1, P, 'B'),
change_arg(4, P, B),
change_arg(1, N, 'B'),
change_arg(2, N, C),
change_arg(3, N, U),
change_arg(4, N, Q),
change_arg(1, T, 'R'),
change_arg(2, T, P),
change_arg(3, T, Y),
change_arg(4, T, N));
Q = 'T'('R', M, V, N),
(M = 'T'('R', B, Y, C), !,
change_arg(1, M, 'B'),
change_arg(2, M, P),
change_arg(3, M, U),
change_arg(4, M, B),
change_arg(1, Q, 'B'),
change_arg(2, Q, C),
change_arg(1, T, 'R'),
change_arg(2, T, M),
change_arg(3, T, Y),
change_arg(4, T, Q);
N = 'T'('R', _, _, _), !,
change_arg(1, Q, 'B'),
change_arg(2, Q, P),
change_arg(3, Q, U),
change_arg(4, Q, M),
change_arg(1, N, 'B'),
change_arg(1, T, 'R'),
change_arg(2, T, Q),
change_arg(3, T, V),
change_arg(4, T, N))).
sys_node_balance(_).
/***************************************************************/
/* Backtracking Modification */
/***************************************************************/
/**
* tree_set(T, K, V, T2):
* The predicate succeeds. It unifies T2 with the red-black tree T
* is extended by the key value pair K,V if the key is new or
* else the value for the K is replaced by V.
*/
% tree_set(+Root, +Term, +Term, -Root)
tree_set('V'(T), K, V, 'V'(T3)) :-
sys_tree_set(T, K, V, T2),
sys_node_black(T2, T3).
% sys_tree_set(+Tree, +Term, +Term, -Tree)
sys_tree_set('E', K, V, 'T'('R', 'E', K-V, 'E')).
sys_tree_set('T'(C, L, K2-V2, R), K, V, T2) :- K @< K2, !,
sys_tree_set(L, K, V, L2),
sys_node_balance(C, L2, K2-V2, R, T2).
sys_tree_set('T'(C, L, K2-_, R), K, V, M) :- K == K2, !,
'T'(C, L, K2-V, R) = M.
sys_tree_set('T'(C, L, P, R), K, V, T2) :-
sys_tree_set(R, K, V, R2),
sys_node_balance(C, L, P, R2, T2).
/**
* tree_add(T, K, V, T2):
* The predicate succeeds if the key is new. It unifies T2 with
* the red-black tree T extended by the key value pair K,V.
*/
% tree_add(+Root, +Term, +Term, -Root)
tree_add('V'(T), K, V, 'V'(T3)) :-
sys_tree_add(T, K, V, T2),
sys_node_black(T2, T3).
% sys_tree_add(+Tree, +Term, +Term, -Tree)
sys_tree_add('E', K, V, 'T'('R', 'E', K-V, 'E')).
sys_tree_add('T'(C, L, K2-V2, R), K, V, T2) :- K @< K2, !,
sys_tree_add(L, K, V, L2),
sys_node_balance(C, L2, K2-V2, R, T2).
sys_tree_add('T'(_, _, K2-_, _), K, _, _) :- K == K2, !,
fail.
sys_tree_add('T'(C, L, P, R), K, V, T2) :-
sys_tree_add(R, K, V, R2),
sys_node_balance(C, L, P, R2, T2).
/***************************************************************/
/* Backtracking Node Helper */
/***************************************************************/
% sys_node_black(+Tree, -Tree)
sys_node_black('T'('R', L, P, R), M) :- !,
'T'('B', L, P, R) = M.
sys_node_black(T, T).
% sys_node_balance(+Atom, +Tree, +Pair, +Tree, -Tree)
sys_node_balance('B', 'T'('R','T'('R', A, X, B), Y, C), Z, D, M) :- !,
'T'('R', 'T'('B', A, X, B), Y, 'T'('B', C, Z, D)) = M.
sys_node_balance('B', 'T'('R', A, X, 'T'('R', B, Y, C)), Z, D, M) :- !,
'T'('R', 'T'('B', A, X, B), Y, 'T'('B', C, Z, D)) = M.
sys_node_balance('B', A, X, 'T'('R', 'T'('R', B, Y, C), Z, D), M) :- !,
'T'('R', 'T'('B', A, X, B), Y, 'T'('B', C, Z, D)) = M.
sys_node_balance('B', A, X, 'T'('R', B, Y, 'T'('R', C, Z, D)), M) :- !,
'T'('R', 'T'('B', A, X, B), Y, 'T'('B', C, Z, D)) = M.
sys_node_balance(C, L, P, R, 'T'(C, L, P, R)).