Prolog "tree"

Admin User, erstellt 06. Apr. 2025
         
/**
* 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(J),
reverse(L, R),
sys_tree_build(R, J, H).
tree_pairs('V'(T), L) :-
sys_tree_pairs(T, L, []).
% sys_tree_build(+List, +Hash, -Hash)
sys_tree_build([], H, H).
sys_tree_build([K-V|L], J, H) :-
tree_add(J, K, V, I), !,
sys_tree_build(L, I, H).
sys_tree_build([_|L], J, H) :-
sys_tree_build(L, J, H).
% 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('V'('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).
/***************************************************************/
/* 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)).