new library module

Zoltan Somogyi zs at cs.mu.OZ.AU
Fri Mar 26 22:13:48 AEDT 1999


A conversation with Mike Codish reminded me that our top-down 234 tree
implementation does not have much use for four-nodes, since they are
split on the way down in insertions (to guarantee that the parent has
room for a key-value pair to be lifted up into it). He suggested that
23 trees may be more efficient.

I have just implemented a 23 tree module. Most of it is copied from
tree234.m, with the code handling four-nodes left out. The insertion
code is substantially different, as it allows a subtree to be split,
and then handles such splits on the way up.

Anyone want to review it? (Before you ask, I haven't checked the
performance impact when it replaces tree234 in map; the bootcheck I need
for that is still going.)

Zoltan.

%---------------------------------------------------------------------------%
% Copyright (C) 1999 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.
%---------------------------------------------------------------------------%

% tree23 - implements a map (dictionary) using 2-3 trees.
% main author: zs.
% stability: medium.

% See map.m for documentation.

%---------------------------------------------------------------------------%

:- module tree23.

:- interface.

:- import_module list, assoc_list.

:- type tree23(K, V).

:- pred tree23__init(tree23(K, V)).
:- mode tree23__init(uo) is det.

:- pred tree23__member(tree23(K, V), K, V).
:- mode tree23__member(in, out, out) is nondet.

:- pred tree23__search(tree23(K, V), K, V).
:- mode tree23__search(in, in, out) is semidet.

:- pred tree23__lookup(tree23(K, V), K, V).
:- mode tree23__lookup(in, in, out) is det.

:- pred tree23__lower_bound_search(tree23(K, V), K, K, V).
:- mode tree23__lower_bound_search(in, in, out, out) is semidet.

:- pred tree23__lower_bound_lookup(tree23(K, V), K, K, V).
:- mode tree23__lower_bound_lookup(in, in, out, out) is det.

:- pred tree23__upper_bound_search(tree23(K, V), K, K, V).
:- mode tree23__upper_bound_search(in, in, out, out) is semidet.

:- pred tree23__upper_bound_lookup(tree23(K, V), K, K, V).
:- mode tree23__upper_bound_lookup(in, in, out, out) is det.

:- pred tree23__insert(tree23(K, V), K, V, tree23(K, V)).
:- mode tree23__insert(di, di, di, uo) is semidet.
:- mode tree23__insert(in, in, in, out) is semidet.

:- pred tree23__set(tree23(K, V), K, V, tree23(K, V)).
:- mode tree23__set(di, di, di, uo) is det.
:- mode tree23__set(in, in, in, out) is det.

:- pred tree23__delete(tree23(K, V), K, tree23(K, V)).
:- mode tree23__delete(di, in, uo) is det.
:- mode tree23__delete(in, in, out) is det.

:- pred tree23__remove(tree23(K, V), K, V, tree23(K, V)).
:- mode tree23__remove(di, in, uo, uo) is semidet.
:- mode tree23__remove(in, in, out, out) is semidet.

:- pred tree23__remove_smallest(tree23(K, V), K, V, tree23(K, V)).
:- mode tree23__remove_smallest(di, uo, uo, uo) is semidet.
:- mode tree23__remove_smallest(in, out, out, out) is semidet.

:- pred tree23__keys(tree23(K, V), list(K)).
:- mode tree23__keys(in, out) is det.

:- pred tree23__values(tree23(K, V), list(V)).
:- mode tree23__values(in, out) is det.

:- pred tree23__update(tree23(K, V), K, V, tree23(K, V)).
:- mode tree23__update(in, in, in, out) is semidet.

:- pred tree23__count(tree23(K, V), int).
:- mode tree23__count(in, out) is det.

:- pred tree23__assoc_list_to_tree23(assoc_list(K, V), tree23(K, V)).
:- mode tree23__assoc_list_to_tree23(in, out) is det.

:- pred tree23__tree23_to_assoc_list(tree23(K, V), assoc_list(K, V)).
:- mode tree23__tree23_to_assoc_list(in, out) is det.

:- pred tree23__foldl(pred(K, V, T, T), tree23(K, V), T, T).
:- mode tree23__foldl(pred(in, in, in, out) is det, in, in, out) is det.
:- mode tree23__foldl(pred(in, in, in, out) is semidet, in, in, out)
		is semidet.
:- mode tree23__foldl(pred(in, in, di, uo) is det, in, di, uo) is det.

:- pred tree23__map_values(pred(K, V, W), tree23(K, V), tree23(K, W)).
:- mode tree23__map_values(pred(in, in, out) is det, in, out) is det.
:- mode tree23__map_values(pred(in, in, out) is semidet, in, out) is semidet.

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

:- implementation.

:- import_module int, require, bool, std_util.

:- type tree23(K, V)	--->
		empty
	;	two(K, V, tree23(K, V), tree23(K, V))
	;	three(K, V, K, V, tree23(K, V), tree23(K, V), tree23(K, V)).

:- interface.

:- inst uniq_tree23(K, V) =
	unique((
		empty
	;	two(K, V, uniq_tree23(K, V), uniq_tree23(K, V))
	;	three(K, V, K, V, uniq_tree23(K, V), uniq_tree23(K, V),
			uniq_tree23(K, V))
	)).

:- inst uniq_tree23_gg =
	unique((
		empty
	;	two(ground, ground, uniq_tree23_gg, uniq_tree23_gg)
	;	three(ground, ground, ground, ground,
			uniq_tree23_gg, uniq_tree23_gg, uniq_tree23_gg)
	)).

