[m-dev.] R-Tree implementation
Gregory James DUCK
gjd at cs.mu.OZ.AU
Wed Mar 8 14:34:37 AEDT 2006
Hi,
I originally sent this mail to mercury at cs.mu.oz.au which was apparently a bad
idea.
Up for grabs is a mercury implementation of an RTree (more specifically, a
234-RTree, see attached). The question is whether it is worth cleaning up the
code and making it part of the standard Mercury library? (I am prepared to do
this). Or are RTrees too obscure to be part of the standard library?
The implementation itself is reasonably simple (i.e. standard Guttman RTrees,
no fancy node splitting with (re)insertion, R*trees etc.).
-Greg.
-------------- next part --------------
:- module rtree.
:- interface.
:- import_module list.
:- type rtree(K,V).
%---------------------------------------------------------------------------%
:- pred init(rtree(K,V)) <= region(K).
:- mode init(out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred search_intersects(rtree(K,V),K,list(V)) <= region(K).
:- mode search_intersects(in,in,out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred search_inside(rtree(K,V),K,list(V)) <= region(K).
:- mode search_inside(in,in,out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred search_general(rtree(K,V),pred(K),list(V)).
:- mode search_general(in,pred(in) is semidet,out) is det.
%---------------------------------------------------------------------------%
% XXX: Deprecated?
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred search_fold_general(rtree(K,V),pred(K),pred(V,D,D),D,D).
:- mode search_fold_general(in,pred(in) is semidet,
pred(in,in,out) is det,in,out) is det.
:- mode search_fold_general(in,pred(in) is semidet,
pred(in,di,uo) is det,di,uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred search_first(rtree(K,V),pred(K,E),pred(V,E),E,V,E).
:- mode search_first(in,pred(in,out) is semidet,pred(in,out) is semidet,in,
out,out) is semidet.
%---------------------------------------------------------------------------%
% search_first(RTree,KTest,VTest,L,V,E)
%
% Searches for a pair (V,E) such that VTest(V,E) holds, and for all other
% pairs (V1,E1) satisfying VTest(V1,E1) we have that compare((>),E,E1) fails.
% I.e., by ordering all possible (V1,E1) pairs, we have that (V,E) is the
% "first".
%
% Here, L is the "limit", and we (additionally) require that
% compare((<),E,L) holds.
%
% KTest is similar to VTest, but calculates an E for a region key. The
% search assumes the following condition holds:
%
% (V \subseteq K) /\ VTest(V,EV) ---> KTest(V,EK) /\ (EK =< EV).
%
% I.e. if K contains V and VTest(V,EV) holds, then KTest(V,EK) holds and
% EK is less-than-or-equal-to EV.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred insert(rtree(K,V),K,V,rtree(K,V)) <= region(K).
:- mode insert(in,in,in,out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pred delete(rtree(K,V),K,V,rtree(K,V)) <= region(K).
:- mode delete(in,in,in,out) is semidet.
%---------------------------------------------------------------------------%
:- typeclass region(K) where [
pred intersects(K,K),
mode intersects(in,in) is semidet,
pred inside(K,K),
mode inside(in,in) is semidet,
pred area(K,float),
mode area(in,out) is det,
pred combine(K,K,K),
mode combine(in,in,out) is det,
pred combined_area(K,K,float),
mode combined_area(in,in,out) is det
].
:- implementation.
:- import_module float.
:- import_module int.
:- import_module require.
:- import_module std_util.
:- type rtree(K,V) ---> empty ; one(K,V) ; rtree(rtree0(K,V)).
:- type rtree0(K,V) ---> leaf(V) ;
two(K,rtree0(K,V),K,rtree0(K,V)) ;
three(K,rtree0(K,V),K,rtree0(K,V),K,rtree0(K,V)) ;
four(K,rtree0(K,V),K,rtree0(K,V),K,rtree0(K,V),
K,rtree0(K,V)).
:- inst four == bound(four(ground,ground,ground,ground,ground,ground,
ground,ground)).
:- type min_result ---> first ; second ; third.
:- type min_result4 ---> first4 ; second4 ; third4 ; fourth4.
:- type deleted(K,V) ---> deleted(K,rtree0(K,V)).
:- type deleted1(K,V) == list(deleted(K,V)).
:- type delete_info(K,V) ---> deleting(deleted1(K,V)) ;
finished(int,deleted1(K,V)).
%---------------------------------------------------------------------------%
init(T) :-
T = empty.
%---------------------------------------------------------------------------%
search_intersects(empty,_,[]).
search_intersects(one(K0,V0),K,Vs) :-
( intersects(K,K0) ->
Vs = [V0]
; Vs = []
).
search_intersects(rtree(T),K,Vs) :-
search_intersects0(T,K,[],Vs).
%---------------------------------------------------------------------------%
search_inside(empty,_,[]).
search_inside(one(K0,V0),K,Vs) :-
( inside(K,K0) ->
Vs = [V0]
; Vs = []
).
search_inside(rtree(T),K,Vs) :-
search_inside0(T,K,[],Vs).
%---------------------------------------------------------------------------%
search_general(empty,_,[]).
search_general(one(K0,V0),P,Vs) :-
( P(K0) ->
Vs = [V0]
; Vs = []
).
search_general(rtree(T),P,Vs) :-
search_general0(T,P,[],Vs).
%---------------------------------------------------------------------------%
search_fold_general(empty,_,_,!D).
search_fold_general(one(K0,V0),P,Q,!D) :-
( P(K0) ->
Q(V0,!D)
; true
).
search_fold_general(rtree(T),P,Q,!D) :-
search_fold_general0(T,P,Q,!D).
%---------------------------------------------------------------------------%
search_first(one(K0,V0),P,C,L,V0,E0) :-
maybe_limit(K0,P,L,_),
maybe_limit(V0,C,L,E0).
search_first(rtree(T),P,C,L,V,E) :-
search_first0(T,P,C,L,V,E).
%---------------------------------------------------------------------------%
insert(empty,K,V,T) :-
T = one(K,V).
insert(one(K0,V0),K,V,T) :-
T1 = two(K0,leaf(V0),K,leaf(V)),
T = rtree(T1).
insert(rtree(T0),K,V,rtree(T1)) :-
insert0(T0,K,V,T1).
%---------------------------------------------------------------------------%
delete(one(_,V),_,V,empty).
delete(rtree(T0),K,V,T) :-
delete0(T0,K,V,1,_,DT,DI),
( DI = finished(D,DLs),
reinsert_deleted_subtrees(DLs,D,DT,T1),
T = rtree(T1)
; DI = deleting(DLs),
( DLs = [deleted(NK,NT)|DLs0],
( NT = leaf(NV) ->
( DLs0 = [] ->
T = one(NK,NV)
; DLs0 = [deleted(NK1,NT1)] ->
T1 = two(NK,NT,NK1,NT1),
T = rtree(T1)
; error("delete: unbalanced rtree")
)
; reinsert_deleted_subtrees(DLs0,1,NT,T1),
T = rtree(T1)
)
; DLs = [],
error("delete: expected delete info")
)
).
%---------------------------------------------------------------------------%
:- pred reinsert_deleted_subtrees(deleted1(K,V),int,rtree0(K,V),rtree0(K,V))
<= region(K).
:- mode reinsert_deleted_subtrees(in,in,in,out) is det.
%---------------------------------------------------------------------------%
reinsert_deleted_subtrees([],_,T,T).
reinsert_deleted_subtrees([deleted(K,T)|DLs],D,T0,T2) :-
insert_tree(T0,K,T,1,D,T1),
( T0 = four(_,_,_,_,_,_,_,_) ->
reinsert_deleted_subtrees(DLs,D+2,T1,T2)
; reinsert_deleted_subtrees(DLs,D+1,T1,T2)
).
%---------------------------------------------------------------------------%
:- pred delete0(rtree0(K,V),K,V,int,K,rtree0(K,V),delete_info(K,V))
<= region(K).
:- mode delete0(in,in,in,in,out,out,out) is semidet.
%---------------------------------------------------------------------------%
delete0(T,K,V,_,DK,DT,DI) :-
T = leaf(V),
DK = K,
DT = T,
DI = deleting([]).
delete0(two(K0,T0,K1,T1),K,V,D,DK,DT,DI) :-
( try_deletion2(K0,T0,K1,T1,K,V,D,DK0,DT0,DI0) ->
DK = DK0,
DT = DT0,
DI = DI0
; try_deletion2(K1,T1,K0,T0,K,V,D,DK,DT,DI)
).
delete0(three(K0,T0,K1,T1,K2,T2),K,V,D,DK,DT,DI) :-
( try_deletion3(K0,T0,K1,T1,K2,T2,K,V,D,DK0,DT0,DI0) ->
DK = DK0,
DT = DT0,
DI = DI0
; try_deletion3(K1,T1,K0,T0,K2,T2,K,V,D,DK0,DT0,DI0) ->
DK = DK0,
DT = DT0,
DI = DI0
; try_deletion3(K2,T2,K0,T0,K1,T1,K,V,D,DK,DT,DI)
).
delete0(four(K0,T0,K1,T1,K2,T2,K3,T3),K,V,D,DK,DT,DI) :-
( try_deletion4(K0,T0,K1,T1,K2,T2,K3,T3,K,V,D,DK0,DT0,DI0) ->
DK = DK0,
DT = DT0,
DI = DI0
; try_deletion4(K1,T1,K0,T0,K2,T2,K3,T3,K,V,D,DK0,DT0,DI0) ->
DK = DK0,
DT = DT0,
DI = DI0
; try_deletion4(K2,T2,K0,T0,K1,T1,K3,T3,K,V,D,DK0,DT0,DI0) ->
DK = DK0,
DT = DT0,
DI = DI0
; try_deletion4(K3,T3,K0,T0,K1,T1,K2,T2,K,V,D,DK,DT,DI)
).
%---------------------------------------------------------------------------%
:- pred try_deletion2(K,rtree0(K,V),K,rtree0(K,V),K,V,int,K,
rtree0(K,V),delete_info(K,V)) <= region(K).
:- mode try_deletion2(in,in,in,in,in,in,in,out,out,out) is semidet.
%---------------------------------------------------------------------------%
try_deletion2(K0,T0,K1,T1,K,V,D,DK,DT,DI) :-
inside(K,K0),
delete0(T0,K,V,D+1,DK0,DT0,DI0),
( DI0 = deleting(DLs),
Del = deleted(K1,T1),
DI = deleting([Del|DLs]),
DT = DT0,
DK = K
; DI0 = finished(_,_),
DT = two(DK0,DT0,K1,T1),
combine(K1,DK0,DK),
DI = DI0
).
%---------------------------------------------------------------------------%
:- pred try_deletion3(K,rtree0(K,V),K,rtree0(K,V),K,rtree0(K,V),K,V,int,K,
rtree0(K,V),delete_info(K,V)) <= region(K).
:- mode try_deletion3(in,in,in,in,in,in,in,in,in,out,out,out) is semidet.
%---------------------------------------------------------------------------%
try_deletion3(K0,T0,K1,T1,K2,T2,K,V,D,DK,DT,DI) :-
inside(K,K0),
delete0(T0,K,V,D+1,DK0,DT0,DI0),
( DI0 = deleting(DLs),
DI = finished(D+1,DLs),
DT = two(K1,T1,K2,T2),
combine(K1,K2,DK)
; DI0 = finished(_,_),
DI = DI0,
DT = three(DK0,DT0,K1,T1,K2,T2),
combine(DK0,K1,TK),
combine(TK,K2,DK)
).
%---------------------------------------------------------------------------%
:- pred try_deletion4(K,rtree0(K,V),K,rtree0(K,V),K,rtree0(K,V),K,rtree0(K,V),
K,V,int,K, rtree0(K,V),delete_info(K,V)) <= region(K).
:- mode try_deletion4(in,in,in,in,in,in,in,in,in,in,in,out,out,out) is semidet.
%---------------------------------------------------------------------------%
try_deletion4(K0,T0,K1,T1,K2,T2,K3,T3,K,V,D,DK,DT,DI) :-
inside(K,K0),
delete0(T0,K,V,D+1,DK0,DT0,DI0),
( DI0 = deleting(DLs),
DI = finished(D+1,DLs),
DT = three(K1,T1,K2,T2,K3,T3),
combine(K1,K2,K12),
combine(K3,K12,DK)
; DI0 = finished(_,_),
DI = DI0,
DT = four(DK0,DT0,K1,T1,K2,T2,K3,T3),
combine(DK0,K1,TK),
combine(K2,K3,K23),
combine(TK,K23,DK)
).
%---------------------------------------------------------------------------%
:- pred search_intersects0(rtree0(K,V),K,list(V),list(V)) <= region(K).
:- mode search_intersects0(in,in,in,out) is det.
%---------------------------------------------------------------------------%
search_intersects0(leaf(V),_,Vs0,Vs1) :-
Vs1 = [V|Vs0].
search_intersects0(two(K0,T0,K1,T1),K,Vs0,Vs2) :-
( intersects(K,K0) ->
search_intersects0(T0,K,Vs0,Vs1)
; Vs1 = Vs0
),
( intersects(K,K1) ->
search_intersects0(T1,K,Vs1,Vs2)
; Vs2 = Vs1
).
search_intersects0(three(K0,T0,K1,T1,K2,T2),K,Vs0,Vs3) :-
( intersects(K,K0) ->
search_intersects0(T0,K,Vs0,Vs1)
; Vs1 = Vs0
),
( intersects(K,K1) ->
search_intersects0(T1,K,Vs1,Vs2)
; Vs2 = Vs1
),
( intersects(K,K2) ->
search_intersects0(T2,K,Vs2,Vs3)
; Vs3 = Vs2
).
search_intersects0(four(K0,T0,K1,T1,K2,T2,K3,T3),K,Vs0,Vs4) :-
( intersects(K,K0) ->
search_intersects0(T0,K,Vs0,Vs1)
; Vs1 = Vs0
),
( intersects(K,K1) ->
search_intersects0(T1,K,Vs1,Vs2)
; Vs2 = Vs1
),
( intersects(K,K2) ->
search_intersects0(T2,K,Vs2,Vs3)
; Vs3 = Vs2
),
( intersects(K,K3) ->
search_intersects0(T3,K,Vs3,Vs4)
; Vs4 = Vs3
).
%---------------------------------------------------------------------------%
:- pred search_inside0(rtree0(K,V),K,list(V),list(V)) <= region(K).
:- mode search_inside0(in,in,in,out) is det.
%---------------------------------------------------------------------------%
search_inside0(leaf(V),_,Vs0,Vs1) :-
Vs1 = [V|Vs0].
search_inside0(two(K0,T0,K1,T1),K,Vs0,Vs2) :-
( inside(K,K0) ->
search_inside0(T0,K,Vs0,Vs1)
; Vs1 = Vs0
),
( inside(K,K1) ->
search_inside0(T1,K,Vs1,Vs2)
; Vs2 = Vs1
).
search_inside0(three(K0,T0,K1,T1,K2,T2),K,Vs0,Vs3) :-
( inside(K,K0) ->
search_inside0(T0,K,Vs0,Vs1)
; Vs1 = Vs0
),
( inside(K,K1) ->
search_inside0(T1,K,Vs1,Vs2)
; Vs2 = Vs1
),
( inside(K,K2) ->
search_inside0(T2,K,Vs2,Vs3)
; Vs3 = Vs2
).
search_inside0(four(K0,T0,K1,T1,K2,T2,K3,T3),K,Vs0,Vs4) :-
( inside(K,K0) ->
search_inside0(T0,K,Vs0,Vs1)
; Vs1 = Vs0
),
( inside(K,K1) ->
search_inside0(T1,K,Vs1,Vs2)
; Vs2 = Vs1
),
( inside(K,K2) ->
search_inside0(T2,K,Vs2,Vs3)
; Vs3 = Vs2
),
( inside(K,K3) ->
search_inside0(T3,K,Vs3,Vs4)
; Vs4 = Vs3
).
%---------------------------------------------------------------------------%
:- pred search_general0(rtree0(K,V),pred(K),list(V),list(V)).
:- mode search_general0(in,pred(in) is semidet,in,out) is det.
%---------------------------------------------------------------------------%
search_general0(leaf(V),_,Vs0,Vs1) :-
Vs1 = [V|Vs0].
search_general0(two(K0,T0,K1,T1),P,Vs0,Vs2) :-
( P(K0) ->
search_general0(T0,P,Vs0,Vs1)
; Vs1 = Vs0
),
( P(K1) ->
search_general0(T1,P,Vs1,Vs2)
; Vs2 = Vs1
).
search_general0(three(K0,T0,K1,T1,K2,T2),P,Vs0,Vs3) :-
( P(K0) ->
search_general0(T0,P,Vs0,Vs1)
; Vs1 = Vs0
),
( P(K1) ->
search_general0(T1,P,Vs1,Vs2)
; Vs2 = Vs1
),
( P(K2) ->
search_general0(T2,P,Vs2,Vs3)
; Vs3 = Vs2
).
search_general0(four(K0,T0,K1,T1,K2,T2,K3,T3),P,Vs0,Vs4) :-
( P(K0) ->
search_general0(T0,P,Vs0,Vs1)
; Vs1 = Vs0
),
( P(K1) ->
search_general0(T1,P,Vs1,Vs2)
; Vs2 = Vs1
),
( P(K2) ->
search_general0(T2,P,Vs2,Vs3)
; Vs3 = Vs2
),
( P(K3) ->
search_general0(T3,P,Vs3,Vs4)
; Vs4 = Vs3
).
%---------------------------------------------------------------------------%
:- pred search_fold_general0(rtree0(K,V),pred(K),pred(V,D,D),D,D).
:- mode search_fold_general0(in,pred(in) is semidet,
pred(in,in,out) is det,in,out) is det.
:- mode search_fold_general0(in,pred(in) is semidet,
pred(in,di,uo) is det,di,uo) is det.
%---------------------------------------------------------------------------%
search_fold_general0(leaf(V),_,Q,!D) :-
Q(V,!D).
search_fold_general0(two(K0,T0,K1,T1),P,Q,!D) :-
( P(K0) ->
search_fold_general0(T0,P,Q,!D)
; true
),
( P(K1) ->
search_fold_general0(T1,P,Q,!D)
; true
).
search_fold_general0(three(K0,T0,K1,T1,K2,T2),P,Q,!D) :-
( P(K0) ->
search_fold_general0(T0,P,Q,!D)
; true
),
( P(K1) ->
search_fold_general0(T1,P,Q,!D)
; true
),
( P(K2) ->
search_fold_general0(T2,P,Q,!D)
; true
).
search_fold_general0(four(K0,T0,K1,T1,K2,T2,K3,T3),P,Q,!D) :-
( P(K0) ->
search_fold_general0(T0,P,Q,!D)
; true
),
( P(K1) ->
search_fold_general0(T1,P,Q,!D)
; true
),
( P(K2) ->
search_fold_general0(T2,P,Q,!D)
; true
),
( P(K3) ->
search_fold_general0(T3,P,Q,!D)
; true
).
%---------------------------------------------------------------------------%
:- pred search_first0(rtree0(K,V),pred(K,E),pred(V,E),E,V,E).
:- mode search_first0(in,pred(in,out) is semidet,pred(in,out) is semidet,
in,out,out) is semidet.
%---------------------------------------------------------------------------%
search_first0(leaf(V),_,C,L,V,E) :-
maybe_limit(V,C,L,E).
search_first0(two(K0,T0,K1,T1),P,C,L,V,E) :-
( maybe_limit(K0,P,L,E0) ->
( maybe_limit(K1,P,L,E1) ->
search_first0_two_choices(E0,E1,T0,T1,P,C,L,V,E)
; search_first0(T0,P,C,L,V,E)
)
; maybe_limit(K1,P,L,_),
search_first0(T1,P,C,L,V,E)
).
search_first0(three(K0,T0,K1,T1,K2,T2),P,C,L,V,E) :-
( maybe_limit(K0,P,L,E0) ->
( maybe_limit(K1,P,L,E1) ->
( maybe_limit(K2,P,L,E2) ->
search_first0_three_choices(E0,E1,E2,T0,T1,T2,P,C,L,V,E)
; search_first0_two_choices(E0,E1,T0,T1,P,C,L,V,E)
)
; maybe_limit(K2,P,L,E2) ->
search_first0_two_choices(E0,E2,T0,T2,P,C,L,V,E)
; search_first0(T0,P,C,L,V,E)
)
; maybe_limit(K1,P,L,E1) ->
( maybe_limit(K2,P,L,E2) ->
search_first0_two_choices(E1,E2,T1,T2,P,C,L,V,E)
; search_first0(T1,P,C,L,V,E)
)
; maybe_limit(K2,P,L,_),
search_first0(T2,P,C,L,V,E)
).
search_first0(four(K0,T0,K1,T1,K2,T2,K3,T3),P,C,L,V,E) :-
( maybe_limit(K0,P,L,E0) ->
( maybe_limit(K1,P,L,E1) ->
( maybe_limit(K2,P,L,E2) ->
( maybe_limit(K3,P,L,E3) ->
search_first0_four_choices(E0,E1,E2,E3,T0,T1,T2,T3,P,C,L,V,E)
; search_first0_three_choices(E0,E1,E2,T0,T1,T2,P,C,L,V,E)
)
; ( maybe_limit(K3,P,L,E3) ->
search_first0_three_choices(E0,E1,E3,T0,T1,T3,P,C,L,V,E)
; search_first0_two_choices(E0,E1,T0,T1,P,C,L,V,E)
)
)
; ( maybe_limit(K2,P,L,E2) ->
( maybe_limit(K3,P,L,E3) ->
search_first0_three_choices(E0,E2,E3,T0,T2,T3,P,C,L,V,E)
; search_first0_two_choices(E0,E2,T0,T2,P,C,L,V,E)
)
; ( maybe_limit(K3,P,L,E3) ->
search_first0_two_choices(E0,E3,T0,T3,P,C,L,V,E)
; search_first0(T0,P,C,L,V,E)
)
)
)
; maybe_limit(K1,P,L,E1) ->
( maybe_limit(K2,P,L,E2) ->
( maybe_limit(K3,P,L,E3) ->
search_first0_three_choices(E1,E2,E3,T1,T2,T3,P,C,L,V,E)
; search_first0_two_choices(E1,E2,T1,T2,P,C,L,V,E)
)
; ( maybe_limit(K3,P,L,E3) ->
search_first0_two_choices(E1,E3,T1,T3,P,C,L,V,E)
; search_first0(T1,P,C,L,V,E)
)
)
; maybe_limit(K2,P,L,E2) ->
( maybe_limit(K3,P,L,E3) ->
search_first0_two_choices(E2,E3,T2,T3,P,C,L,V,E)
; search_first0(T2,P,C,L,V,E)
)
; maybe_limit(K3,P,L,_),
search_first0(T3,P,C,L,V,E)
).
%---------------------------------------------------------------------------%
:- pred maybe_limit(K,pred(K,E),E,E).
:- mode maybe_limit(in,pred(in,out) is semidet,in,out) is semidet.
%---------------------------------------------------------------------------%
% maybe_limit(K,P,L,E) holds if P(K,E) holds and E is less than the limit L.
%---------------------------------------------------------------------------%
maybe_limit(K,P,L,E) :-
P(K,E),
compare((<),E,L).
%---------------------------------------------------------------------------%
:- pred search_first0_two_choices(E,E,rtree0(K,V),rtree0(K,V),pred(K,E),
pred(V,E),E,V,E).
:- mode search_first0_two_choices(in,in,in,in,pred(in,out) is semidet,
pred(in,out) is semidet,in,out,out) is semidet.
%---------------------------------------------------------------------------%
search_first0_two_choices(E0,E1,T0,T1,P,C,L,V,E) :-
compare(R,E0,E1),
( R = (<) ->
search_first0_try_first_from_two(E1,T0,T1,P,C,L,V,E)
; search_first0_try_first_from_two(E0,T1,T0,P,C,L,V,E)
).
%---------------------------------------------------------------------------%
:- pred search_first0_three_choices(E,E,E,rtree0(K,V),rtree0(K,V),rtree0(K,V),
pred(K,E),pred(V,E),E,V,E).
:- mode search_first0_three_choices(in,in,in,in,in,in,pred(in,out) is semidet,
pred(in,out) is semidet,in,out,out) is semidet.
%---------------------------------------------------------------------------%
search_first0_three_choices(E0,E1,E2,T0,T1,T2,P,C,L,V,E) :-
min_3(E0,E1,E2,R),
( R = first,
search_first0_try_first_from_three(E1,E2,T0,T1,T2,P,C,L,V,E)
; R = second,
search_first0_try_first_from_three(E0,E2,T1,T0,T2,P,C,L,V,E)
; R = third,
search_first0_try_first_from_three(E0,E1,T2,T0,T1,P,C,L,V,E)
).
%---------------------------------------------------------------------------%
:- pred search_first0_four_choices(E,E,E,E,rtree0(K,V),rtree0(K,V),
rtree0(K,V),rtree0(K,V),pred(K,E),pred(V,E),E,V,E).
:- mode search_first0_four_choices(in,in,in,in,in,in,in,in,
pred(in,out) is semidet,pred(in,out) is semidet,in,out,out)
is semidet.
%---------------------------------------------------------------------------%
search_first0_four_choices(E0,E1,E2,E3,T0,T1,T2,T3,P,C,L,V,E) :-
min_4(E0,E1,E2,E3,R),
( R = first4,
search_first0_try_first_from_four(E1,E2,E3,T0,T1,T2,T3,P,C,L,V,E)
; R = second4,
search_first0_try_first_from_four(E0,E2,E3,T1,T0,T2,T3,P,C,L,V,E)
; R = third4,
search_first0_try_first_from_four(E0,E1,E3,T2,T0,T1,T3,P,C,L,V,E)
; R = fourth4,
search_first0_try_first_from_four(E0,E1,E2,T3,T0,T1,T2,P,C,L,V,E)
).
%---------------------------------------------------------------------------%
:- pred search_first0_try_first_from_four(E,E,E,rtree0(K,V),rtree0(K,V),
rtree0(K,V),rtree0(K,V),pred(K,E),pred(V,E),E,V,E).
:- mode search_first0_try_first_from_four(in,in,in,in,in,in,in,
pred(in,out) is semidet,pred(in,out) is semidet,in,out,out)
is semidet.
%---------------------------------------------------------------------------%
search_first0_try_first_from_four(E1,E2,E3,T0,T1,T2,T3,P,C,L,V,E) :-
( search_first0(T0,P,C,L,V0,E0) ->
search_first0_find_better_solution_three(V0,E0,E1,E2,E3,T1,T2,T3,P,C,V,E)
; search_first0_three_choices(E1,E2,E3,T1,T2,T3,P,C,L,V,E)
).
%---------------------------------------------------------------------------%
:- pred search_first0_try_first_from_three(E,E,rtree0(K,V),rtree0(K,V),
rtree0(K,V),pred(K,E),pred(V,E),E,V,E).
:- mode search_first0_try_first_from_three(in,in,in,in,in,
pred(in,out) is semidet,pred(in,out) is semidet,in,out,out)
is semidet.
%---------------------------------------------------------------------------%
search_first0_try_first_from_three(E1,E2,T0,T1,T2,P,C,L,V,E) :-
( search_first0(T0,P,C,L,V0,E0) ->
search_first0_find_better_solution_two(V0,E0,E1,E2,T1,T2,P,C,V,E)
; search_first0_two_choices(E1,E2,T1,T2,P,C,L,V,E)
).
%---------------------------------------------------------------------------%
:- pred search_first0_try_first_from_two(E,rtree0(K,V),rtree0(K,V),
pred(K,E),pred(V,E),E,V,E).
:- mode search_first0_try_first_from_two(in,in,in,
pred(in,out) is semidet,pred(in,out) is semidet,in,out,out)
is semidet.
%---------------------------------------------------------------------------%
search_first0_try_first_from_two(E1,T0,T1,P,C,L,V,E) :-
( search_first0(T0,P,C,L,V0,E0) ->
search_first0_find_better_solution_one(V0,E0,E1,T1,P,C,V,E)
; search_first0(T1,P,C,L,V,E)
).
%---------------------------------------------------------------------------%
:- pred search_first0_find_better_solution_one(V,E,E,rtree0(K,V),
pred(K,E),pred(V,E),V,E).
:- mode search_first0_find_better_solution_one(in,in,in,in,
pred(in,out) is semidet,pred(in,out) is semidet,out,out)
is det.
%---------------------------------------------------------------------------%
search_first0_find_better_solution_one(VM,EM,E0,T0,P,C,V,E) :-
compare(R,EM,E0),
( R = (<) ->
V = VM,
E = EM
; search_first0(T0,P,C,EM,V0,F0) ->
compare(R1,EM,F0),
( R1 = (<) ->
V = VM,
E = EM
; V = V0,
E = F0
)
; V = VM,
E = EM
).
%---------------------------------------------------------------------------%
:- pred search_first0_find_better_solution_two(V,E,E,E,rtree0(K,V),
rtree0(K,V),pred(K,E),pred(V,E),V,E).
:- mode search_first0_find_better_solution_two(in,in,in,in,in,
in,pred(in,out) is semidet,pred(in,out) is semidet,out,out)
is det.
%---------------------------------------------------------------------------%
search_first0_find_better_solution_two(VM,EM,E0,E1,T0,T1,P,C,V,E) :-
min_3(EM,E0,E1,R),
( R = first,
V = VM,
E = EM
; R = second,
search_first0_better_solution_two(VM,EM,E1,T0,T1,P,C,V,E)
; R = third,
search_first0_better_solution_two(VM,EM,E0,T1,T0,P,C,V,E)
).
%---------------------------------------------------------------------------%
:- pred search_first0_better_solution_two(V,E,E,rtree0(K,V),
rtree0(K,V),pred(K,E),pred(V,E),V,E).
:- mode search_first0_better_solution_two(in,in,in,in,
in,pred(in,out) is semidet,pred(in,out) is semidet,out,out)
is det.
%---------------------------------------------------------------------------%
search_first0_better_solution_two(VM,EM,E1,T0,T1,P,C,V,E) :-
( search_first0(T0,P,C,EM,V0,F0) ->
compare(RM,EM,F0),
( RM = (<) ->
search_first0_find_better_solution_one(VM,EM,E1,T1,P,C,V,E)
; search_first0_find_better_solution_one(V0,F0,E1,T1,P,C,V,E)
)
; search_first0_find_better_solution_one(VM,EM,E1,T1,P,C,V,E)
).
%---------------------------------------------------------------------------%
:- pred search_first0_find_better_solution_three(V,E,E,E,E,rtree0(K,V),
rtree0(K,V),rtree0(K,V),pred(K,E),pred(V,E),V,E).
:- mode search_first0_find_better_solution_three(in,in,in,in,in,in,in,
in,pred(in,out) is semidet,pred(in,out) is semidet,out,out)
is det.
%---------------------------------------------------------------------------%
search_first0_find_better_solution_three(VM,EM,E0,E1,E2,T0,T1,T2,P,C,V,E) :-
min_4(EM,E0,E1,E2,R),
( R = first4,
V = VM,
E = EM
; R = second4,
search_first0_better_solution_three(VM,EM,E1,E2,T0,T1,T2,P,C,V,E)
; R = third4,
search_first0_better_solution_three(VM,EM,E0,E2,T1,T0,T2,P,C,V,E)
; R = fourth4,
search_first0_better_solution_three(VM,EM,E0,E1,T2,T0,T1,P,C,V,E)
).
%---------------------------------------------------------------------------%
:- pred search_first0_better_solution_three(V,E,E,E,rtree0(K,V),
rtree0(K,V),rtree0(K,V),pred(K,E),pred(V,E),V,E).
:- mode search_first0_better_solution_three(in,in,in,in,in,in,
in,pred(in,out) is semidet,pred(in,out) is semidet,out,out)
is det.
%---------------------------------------------------------------------------%
search_first0_better_solution_three(VM,EM,E1,E2,T0,T1,T2,P,C,V,E) :-
( search_first0(T0,P,C,EM,V0,F0) ->
compare(RM,EM,F0),
( RM = (<) ->
search_first0_find_better_solution_two(VM,EM,E1,E2,T1,T2,P,C,V,E)
; search_first0_find_better_solution_two(V0,F0,E1,E2,T1,T2,P,C,V,E)
)
; search_first0_find_better_solution_two(VM,EM,E1,E2,T1,T2,P,C,V,E)
).
%---------------------------------------------------------------------------%
:- pred insert0(rtree0(K,V),K,V,rtree0(K,V)) <= region(K).
:- mode insert0(in,in,in,out) is det.
%---------------------------------------------------------------------------%
% Note: the 4-node case means the input tree is the root node, otherwise
% splitting ensures we only see 2 or 3 nodes for the rest of the descent.
% Also, we should never see a leaf node.
%---------------------------------------------------------------------------%
insert0(leaf(_),_,_,_) :-
error("insert: leaf unexpected").
insert0(two(K0,T0,K1,T1),K,V,T) :-
include2(K,K0,K1,Result),
( Result = first ->
insert_and_split_child2(K0,T0,K1,T1,K,V,T)
; insert_and_split_child2(K1,T1,K0,T0,K,V,T)
).
insert0(three(K0,T0,K1,T1,K2,T2),K,V,T) :-
include3(K,K0,K1,K2,Result),
( Result = first,
insert_and_split_child3(K0,T0,K1,T1,K2,T2,K,V,T)
; Result = second,
insert_and_split_child3(K1,T1,K0,T0,K2,T2,K,V,T)
; Result = third,
insert_and_split_child3(K2,T2,K0,T0,K1,T1,K,V,T)
).
insert0(Four,K,V,T) :-
Four = four(_,_,_,_,_,_,_,_),
split_4_node(Four,K0,T0,K1,T1),
NRT = two(K0,T0,K1,T1),
insert0(NRT,K,V,T).
%---------------------------------------------------------------------------%
:- pred insert_and_split_child2(K,rtree0(K,V),K,rtree0(K,V),K,V,
rtree0(K,V)) <= region(K).
:- mode insert_and_split_child2(in,in,in,in,in,in,out) is det.
%---------------------------------------------------------------------------%
insert_and_split_child2(K0,T0,K1,T1,K,V,T) :-
( T0 = leaf(_),
T = three(K0,T0,K1,T1,K,leaf(V))
; T0 = two(_,_,_,_),
combine(K,K0,NK0),
insert0(T0,K,V,NT0),
T = two(NK0,NT0,K1,T1)
; T0 = three(_,_,_,_,_,_),
combine(K,K0,NK0),
insert0(T0,K,V,NT0),
T = two(NK0,NT0,K1,T1)
; T0 = four(_,_,_,_,_,_,_,_),
split_4_node(T0,K2,T2,K3,T3),
include2(K,K2,K3,Result),
( Result = first ->
combine(K,K2,K4),
insert0(T2,K,V,T4),
T = three(K1,T1,K3,T3,K4,T4)
; combine(K,K3,K4),
insert0(T3,K,V,T4),
T = three(K1,T1,K2,T2,K4,T4)
)
).
%---------------------------------------------------------------------------%
:- pred insert_and_split_child3(K,rtree0(K,V),K,rtree0(K,V),K,rtree0(K,V),K,V,
rtree0(K,V)) <= region(K).
:- mode insert_and_split_child3(in,in,in,in,in,in,in,in,out) is det.
%---------------------------------------------------------------------------%
insert_and_split_child3(K0,T0,K1,T1,K2,T2,K,V,T) :-
( T0 = leaf(_),
T = four(K0,T0,K1,T1,K2,T2,K,leaf(V))
; T0 = two(_,_,_,_),
combine(K,K0,NK0),
insert0(T0,K,V,NT0),
T = three(NK0,NT0,K1,T1,K2,T2)
; T0 = three(_,_,_,_,_,_),
combine(K,K0,NK0),
insert0(T0,K,V,NT0),
T = three(NK0,NT0,K1,T1,K2,T2)
; T0 = four(_,_,_,_,_,_,_,_),
split_4_node(T0,K3,T3,K4,T4),
include2(K,K2,K3,Result),
( Result = first ->
combine(K,K3,K5),
insert0(T3,K,V,T5),
T = four(K1,T1,K2,T2,K4,T4,K5,T5)
; combine(K,K4,K5),
insert0(T4,K,V,T5),
T = four(K1,T1,K2,T2,K3,T3,K5,T5)
)
).
%---------------------------------------------------------------------------%
:- pred insert_tree(rtree0(K,V),K,rtree0(K,V),int,int,rtree0(K,V))
<= region(K).
:- mode insert_tree(in,in,in,in,in,out) is det.
%---------------------------------------------------------------------------%
% Very similar to insert0, except we are inserting a subtree at depth D0,
% instead of data into a leaf.
%---------------------------------------------------------------------------%
insert_tree(leaf(_),_,_,_,_,_) :-
error("insert_tree: leaf unexpected").
insert_tree(two(K0,T0,K1,T1),K,S,D0,D,T) :-
( D0 = D ->
T = three(K0,T0,K1,T1,K,S)
; include2(K,K0,K1,Result),
( Result = first ->
insert_tree_and_split_child2(K0,T0,K1,T1,K,S,D0+1,D,T)
; insert_tree_and_split_child2(K1,T1,K0,T0,K,S,D0+1,D,T)
)
).
insert_tree(three(K0,T0,K1,T1,K2,T2),K,S,D0,D,T) :-
( D0 = D ->
T = four(K0,T0,K1,T1,K2,T2,K,S)
; include3(K,K0,K1,K2,Result),
( Result = first,
insert_tree_and_split_child3(K0,T0,K1,T1,K2,T2,K,S,D0+1,D,T)
; Result = second,
insert_tree_and_split_child3(K1,T1,K0,T0,K2,T2,K,S,D0+1,D,T)
; Result = third,
insert_tree_and_split_child3(K2,T2,K0,T0,K1,T1,K,S,D0+1,D,T)
)
).
insert_tree(Four,K,S,_,D,T) :-
Four = four(_,_,_,_,_,_,_,_),
split_4_node(Four,K0,T0,K1,T1),
NRT = two(K0,T0,K1,T1),
insert_tree(NRT,K,S,1,D+1,T).
%---------------------------------------------------------------------------%
:- pred insert_tree_and_split_child2(K,rtree0(K,V),K,rtree0(K,V),K,rtree0(K,V),
int,int,rtree0(K,V)) <= region(K).
:- mode insert_tree_and_split_child2(in,in,in,in,in,in,in,in,out) is det.
%---------------------------------------------------------------------------%
insert_tree_and_split_child2(K0,T0,K1,T1,K,S,D0,D,T) :-
( T0 = leaf(_),
T = three(K0,T0,K1,T1,K,S)
; T0 = two(_,_,_,_),
combine(K,K0,NK0),
insert_tree(T0,K,S,D0,D,NT0),
T = two(NK0,NT0,K1,T1)
; T0 = three(_,_,_,_,_,_),
combine(K,K0,NK0),
insert_tree(T0,K,S,D0,D,NT0),
T = two(NK0,NT0,K1,T1)
; T0 = four(_,_,_,_,_,_,_,_),
split_4_node(T0,K2,T2,K3,T3),
include2(K,K2,K3,Result),
( Result = first ->
combine(K,K2,K4),
insert_tree(T2,K,S,D0,D,T4),
T = three(K1,T1,K3,T3,K4,T4)
; combine(K,K3,K4),
insert_tree(T3,K,S,D0,D,T4),
T = three(K1,T1,K2,T2,K4,T4)
)
).
%---------------------------------------------------------------------------%
:- pred insert_tree_and_split_child3(K,rtree0(K,V),K,rtree0(K,V),K,rtree0(K,V),
K,rtree0(K,V),int,int,rtree0(K,V)) <= region(K).
:- mode insert_tree_and_split_child3(in,in,in,in,in,in,in,in,in,in,out) is det.
%---------------------------------------------------------------------------%
insert_tree_and_split_child3(K0,T0,K1,T1,K2,T2,K,S,D0,D,T) :-
( T0 = leaf(_),
T = four(K0,T0,K1,T1,K2,T2,K,S)
; T0 = two(_,_,_,_),
combine(K,K0,NK0),
insert_tree(T0,K,S,D0,D,NT0),
T = three(NK0,NT0,K1,T1,K2,T2)
; T0 = three(_,_,_,_,_,_),
combine(K,K0,NK0),
insert_tree(T0,K,S,D0,D,NT0),
T = three(NK0,NT0,K1,T1,K2,T2)
; T0 = four(_,_,_,_,_,_,_,_),
split_4_node(T0,K3,T3,K4,T4),
include2(K,K2,K3,Result),
( Result = first ->
combine(K,K3,K5),
insert_tree(T3,K,S,D0,D,T5),
T = four(K1,T1,K2,T2,K4,T4,K5,T5)
; combine(K,K4,K5),
insert_tree(T4,K,S,D0,D,T5),
T = four(K1,T1,K2,T2,K3,T3,K5,T5)
)
).
%---------------------------------------------------------------------------%
:- pred include2(K,K,K,min_result) <= region(K).
:- mode include2(in,in,in,out) is det.
%---------------------------------------------------------------------------%
include2(K0,K1,K2,Result) :-
area(K1,A1),
area(K2,A2),
combined_area(K0,K1,A01),
combined_area(K0,K2,A02),
D1 = A01 - A1,
D2 = A02 - A2,
include_min(D1,D2,A1,A2,first,second,Result).
%---------------------------------------------------------------------------%
:- pred include3(K,K,K,K,min_result) <= region(K).
:- mode include3(in,in,in,in,out) is det.
%---------------------------------------------------------------------------%
include3(K0,K1,K2,K3,Result) :-
area(K1,A1),
area(K2,A2),
area(K3,A3),
combined_area(K0,K1,A01),
combined_area(K0,K2,A02),
combined_area(K0,K3,A03),
D1 = A01 - A1,
D2 = A02 - A2,
D3 = A03 - A3,
include_min(D1,D2,A1,A2,first,second,Result0),
( Result0 = first ->
include_min(D1,D3,A1,A3,first,third,Result)
; include_min(D2,D3,A2,A3,second,third,Result)
).
%---------------------------------------------------------------------------%
:- pred include_min(float,float,float,float,min_result,min_result,min_result).
:- mode include_min(in,in,in,in,in,in,out) is det.
%---------------------------------------------------------------------------%
include_min(D1,D2,A1,A2,R1,R2,R3) :-
( D1 < D2 ->
R3 = R1
; D1 > D2 ->
R3 = R2
; A1 =< A2 ->
R3 = R1
; R3 = R2
).
%---------------------------------------------------------------------------%
:- pred split_4_node(rtree0(K,V),K,rtree0(K,V),K,rtree0(K,V)) <= region(K).
:- mode split_4_node(in(four),out,out,out,out) is det.
%---------------------------------------------------------------------------%
split_4_node(Four,K4,T4,K5,T5) :-
Four = four(K0,T0,K1,T1,K2,T2,K3,T3),
combined_area(K0,K1,A01),
combined_area(K2,K3,A23),
A0123 = A01 + A23,
combined_area(K0,K2,A02),
combined_area(K1,K3,A13),
A0213 = A02 + A13,
combined_area(K0,K3,A03),
combined_area(K1,K2,A12),
A0312 = A03 + A12,
( A0123 =< A0213 ->
( A0123 =< A0312 ->
Min = first
; Min = third
)
; ( A0213 =< A0312 ->
Min = second
; Min = third
)
),
( Min = first,
combine(K0,K1,K4),
T4 = two(K0,T0,K1,T1),
combine(K2,K3,K5),
T5 = two(K2,T2,K3,T3)
; Min = second,
combine(K0,K2,K4),
T4 = two(K0,T0,K2,T2),
combine(K1,K3,K5),
T5 = two(K1,T1,K3,T3)
; Min = third,
combine(K0,K3,K4),
T4 = two(K0,T0,K3,T3),
combine(K1,K2,K5),
T5 = two(K1,T1,K2,T2)
).
%---------------------------------------------------------------------------%
:- pred min_3(E,E,E,min_result).
:- mode min_3(in,in,in,out) is det.
%---------------------------------------------------------------------------%
min_3(E0,E1,E2,M) :-
compare(R0,E0,E1),
( R0 = (<) ->
compare(R1,E0,E2),
( R1 = (<) ->
M = first
; M = third
)
; compare(R1,E1,E2),
( R1 = (<) ->
M = second
; M = third
)
).
%---------------------------------------------------------------------------%
:- pred min_4(E,E,E,E,min_result4).
:- mode min_4(in,in,in,in,out) is det.
%---------------------------------------------------------------------------%
min_4(E0,E1,E2,E3,M) :-
compare(R0,E0,E1),
( R0 = (<) ->
M0 = first4,
F0 = E0
; M0 = second4,
F0 = E1
),
compare(R1,F0,E2),
( R1 = (<) ->
M1 = M0,
F1 = F0
; M1 = third4,
F1 = E2
),
compare(R2,F1,E3),
( R2 = (<) ->
M = M1
; M = fourth4
).
/*
%---------------------------------------------------------------------------%
:- pred is_balanced(string,rtree0(K,V)).
:- mode is_balanced(in,in) is det.
%---------------------------------------------------------------------------%
is_balanced(M,T) :-
( is_balanced(T,1,_) ->
true
; error(M ++ " NOT BALANCED!")
).
%---------------------------------------------------------------------------%
:- pred is_balanced(rtree0(K,V),int,int).
:- mode is_balanced(in,in,out) is semidet.
%---------------------------------------------------------------------------%
% XXX: for debugging.
%---------------------------------------------------------------------------%
is_balanced(leaf(_),D0,D1) :-
D1 = D0.
is_balanced(two(_,T0,_,T1),D0,D1) :-
is_balanced(T0,D0+1,DT0),
is_balanced(T1,D0+1,DT1),
max(DT0,DT1,Mx),
min(DT0,DT1,Mn),
Mx - Mn =< 1,
D1 = Mx.
is_balanced(three(_,T0,_,T1,_,T2),D0,D1) :-
is_balanced(T0,D0+1,DT0),
is_balanced(T1,D0+1,DT1),
is_balanced(T2,D0+1,DT2),
max(DT0,DT1,Mx0),
max(Mx0,DT2,Mx),
min(DT0,DT1,Mn0),
min(DT2,Mn0,Mn),
Mx - Mn =< 1,
D1 = Mx.
is_balanced(four(_,T0,_,T1,_,T2,_,T3),D0,D1) :-
is_balanced(T0,D0+1,DT0),
is_balanced(T1,D0+1,DT1),
is_balanced(T2,D0+1,DT2),
is_balanced(T3,D0+1,DT3),
max(DT0,DT1,Mx0),
max(Mx0,DT2,Mx1),
max(Mx1,DT3,Mx),
min(DT0,DT1,Mn0),
min(DT2,Mn0,Mn1),
min(DT3,Mn1,Mn),
Mx - Mn =< 1,
D1 = Mx.
*/
More information about the developers
mailing list