[m-dev.] R-Tree implementation
Gregory James DUCK
gjd at cs.mu.OZ.AU
Thu Mar 23 11:58:11 AEDT 2006
Hi,
> > 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?
>
> Yes, I think so. The cleanup should make the module conform to the style
> we used in the other modules of the standard library, e.g. tree234.m.
Find a new version of rtree.m attached.
I've clean up the file (e.g. correct spacing, comments) + added some additional
functionality (e.g. fold, map_values). Also added three "built-in" instances
of the typeclass region(K).
I think the plan is that Julien will integrate the module into the library --
unless people request further changes.
Cheers,
-Greg.
-------------- next part --------------
%---------------------------------------------------------------------------%
% Copyright (C) 2006 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: rtree.m - implements an R-tree for organizing spatial data.
% Main author: gjd.
% Stability: low.
%
% This file provides an region tree (R-tree) ADT. An R-tree associates
% values to regions in some space, e.g. rectangles in the 2D plane, or
% bounding spheres in 3D space, etc. R-trees accept spacial queries, e.g. a
% typical usage is "find all pubs within a 2Km radius".
%
% This module provides the region(K) typeclass, which allows the user to
% define new regions and spaces. Three "builtin" instances for region(K)
% are provided: region(interval), region(box) and region(box3d) corresponding
% to "square" regions in 1, 2 and 3 dimensional space respectively.
%
%---------------------------------------------------------------------------%
:- module rtree.
:- interface.
:- import_module list.
:- type rtree(K, V).
:- typeclass region(K) where [
% Tests whether two regions intersect.
%
pred intersects(K::in, K::in) is semidet,
% Tests whether the first region is contained with the second.
%
pred contains(K::in, K::in) is semidet,
% Computes the "size" of a region.
% E.g. for a 2D box, the "size" is equivalent to area.
%
func size(K) = float,
% Computes a bounding region that contains both input regions.
% The resulting region should be as small as possible.
%
func bounding_region(K, K) = K,
% Computes the size of the bounding region returned by
% bounding_region/2, i.e.
%
% bounding_region_size(K1,K2) =
% size(bounding_region(K1,K2)).
%
% Lazy programmers can use this definition, however usually a
% better implementation can be found, e.g. for intervals:
%
% bounding_region_size(interval(X0,X1),interval(Y0,Y1)) =
% max(X1,Y1) - min(X0,Y0).
%
% This version is more efficient since it does not create a
% temporary interval.
%
func bounding_region_size(K, K) = float
].
% Initialize an empty rtree.
%
:- pred rtree.init(rtree(K, V)::uo) is det <= region(K).
:- func rtree.init = (rtree(K, V)::uo) is det <= region(K).
% Check whether an rtree is empty.
%
:- pred rtree.is_empty(rtree(K, V)::in) is semidet.
% Insert a new key and corresponding value into an rtree.
%
:- pred rtree.insert(K::in, V::in, rtree(K, V)::in, rtree(K, V)::out) is det
<= region(K).
% Delete a key-value pair from an rtree.
% Assumes that K is either the key for V, or is contained in the key for
% V.
%
:- pred rtree.delete(K::in, V::in, rtree(K, V)::in, rtree(K, V)::out)
is semidet <= region(K).
% Search for all values with keys that intersect the query key.
%
:- pred rtree.search_intersects(rtree(K, V)::in, K::in, list(V)::out) is det
<= region(K).
% Search for all values with keys that contain the query key.
%
:- pred rtree.search_contains(rtree(K, V)::in, K::in, list(V)::out) is det
<= region(K).
% search_general(KTest,VTest,T,Vs):
%
% Search for all values V with associated keys K that satisfy
% KTest(K) /\ VTest(V). The search assumes that for all K1, K2 such
% that K1 contains K2, then if KTest(K2) holds we have that KTest(K1) also
% holds.
%
% We have that:
% search_intersects(T,K,Vs) <=> search_general(intersects(K),true,T,Vs)
% search_contains(T,K,Vs) <=> search_general(contains(K),true,T,Vs)
%
:- pred rtree.search_general(pred(K), pred(V), rtree(K, V), list(V)).
:- mode rtree.search_general(pred(in) is semidet, pred(in) is semidet, in, out)
is det.
% search_first(KTest,VTest,Max,T,V,L):
%
% Search for a value V with associated key K such that
% KTest(K,_) /\ VTest(V,L) is satisfied and there does not exist a
% V' with K' such that KTest(K',_) /\ VTest(V',L') /\ (L' < L) is
% satisfied. Fail if no such key-value pair exists.
%
% The search assumes that for all K1, K2 such that
% K1 contains K2, then if KTest(K2,L2) holds we have that
% KTest(K1,L1) holds with L2 >= L1.
%
% If there exists multiple key-value pairs which satisfy the above
% conditions, then one of the candidates is chosen arbitrarily.
%
:- pred rtree.search_first(pred(K, L), pred(V, L), rtree(K, V), L, V, L).
:- mode rtree.search_first(pred(in, out) is semidet,
pred(in, out) is semidet, in, in, out, out) is semidet.
% search_general_fold(KTest,VPred,T,D0,D1):
%
% Apply accumulator VPred to each key-value pair K-V that satisfies
% KTest(K). The same assumptions for KTest from search_general apply
% here.
%
:- pred rtree.search_general_fold(pred(K), pred(K, V, D, D), rtree(K, V),
D, D).
:- mode rtree.search_general_fold(pred(in) is semidet,
pred(in, in, in, out) is det, in, in, out) is det.
:- mode rtree.search_general_fold(pred(in) is semidet,
pred(in, in, di, uo) is det, in, di, uo) is det.
% Perform a traversal of the rtree, applying an accumulator predicate
% for each key-value pair.
%
:- pred rtree.fold(pred(K, V, A, A), rtree(K, V), A, A).
:- mode rtree.fold(pred(in, in, in, out) is det, in, in, out) is det.
:- mode rtree.fold(pred(in, in, in, out) is semidet, in, in, out) is semidet.
:- mode rtree.fold(pred(in, in, di, uo) is det, in, di, uo) is det.
% Apply a transformation predicate to all the values in an rtree.
%
:- pred rtree.map_values(pred(K, V, W), rtree(K, V), rtree(K, W)).
:- mode rtree.map_values(pred(in, in, out) is det, in, out) is det.
:- mode rtree.map_values(pred(in, in, out) is semidet, in, out) is semidet.
% An interval type represented as interval(Min,Max).
%
:- type interval ---> interval(float, float).
:- instance region(interval).
% A 2D axis aligned box represented as box(XMin,XMax,YMin,YMax).
%
:- type box ---> box(float, float, float, float).
:- instance region(box).
% A 3D axis aligned box represeted as box(XMin,XMax,YMin,YMax,ZMin,ZMax).
%
:- type box3d ---> box3d(float, float, float, float, float, float).
:- instance region(box3d).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module float.
:- import_module int.
:- import_module require.
:- import_module std_util.
% The empty rtree, and singleton rtrees are treated as a special case.
%
:- type rtree(K, V)
---> empty
; one(K, V)
; rtree(rtree0(K, V)).
% The "real" rtree structure is rtree0, which consists of leaf nodes
% (which contain the values) and 2/3/4 nodes which contain 2/3/4 keys
% which are the bounding regions of the 2/3/4 subtrees.
%
% The key for the root node is not stored anywhere. This means queries
% outside the bounds of the tree will be slower, since we must descend
% to level 1 instead of level 0. However, we will win if the query is
% within range. Also doing this simplifies the code slightly.
%
:- 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.
% When deleting from an rtree, we may need to collect some subtrees that
% need to be reinserted.
%
:- 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(empty).
init = T :-
init(T).
%---------------------------------------------------------------------------%
is_empty(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_contains(empty, _, []).
search_contains(one(K0, V0), K, Vs) :-
( contains(K, K0) ->
Vs = [V0]
; Vs = []
).
search_contains(rtree(T), K, Vs) :-
search_contains0(T, K, [], Vs).
%---------------------------------------------------------------------------%
search_general(_, _, empty, []).
search_general(KT, VT, one(K0, V0), Vs) :-
( KT(K0),
VT(V0) ->
Vs = [V0]
; Vs = []
).
search_general(KT, VT, rtree(T), Vs) :-
search_general0(T, KT, VT, [], Vs).
%---------------------------------------------------------------------------%
search_general_fold(_, _, empty, !D).
search_general_fold(P, Q, one(K0, V0), !D) :-
( P(K0) ->
Q(K0, V0, !D)
; true
).
search_general_fold(P, Q, rtree(T), !D) :-
search_general_fold0(T, P, Q, !D).
%---------------------------------------------------------------------------%
search_first(P, C, one(K0, V0), L, V0, E0) :-
maybe_limit(K0, P, L, _),
maybe_limit(V0, C, L, E0).
search_first(P, C, rtree(T), L, V, E) :-
search_first0(T, P, C, L, V, E).
%---------------------------------------------------------------------------%
fold(_, empty, !A).
fold(P, one(K, V), !A) :-
P(K, V, !A).
fold(P, rtree(T), !A) :-
fold0(P, T, !A).
%---------------------------------------------------------------------------%
map_values(_, empty, empty).
map_values(P, one(K, V), one(K, W)) :-
P(K, V, W).
map_values(P, rtree(T), rtree(U)) :-
map_values0(P, T, U).
%---------------------------------------------------------------------------%
insert(K, V, empty, T) :-
T = one(K, V).
insert(K, V, one(K0, V0), T) :-
T1 = two(K0, leaf(V0), K, leaf(V)),
T = rtree(T1).
insert(K, V, rtree(T0), rtree(T1)) :-
insert0(T0, K, V, T1).
%---------------------------------------------------------------------------%
delete(K, V, one(K0, V), empty) :-
contains(K, K0).
delete(K, V, rtree(T0), 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),
% We are still deleting & we have reached the root node. This
% means the path to the deleted leaf contained all 2-nodes
% (including the root-node).
%
( DLs = [deleted(NK, NT)|DLs0],
% Here we detect the special case that the root was a 2-node
% with two leaves (& one was deleted). Thus we need to drop
% back to a 1-node.
%
( 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")
)
).
%---------------------------------------------------------------------------%
% Given a list of deleted trees (with their bounding regions),
% (re)insert the trees back into the main tree at the specified depth.
%
:- 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)
).
%---------------------------------------------------------------------------%
% Algorithm: descend into subtrees with bounding regions that contain the
% query key. Fail if key-value pair is not found in any subtree.
%
:- 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) :-
contains(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),
DK = bounding_region(K1, DK0),
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) :-
contains(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),
DK = bounding_region(K1, K2)
; DI0 = finished(_, _),
DI = DI0,
DT = three(DK0, DT0, K1, T1, K2, T2),
TK = bounding_region(DK0, K1),
DK = bounding_region(TK, K2)
).
%---------------------------------------------------------------------------%
:- 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) :-
contains(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),
K12 = bounding_region(K1, K2),
DK = bounding_region(K3, K12)
; DI0 = finished(_, _),
DI = DI0,
DT = four(DK0, DT0, K1, T1, K2, T2, K3, T3),
TK = bounding_region(DK0, K1),
K23 = bounding_region(K2, K3),
DK = bounding_region(TK, K23)
).
%---------------------------------------------------------------------------%
% Algorithm: descend into subtrees with bounding regions that intersect
% the query key and accumulate leaf values.
%
:- 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
).
%---------------------------------------------------------------------------%
% Algorithm: descend into subtrees with bounding regions that contain
% the query key and accumulate leaf values.
%
:- pred search_contains0(rtree0(K, V), K, list(V), list(V)) <= region(K).
:- mode search_contains0(in, in, in, out) is det.
search_contains0(leaf(V), _, Vs0, Vs1) :-
Vs1 = [V|Vs0].
search_contains0(two(K0, T0, K1, T1), K, Vs0, Vs2) :-
( contains(K, K0) ->
search_contains0(T0, K, Vs0, Vs1)
; Vs1 = Vs0
),
( contains(K, K1) ->
search_contains0(T1, K, Vs1, Vs2)
; Vs2 = Vs1
).
search_contains0(three(K0, T0, K1, T1, K2, T2), K, Vs0, Vs3) :-
( contains(K, K0) ->
search_contains0(T0, K, Vs0, Vs1)
; Vs1 = Vs0
),
( contains(K, K1) ->
search_contains0(T1, K, Vs1, Vs2)
; Vs2 = Vs1
),
( contains(K, K2) ->
search_contains0(T2, K, Vs2, Vs3)
; Vs3 = Vs2
).
search_contains0(four(K0, T0, K1, T1, K2, T2, K3, T3), K, Vs0, Vs4) :-
( contains(K, K0) ->
search_contains0(T0, K, Vs0, Vs1)
; Vs1 = Vs0
),
( contains(K, K1) ->
search_contains0(T1, K, Vs1, Vs2)
; Vs2 = Vs1
),
( contains(K, K2) ->
search_contains0(T2, K, Vs2, Vs3)
; Vs3 = Vs2
),
( contains(K, K3) ->
search_contains0(T3, K, Vs3, Vs4)
; Vs4 = Vs3
).
%---------------------------------------------------------------------------%
% Algorithm: descend into subtrees with bounding regions that satisfy
% the key test and accumulate leaf values that satisfy the value test.
%
:- pred search_general0(rtree0(K, V), pred(K), pred(V), list(V), list(V)).
:- mode search_general0(in, pred(in) is semidet, pred(in) is semidet, in, out)
is det.
search_general0(leaf(V), _, VT, Vs0, Vs1) :-
( VT(V) ->
Vs1 = [V|Vs0]
; Vs1 = Vs0
).
search_general0(two(K0, T0, K1, T1), KT, VT, Vs0, Vs2) :-
( KT(K0) ->
search_general0(T0, KT, VT, Vs0, Vs1)
; Vs1 = Vs0
),
( KT(K1) ->
search_general0(T1, KT, VT, Vs1, Vs2)
; Vs2 = Vs1
).
search_general0(three(K0, T0, K1, T1, K2, T2), KT, VT, Vs0, Vs3) :-
( KT(K0) ->
search_general0(T0, KT, VT, Vs0, Vs1)
; Vs1 = Vs0
),
( KT(K1) ->
search_general0(T1, KT, VT, Vs1, Vs2)
; Vs2 = Vs1
),
( KT(K2) ->
search_general0(T2, KT, VT, Vs2, Vs3)
; Vs3 = Vs2
).
search_general0(four(K0, T0, K1, T1, K2, T2, K3, T3), KT, VT, Vs0, Vs4) :-
( KT(K0) ->
search_general0(T0, KT, VT, Vs0, Vs1)
; Vs1 = Vs0
),
( KT(K1) ->
search_general0(T1, KT, VT, Vs1, Vs2)
; Vs2 = Vs1
),
( KT(K2) ->
search_general0(T2, KT, VT, Vs2, Vs3)
; Vs3 = Vs2
),
( KT(K3) ->
search_general0(T3, KT, VT, Vs3, Vs4)
; Vs4 = Vs3
).
%---------------------------------------------------------------------------%
% Similar to search_general, except call accumulator over values.
%
:- pred search_general_fold0(rtree0(K, V), pred(K), pred(K, V, D, D), D, D).
:- mode search_general_fold0(in, pred(in) is semidet,
pred(in, in, in, out) is det, in, out) is det.
:- mode search_general_fold0(in, pred(in) is semidet,
pred(in, in, di, uo) is det, di, uo) is det.
search_general_fold0(leaf(_), _, _, _, _) :-
error("search_general_fold0: unexpected leaf node").
search_general_fold0(two(K0, T0, K1, T1), P, Q, !D) :-
( P(K0) ->
search_general_fold0(K0, T0, P, Q, !D)
; true
),
( P(K1) ->
search_general_fold0(K1, T1, P, Q, !D)
; true
).
search_general_fold0(three(K0, T0, K1, T1, K2, T2), P, Q, !D) :-
( P(K0) ->
search_general_fold0(K0, T0, P, Q, !D)
; true
),
( P(K1) ->
search_general_fold0(K1, T1, P, Q, !D)
; true
),
( P(K2) ->
search_general_fold0(K2, T2, P, Q, !D)
; true
).
search_general_fold0(four(K0, T0, K1, T1, K2, T2, K3, T3), P, Q, !D) :-
( P(K0) ->
search_general_fold0(K0, T0, P, Q, !D)
; true
),
( P(K1) ->
search_general_fold0(K1, T1, P, Q, !D)
; true
),
( P(K2) ->
search_general_fold0(K2, T2, P, Q, !D)
; true
),
( P(K3) ->
search_general_fold0(K3, T3, P, Q, !D)
; true
).
%---------------------------------------------------------------------------%
:- pred search_general_fold0(K, rtree0(K, V), pred(K), pred(K, V, D, D),
D, D).
:- mode search_general_fold0(in, in, pred(in) is semidet,
pred(in, in, in, out) is det, in, out) is det.
:- mode search_general_fold0(in, in, pred(in) is semidet,
pred(in, in, di, uo) is det, di, uo) is det.
search_general_fold0(K, T, P, Q, !D) :-
( T = leaf(V) ->
Q(K, V, !D)
; search_general_fold0(T, P, Q, !D)
).
%---------------------------------------------------------------------------%
% Algorithm: searches for the first element by traversing the tree in
% the order induced by KTest. If we find a solution, we try and find
% a better solution by setting a tighter maximum.
%
% We avoid searching the entire tree by (1) not searching subtrees that
% fail KTest, and (2) not searching trees with a value greater than the
% maximum.
%
:- 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)
).
%---------------------------------------------------------------------------%
% maybe_limit(K, P, L, E) holds if P(K, E) holds and E is less than the
% limit L.
%
:- 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) :-
P(K, E),
compare((<), E, L).
%---------------------------------------------------------------------------%
% Search the "closest" subtree first.
%
:- 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)
).
%---------------------------------------------------------------------------%
% Search the first subtree, if we find a solution, we then try and find
% a better solution. Otherwise we search the remaining 3 choices.
% Arguments are ordered in terms of "goodness".
%
:- 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)
).
%---------------------------------------------------------------------------%
% We have found a solution, however it may not be the best solution,
% so we search the other possibilities. The first solution becomes the
% new maximum, so it is likely the new searches are cheaper.
%
:- 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 fold0(pred(K, V, A, A), rtree0(K, V), A, A).
:- mode fold0(pred(in, in, in, out) is det, in, in, out) is det.
:- mode fold0(pred(in, in, in, out) is semidet, in, in, out) is semidet.
:- mode fold0(pred(in, in, di, uo) is det, in, di, uo) is det.
fold0(_, leaf(_), _, _) :-
error("fold: leaf unexpected").
fold0(P, two(K0, T0, K1, T1), !A) :-
fold0(P, K0, T0, !A),
fold0(P, K1, T1, !A).
fold0(P, three(K0, T0, K1, T1, K2, T2), !A) :-
fold0(P, K0, T0, !A),
fold0(P, K1, T1, !A),
fold0(P, K2, T2, !A).
fold0(P, four(K0, T0, K1, T1, K2, T2, K3, T3), !A) :-
fold0(P, K0, T0, !A),
fold0(P, K1, T1, !A),
fold0(P, K2, T2, !A),
fold0(P, K3, T3, !A).
:- pred fold0(pred(K, V, A, A), K, rtree0(K, V), A, A).
:- mode fold0(pred(in, in, in, out) is det, in, in, in, out) is det.
:- mode fold0(pred(in, in, in, out) is semidet, in, in, in, out) is semidet.
:- mode fold0(pred(in, in, di, uo) is det, in, in, di, uo) is det.
fold0(P, K, T, !A) :-
( T = leaf(V) ->
P(K, V, !A)
; fold0(P, T, !A)
).
%---------------------------------------------------------------------------%
:- pred map_values0(pred(K, V, W), rtree0(K, V), rtree0(K, W)).
:- mode map_values0(pred(in, in, out) is det, in, out) is det.
:- mode map_values0(pred(in, in, out) is semidet, in, out) is semidet.
map_values0(_, leaf(_), _) :-
error("map_values: leaf unexpected").
map_values0(P, two(K0, T0, K1, T1), two(K0, U0, K1, U1)) :-
map_values0(P, K0, T0, U0),
map_values0(P, K1, T1, U1).
map_values0(P, three(K0, T0, K1, T1, K2, T2), three(K0, U0, K1, U1, K2, U2)) :-
map_values0(P, K0, T0, U0),
map_values0(P, K1, T1, U1),
map_values0(P, K2, T2, U2).
map_values0(P, four(K0, T0, K1, T1, K2, T2, K3, T3),
four(K0, U0, K1, U1, K2, U2, K3, U3)) :-
map_values0(P, K0, T0, U0),
map_values0(P, K1, T1, U1),
map_values0(P, K2, T2, U2),
map_values0(P, K3, T3, U3).
:- pred map_values0(pred(K, V, W), K, rtree0(K, V), rtree0(K, W)).
:- mode map_values0(pred(in, in, out) is det, in, in, out) is det.
:- mode map_values0(pred(in, in, out) is semidet, in, in, out) is semidet.
map_values0(P, K, T, U) :-
( T = leaf(V) ->
P(K, V, W),
U = leaf(W)
; map_values0(P, T, U)
).
%---------------------------------------------------------------------------%
% 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.
%
:- pred insert0(rtree0(K, V), K, V, rtree0(K, V)) <= region(K).
:- mode insert0(in, in, in, out) is det.
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).
%---------------------------------------------------------------------------%
% Split the child (if a 4 node) and insert into T0.
%
:- 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(_, _, _, _),
NK0 = bounding_region(K, K0),
insert0(T0, K, V, NT0),
T = two(NK0, NT0, K1, T1)
; T0 = three(_, _, _, _, _, _),
NK0 = bounding_region(K, K0),
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 ->
K4 = bounding_region(K, K2),
insert0(T2, K, V, T4),
T = three(K1, T1, K3, T3, K4, T4)
; K4 = bounding_region(K, K3),
insert0(T3, K, V, T4),
T = three(K1, T1, K2, T2, K4, T4)
)
).
%---------------------------------------------------------------------------%
% Split the child (if a 4 node) and insert into T0.
%
:- 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(_, _, _, _),
NK0 = bounding_region(K, K0),
insert0(T0, K, V, NT0),
T = three(NK0, NT0, K1, T1, K2, T2)
; T0 = three(_, _, _, _, _, _),
NK0 = bounding_region(K, K0),
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 ->
K5 = bounding_region(K, K3),
insert0(T3, K, V, T5),
T = four(K1, T1, K2, T2, K4, T4, K5, T5)
; K5 = bounding_region(K, K4),
insert0(T4, K, V, T5),
T = four(K1, T1, K2, T2, K3, T3, K5, T5)
)
).
%---------------------------------------------------------------------------%
% The code here is almost identical to 'insert', however we are
% inserting a tree at depth D0 as opposed to data to a leaf.
%
:- 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.
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(_, _, _, _),
NK0 = bounding_region(K, K0),
insert_tree(T0, K, S, D0, D, NT0),
T = two(NK0, NT0, K1, T1)
; T0 = three(_, _, _, _, _, _),
NK0 = bounding_region(K, K0),
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 ->
K4 = bounding_region(K, K2),
insert_tree(T2, K, S, D0, D, T4),
T = three(K1, T1, K3, T3, K4, T4)
; K4 = bounding_region(K, K3),
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(_, _, _, _),
NK0 = bounding_region(K, K0),
insert_tree(T0, K, S, D0, D, NT0),
T = three(NK0, NT0, K1, T1, K2, T2)
; T0 = three(_, _, _, _, _, _),
NK0 = bounding_region(K, K0),
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 ->
K5 = bounding_region(K, K3),
insert_tree(T3, K, S, D0, D, T5),
T = four(K1, T1, K2, T2, K4, T4, K5, T5)
; K5 = bounding_region(K, K4),
insert_tree(T4, K, S, D0, D, T5),
T = four(K1, T1, K2, T2, K3, T3, K5, T5)
)
).
%---------------------------------------------------------------------------%
% Decides which subtree to insert value with K0.
%
:- pred include2(K, K, K, min_result) <= region(K).
:- mode include2(in, in, in, out) is det.
include2(K0, K1, K2, Result) :-
A1 = size(K1),
A2 = size(K2),
A01 = bounding_region_size(K0, K1),
A02 = bounding_region_size(K0, K2),
D1 = A01 - A1,
D2 = A02 - A2,
include_min(D1, D2, A1, A2, first, second, Result).
%---------------------------------------------------------------------------%
% Decides which subtree to insert value with K0.
%
:- 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) :-
A1 = size(K1),
A2 = size(K2),
A3 = size(K3),
A01 = bounding_region_size(K0, K1),
A02 = bounding_region_size(K0, K2),
A03 = bounding_region_size(K0, K3),
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
).
%---------------------------------------------------------------------------%
% Split a 4 node into two 2 nodes. Attempts to minimise the size of
% the resulting keys.
%
:- 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),
A01 = bounding_region_size(K0, K1),
A23 = bounding_region_size(K2, K3),
A0123 = A01 + A23,
A02 = bounding_region_size(K0, K2),
A13 = bounding_region_size(K1, K3),
A0213 = A02 + A13,
A03 = bounding_region_size(K0, K3),
A12 = bounding_region_size(K1, K2),
A0312 = A03 + A12,
( A0123 =< A0213 ->
( A0123 =< A0312 ->
Min = first
; Min = third
)
; ( A0213 =< A0312 ->
Min = second
; Min = third
)
),
( Min = first,
K4 = bounding_region(K0, K1),
T4 = two(K0, T0, K1, T1),
K5 = bounding_region(K2, K3),
T5 = two(K2, T2, K3, T3)
; Min = second,
K4 = bounding_region(K0, K2),
T4 = two(K0, T0, K2, T2),
K5 = bounding_region(K1, K3),
T5 = two(K1, T1, K3, T3)
; Min = third,
K4 = bounding_region(K0, K3),
T4 = two(K0, T0, K3, T3),
K5 = bounding_region(K1, K2),
T5 = two(K1, T1, K2, T2)
).
%---------------------------------------------------------------------------%
% Find the minimum of three values.
%
:- 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
)
).
%---------------------------------------------------------------------------%
% Find the minimum of four values.
%
:- 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
).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- instance region(box3d) where [
pred(intersects/2) is box3d_intersects,
pred(contains/2) is box3d_contains,
func(size/1) is box3d_volume,
func(bounding_region/2) is box3d_bounding_region,
func(bounding_region_size/2) is box3d_bounding_region_volume
].
%---------------------------------------------------------------------------%
:- pred box3d_intersects(box3d, box3d).
:- mode box3d_intersects(in, in) is semidet.
box3d_intersects(Bx0, Bx1) :-
Bx0 = box3d(X0, X1, Y0, Y1, Z0, Z1),
Bx1 = box3d(A0, A1, B0, B1, C0, C1),
( X0 =< A0 ->
X1 >= A0
; X0 =< A1
),
( Y0 =< B0 ->
Y1 >= B0
; Y0 =< B1
),
( Z0 =< C0 ->
Z1 >= C0
; Z0 =< C1
).
%---------------------------------------------------------------------------%
:- pred box3d_contains(box3d, box3d).
:- mode box3d_contains(in, in) is semidet.
box3d_contains(Bx0, Bx1) :-
Bx0 = box3d(X0, X1, Y0, Y1, Z0, Z1),
Bx1 = box3d(A0, A1, B0, B1, C0, C1),
X0 >= A0,
X1 =< A1,
Y0 >= B0,
Y1 =< B1,
Z0 >= C0,
Z1 =< C1.
%---------------------------------------------------------------------------%
:- func box3d_volume(box3d) = float.
box3d_volume(Bx) = A :-
Bx = box3d(X0, X1, Y0, Y1, Z0, Z1),
A = (X1-X0)*(Y1-Y0)*(Z1-Z0).
%---------------------------------------------------------------------------%
:- func box3d_bounding_region(box3d, box3d) = box3d.
box3d_bounding_region(Bx0, Bx1) = Bx2 :-
Bx0 = box3d(X0, X1, Y0, Y1, Z0, Z1),
Bx1 = box3d(A0, A1, B0, B1, C0, C1),
M0 = min(X0, A0),
M1 = max(X1, A1),
N0 = min(Y0, B0),
N1 = max(Y1, B1),
O0 = min(Z0, C0),
O1 = max(Z1, C1),
Bx2 = box3d(M0, M1, N0, N1, O0, O1).
%---------------------------------------------------------------------------%
:- func box3d_bounding_region_volume(box3d, box3d) = float.
box3d_bounding_region_volume(Bx0, Bx1) = CA :-
Bx0 = box3d(X0, X1, Y0, Y1, Z0, Z1),
Bx1 = box3d(A0, A1, B0, B1, C0, C1),
M0 = min(X0, A0),
M1 = max(X1, A1),
N0 = min(Y0, B0),
N1 = max(Y1, B1),
O0 = min(Z0, C0),
O1 = max(Z1, C1),
CA = (M1-M0)*(N1-N0)*(O1-O0).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- instance region(box) where [
pred(intersects/2) is box_intersects,
pred(contains/2) is box_contains,
func(size/1) is box_area,
func(bounding_region/2) is box_bounding_region,
func(bounding_region_size/2) is box_bounding_region_area
].
%---------------------------------------------------------------------------%
:- pred box_intersects(box, box).
:- mode box_intersects(in, in) is semidet.
box_intersects(Bx0, Bx1) :-
Bx0 = box(X0, X1, Y0, Y1),
Bx1 = box(A0, A1, B0, B1),
( X0 =< A0 ->
X1 >= A0
; X0 =< A1
),
( Y0 =< B0 ->
Y1 >= B0
; Y0 =< B1
).
%---------------------------------------------------------------------------%
:- pred box_contains(box, box).
:- mode box_contains(in, in) is semidet.
box_contains(Bx0, Bx1) :-
Bx0 = box(X0, X1, Y0, Y1),
Bx1 = box(A0, A1, B0, B1),
X0 >= A0,
X1 =< A1,
Y0 >= B0,
Y1 =< B1.
%---------------------------------------------------------------------------%
:- func box_area(box) = float.
box_area(Bx) = A :-
Bx = box(X0, X1, Y0, Y1),
A = (X1-X0)*(Y1-Y0).
%---------------------------------------------------------------------------%
:- func box_bounding_region(box, box) = box.
box_bounding_region(Bx0, Bx1) = Bx2 :-
Bx0 = box(X0, X1, Y0, Y1),
Bx1 = box(A0, A1, B0, B1),
M0 = min(X0, A0),
M1 = max(X1, A1),
N0 = min(Y0, B0),
N1 = max(Y1, B1),
Bx2 = box(M0, M1, N0, N1).
%---------------------------------------------------------------------------%
:- func box_bounding_region_area(box, box) = float.
box_bounding_region_area(Bx0, Bx1) = CA :-
Bx0 = box(X0, X1, Y0, Y1),
Bx1 = box(A0, A1, B0, B1),
M0 = min(X0, A0),
M1 = max(X1, A1),
N0 = min(Y0, B0),
N1 = max(Y1, B1),
CA = (M1-M0)*(N1-N0).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- instance region(interval) where [
pred(intersects/2) is interval_intersects,
pred(contains/2) is interval_contains,
func(size/1) is interval_length,
func(bounding_region/2) is interval_bounding_region,
func(bounding_region_size/2) is interval_bounding_region_length
].
%---------------------------------------------------------------------------%
:- pred interval_intersects(interval, interval).
:- mode interval_intersects(in, in) is semidet.
interval_intersects(Bx0, Bx1) :-
Bx0 = interval(X0, X1),
Bx1 = interval(A0, A1),
( X0 =< A0 ->
X1 >= A0
; X0 =< A1
).
%---------------------------------------------------------------------------%
:- pred interval_contains(interval, interval).
:- mode interval_contains(in, in) is semidet.
interval_contains(Bx0, Bx1) :-
Bx0 = interval(X0, X1),
Bx1 = interval(A0, A1),
X0 >= A0,
X1 =< A1.
%---------------------------------------------------------------------------%
:- func interval_length(interval) = float.
interval_length(Bx) = A :-
Bx = interval(X0, X1),
A = X1-X0.
%---------------------------------------------------------------------------%
:- func interval_bounding_region(interval, interval) = interval.
interval_bounding_region(Bx0, Bx1) = Bx2 :-
Bx0 = interval(X0, X1),
Bx1 = interval(A0, A1),
Bx2 = interval(min(X0, A0), max(X1, A1)).
%---------------------------------------------------------------------------%
:- func interval_bounding_region_length(interval, interval) = float.
interval_bounding_region_length(Bx0, Bx1) = CA :-
Bx0 = interval(X0, X1),
Bx1 = interval(A0, A1),
CA = max(X1, A1) - min(X0, A0).
More information about the developers
mailing list