:- mode di_tree23(K, V) :: uniq_tree23(K, V) -> dead.
:- mode di_tree23       :: uniq_tree23(ground, ground) -> dead.
:- mode uo_tree23(K, V) :: free -> uniq_tree23(K, V).
:- mode uo_tree23       :: free -> uniq_tree23(ground, ground).

:- implementation.

%------------------------------------------------------------------------------%

tree23__init(empty).

%------------------------------------------------------------------------------%

tree23__member(empty, _K, _V) :- fail.
tree23__member(two(K0, V0, T0, T1), K, V) :-
	(
		K = K0,
		V = V0
	;
		tree23__member(T0, K, V)
	;
		tree23__member(T1, K, V)
	).
tree23__member(three(K0, V0, K1, V1, T0, T1, T2), K, V) :-
	(
		K = K0,
		V = V0
	;
		K = K1,
		V = V1
	;
		tree23__member(T0, K, V)
	;
		tree23__member(T1, K, V)
	;
		tree23__member(T2, K, V)
	).

%------------------------------------------------------------------------------%

tree23__search(T, K, V) :-
	(
		T = empty,
		fail
	;
		T = two(K0, _, _, _),
		compare(Result, K, K0),
		(
			Result = (<),
			T = two(_, _, T0, _),
			tree23__search(T0, K, V)
		;
			Result = (=),
			T = two(_, V0, _, _),
			V = V0
		;
			Result = (>),
			T = two(_, _, _, T1),
			tree23__search(T1, K, V)
		)
	;
		T = three(K0, _, _, _, _, _, _),
		compare(Result0, K, K0),
		(
			Result0 = (<),
			T = three(_, _, _, _, T0, _, _),
			tree23__search(T0, K, V)
		;
			Result0 = (=),
			T = three(_, V0, _, _, _, _, _),
			V = V0
		;
			Result0 = (>),
			T = three(_, _, K1, _, _, _, _),
			compare(Result1, K, K1),
			(
				Result1 = (<),
				T = three(_, _, _, _, _, T1, _),
				tree23__search(T1, K, V)
			;
				Result1 = (=),
				T = three(_, _, _, V1, _, _, _),
				V = V1
			;
				Result1 = (>),
				T = three(_, _, _, _, _, _, T2),
				tree23__search(T2, K, V)
			)
		)
	).

tree23__lookup(T, K, V) :-
	( tree23__search(T, K, V0) ->
		V = V0
	;
		report_lookup_error("tree23__lookup: key not found.", K, V)
	).

%------------------------------------------------------------------------------%

tree23__lower_bound_search(T, SearchK, K, V) :-
	(
		T = empty,
		fail
	;
		T = two(K0, _, _, _),
		compare(Result, SearchK, K0),
		(
			Result = (<),
			T = two(_, _, T0, _),
			tree23__lower_bound_search(T0, SearchK, K, V)
		;
			Result = (=),
			T = two(_, V0, _, _),
			K = SearchK,
			V = V0
		;
			Result = (>),
			T = two(_, _, _, T1),
			( tree23__lower_bound_search(T1, SearchK, Kp, Vp) ->
				K = Kp,
				V = Vp
			;
				T = two(_, V0, _, _),
				K = K0,
				V = V0
			)
		)
	;
		T = three(K0, _, _, _, _, _, _),
		compare(Result0, SearchK, K0),
		(
			Result0 = (<),
			T = three(_, _, _, _, T0, _, _),
			tree23__lower_bound_search(T0, SearchK, K, V)
		;
			Result0 = (=),
			T = three(_, V0, _, _, _, _, _),
			K = SearchK,
			V = V0
		;
			Result0 = (>),
			T = three(_, _, K1, _, _, _, _),
			compare(Result1, SearchK, K1),
			(
				Result1 = (<),
				T = three(_, _, _, _, _, T1, _),
				( tree23__lower_bound_search(T1, SearchK,
					Kp, Vp)
				-> 
					K = Kp,
					V = Vp
				;
					T = three(_, V0, _, _, _, _, _),
					K = K0,
					V = V0
				)
			;
				Result1 = (=),
				T = three(_, _, _, V1, _, _, _),
				K = SearchK,
				V = V1
			;
				Result1 = (>),
				T = three(_, _, _, _, _, _, T2),
				( tree23__lower_bound_search(T2, SearchK,
					Kp, Vp)
				-> 
					K = Kp,
					V = Vp
				;
					T = three(_, _, _, V1, _, _, _),
					K = K1,
					V = V1
				)
			)
		)
	).

tree23__lower_bound_lookup(T, SearchK, K, V) :-
	( tree23__lower_bound_search(T, SearchK, K0, V0) ->
		K = K0,
		V = V0
	;
		report_lookup_error("tree23__lower_bound_lookup: key not found.",
			SearchK, V)
	).

%------------------------------------------------------------------------------%

