avl_tools

add_true_to_list([],[]).

add_true_to_list([H|T],[H-true|TT]) :- add_true_to_list(T,TT).

avl_apply(Key, node((K,KY),_,_,L,R),Res,Span,WF) :-
    compare(O, Key, K),
    avl_apply_1(O, Key, L, R, KY, Res,Span,WF).

avl_apply_1(<, Key, NODE, _, _, Res,Span,WF) :-
    (NODE=node((K,KY),_,_,L,R)
    -> compare(O, Key, K),
    avl_apply_1(O, Key, L, R, KY, Res,Span,WF)
    ; add_wd_error_span('function applied outside of domain (#6): ','@fun'(Key,[]),Span,WF)
).

avl_apply_1(>, Key, _, NODE,_,Res,Span,WF) :-
    (NODE=node((K,KY),_,_,L,R)
    -> compare(O, Key, K),
    avl_apply_1(O, Key, L, R, KY, Res,Span,WF)
    ; add_wd_error_span('function applied outside of domain (#7): ','@fun'(Key,[]),Span,WF)
).

avl_apply_1(=, Key, Left,Right, KY, Res,Span,WF) :-
    ((Left = node((Key,KY2),_,_,_,_) ;
    Right = node((Key,KY2),_,_,_,_)) % this is only a partial quick test; the next & previous elements could be deeper in the tree
    % TO DO: use optimized version of avl_fetch((Key,KY2),Left) ; avl_fetch((Key,KY2),Right) if preferences:preference(find_abort_values,true),
    -> add_wd_error_span('function application used for relation: ','@rel'(Key,KY,KY2),Span,WF)
    % we do not instantiate Res in this case
    ; Res=KY).

avl_approximate_size_from_height(Height,Size) :- Size is floor(2**Height)-1.

avl_delete_pair(Key, AVL0, Val, AVL) :-
    avl_delete_pair5(AVL0, Key, Val, AVL, _).

avl_delete_pair(<, Key, Val, AVL, Delta, K, V, B, L, R) :-
    avl_delete_pair5(L, Key, Val, L1, D1),
    B1 is B+D1,
    avl:avl(B1, K, V, L1, R, AVL),
    avl:avl_shrinkage(AVL, D1, Delta).

avl_delete_pair(=, _, Val, AVL, Delta, _, Val, B, L, R) :-
    ( L == empty -> AVL = R, Delta = 1
    ; R == empty -> AVL = L, Delta = 1
    ; avl:avl_del_max(L, K, V, L1, D1),
    B1 is B+D1,
    avl:avl(B1, K, V, L1, R, AVL),
    avl:avl_shrinkage(AVL, D1, Delta)
).

avl_delete_pair(>, Key, Val, AVL, Delta, K, V, B, L, R) :-
    avl_delete_pair5(R, Key, Val, R1, D1),
    B1 is B-D1,
    avl:avl(B1, K, V, L, R1, AVL),
    avl:avl_shrinkage(AVL, D1, Delta).

avl_delete_pair5(node(K,V,B,L,R), Key, Val, AVL, Delta) :-
    K = (KX,_KY), % crucial difference
    compare(C, Key, KX),
    avl_delete_pair(C, Key, Val, AVL, Delta, K, V, B, L, R).

avl_fetch_bin(Key, BinFunctor, AVL, Res) :- (AVL=empty ; AVL=node(_,_,_,_,_)),!,
    avl_fetch_bin0(Key, BinFunctor, AVL, Res).

avl_fetch_bin(Key, BinFunctor, AVL, Res) :-
    add_internal_error('Illegal AVL tree: ',avl_fetch_bin(Key, BinFunctor, AVL, Res)),fail.

avl_fetch_bin0(Key, BinFunctor, node(Expr,_,_,L,R),Res) :-
    my_compare_bin(Expr,BinFunctor, O, Key, KY),
    avl_fetch_bin_1(O, Key, BinFunctor, L, R, KY, Res).

avl_fetch_bin_1(<, Key, BinFunctor, node(Expr,_,_,L,R), _, _, Res) :-
    my_compare_bin(Expr,BinFunctor, O, Key, KY),
    avl_fetch_bin_1(O, Key,BinFunctor, L, R, KY, Res).

avl_fetch_bin_1(=, _Key, _, _L, _R, KY, KY).

avl_fetch_bin_1(>, Key, BinFunctor, _, node(Expr,_,_,L,R),_,Res) :-
    my_compare_bin(Expr,BinFunctor, O, Key, KY),
    avl_fetch_bin_1(O, Key,BinFunctor, L, R, KY, Res).

avl_fetch_idx_1(<, Key, node(Value,_,_,L,R), _, _, Res) :-
    decompose_index(Value,K,KY),
    my_compare(O, Key, K), %((O='=',nonvar(Res)) -> print(comp(Res,KY)),nl ; true), % see TODO below
    avl_fetch_idx_1(O, Key, L, R, KY, Res).

avl_fetch_idx_1(=, _Key, _L, _R, KY, KY).

avl_fetch_idx_1(>, Key, _, node(Value,_,_,L,R),_,Res) :-
    decompose_index(Value,K,KY),
    my_compare(O, Key, K), %((O='=',nonvar(Res)) -> print(comp(Res,KY)),nl ; true), % see TODO below
    avl_fetch_idx_1(O, Key, L, R, KY, Res).

avl_fetch_pair(Key, node((K,KY),_,_,L,R),Res) :-
    my_compare(O, Key, K), %((O='=',nonvar(Res)) -> print(comp(Res,KY)),nl ; true), % see TODO below
    avl_fetch_pair_1(O, Key, L, R, KY, Res).