tree23__upper_bound_search(T, SearchK, K, V) :-
	(
		T = empty,
		fail
	;
		T = two(K0, _, _, _),
		compare(Result, SearchK, K0),
		(
			Result = (<),
			T = two(_, _, T0, _),
			( tree23__upper_bound_search(T0, SearchK, Kp, Vp) -> 
				K = Kp,
				V = Vp
			;
				T = two(_, V0, _, _),
				K = K0,
				V = V0
			)
		;
			Result = (=),
			T = two(_, V0, _, _),
			K = SearchK,
			V = V0
		;
			Result = (>),
			T = two(_, _, _, T1),
			tree23__upper_bound_search(T1, SearchK, K, V)
		)
	;
		T = three(K0, _, _, _, _, _, _),
		compare(Result0, SearchK, K0),
		(
			Result0 = (<),
			T = three(_, _, _, _, T0, _, _),
			( tree23__upper_bound_search(T0, SearchK, Kp, Vp) ->
				K = Kp,
				V = Vp
			;
				T = three(_, V0, _, _, _, _, _),
				K = K0,
				V = V0
			)
		;
			Result0 = (=),
			T = three(_, V0, _, _, _, _, _),
			K = SearchK,
			V = V0
		;
			Result0 = (>),
			T = three(_, _, K1, _, _, _, _),
			compare(Result1, SearchK, K1),
			(
				Result1 = (<),
				T = three(_, _, _, _, _, T1, _),
				( tree23__upper_bound_search(T1, SearchK,
					Kp, Vp)
				->
					K = Kp,
					V = Vp
				;
					T = three(_, _, _, V1, _, _, _),
					K = K1,
					V = V1
				)
			;
				Result1 = (=),
				T = three(_, _, _, V1, _, _, _),
				K = SearchK,
				V = V1
			;
				Result1 = (>),
				T = three(_, _, _, _, _, _, T2),
				tree23__upper_bound_search(T2, SearchK, K, V)
			)
		)
	).

tree23__upper_bound_lookup(T, SearchK, K, V) :-
	( tree23__upper_bound_search(T, SearchK, K0, V0) ->
		K = K0,
		V = V0
	;
		report_lookup_error("tree23__upper_bound_lookup: key not found.",
			SearchK, V)
	).

%------------------------------------------------------------------------------%

tree23__update(Tin, K, V, Tout) :-
	(
		Tin = empty,
		fail
	;
		Tin = two(K0, _, _, _),
		compare(Result, K, K0),
		(
			Result = (<),
			Tin = two(_, _, T0, _),
			tree23__update(T0, K, V, NewT0),
			Tin = two(_, V0, _, T1),
			Tout = two(K0, V0, NewT0, T1)
		;
			Result = (=),
			Tin = two(_, _, T0, T1),
			Tout = two(K0, V, T0, T1)
		;
			Result = (>),
			Tin = two(_, _, _, T1),
			tree23__update(T1, K, V, NewT1),
			Tin = two(_, V0, T0, _),
			Tout = two(K0, V0, T0, NewT1)
		)
	;
		Tin = three(K0, _, _, _, _, _, _),
		compare(Result0, K, K0),
		(
			Result0 = (<),
			Tin = three(_, _, _, _, T0, _, _),
			tree23__update(T0, K, V, NewT0),
			Tin = three(_, V0, K1, V1, _, T1, T2),
			Tout = three(K0, V0, K1, V1, NewT0, T1, T2)
		;
			Result0 = (=),
			Tin = three(_, _, K1, V1, T0, T1, T2),
			Tout = three(K0, V, K1, V1, T0, T1, T2)
		;
			Result0 = (>),
			Tin = three(_, _, K1, _, _, _, _),
			compare(Result1, K, K1),
			(
				Result1 = (<),
				Tin = three(_, _, _, _, _, T1, _),
				tree23__update(T1, K, V, NewT1),
				Tin = three(_, V0, _, V1, T0, _, T2),
				Tout = three(K0, V0, K1, V1, T0, NewT1, T2)
			;
				Result1 = (=),
				Tin = three(_, V0, _, _, T0, T1, T2),
				Tout = three(K0, V0, K1, V, T0, T1, T2)
			;
				Result1 = (>),
				Tin = three(_, _, _, _, _, _, T2),
				tree23__update(T2, K, V, NewT2),
				Tin = three(_, V0, _, V1, T0, T1, _),
				Tout = three(K0, V0, K1, V1, T0, T1, NewT2)
			)
		)
	).

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

:- type tree23_res(K, V)	--->
		no_split(tree23(K, V))
	;	split(K, V, tree23(K, V), tree23(K, V)).

:- inst top_uniq_tree23_res =
	unique((
		no_split(ground)
	;	split(ground, ground, ground, ground)
	)).

:- mode top_uo_tree23_res :: free -> top_uniq_tree23_res.
:- mode top_di_tree23_res :: top_uniq_tree23_res -> clobbered.

%------------------------------------------------------------------------------%

:- pred tree23__convert_from_res(tree23_res(K, V), tree23(K, V)).
:- mode tree23__convert_from_res(top_di_tree23_res, out) is det.
:- mode tree23__convert_from_res(di, uo) is det.

tree23__convert_from_res(Tres, Tout) :-
	(
		Tres = no_split(Tout)
	;
		Tres = split(K0, V0, T0, T1),
		Tout = two(K0, V0, T0, T1)
	).

%------------------------------------------------------------------------------%

tree23__insert(Tin, K, V, Tout) :-
	tree23__insert_ext(Tin, K, V, Tres),
	tree23__convert_from_res(Tres, Tout).

:- pred tree23__insert_ext(tree23(K, V), K, V, tree23_res(K, V)).
:- mode tree23__insert_ext(di, di, di, uo) is semidet.
:- mode tree23__insert_ext(in, in, in, top_uo_tree23_res) is semidet.

tree23__insert_ext(Tin, K, V, Tout) :-
	(
		Tin = empty,
		Tout = split(K, V, empty, empty)
	;
		Tin = two(K0, V0, T0, T1),
		compare(Result, K, K0),
		(
			Result = (<),
			tree23__insert_ext(T0, K, V, ExtT0),
			(
				ExtT0 = no_split(NewT0),
				Tout = no_split(two(K0, V0, NewT0, T1))
			;
				ExtT0 = split(KS, VS, TS0, TS1),
				Tout = no_split(three(KS, VS, K0, V0,
					TS0, TS1, T1))
			)
		;
			Result = (=),
			fail
		;
			Result = (>),
			tree23__insert_ext(T1, K, V, ExtT1),
			(
				ExtT1 = no_split(NewT1),
				Tout = no_split(two(K0, V0, T0, NewT1))
			;
				ExtT1 = split(KS, VS, TS0, TS1),
				Tout = no_split(three(K0, V0, KS, VS,
					T0, TS0, TS1))
			)
		)
	;
		Tin = three(K0, V0, K1, V1, T0, T1, T2),
		compare(Result0, K, K0),
		(
			Result0 = (<),
			tree23__insert_ext(T0, K, V, ExtT0),
			(
				ExtT0 = no_split(NewT0),
				Tout = no_split(three(K0, V0, K1, V1,
					NewT0, T1, T2))
			;
				ExtT0 = split(KS, VS, TS0, TS1),
				Tout = split(K0, V0,
					two(KS, VS, TS0, TS1),
					two(K1, V1, T1, T2))
			)
		;
			Result0 = (=),
			fail
		;
			Result0 = (>),
			compare(Result1, K, K1),
			(
				Result1 = (<),
				tree23__insert_ext(T1, K, V, ExtT1),
				(
					ExtT1 = no_split(NewT1),
					Tout = no_split(three(K0, V0, K1, V1,
						T0, NewT1, T2))
				;
					ExtT1 = split(KS, VS, TS0, TS1),
					Tout = split(KS, VS,
						two(K0, V0, T0, TS0),
						two(K1, V1, TS1, T2))
				)
			;
				Result1 = (=),
				fail
			;
				Result1 = (>),
				tree23__insert_ext(T2, K, V, ExtT2),
				(
					ExtT2 = no_split(NewT2),
					Tout = no_split(three(K0, V0, K1, V1,
						T0, T1, NewT2))
				;
					ExtT2 = split(KS, VS, TS0, TS1),
					Tout = split(K1, V1,
						two(K0, V0, T0, T1),
						two(KS, VS, TS0, TS1))
				)
			)
		)
	).

%------------------------------------------------------------------------------%

% tree23__set uses the same algorithm as used for tree23__insert,
% except that instead of failing for equal keys, we replace the value.

tree23__set(Tin, K, V, Tout) :-
	tree23__set_ext(Tin, K, V, Tres),
	tree23__convert_from_res(Tres, Tout).

:- pred tree23__set_ext(tree23(K, V), K, V, tree23_res(K, V)).
:- mode tree23__set_ext(di, di, di, uo) is det.
:- mode tree23__set_ext(in, in, in, top_uo_tree23_res) is det.

tree23__set_ext(Tin, K, V, Tout) :-
	(
		Tin = empty,
		Tout = split(K, V, empty, empty)
	;
		Tin = two(K0, V0, T0, T1),
		compare(Result, K, K0),
		(
			Result = (<),
			tree23__set_ext(T0, K, V, ExtT0),
			(
				ExtT0 = no_split(NewT0),
				Tout = no_split(two(K0, V0, NewT0, T1))
			;
				ExtT0 = split(KS, VS, TS0, TS1),
				Tout = no_split(three(KS, VS, K0, V0,
					TS0, TS1, T1))
			)
		;
			Result = (=),
			Tout = no_split(two(K0, V, T0, T1))
		;
			Result = (>),
			tree23__set_ext(T1, K, V, ExtT1),
			(
				ExtT1 = no_split(NewT1),
				Tout = no_split(two(K0, V0, T0, NewT1))
			;
				ExtT1 = split(KS, VS, TS0, TS1),
				Tout = no_split(three(K0, V0, KS, VS,
					T0, TS0, TS1))
			)
		)
	;
		Tin = three(K0, V0, K1, V1, T0, T1, T2),
		compare(Result0, K, K0),
		(
			Result0 = (<),
			tree23__set_ext(T0, K, V, ExtT0),
			(
				ExtT0 = no_split(NewT0),
				Tout = no_split(three(K0, V0, K1, V1,
					NewT0, T1, T2))
			;
				ExtT0 = split(KS, VS, TS0, TS1),
				Tout = split(K0, V0,
					two(KS, VS, TS0, TS1),
					two(K1, V1, T1, T2))
			)
		;
			Result0 = (=),
			Tout = no_split(three(K0, V, K1, V1, T0, T1, T2))
		;
			Result0 = (>),
			compare(Result1, K, K1),
			(
				Result1 = (<),
				tree23__set_ext(T1, K, V, ExtT1),
				(
					ExtT1 = no_split(NewT1),
					Tout = no_split(three(K0, V0, K1, V1,
						T0, NewT1, T2))
				;
					ExtT1 = split(KS, VS, TS0, TS1),
					Tout = split(KS, VS,
						two(K0, V0, T0, TS0),
						two(K1, V1, TS1, T2))
				)
			;
				Result1 = (=),
				Tout = no_split(three(K0, V0, K1, V,
					T0, T1, T2))
			;
				Result1 = (>),
				tree23__set_ext(T2, K, V, ExtT2),
				(
					ExtT2 = no_split(NewT2),
					Tout = no_split(three(K0, V0, K1, V1,
						T0, T1, NewT2))
				;
					ExtT2 = split(KS, VS, TS0, TS1),
					Tout = split(K1, V1,
						two(K0, V0, T0, T1),
						two(KS, VS, TS0, TS1))
				)
			)
		)
	).

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