avl_fetch_pair_1(<, Key, node((K,KY),_,_,L,R), _, _, Res) :-
    my_compare(O, Key, K), %((O='=',nonvar(Res)) -> print(comp(Res,KY)),nl ; true), % see TODO below
    avl_fetch_pair_1(O, Key, L, R, KY, Res).

avl_fetch_pair_1(=, _Key, _L, _R, KY, KY).

avl_fetch_pair_1(>, Key, _, node((K,KY),_,_,L,R),_,Res) :-
    my_compare(O, Key, K), %((O='=',nonvar(Res)) -> print(comp(Res,KY)),nl ; true), % see TODO below
    avl_fetch_pair_1(O, Key, L, R, KY, Res).

avl_fetch_with_index(Key, node(Value,_,_,L,R),Res) :- decompose_index(Value,K,KY),
    my_compare(O, Key, K), %((O='=',nonvar(Res)) -> print(comp(Res,KY)),nl ; true), % see TODO below
    avl_fetch_idx_1(O, Key, L, R, KY, Res).

avl_height_compare(A,B,Res) :- avl_height_compare_up_to(A,B,0,0,_,Res).

avl_height_compare_up_to(Avl1,Avl2,MaxDiff,ResSz,ResCmp) :-
    avl_height_compare_up_to(Avl1,Avl2,MaxDiff,0,ResSz,ResCmp).

avl_height_compare_up_to(empty,empty,_,Sz,Sz,eq).

avl_height_compare_up_to(empty,node(_,_,B,L,R),MaxDiff,Sz,Sz,Res) :-
    (avl_height_less_than(node(_,_,B,L,R),MaxDiff) -> Res=eq ; Res=lt).

avl_height_compare_up_to(node(_,_,B,L,R),empty,MaxDiff,Sz,Sz,Res) :-
    (avl_height_less_than(node(_,_,B,L,R),MaxDiff) -> Res=eq ; Res=gt).

avl_height_compare_up_to(node(_,_,B1,L1,R1),node(_,_,B2,L2,R2),MaxDiff,AccSz,ResSz,Res) :-
    ( B1 >= 0 -> A1=R1 ; A1=L1),
    ( B2 >= 0 -> A2=R2 ; A2=L2),
    Acc1 is AccSz+1,
    avl_height_compare_up_to(A1,A2,MaxDiff,Acc1,ResSz,Res).

avl_height_less_than(empty, MaxHeight) :- MaxHeight>0.

avl_height_less_than(node(_,_,B,L,R), H0) :- H0>1,
    H1 is H0-1,
    ( B >= 0 -> avl_height_less_than(R, H1)
    ; avl_height_less_than(L, H1)
).

avl_image_interval(From,To, node((K,KY),_,_,L,R),Res) :-
    comp_interval(O, From,To, K),
    avl_image_interval_1(O, From,To, L, R, KY, Res).

avl_image_interval_1(<, From,To, NODE, _, _, Res) :-
    NODE=node((K,KY),_,_,L,R),comp_interval(O, From,To, K),
    avl_image_interval_1(O, From,To, L, R, KY, Res).

avl_image_interval_1(=, _From,_To, _Left,_Right, KY, Res) :- Res=KY.

avl_image_interval_1(>, From,To, _, NODE,_,Res) :-
    NODE=node((K,KY),_,_,L,R),
    comp_interval(O, From,To, K),
    avl_image_interval_1(O, From,To, L, R, KY, Res).

avl_max_pair(AVLFun,FFrom,FTo) :-
    (avl_max(AVLFun,(FFrom,FTo)) -> true
    ; add_error_fail(avl_max_pair,'Could not extract maximum pair of AVL set',AVLFun)).

avl_min_pair(AVLFun,FFrom,FTo) :-
    (avl_min(AVLFun,(FFrom,FTo)) -> true
    ; add_error_fail(avl_min_pair,'Could not extract minimum pair of AVL set',AVLFun)).

check_is_non_empty_avl(V) :- var(V),!, add_internal_error('Variable AVL tree:',check_is_non_empty_avl(V)).

check_is_non_empty_avl(empty) :- !, add_internal_error('Empty AVL tree:',check_is_non_empty_avl(empty)).

check_is_non_empty_avl(node(_,_,_,_,_)) :- !.

check_is_non_empty_avl(V) :- add_internal_error('Illegal AVL tree:',check_is_non_empty_avl(V)).

comp_interval(O,From,To,int(Key)) :-
    ( number(From),Key<From -> O = ('>') % could be minus_inf
    ; number(To), Key>To -> O = ('<')
    ; O = ('<') ; O = ('=') ; O = ('>')
).

decompose_index((K,KY),K,KY).

decompose_index(rec([field(F,FH)|T]),field(F,FH),rec(T)) :- T\==[]. % we could just use FH as key; assuming typechecker would catch if names mismatch

my_compare(O,K1,K2) :- compare(OK,K1,K2),
    (OK=('=') -> true /* leave O free variable */
    % TO DO: think about comparing KY and Res above
    ; O=OK).

my_compare_bin(Expr,BinFunctor, O,Key,KY) :- functor(Expr,BinFunctor,2),!,
    arg(1,Expr,K), arg(2,Expr,KY),
    my_compare(O,Key,K).

my_compare_bin(Other,BinFunctor, O,_Key,'$none') :-
    functor(Search,BinFunctor,2), % TODO: pass term with Key?
    compare(O,Search,Other).

ord_domain_list_to_avl(List,Res) :-
    add_true_to_list(List,LT),
    ord_list_to_avl(LT,Res).

quick_avl_approximate_size(AVL,Size) :- avl_height(AVL,Height), Size is floor(2**Height)-1.

test_avl_set(node(((int(2),int(3)),int(6)),true,0,node(((int(1),int(2)),int(2)),true,0,empty,empty),node(((int(3),int(4)),int(12)),true,0,empty,empty))).