tree23__delete(Tin, K, Tout) :-
	tree23__delete_2(Tin, K, Tout, _).

	% When deleting an item from a tree, the height of the tree may be
	% reduced by one. The last argument says whether this has occurred.

:- pred tree23__delete_2(tree23(K, V), K, tree23(K, V), bool).
:- mode tree23__delete_2(di, in, uo, out) is det.
:- mode tree23__delete_2(in, in, out, out) is det.

tree23__delete_2(Tin, K, Tout, RH) :-
	(
		Tin = empty,
		Tout = empty,
		RH = no
	;
		Tin = two(K0, V0, T0, T1),
		compare(Result0, K, K0),
		(
			Result0 = (<),
			tree23__delete_2(T0, K, NewT0, RHT0),
			( RHT0 = yes ->
				fix_2node_t0(K0, V0, NewT0, T1, Tout, RH)
			;
				Tout = two(K0, V0, NewT0, T1),
				RH = no
			)
		;
			Result0 = (=),
			(
				tree23__remove_smallest_2(T1, ST1K, ST1V,
					NewT1, RHT1)
			->
				( RHT1 = yes ->
					fix_2node_t1(ST1K, ST1V, T0, NewT1,
						Tout, RH)
				;
					Tout = two(ST1K, ST1V, T0, NewT1),
					RH = no
				)
			;
				% T1 must be empty
				Tout = T0,
				RH = yes
			)
		;
			Result0 = (>),
			tree23__delete_2(T1, K, NewT1, RHT1),
			( RHT1 = yes ->
				fix_2node_t1(K0, V0, T0, NewT1, Tout, RH)
			;
				Tout = two(K0, V0, T0, NewT1),
				RH = no
			)
		)
	;
		Tin = three(K0, V0, K1, V1, T0, T1, T2),
		compare(Result0, K, K0),
		(
			Result0 = (<),
			tree23__delete_2(T0, K, NewT0, RHT0),
			( RHT0 = yes ->
				fix_3node_t0(K0, V0, K1, V1, NewT0, T1, T2,
					Tout, RH)
			;
				Tout = three(K0, V0, K1, V1, NewT0, T1, T2),
				RH = no
			)
		;
			Result0 = (=),
			(
				tree23__remove_smallest_2(T1, ST1K, ST1V,
					NewT1, RHT1)
			->
				( RHT1 = yes ->
					fix_3node_t1(ST1K, ST1V, K1, V1,
						T0, NewT1, T2, Tout, RH)
				;
					Tout = three(ST1K, ST1V, K1, V1,
						T0, NewT1, T2),
					RH = no
				)
			;
				% T1 must be empty
				Tout = two(K1, V1, T0, T2),
				RH = no
			)
		;
			Result0 = (>),
			compare(Result1, K, K1),
			(
				Result1 = (<),
				tree23__delete_2(T1, K, NewT1, RHT1),
				( RHT1 = yes ->
					fix_3node_t1(K0, V0, K1, V1,
						T0, NewT1, T2, Tout, RH)
				;
					Tout = three(K0, V0, K1, V1,
						T0, NewT1, T2),
					RH = no
				)
			;
				Result1 = (=),
				(
					tree23__remove_smallest_2(T2,
						ST2K, ST2V, NewT2, RHT2)
				->
					( RHT2 = yes ->
						fix_3node_t2(K0, V0, ST2K, ST2V,
							T0, T1, NewT2, Tout, RH)
					;
						Tout = three(K0, V0, ST2K, ST2V,
							T0, T1, NewT2),
						RH = no
					)
				;
					% T2 must be empty
					Tout = two(K0, V0, T0, T1),
					RH = no
				)
			;
				Result1 = (>),
				tree23__delete_2(T2, K, NewT2, RHT2),
				( RHT2 = yes ->
					fix_3node_t2(K0, V0, K1, V1,
						T0, T1, NewT2, Tout, RH)
				;
					Tout = three(K0, V0, K1, V1,
						T0, T1, NewT2),
					RH = no
				)
			)
		)
	).

%------------------------------------------------------------------------------%

	% We use the same algorithm as tree23__delete.

tree23__remove(Tin, K, V, Tout) :-
	tree23__remove_2(Tin, K, V, Tout, _).

:- pred tree23__remove_2(tree23(K, V), K, V, tree23(K, V), bool).
:- mode tree23__remove_2(di, in, uo, uo, out) is semidet.
:- mode tree23__remove_2(in, in, out, out, out) is semidet.

tree23__remove_2(Tin, K, V, Tout, RH) :-
	(
		Tin = empty,
		fail
	;
		Tin = two(K0, V0, T0, T1),
		compare(Result0, K, K0),
		(
			Result0 = (<),
			tree23__remove_2(T0, K, V, NewT0, RHT0),
			( RHT0 = yes ->
				fix_2node_t0(K0, V0, NewT0, T1, Tout, RH)
			;
				Tout = two(K0, V0, NewT0, T1),
				RH = no
			)
		;
			Result0 = (=),
			(
				tree23__remove_smallest_2(T1, ST1K, ST1V,
					NewT1, RHT1)
			->
				( RHT1 = yes ->
					fix_2node_t1(ST1K, ST1V, T0, NewT1,
						Tout, RH)
				;
					Tout = two(ST1K, ST1V, T0, NewT1),
					RH = no
				)
			;
				% T1 must be empty
				Tout = T0,
				RH = yes
			),
			V = V0
		;
			Result0 = (>),
			tree23__remove_2(T1, K, V, NewT1, RHT1),
			( RHT1 = yes ->
				fix_2node_t1(K0, V0, T0, NewT1, Tout, RH)
			;
				Tout = two(K0, V0, T0, NewT1),
				RH = no
			)
		)
	;
		Tin = three(K0, V0, K1, V1, T0, T1, T2),
		compare(Result0, K, K0),
		(
			Result0 = (<),
			tree23__remove_2(T0, K, V, NewT0, RHT0),
			( RHT0 = yes ->
				fix_3node_t0(K0, V0, K1, V1, NewT0, T1, T2,
					Tout, RH)
			;
				Tout = three(K0, V0, K1, V1, NewT0, T1, T2),
				RH = no
			)
		;
			Result0 = (=),
			(
				tree23__remove_smallest_2(T1, ST1K, ST1V,
					NewT1, RHT1)
			->
				( RHT1 = yes ->
					fix_3node_t1(ST1K, ST1V, K1, V1,
						T0, NewT1, T2, Tout, RH)
				;
					Tout = three(ST1K, ST1V, K1, V1,
						T0, NewT1, T2),
					RH = no
				)
			;
				% T1 must be empty
				Tout = two(K1, V1, T0, T2),
				RH = no
			),
			V = V0
		;
			Result0 = (>),
			compare(Result1, K, K1),
			(
				Result1 = (<),
				tree23__remove_2(T1, K, V, NewT1, RHT1),
				( RHT1 = yes ->
					fix_3node_t1(K0, V0, K1, V1,
						T0, NewT1, T2, Tout, RH)
				;
					Tout = three(K0, V0, K1, V1,
						T0, NewT1, T2),
					RH = no
				)
			;
				Result1 = (=),
				(
					tree23__remove_smallest_2(T2,
						ST2K, ST2V, NewT2, RHT2)
				->
					( RHT2 = yes ->
						fix_3node_t2(K0, V0, ST2K, ST2V,
							T0, T1, NewT2, Tout, RH)
					;
						Tout = three(K0, V0, ST2K, ST2V,
							T0, T1, NewT2),
						RH = no
					)
				;
					% T2 must be empty
					Tout = two(K0, V0, T0, T1),
					RH = no
				),
				V = V1
			;
				Result1 = (>),
				tree23__remove_2(T2, K, V, NewT2, RHT2),
				( RHT2 = yes ->
					fix_3node_t2(K0, V0, K1, V1,
						T0, T1, NewT2, Tout, RH)
				;
					Tout = three(K0, V0, K1, V1,
						T0, T1, NewT2),
					RH = no
				)
			)
		)
	).

%------------------------------------------------------------------------------%

	% The algorithm we use similar to tree23__delete, except that we
	% always go down the left subtree.

tree23__remove_smallest(Tin, K, V, Tout) :-
	tree23__remove_smallest_2(Tin, K, V, Tout, _).

:- pred tree23__remove_smallest_2(tree23(K, V), K, V, tree23(K, V), bool).
:- mode tree23__remove_smallest_2(di, uo, uo, uo, out) is semidet.
:- mode tree23__remove_smallest_2(in, out, out, out, out) is semidet.

tree23__remove_smallest_2(Tin, K, V, Tout, RH) :-
	(
		Tin = empty,
		fail
	;
		Tin = two(K0, V0, T0, T1),
		(
			T0 = empty
		->
			K = K0,
			V = V0,
			Tout = T1,
			RH = yes
		;
			tree23__remove_smallest_2(T0, K, V, NewT0, RHT0),
			( RHT0 = yes ->
				fix_2node_t0(K0, V0, NewT0, T1, Tout, RH)
			;
				Tout = two(K0, V0, NewT0, T1),
				RH = no
			)
		)
	;
		Tin = three(K0, V0, K1, V1, T0, T1, T2),
		(
			T0 = empty
		->
			K = K0,
			V = V0,
			Tout = two(K1, V1, T1, T2),
			RH = no
		;
			tree23__remove_smallest_2(T0, K, V, NewT0, RHT0),
			( RHT0 = yes ->
				fix_3node_t0(K0, V0, K1, V1, NewT0, T1, T2,
					Tout, RH)
			;
				Tout = three(K0, V0, K1, V1, NewT0, T1, T2),
				RH = no
			)
		)
	).

%------------------------------------------------------------------------------%

	% The input to the following group of predicates are the components
	% of a two- or three-node in which the height of the indicated
	% subtree is one less than it should be. If it is possible to increase
	% the height of that subtree by moving into it elements from its
	% neighboring subtrees, do so, and return the resulting tree with RH
	% set to no. Otherwise, return a balanced tree whose height is reduced
	% by one, with RH set to yes to indicate the reduced height.

:- pred fix_2node_t0(K, V, tree23(K, V), tree23(K, V), tree23(K, V), bool).
:- mode fix_2node_t0(di, di, di, di, uo, out) is det.
:- mode fix_2node_t0(in, in, in, in, out, out) is det.

fix_2node_t0(K0, V0, T0, T1, Tout, RH) :-
	(
		% steal T1's leftmost subtree and combine it with T0
		T1 = three(K10, V10, K11, V11, T10, T11, T12),
		NewT1 = two(K11, V11, T11, T12),
		Node = two(K0, V0, T0, T10),
		Tout = two(K10, V10, Node, NewT1),
		RH = no
	;
		% move T0 one level down and combine it with the subtrees of T1
		% this reduces the depth of the tree
		T1 = two(K10, V10, T10, T11),
		Tout = three(K0, V0, K10, V10, T0, T10, T11),
		RH = yes
	;
		T1 = empty,
		error("unbalanced 23 tree")
		% Tout = two(K0, V0, T0, T1),
		% RH = yes
	).

:- pred fix_2node_t1(K, V, tree23(K, V), tree23(K, V), tree23(K, V), bool).
:- mode fix_2node_t1(di, di, di, di, uo, out) is det.
:- mode fix_2node_t1(in, in, in, in, out, out) is det.

fix_2node_t1(K0, V0, T0, T1, Tout, RH) :-
	(
		% steal T0's leftmost subtree and combine it with T1
		T0 = three(K00, V00, K01, V01, T00, T01, T02),
		NewT0 = two(K00, V00, T00, T01),
		Node = two(K0, V0, T02, T1),
		Tout = two(K01, V01, NewT0, Node),
		RH = no
	;
		% move T1 one level down and combine it with the subtrees of T0
		% this reduces the depth of the tree
		T0 = two(K00, V00, T00, T01),
		Tout = three(K00, V00, K0, V0, T00, T01, T1),
		RH = yes
	;
		T0 = empty,
		error("unbalanced 23 tree")
		% Tout = two(K0, V0, T0, T1),
		% RH = yes
	).

:- pred fix_3node_t0(K, V, K, V, tree23(K, V), tree23(K, V), tree23(K, V),
	tree23(K, V), bool).
:- mode fix_3node_t0(di, di, di, di, di, di, di, uo, out) is det.
:- mode fix_3node_t0(in, in, in, in, in, in, in, out, out) is det.

fix_3node_t0(K0, V0, K1, V1, T0, T1, T2, Tout, RH) :-
	(
		% steal T1's leftmost subtree and combine it with T0
		T1 = three(K10, V10, K11, V11, T10, T11, T12),
		NewT1 = two(K11, V11, T11, T12),
		Node = two(K0, V0, T0, T10),
		Tout = three(K10, V10, K1, V1, Node, NewT1, T2),
		RH = no
	;
		% move T0 one level down to become the leftmost subtree of T1
		T1 = two(K10, V10, T10, T11),
		NewT1 = three(K0, V0, K10, V10, T0, T10, T11),
		Tout = two(K1, V1, NewT1, T2),
		RH = no
	;
		T1 = empty,
		error("unbalanced 23 tree")
		% Tout = three(K0, V0, K1, V1, T0, T1, T2),
		% The heights of T1 and T2 are unchanged
		% RH = no
	).

:- pred fix_3node_t1(K, V, K, V, tree23(K, V), tree23(K, V), tree23(K, V),
	tree23(K, V), bool).
:- mode fix_3node_t1(di, di, di, di, di, di, di, uo, out) is det.
:- mode fix_3node_t1(in, in, in, in, in, in, in, out, out) is det.

fix_3node_t1(K0, V0, K1, V1, T0, T1, T2, Tout, RH) :-
	(
		% steal T0's rightmost subtree and combine it with T1
		T0 = three(K00, V00, K01, V01, T00, T01, T02),
		NewT0 = two(K00, V00, T00, T01),
		Node = two(K0, V0, T02, T1),
		Tout = three(K01, V01, K1, V1, NewT0, Node, T2),
		RH = no
	;
		% move T1 one level down to become the rightmost subtree of T0
		T0 = two(K00, V00, T00, T01),
		NewT0 = three(K00, V00, K0, V0, T00, T01, T1),
		Tout = two(K1, V1, NewT0, T2),
		RH = no
	;
		T0 = empty,
		error("unbalanced 23 tree")
		% Tout = three(K0, V0, K1, V1, T0, T1, T2),
		% The heights of T0 and T2 are unchanged
		% RH = no
	).

:- pred fix_3node_t2(K, V, K, V, tree23(K, V), tree23(K, V), tree23(K, V),
	tree23(K, V), bool).
:- mode fix_3node_t2(di, di, di, di, di, di, di, uo, out) is det.
:- mode fix_3node_t2(in, in, in, in, in, in, in, out, out) is det.

fix_3node_t2(K0, V0, K1, V1, T0, T1, T2, Tout, RH) :-
	(
		% steal T1's rightmost subtree and combine it with T2
		T1 = three(K10, V10, K11, V11, T10, T11, T12),
		NewT1 = two(K10, V10, T10, T11),
		Node = two(K1, V1, T12, T2),
		Tout = three(K0, V0, K11, V11, T0, NewT1, Node),
		RH = no
	;
		% move T2 one level down to become the rightmost subtree of T1
		T1 = two(K10, V10, T10, T11),
		NewT1 = three(K10, V10, K1, V1, T10, T11, T2),
		Tout = two(K0, V0, T0, NewT1),
		RH = no
	;
		T1 = empty,
		error("unbalanced 23 tree")
		% Tout = three(K0, V0, K1, V1, T0, T1, T2),
		% The heights of T0 and T1 are unchanged
		% RH = no
	).

%------------------------------------------------------------------------------%

tree23__keys(Tree, Keys) :-
	tree23__keys_2(Tree, [], Keys).

:- pred tree23__keys_2(tree23(K, V), list(K), list(K)).
:- mode tree23__keys_2(in, in, out) is det.

tree23__keys_2(empty, List, List).
tree23__keys_2(two(K0, _V0, T0, T1), L0, L) :-
	tree23__keys_2(T1, L0, L1),
	tree23__keys_2(T0, [K0 | L1], L).
tree23__keys_2(three(K0, _V0, K1, _V1, T0, T1, T2), L0, L) :-
	tree23__keys_2(T2, L0, L1),
	tree23__keys_2(T1, [K1 | L1], L2),
	tree23__keys_2(T0, [K0 | L2], L).

%------------------------------------------------------------------------------%

tree23__values(Tree, Values) :-
	tree23__values_2(Tree, [], Values).

:- pred tree23__values_2(tree23(K, V), list(V), list(V)).
:- mode tree23__values_2(in, in, out) is det.

tree23__values_2(empty, List, List).
tree23__values_2(two(_K0, V0, T0, T1), L0, L) :-
	tree23__values_2(T1, L0, L1),
	tree23__values_2(T0, [V0 | L1], L).
tree23__values_2(three(_K0, V0, _K1, V1, T0, T1, T2), L0, L) :-
	tree23__values_2(T2, L0, L1),
	tree23__values_2(T1, [V1 | L1], L2),
	tree23__values_2(T0, [V0 | L2], L).

%------------------------------------------------------------------------------%

tree23__assoc_list_to_tree23(AssocList, Tree) :-
	tree23__assoc_list_to_tree23_2(AssocList, empty, Tree).

:- pred tree23__assoc_list_to_tree23_2(assoc_list(K, V), tree23(K, V),
	tree23(K, V)).
:- mode tree23__assoc_list_to_tree23_2(in, in, out) is det.

tree23__assoc_list_to_tree23_2([], Tree, Tree).
tree23__assoc_list_to_tree23_2([K - V | Rest], Tree0, Tree) :-
	tree23__set(Tree0, K, V, Tree1),
	tree23__assoc_list_to_tree23_2(Rest, Tree1, Tree).

%------------------------------------------------------------------------------%

tree23__tree23_to_assoc_list(Tree, AssocList) :-
	tree23__tree23_to_assoc_list_2(Tree, [], AssocList).

:- pred tree23__tree23_to_assoc_list_2(tree23(K, V), assoc_list(K, V),
	assoc_list(K, V)).
:- mode tree23__tree23_to_assoc_list_2(in, in, out) is det.

tree23__tree23_to_assoc_list_2(empty, List, List).
tree23__tree23_to_assoc_list_2(two(K0, V0, T0, T1), L0, L) :-
	tree23__tree23_to_assoc_list_2(T1, L0, L1),
	tree23__tree23_to_assoc_list_2(T0, [K0 - V0 | L1], L).
tree23__tree23_to_assoc_list_2(three(K0, V0, K1, V1, T0, T1, T2), L0, L) :-
	tree23__tree23_to_assoc_list_2(T2, L0, L1),
	tree23__tree23_to_assoc_list_2(T1, [K1 - V1 | L1], L2),
	tree23__tree23_to_assoc_list_2(T0, [K0 - V0 | L2], L).

%------------------------------------------------------------------------------%

tree23__foldl(_Pred, empty, Acc, Acc).
tree23__foldl(Pred, two(K, V, T0, T1), Acc0, Acc) :-
	tree23__foldl(Pred, T0, Acc0, Acc1),
	call(Pred, K, V, Acc1, Acc2),
	tree23__foldl(Pred, T1, Acc2, Acc).
tree23__foldl(Pred, three(K0, V0, K1, V1, T0, T1, T2), Acc0, Acc) :-
	tree23__foldl(Pred, T0, Acc0, Acc1),
	call(Pred, K0, V0, Acc1, Acc2),
	tree23__foldl(Pred, T1, Acc2, Acc3),
	call(Pred, K1, V1, Acc3, Acc4),
	tree23__foldl(Pred, T2, Acc4, Acc).

%------------------------------------------------------------------------------%

tree23__map_values(_Pred, empty, empty).
tree23__map_values(Pred, Tree0, Tree) :-
	Tree0 = two(K0, V0, Left0, Right0),
	Tree  = two(K0, W0, Left, Right),
	call(Pred, K0, V0, W0),
	tree23__map_values(Pred, Left0, Left),
	tree23__map_values(Pred, Right0, Right).
tree23__map_values(Pred, Tree0, Tree) :-
	Tree0 = three(K0, V0, K1, V1, Left0, Middle0, Right0),
	Tree  = three(K0, W0, K1, W1, Left, Middle, Right),
	call(Pred, K0, V0, W0),
	call(Pred, K1, V1, W1),
	tree23__map_values(Pred, Left0, Left),
	tree23__map_values(Pred, Middle0, Middle),
	tree23__map_values(Pred, Right0, Right).

%------------------------------------------------------------------------------%

	% count the number of elements in a tree
tree23__count(empty, 0).
tree23__count(two(_, _, T0, T1), N) :-
	tree23__count(T0, N0),
	tree23__count(T1, N1),
	N is 1 + N0 + N1.
tree23__count(three(_, _, _, _, T0, T1, T2), N) :-
	tree23__count(T0, N0),
	tree23__count(T1, N1),
	tree23__count(T2, N2),
	N is 2 + N0 + N1 + N2.

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%



More information about the developers mailing list