Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Pull in rvirdings code as well for now. This is just testing.

  • Loading branch information...
commit af1fdd53bb1ecc059c5e7312d8220f30444d741f 1 parent 39c7da5
@jlouis authored
View
3  ebin/myapp.app
@@ -5,4 +5,5 @@
{applications,[kernel,stdlib]},
{mod,{myapp_app,[]}},
{env,[]},
- {modules,[bench_map,myapp_app,myapp_sup]}]}.
+ {modules,[bench_map,h_rb_set,myapp_app,myapp_sup,patricia,
+ rbdict,rbdict1,rbsets]}]}.
View
2  rebar.config
@@ -19,3 +19,5 @@
{xref_checks, [undefined_function_calls,
locals_not_used,
exports_not_used]}.
+
+%{deps, [{rb, ".*", {git, "git://github.com/rvirding/rb.git", "master"}}]}.
View
57 src/bench_map.erl
@@ -1,23 +1,33 @@
-module(bench_map).
--export([foo/0]).
+-export([run/0]).
-ifdef(TEST).
-include_lib("eqc/include/eqc.hrl").
-include_lib("eunit/include/eunit.hrl").
-endif.
-foo() ->
- foo.
-
-
--ifdef(EUNIT).
--ifdef(EQC).
+run() ->
+ [{sets, runs(
+ fun () ->
+ timer:tc(fun() -> set_test(), ok end, [])
+ end)},
+ {dict, timer:tc(fun() -> dict_test(), ok end, [])},
+ {gb_sets, runs(
+ fun () ->
+ timer:tc(fun() -> gb_sets_test(), ok end, [])
+ end)},
+ {gb_trees, timer:tc(fun() -> gb_trees_test(), ok end, [])},
+ {h_rb_sets, timer:tc(fun() -> h_rb_set_test(), ok end, [])},
+ {rb_sets, timer:tc(fun() -> rb_sets_test(), ok end, [])}].
+
+runs(F) ->
+ [F() || _ <- lists:seq(1, 10)].
words() ->
Words = "/usr/share/dict/words",
{ok, Content} = file:read_file(Words),
- binary:split(Content, <<"\n">>, [global]).
+ [binary_to_list(W) || W <- binary:split(Content, <<"\n">>, [global])].
list_shuffle(L) ->
random:seed(), %% Reset Random function
@@ -32,6 +42,20 @@ test_sets_words(Words, Set) ->
end,
Words).
+test_h_rb_set_words(Words, Set) ->
+ lists:foreach(
+ fun(Word) ->
+ true = h_rb_set:is_element(Word, Set)
+ end,
+ Words).
+
+test_rb_sets_words(Words, Set) ->
+ lists:foreach(
+ fun(Word) ->
+ true = rbsets:is_element(Word, Set)
+ end,
+ Words).
+
test_gb_sets_words(Words, Set) ->
lists:foreach(
fun(Word) ->
@@ -60,6 +84,12 @@ test_map(Generator, TestFun) ->
TestFun(lists:reverse(Ws), S),
TestFun(list_shuffle(Ws), S).
+h_rb_set_test() ->
+ test_map(fun(Ws) ->
+ h_rb_set:from_list(Ws)
+ end,
+ fun test_h_rb_set_words/2).
+
set_test() ->
test_map(fun(Ws) ->
sets:from_list(Ws)
@@ -89,6 +119,17 @@ gb_trees_test() ->
end,
fun test_gb_trees_words/2).
+rb_sets_test() ->
+ test_map(fun(Ws) ->
+ rbsets:from_list(Ws)
+ end,
+ fun test_rb_sets_words/2).
+
+-ifdef(EUNIT).
+-ifdef(EQC).
+
+
+
-endif.
-endif.
View
17 src/h_rb_set.erl
@@ -0,0 +1,17 @@
+-module(h_rb_set).
+
+-export([from_list/1, is_element/2]).
+
+from_list(L) ->
+ lists:foldl(
+ fun(K, T) ->
+ H = erlang:phash2(K),
+ rbdict:append(H, K, T)
+ end,
+ rbdict:new(),
+ L).
+
+is_element(Key, Tree) ->
+ H = erlang:phash2(Key),
+ Elems = rbdict:fetch(H, Tree),
+ lists:member(Key, Elems).
View
110 src/patricia.erl
@@ -0,0 +1,110 @@
+-module(patricia).
+%% @todo Go over all the ordering values and check them.
+
+-export([insert/2, is_element/2, from_list/1, new/0]).
+
+-define(BIT_MAX, 27). % Set by virtue of erlang:phash2
+-type ptree(A) :: empty | {leaf, [A]} | {node, pos_integer(), ptree(A), ptree(A)}.
+
+-spec insert(A, ptree(A)) -> ptree(A) | already.
+
+hash(X) ->
+ erlang:phash2(X).
+
+from_list(L) ->
+ lists:foldl(
+ fun insert/2,
+ new(),
+ L).
+
+new() ->
+ empty.
+
+insert(E, empty) ->
+ {leaf, [E]};
+insert(E, Tree) ->
+ H = hash(E),
+ {Bit, Lt} = find_bit(H, Tree),
+ insert(H, E, Bit, Lt, Tree).
+
+find_bit(H, {leaf, [A | _]}) ->
+ H1 = hash(A),
+ crit_bit(H, H1);
+find_bit(H, {node, Bit, Left, Right}) ->
+ case inspect_bit(H, Bit) of
+ left -> find_bit(H, Left);
+ right -> find_bit(H, Right)
+ end.
+
+crit_bit(I1, I2) ->
+ crit_bit(I1, I2, ?BIT_MAX).
+
+cmp_lt_bit(I1, I2, N) ->
+ Bit = (1 bsr N),
+ (Bit band I1) < (Bit band I2).
+
+crit_bit(I1, I2, N) ->
+ Bit = (1 bsr N),
+ case (Bit band I1) bxor (Bit band I2) of
+ 0 ->
+ crit_bit(I1, I2, N-1);
+ _ ->
+ {N, cmp_lt_bit(I1, I2, N)}
+ end.
+
+inspect_bit(H, Bit) ->
+ case H band (1 bsr Bit) of
+ 0 -> left;
+ _ -> right
+ end.
+
+
+insert(_H, E, Bit, Lt, {leaf, Es} = Lf) ->
+ case lists:member(E, Es) of
+ true ->
+ {leaf, Es};
+ false ->
+ case Lt of
+ true ->
+ {node, Bit, {leaf, [E]}, Lf};
+ false ->
+ {node, Bit, Lf, {leaf, [E]}}
+ end
+ end;
+insert(H, E, Bit, Lt, {node, CBit, Left, Right}) when Bit < CBit ->
+ case inspect_bit(H, CBit) of
+ left ->
+ {node, CBit, insert(H, E, Lt, Bit, Left), Right};
+ right ->
+ {node, CBit, Left, insert(H, E, Lt, Bit, Right)}
+ end;
+insert(_H, E, Bit, Lt, {node, CBit, _Left, _Right} = N) when Bit > CBit ->
+ case Lt of
+ true ->
+ {node, Bit, {leaf, [E]}, N};
+ false ->
+ {node, Bit, N, {leaf, [E]}}
+ end.
+
+is_element(Key, Tree) ->
+ H = hash(Key),
+ is_element1(H, Key, 0, Tree).
+
+is_element1(_, _, _, empty) -> false;
+is_element1(_H, Key, _Cnt, {leaf, Elems}) ->
+ lists:member(Key, Elems);
+is_element1(H, Key, Cnt, {node, Bit, L, R}) ->
+ case H band (1 bsr (Cnt + Bit)) of
+ 0 -> is_element1(H, Key, Cnt+Bit, L);
+ 1 -> is_element1(H, Key, Cnt+Bit, R)
+ end.
+
+
+
+
+
+
+
+
+
+
View
425 src/rbdict.erl
@@ -0,0 +1,425 @@
+%% Copyright (c) 2008 Robert Virding. All rights reserved.
+%%
+%% Redistribution and use in source and binary forms, with or without
+%% modification, are permitted provided that the following conditions
+%% are met:
+%%
+%% 1. Redistributions of source code must retain the above copyright
+%% notice, this list of conditions and the following disclaimer.
+%% 2. Redistributions in binary form must reproduce the above copyright
+%% notice, this list of conditions and the following disclaimer in the
+%% documentation and/or other materials provided with the distribution.
+%%
+%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+%% "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+%% LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+%% FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+%% COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+%% INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+%% BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+%% LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+%% LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+%% ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+%% POSSIBILITY OF SUCH DAMAGE.
+
+-module(rbdict).
+
+%% Standard interface.
+-export([new/0,is_key/2,to_list/1,from_list/1,size/1]).
+-export([fetch/2,find/2,fetch_keys/1,erase/2]).
+-export([store/3,append/3,append_list/3]).
+-export([update_val/3,update/3,update/4,update_counter/3]).
+-export([fold/3,map/2,filter/2,merge/3]).
+
+%% Deprecated interface.
+-export([dict_to_list/1,list_to_dict/1]).
+-deprecated([{dict_to_list,1},{list_to_dict,1}]).
+
+-ifdef(DEBUG).
+-export([check/1,erase_check/2,t/1,r1/0,r2/0]).
+-endif.
+
+%% -compile([export_all]).
+
+%% The algorithms here are taken directly from Okasaki and Rbset in
+%% ML/Scheme. The interface is compatible with the standard dict
+%% interface.
+%%
+%% The following structures are used to build the the RB-dict:
+%%
+%% {r,Left,Key,Val,Right}
+%% {b,Left,Key,Val,Right}
+%% empty
+%%
+%% It is interesting to note that expanding out the first argument of
+%% l/rbalance, the colour, in store etc. is actually slower than not
+%% doing it. Measured.
+
+%% new() -> Dict.
+
+new() -> empty.
+
+%% is_key(Key, Dict) -> true | false.
+
+is_key(_, empty) -> false;
+is_key(K, {_,Left,K1,_,_}) when K < K1 ->
+ is_key(K, Left);
+is_key(K, {_,_,K1,_,Right}) when K > K1 ->
+ is_key(K, Right);
+is_key(_, {_,_,_,_,_}) -> true.
+
+%% to_list(Dict) -> [{Key,Value}].
+
+to_list(T) -> to_list(T, []).
+
+to_list(empty, List) -> List;
+to_list({_,A,Xk,Xv,B}, List) ->
+ to_list(A, [{Xk,Xv}|to_list(B, List)]).
+
+%% from_list([{Key,Value}]) -> Dict.
+
+from_list(L) ->
+ lists:foldl(fun ({K,V}, D) -> store(K, V, D) end, new(), L).
+
+%% size(Dict) -> int().
+
+size(T) -> size1(T).
+
+size1(empty) -> 0;
+size1({_,L,_,_,R}) ->
+ size1(L) + size1(R) + 1.
+
+%% fetch(Key, Dict) -> Value.
+
+fetch(K, {_,Left,K1,_,_}) when K < K1 ->
+ fetch(K, Left);
+fetch(K, {_,_,K1,_,Right}) when K > K1 ->
+ fetch(K, Right);
+fetch(_, {_,_,_,Val,_}) -> Val.
+
+%% find(Key, Dict) -> {ok,Value} | error.
+
+find(_, empty) -> error;
+find(K, {_,Left,K1,_,_}) when K < K1 ->
+ find(K, Left);
+find(K, {_,_,K1,_,Right}) when K > K1 ->
+ find(K, Right);
+find(_, {_,_,_,Val,_}) -> {ok,Val}.
+
+%% fetch_keys(Dict) -> [Key].
+
+fetch_keys(T) -> fetch_keys(T, []).
+
+fetch_keys(empty, Tail) -> Tail;
+fetch_keys({_,L,K,_,R}, Tail) ->
+ fetch_keys(L, [K|fetch_keys(R, Tail)]).
+
+%% store(Key, Val, Dict) -> Dict.
+
+store(K, V, T) ->
+ {_,L,K1,V1,R} = store1(K, V, T),
+ {b,L,K1,V1,R}. %setelement(1, b, T1).
+
+store1(K, V, empty) -> {r,empty,K,V,empty};
+store1(K, V, {C,Left,K1,V1,Right}) when K < K1 ->
+ lbalance(C, store1(K, V, Left), K1, V1, Right);
+store1(K, V, {C,Left,K1,V1,Right}) when K > K1 ->
+ rbalance(C, Left, K1, V1, store1(K, V, Right));
+store1(K, V, {C,L,_,_,R}) ->
+ {C,L,K,V,R}.
+
+%% Expanding out l/rbalance is slower!
+%% store1(K, V, empty) -> {r,empty,K,V,empty};
+%% store1(K, V, {r,Left,K1,V1,Right}) ->
+%% if K < K1 -> {r,store1(K, V, Left),K1,V1,Right};
+%% K > K1 -> {r,Left,K1,V1,store1(K, V, Right)};
+%% true -> {r,Left,K,V,Right}
+%% end;
+%% store1(K, V, {b,Left,K1,V1,Right}) ->
+%% if K < K1 ->
+%% lbalance(store1(K, V, Left), K1, V1, Right);
+%% K > K1 ->
+%% rbalance(Left, K1, V1, store1(K, V, Right));
+%% true -> {b,Left,K,V,Right}
+%% end.
+
+%% append(Key, Val, Dict) -> Dict.
+
+append(K, V, T) ->
+ {_,L,K1,V1,R} = append1(K, V, T),
+ {b,L,K1,V1,R}. %setelement(1, b, T1).
+
+append1(K, V, empty) -> {r,empty,K,[V],empty};
+append1(K, V, {C,Left,K1,V1,Right}) when K < K1 ->
+ lbalance(C, append1(K, V, Left), K1, V1, Right);
+append1(K, V, {C,Left,K1,V1,Right}) when K > K1 ->
+ rbalance(C, Left, K1, V1, append1(K, V, Right));
+append1(K, V, {C,L,_,V1,R}) -> {C,L,K,V1 ++ [V],R}.
+
+%% append(Key, [Val], Dict) -> Dict.
+
+append_list(K, V, T) ->
+ {_,L,K1,V1,R} = append_list1(K, V, T),
+ {b,L,K1,V1,R}. %setelement(1, b, T1).
+
+append_list1(K, V, empty) -> {r,empty,K,V,empty};
+append_list1(K, V, {C,Left,K1,V1,Right}) when K < K1 ->
+ lbalance(C, append_list1(K, V, Left), K1, V1, Right);
+append_list1(K, V, {C,Left,K1,V1,Right}) when K > K1 ->
+ rbalance(C, Left, K1, V1, append_list1(K, V, Right));
+append_list1(K, V, {C,L,_,V1,R}) -> {C,L,K,V1 ++ V,R}.
+
+%% update_val(Key, Val, Dict) -> Dict.
+
+update_val(K, V, {RB,A,Xk,Xv,B}) when K < Xk ->
+ {RB,update_val(K, V, A),Xk,Xv,B};
+update_val(K, V, {RB,A,Xk,Xv,B}) when K > Xk ->
+ {RB,A,Xk,Xv,update_val(K, V, B)};
+update_val(_, V, {RB,A,Xk,_,B}) ->
+ {RB,A,Xk,V,B}.
+
+%% update(Key, Fun, Dict) -> Dict.
+
+update(K, F, {RB,A,Xk,Xv,B}) when K < Xk ->
+ {RB,update(K, F, A),Xk,Xv,B};
+update(K, F, {RB,A,Xk,Xv,B}) when K > Xk ->
+ {RB,A,Xk,Xv,update(K, F, B)};
+update(_, F, {RB,A,Xk,Xv,B}) ->
+ {RB,A,Xk,F(Xv),B}.
+
+%% update(Key, Fun, Init, Dict) -> Dict.
+
+update(K, F, I, T) ->
+ {_,L,K1,V1,R} = update1(K, F, I, T),
+ {b,L,K1,V1,R}. %setelement(1, b, T1).
+
+update1(K, _, I, empty) -> {r,empty,K,I,empty};
+update1(K, F, I, {RB,A,Xk,Xv,B}) when K < Xk ->
+ lbalance(RB, update1(K, F, I, A), Xk, Xv, B);
+update1(K, F, I, {RB,A,Xk,Xv,B}) when K > Xk ->
+ rbalance(RB, A, Xk, Xv, update1(K, F, I, B));
+update1(_, F, _, {RB,A,Xk,Xv,B}) ->
+ {RB,A,Xk,F(Xv),B}.
+
+%% update_counter(Key, Incr, Dict) -> Dict.
+
+update_counter(K, I, T) ->
+ {_,L,K1,V1,R} = update_counter1(K, I, T),
+ {b,L,K1,V1,R}. %setelement(1, b, T1).
+
+update_counter1(K, I, empty) -> {r,empty,K,I,empty};
+update_counter1(K, I, {RB,A,Xk,Xv,B}) when K < Xk ->
+ lbalance(RB, update_counter1(K, I, A), Xk, Xv, B);
+update_counter1(K, I, {RB,A,Xk,Xv,B}) when K > Xk ->
+ rbalance(RB, A, Xk, Xv, update_counter1(K, I, B));
+update_counter1(_, I, {RB,A,Xk,Xv,B}) ->
+ {RB,A,Xk,Xv+I,B}.
+
+%% lbalance(Colour, Left, Key, Val, Right).
+%% rbalance(Colour, Left, Key, Val, Right).
+%% Balance a tree afer (possibly) adding a node to the left/right.
+
+lbalance(b, {r,{r,A,Xk,Xv,B},Yk,Yv,C}, Zk, Zv, D) ->
+ {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+lbalance(b, {r,A,Xk,Xv,{r,B,Yk,Yv,C}}, Zk, Zv, D) ->
+ {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+lbalance(C, A, Xk, Xv, B) -> {C,A,Xk,Xv,B}.
+
+rbalance(b, A, Xk, Xv, {r,{r,B,Yk,Yv,C},Zk,Zv,D}) ->
+ {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+rbalance(b, A, Xk, Xv, {r,B,Yk,Yv,{r,C,Zk,Zv,D}}) ->
+ {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+rbalance(C, A, Xk, Xv, B) -> {C,A,Xk,Xv,B}.
+
+%% erase(Key, Dict) -> Dict.
+
+erase(K, T) ->
+ {T1,_} = erase_aux(K, T),
+ T1.
+
+%% erase_aux(Key, Node) -> {Node,Decreased}.
+
+erase_aux(_, empty) -> {empty,false};
+erase_aux(K, {b,A,Xk,Xv,B}) ->
+ if K < Xk ->
+ {A1,Dec} = erase_aux(K, A),
+ if Dec -> unbalright(b, A1, Xk, Xv, B);
+ true -> {{b,A1,Xk,Xv,B},false}
+ end;
+ K > Xk ->
+ {B1,Dec} = erase_aux(K, B),
+ if Dec -> unballeft(b, A, Xk, Xv, B1);
+ true -> {{b,A,Xk,Xv,B1},false}
+ end;
+ true ->
+ case B of
+ empty -> blackify(A);
+ _ ->
+ {B1,{Mk,Mv},Dec} = erase_min(B),
+ if Dec -> unballeft(b, A, Mk, Mv, B1);
+ true -> {{b,A,Mk,Mv,B1},false}
+ end
+ end
+ end;
+erase_aux(K, {r,A,Xk,Xv,B}) ->
+ if K < Xk ->
+ {A1,Dec} = erase_aux(K, A),
+ if Dec -> unbalright(r, A1, Xk, Xv, B);
+ true -> {{r,A1,Xk,Xv,B},false}
+ end;
+ K > Xk ->
+ {B1,Dec} = erase_aux(K, B),
+ if Dec -> unballeft(r, A, Xk, Xv, B1);
+ true -> {{r,A,Xk,Xv,B1},false}
+ end;
+ true ->
+ case B of
+ empty -> {A,false};
+ _ ->
+ {B1,{Mk,Mv},Dec} = erase_min(B),
+ if Dec -> unballeft(r, A, Mk, Mv, B1);
+ true -> {{r,A,Mk,Mv,B1},false}
+ end
+ end
+ end.
+
+%% erase_min(Node) -> {Node,{NodeKey,NodeVal},Decreased}.
+
+erase_min({b,empty,Xk,Xv,empty}) ->
+ {empty,{Xk,Xv},true};
+erase_min({b,empty,Xk,Xv,{r,A,Yk,Yv,B}}) ->
+ {{b,A,Yk,Yv,B},{Xk,Xv},false};
+erase_min({b,empty,_,_,{b,_,_,_,_}}) -> exit(boom);
+erase_min({r,empty,Xk,Xv,A}) ->
+ {A,{Xk,Xv},false};
+%% Rec from left
+erase_min({b,A,Xk,Xv,B}) ->
+ {A1,Min,Dec} = erase_min(A),
+ if Dec ->
+ {T,Dec1} = unbalright(b, A1, Xk, Xv, B),
+ {T,Min,Dec1};
+ true -> {{b,A1,Xk,Xv,B},Min,false}
+ end;
+erase_min({r,A,Xk,Xv,B}) ->
+ {A1,Min,Dec} = erase_min(A),
+ if Dec ->
+ {T,Dec1} = unbalright(r, A1, Xk, Xv, B),
+ {T,Min,Dec1};
+ true -> {{r,A1,Xk,Xv,B},Min,false}
+ end.
+
+blackify({r,A,K,V,B}) -> {{b,A,K,V,B},false};
+blackify(Node) -> {Node,true}.
+
+unballeft(r, {b,A,Xk,Xv,B}, Yk, Yv, C) ->
+ {lbalance(b, {r,A,Xk,Xv,B}, Yk, Yv, C),false};
+unballeft(b, {b,A,Xk,Xv,B}, Yk, Yv, C) ->
+ {lbalance(b, {r,A,Xk,Xv,B},Yk, Yv, C),true};
+unballeft(b, {r,A,Xk,Xv,{b,B,Yk,Yv,C}}, Zk, Zv, D) ->
+ {{b,A,Xk,Xv,lbalance(b, {r,B,Yk,Yv,C}, Zk, Zv, D)},false}.
+
+unbalright(r, A, Xk, Xv, {b,B,Yk,Yv,C}) ->
+ {rbalance(b, A, Xk, Xv, {r,B,Yk,Yv,C}),false};
+unbalright(b, A, Xk, Xv, {b,B,Yk,Yv,C}) ->
+ {rbalance(b, A, Xk, Xv, {r,B,Yk,Yv,C}),true};
+unbalright(b, A, Xk, Xv, {r,{b,B,Yk,Yv,C},Zk,Zv,D}) ->
+ {{b,rbalance(b, A, Xk, Xv, {r,B,Yk,Yv,C}), Zk, Zv, D},false}.
+
+%% fold(Fun, Acc, Dict) -> Acc.
+
+fold(_, Acc, empty) -> Acc;
+fold(F, Acc, {_,A,Xk,Xv,B}) ->
+ fold(F, F(Xk, Xv, fold(F, Acc, B)), A).
+
+%% map(Fun, Dict) -> Dict.
+
+map(_, empty) -> empty;
+map(F, {RB,A,Xk,Xv,B}) ->
+ {RB,map(F,A),Xk,F(Xk, Xv),map(F, B)}.
+
+%% filter(Fun, Dict) -> Dict.
+
+filter(F, T) -> filter(F, T, new()).
+
+filter(_, empty, New) -> New;
+filter(F, {_,A,Xk,Xv,B}, New0) ->
+ New1 = filter(F, A, New0),
+ New2 = case F(Xk, Xv) of
+ true -> store(Xk, Xv, New1);
+ false -> New1
+ end,
+ filter(F, B, New2).
+
+%% merge(Fun, Dict, Dict) -> Dict.
+
+merge(F, D1, D2) ->
+ fold(fun (K, V2, D) ->
+ update(K, fun(V1) -> F(K, V1, V2) end, V2, D)
+ end, D1, D2).
+
+%% Deprecated interface.
+
+%% dict_to_list(Dictionary) -> [{Key,Value}].
+
+dict_to_list(D) -> to_list(D).
+
+%% list_to_dict([{Key,Value}]) -> Dictionary.
+
+list_to_dict(L) -> from_list(L).
+
+-ifdef(DEBUG).
+%% Test functions.
+
+erase_check(K, T) ->
+ T1 = erase(K, T),
+ check(T1),
+ T1.
+
+check(T) -> check(T, r).
+
+check(empty, _) -> 1;
+check({r,A,Xk,Xv,B}, b) -> %Must have black parent
+ case {check(A, r),check(B, r)} of
+ {D,D}-> D;
+ {Dl,Dr} -> exit({depth,{r,Dl,Xk,Xv,Dr}})
+ end;
+check({r,_,Xk,Xv,_}, r) -> %Must have black parent
+ exit({parent,{r,'-',Xk,Xv,'-'}});
+check({b,A,Xk,Xv,B}, _) ->
+ case {check(A, b),check(B,b)} of
+ {D,D}-> D+1; %Increase depth
+ {Dl,Dr} -> exit({depth,{b,Dl,Xk,Xv,Dr}})
+ end.
+
+t(Ks) -> t(Ks, new()).
+
+t([K|Ks], D0) ->
+ D1 = store(K, K, D0),
+ t(Ks, D1);
+t([], D) -> D.
+
+%% Known error cases which have been fixed.
+
+r1() ->
+ {{b,{b,empty,37,37,empty},
+ 38,
+ 38,
+ {b,{r,empty,39,39,empty},40,40,empty}},
+ 39,
+ {b,{r,empty,37,37,empty},38,38,{b,empty,40,40,empty}}}.
+
+r2() ->
+ {{b,{r,{b,empty,43,43,empty},
+ 46,
+ 46,
+ {b,empty,48,48,empty}},
+ 50,
+ 50,
+ {b,empty,53,53,empty}},
+ 53,
+ {b,{b,empty,43,43,empty},
+ 46,
+ 46,
+ {r,{b,empty,48,48,empty},50,50,empty}}}.
+-endif.
View
403 src/rbdict1.erl
@@ -0,0 +1,403 @@
+-module(rbdict1).
+
+-export([new/0,is_key/2,to_list/1,from_list/1,size/1]).
+-export([fetch/2,find/2,fetch_keys/1,erase/2]).
+-export([store/3,append/3,append_list/3]).
+-export([update_val/3,update/3,update/4,update_counter/3]).
+-export([fold/3,map/2,filter/2,merge/3]).
+
+%% Deprecated interface.
+-export([dict_to_list/1,list_to_dict/1]).
+-deprecated([{dict_to_list,1},{list_to_dict,1}]).
+
+-ifdef(DEBUG).
+-export([check/1,erase_check/2,t/1,r1/0,r2/0]).
+-endif.
+
+%% -compile([export_all]).
+
+%% {r,Left,K,V,Right}
+%% {b,Left,K,V,Right}
+%% empty
+
+-define(IS_RED(N), (is_tuple(N) andalso element(1, N) == r)).
+%% -define(IS_BLACK(N), not (is_tuple(N) andalso element(1, N) == r)).
+-define(IS_BLACK(N),
+ ((is_tuple(N) andalso (element(1, N) == b)) orelse (N == empty))).
+
+-define(DBLACK(N), [b|N]).
+
+%% new() -> Dict.
+
+new() -> empty.
+
+%% is_key(Key, Dict) -> true | false.
+
+is_key(_, empty) -> false;
+is_key(K, {_,Left,K1,_,_}) when K < K1 ->
+ is_key(K, Left);
+is_key(K, {_,_,K1,_,Right}) when K > K1 ->
+ is_key(K, Right);
+is_key(_, {_,_,_,_,_}) -> true.
+
+%% to_list(Dict) -> [{Key,Value}].
+
+to_list(T) -> to_list(T, []).
+
+to_list(empty, List) -> List;
+to_list({_,A,Xk,Xv,B}, List) ->
+ to_list(A, [{Xk,Xv}|to_list(B, List)]).
+
+%% from_list([{Key,Value}]) -> Dict.
+
+from_list(L) ->
+ fold(fun ({K,V}, D) -> store(K, V, D) end, new(), L).
+
+%% size(Dict) -> int().
+
+size(T) -> size1(T).
+
+size1(empty) -> 0;
+size1({_,L,_,_,R}) ->
+ size1(L) + size1(R) + 1.
+
+%% fetch(Key, Dict) -> Value.
+
+fetch(K, {_,Left,K1,_,_}) when K < K1 ->
+ fetch(K, Left);
+fetch(K, {_,_,K1,_,Right}) when K > K1 ->
+ fetch(K, Right);
+fetch(_, {_,_,_,Val,_}) -> Val.
+
+%% find(Key, Dict) -> {ok,Value} | error.
+
+find(_, empty) -> error;
+find(K, {_,Left,K1,_,_}) when K < K1 ->
+ find(K, Left);
+find(K, {_,_,K1,_,Right}) when K > K1 ->
+ fetch(K, Right);
+find(_, {_,_,_,Val,_}) -> {ok,Val}.
+
+%% fetch_keys(Dict) -> [Key].
+
+fetch_keys(T) -> fetch_keys(T, []).
+
+fetch_keys(empty, Tail) -> Tail;
+fetch_keys({_,L,K,_,R}, Tail) ->
+ fetch_keys(L, [K|fetch_keys(R, Tail)]).
+
+%% store(Key, Val, Dict) -> Dict.
+
+store(K, V, T) ->
+ {_,L,K1,V1,R} = store1(K, V, T),
+ {b,L,K1,V1,R}. %setelement(1, b, T1).
+
+store1(K, V, empty) -> {r,empty,K,V,empty};
+store1(K, V, {C,Left,K1,V1,Right}) when K < K1 ->
+ lbalance(C, store1(K, V, Left), K1, V1, Right);
+store1(K, V, {C,Left,K1,V1,Right}) when K > K1 ->
+ rbalance(C, Left, K1, V1, store1(K, V, Right));
+store1(K, V, {C,L,_,_,R}) ->
+ {C,L,K,V,R}.
+
+%% append(Key, Val, Dict) -> Dict.
+
+append(K, V, T) ->
+ {_,L,K1,V1,R} = append1(K, V, T),
+ {b,L,K1,V1,R}. %setelement(1, b, T1).
+
+append1(K, V, empty) -> {r,empty,K,[V],empty};
+append1(K, V, {C,Left,K1,V1,Right}) when K < K1 ->
+ lbalance(C, append1(K, V, Left), K1, V1, Right);
+append1(K, V, {C,Left,K1,V1,Right}) when K > K1 ->
+ rbalance(C, Left, K1, V1, append1(K, V, Right));
+append1(K, V, {C,L,_,V1,R}) -> {C,L,K,V1 ++ [V],R}.
+
+%% append(Key, [Val], Dict) -> Dict.
+
+append_list(K, V, T) ->
+ {_,L,K1,V1,R} = append_list1(K, V, T),
+ {b,L,K1,V1,R}. %setelement(1, b, T1).
+
+append_list1(K, V, empty) -> {r,empty,K,V,empty};
+append_list1(K, V, {C,Left,K1,V1,Right}) when K < K1 ->
+ lbalance(C, append_list1(K, V, Left), K1, V1, Right);
+append_list1(K, V, {C,Left,K1,V1,Right}) when K > K1 ->
+ rbalance(C, Left, K1, V1, append_list1(K, V, Right));
+append_list1(K, V, {C,L,_,V1,R}) -> {C,L,K,V1 ++ V,R}.
+
+%% update_val(Key, Val, Dict) -> Dict.
+
+update_val(K, V, {RB,A,Xk,Xv,B}) when K < Xk ->
+ {RB,update_val(K, V, A),Xk,Xv,B};
+update_val(K, V, {RB,A,Xk,Xv,B}) when K > Xk ->
+ {RB,A,Xk,Xv,update_val(K, V, B)};
+update_val(_, V, {RB,A,Xk,_,B}) ->
+ {RB,A,Xk,V,B}.
+
+%% update(Key, Fun, Dict) -> Dict.
+
+update(K, F, {RB,A,Xk,Xv,B}) when K < Xk ->
+ {RB,update(K, F, A),Xk,Xv,B};
+update(K, F, {RB,A,Xk,Xv,B}) when K > Xk ->
+ {RB,A,Xk,Xv,update(K, F, B)};
+update(_, F, {RB,A,Xk,Xv,B}) ->
+ {RB,A,Xk,F(Xv),B}.
+
+%% update(Key, Fun, Init, Dict) -> Dict.
+
+update(K, F, I, T) ->
+ {_,L,K1,V1,R} = update1(K, F, I, T),
+ {b,L,K1,V1,R}. %setelement(1, b, T1).
+
+update1(K, _, I, empty) -> {r,empty,K,I,empty};
+update1(K, F, I, {RB,A,Xk,Xv,B}) when K < Xk ->
+ lbalance(RB, update1(K, F, I, A), Xk, Xv, B);
+update1(K, F, I, {RB,A,Xk,Xv,B}) when K > Xk ->
+ rbalance(RB, A, Xk, Xv, update1(K, F, I, B));
+update1(_, F, _, {RB,A,Xk,Xv,B}) ->
+ {RB,A,Xk,F(Xv),B}.
+
+%% update_counter(Key, Incr, Dict) -> Dict.
+
+update_counter(K, I, T) ->
+ {_,L,K1,V1,R} = update_counter1(K, I, T),
+ {b,L,K1,V1,R}. %setelement(1, b, T1).
+
+update_counter1(K, I, empty) -> {r,empty,K,I,empty};
+update_counter1(K, I, {RB,A,Xk,Xv,B}) when K < Xk ->
+ lbalance(RB, update_counter1(K, I, A), Xk, Xv, B);
+update_counter1(K, I, {RB,A,Xk,Xv,B}) when K > Xk ->
+ rbalance(RB, A, Xk, Xv, update_counter1(K, I, B));
+update_counter1(_, I, {RB,A,Xk,Xv,B}) ->
+ {RB,A,Xk,Xv+I,B}.
+
+%% lbalance(Colour, Left, Key, Val, Right).
+%% rbalance(Colour, Left, Key, Val, Right).
+%% Balance a tree afer (possibly) adding a node to the left/right.
+
+lbalance(b, {r,{r,A,Xk,Xv,B},Yk,Yv,C}, Zk, Zv, D) ->
+ {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+lbalance(b, {r,A,Xk,Xv,{r,B,Yk,Yv,C}}, Zk, Zv, D) ->
+ {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+lbalance(C, A, Xk, Xv, B) -> {C,A,Xk,Xv,B}.
+
+rbalance(b, A, Xk, Xv, {r,{r,B,Yk,Yv,C},Zk,Zv,D}) ->
+ {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+rbalance(b, A, Xk, Xv, {r,B,Yk,Yv,{r,C,Zk,Zv,D}}) ->
+ {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+rbalance(C, A, Xk, Xv, B) -> {C,A,Xk,Xv,B}.
+
+add_token({r,L,K,V,R}) -> {b,L,K,V,R};
+add_token(Node) -> ?DBLACK(Node).
+
+%% erase(Key, Dict) -> Dict.
+
+erase(K, T) ->
+ case erase1(K, T) of
+ {r,L1,K1,V1,R1} -> {b,L1,K1,V1,R1}; %setelement(1, b, T1).
+ ?DBLACK(X) -> X;
+ Node -> Node
+ end.
+
+erase1(_, empty) -> empty; %Not found
+erase1(K, {r,empty,Xk,_,empty}=A) ->
+ if K < Xk -> A; %Not found
+ K > Xk -> A; %Not found
+ true -> empty %Won't change balance
+ end;
+erase1(K, {b,empty,Xk,_,empty}=A) ->
+ if K < Xk -> A; %Not found
+ K > Xk -> A; %Not found
+ true -> add_token(empty) %This is it
+ end;
+erase1(K, {r,A,Xk,Xv,B}=X) ->
+ if K < Xk ->
+ balleft(r, erase1(K, A), Xk, Xv, B);
+ K > Xk ->
+ balright(r, A, Xk, Xv, erase1(K, B));
+ true -> %This is it
+ raise_pred_succ(X)
+ end;
+erase1(K, {b,A,Xk,Xv,B}=X) ->
+ if K < Xk ->
+ balleft(b, erase1(K, A), Xk, Xv, B);
+ K > Xk ->
+ balright(b, A, Xk, Xv, erase1(K, B));
+ true -> %This is it
+ raise_pred_succ(X)
+ end.
+
+%% raise_pred_succ(Node) -> Node.
+
+%% Remove and raise the successor node if the left branch is empty
+%% else raise the predecessor node. Rebuild tree with removed node as
+%% head making sure the resulting tree balanced. We KNOW that both
+%% Left and Right cannot be empty.
+
+raise_pred_succ({C,empty,_,_,B}) ->
+ {B1,{Xk1,Xv1}} = raise_succ(B),
+ balright(C, empty, Xk1, Xv1, B1);
+raise_pred_succ({C,A,_,_,B}) ->
+ {A1,{Xk1,Xv1}} = raise_pred(A),
+ balleft(C, A1, Xk1, Xv1, B).
+
+%% raise_pred(Node) -> {PredTree,{NodeKey,NodeVal}}.
+%% raise_succ(Node) -> {SuccTree,{NodeKey,NodeVal}}.
+%% Remove and raise the predecessor/successor node rebalancing the
+%% tree when necessary.
+
+raise_pred({b,A,Xk,Xv,empty}) -> {add_token(A),{Xk,Xv}};
+raise_pred({r,A,Xk,Xv,empty}) -> {A,{Xk,Xv}}; %Won't change balance
+raise_pred({b,A,Xk,Xv,B}) ->
+ {B1,Pred} = raise_pred(B),
+ {balright(b, A, Xk, Xv, B1),Pred};
+raise_pred({r,A,Xk,Xv,B}) ->
+ {B1,Pred} = raise_pred(B),
+ {balright(r, A, Xk, Xv, B1),Pred}.
+
+raise_succ({b,empty,Xk,Xv,A}) -> {add_token(A),{Xk,Xv}};
+raise_succ({r,empty,Xk,Xv,A}) -> {A,{Xk,Xv}}; %Won't change balance
+raise_succ({b,A,Xk,Xv,B}) ->
+ {A1,Succ} = raise_succ(A),
+ {balleft(b, A1, Xk, Xv, B),Succ};
+raise_succ({r,A,Xk,Xv,B}) ->
+ {A1,Succ} = raise_succ(A),
+ {balleft(r, A1, Xk, Xv, B),Succ}.
+
+%% balleft(Colour, Left, Key, Val, Right)
+%% balright(Colour, Left, Key, Val, Right)
+%% Rebalance a tree knowing that the left/right tree may have been
+%% made smaller.
+
+balleft(RB, ?DBLACK(A), Xk, Xv, {b,{r,B,Yk,Yv,C},Zk,Zv,D})
+ when ?IS_BLACK(A) ->
+ %%io:fwrite("LA(~w)\n", [Xk]),
+ {RB,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+balleft(RB, ?DBLACK(A), Xk, Xv, {b,B,Yk,Yv,{r,C,Zk,Zv,D}})
+ when ?IS_BLACK(A) ->
+ {RB,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+balleft(RB, ?DBLACK(A), Xk, Xv, {b,B,Yk,Yv,C})
+ when ?IS_BLACK(A) and ?IS_BLACK(B) and ?IS_BLACK(C) ->
+ add_token({RB,A,Xk,Xv,{r,B,Yk,Yv,C}});
+balleft(b, ?DBLACK(A), Xk, Xv, {r,B,Yk,Yv,C})
+ when ?IS_BLACK(A) and ?IS_BLACK(B) and ?IS_BLACK(C) ->
+ balleft(b, balleft(r, ?DBLACK(A), Xk, Xv, B), Yk, Yv, C);
+%% No rule matches, just pass double black up the tree.
+balleft(RB, ?DBLACK(A), Xk, Xv, B) -> add_token({RB,A,Xk,Xv,B});
+balleft(RB, A, Xk, Xv, B) -> {RB,A,Xk,Xv,B}.
+
+balright(RB, {b,{r,A,Xk,Xv,B},Yk,Yv,C}, Zk, Zv, ?DBLACK(D))
+ when ?IS_BLACK(D) ->
+ %%io:fwrite("RA(~w)\n", [Zk]),
+ {RB,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+balright(RB, {b,A,Xk,Xv,{r,B,Yk,Yv,C}}, Zk, Zv, ?DBLACK(D))
+ when ?IS_BLACK(D) ->
+ {RB,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}};
+balright(RB, {b,A,Xk,Xv,B}, Yk, Yv, ?DBLACK(C))
+ when ?IS_BLACK(A) and ?IS_BLACK(B) and ?IS_BLACK(C) ->
+ add_token({RB,{r,A,Xk,Xv,B},Yk,Yv,C});
+balright(b, {r,A,Xk,Xv,B}, Yk, Yv, ?DBLACK(C))
+ when ?IS_BLACK(A) and ?IS_BLACK(B) and ?IS_BLACK(C) ->
+ balright(b, A, Xk, Xv, balright(r, B, Yk, Yv, ?DBLACK(C)));
+%% No rule matches, just pass double black up the tree.
+balright(RB, A, Xk, Xv, ?DBLACK(B)) -> add_token({RB,A,Xk,Xv,B});
+balright(RB, A, Xk, Xv, B) -> {RB,A,Xk,Xv,B}.
+
+%% fold(Fun, Acc, Dict) -> Acc.
+
+fold(_, Acc, empty) -> Acc;
+fold(F, Acc, {_,A,Xk,Xv,B}) ->
+ fold(F, F(Xk, Xv, fold(F, Acc, B)), A).
+
+%% map(Fun, Dict) -> Dict.
+
+map(_, empty) -> empty;
+map(F, {RB,A,Xk,Xv,B}) ->
+ {RB,map(F,A),Xk,F(Xk, Xv),map(F, B)}.
+
+%% filter(Fun, Dict) -> Dict.
+
+filter(F, T) -> filter(F, T, new()).
+
+filter(_, empty, New) -> New;
+filter(F, {_,A,Xk,Xv,B}, New0) ->
+ New1 = filter(F, A, New0),
+ New2 = case F(Xk, Xv) of
+ true -> store(Xk, Xv, New1);
+ false -> New1
+ end,
+ filter(F, B, New2).
+
+%% merge(Fun, Dict, Dict) -> Dict.
+
+merge(F, D1, D2) ->
+ fold(fun (K, V2, D) ->
+ update(K, fun(V1) -> F(K, V1, V2) end, V2, D)
+ end, D1, D2).
+
+%% Deprecated interface.
+
+%% dict_to_list(Dictionary) -> [{Key,Value}].
+
+dict_to_list(D) -> to_list(D).
+
+%% list_to_dict([{Key,Value}]) -> Dictionary.
+
+list_to_dict(L) -> from_list(L).
+
+-ifdef(DEBUG).
+%% Test functions.
+
+erase_check(K, T) ->
+ T1 = erase(K, T),
+ check(T1),
+ T1.
+
+check(T) -> check(T, r).
+
+check(empty, _) -> 1;
+check({r,A,Xk,Xv,B}, b) -> %Must have black parent
+ case {check(A, r),check(B, r)} of
+ {D,D}-> D;
+ {Dl,Dr} -> exit({depth,{r,Dl,Xk,Xv,Dr}})
+ end;
+check({r,_,Xk,Xv,_}, r) -> %Must have black parent
+ exit({parent,{r,'-',Xk,Xv,'-'}});
+check({b,A,Xk,Xv,B}, _) ->
+ case {check(A, b),check(B,b)} of
+ {D,D}-> D+1; %Increase depth
+ {Dl,Dr} -> exit({depth,{b,Dl,Xk,Xv,Dr}})
+ end.
+
+t(Ks) -> t(Ks, new()).
+
+t([K|Ks], D0) ->
+ D1 = store(K, K, D0),
+ t(Ks, D1);
+t([], D) -> D.
+
+%% Known error cases which have been fixed.
+
+r1() ->
+ {{b,{b,empty,37,37,empty},
+ 38,
+ 38,
+ {b,{r,empty,39,39,empty},40,40,empty}},
+ 39,
+ {b,{r,empty,37,37,empty},38,38,{b,empty,40,40,empty}}}.
+
+r2() ->
+ {{b,{r,{b,empty,43,43,empty},
+ 46,
+ 46,
+ {b,empty,48,48,empty}},
+ 50,
+ 50,
+ {b,empty,53,53,empty}},
+ 53,
+ {b,{b,empty,43,43,empty},
+ 46,
+ 46,
+ {r,{b,empty,48,48,empty},50,50,empty}}}.
+-endif.
View
408 src/rbsets.erl
@@ -0,0 +1,408 @@
+%% Copyright (c) 2008 Robert Virding. All rights reserved.
+%%
+%% Redistribution and use in source and binary forms, with or without
+%% modification, are permitted provided that the following conditions
+%% are met:
+%%
+%% 1. Redistributions of source code must retain the above copyright
+%% notice, this list of conditions and the following disclaimer.
+%% 2. Redistributions in binary form must reproduce the above copyright
+%% notice, this list of conditions and the following disclaimer in the
+%% documentation and/or other materials provided with the distribution.
+%%
+%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+%% "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+%% LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+%% FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+%% COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+%% INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+%% BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+%% LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+%% LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+%% ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+%% POSSIBILITY OF SUCH DAMAGE.
+
+-module(rbsets).
+
+%% Standard interface.
+-export([new/0,is_set/1,size/1,to_list/1,from_list/1]).
+-export([is_element/2,add_element/2,del_element/2]).
+-export([union/2,union/1,intersection/2,intersection/1]).
+-export([subtract/2,is_subset/2]).
+-export([fold/3,filter/2]).
+
+%% Extended interface.
+-export([all/2,any/2,foreach/2,partition/2]).
+
+%% Deprecated interface.
+
+-export([new_set/0,set_to_list/1,list_to_set/1,subset/2]).
+-deprecated([{new_set,0},{set_to_list,1},{list_to_set,1},{subset,2}]).
+
+-ifdef(DEBUG).
+-export([check/1,erase_check/2,t/1,r1/0,r2/0]).
+-endif.
+
+%% The algorithms here are taken directly from Okasaki and Rbset in
+%% ML/Scheme. The interface is compatible with the standard dict
+%% interface.
+%%
+%% The following structures are used to build the the RB-set:
+%%
+%% {r,Left,Element,Right}
+%% {b,Left,Element,Right}
+%% empty
+%%
+%% It is interesting to note that expanding out the first argument of
+%% l/rbalance, the colour, in store etc. is actually slower than not
+%% doing it. Measured.
+
+%% new() -> Set.
+
+new() -> empty.
+
+%% is_set(Set) -> bool().
+%% Return 'true' if Set is a set of elements, else 'false'.
+
+is_set({r,Left,_,Right}) ->
+ is_set(Left) andalso is_set(Right);
+is_set({b,Left,_,Right}) ->
+ is_set(Left) andalso is_set(Right);
+is_set(empty) -> true.
+
+%% size(Set) -> int().
+
+size(S) -> size1(S).
+
+size1({r,Left,_,Right}) ->
+ size1(Left) + 1 + size1(Right);
+size1({b,Left,_,Right}) ->
+ size1(Left) + 1 + size1(Right);
+size1(empty) -> 0.
+
+%% to_list(Set) -> [Element].
+
+to_list(T) -> to_list(T, []).
+
+to_list(empty, List) -> List;
+to_list({_,A,X,B}, List) ->
+ to_list(A, [X|to_list(B, List)]).
+
+%% from_list([Element]) -> Set.
+
+from_list(L) ->
+ lists:foldl(fun (E, S) -> add_element(E, S) end, new(), L).
+
+%% is_element(Element, Set) -> true | false.
+
+is_element(_, empty) -> false;
+is_element(X, {_,A,Y,_}) when X < Y ->
+ is_element(X, A);
+is_element(X, {_,_,Y,B}) when X > Y ->
+ is_element(X, B);
+is_element(_, {_,_,_,_}) -> true.
+
+%% add_element(Element, Set) -> Set.
+
+add_element(E, T) ->
+ {_,L,E1,R} = add_element1(E, T),
+ {b,L,E1,R}. %setelement(1, b, T1).
+
+add_element1(X, empty) -> {r,empty,X,empty};
+add_element1(X, {C,A,Y,B}) when X < Y ->
+ lbalance(C, add_element1(X, A), Y, B);
+add_element1(X, {C,A,Y,B}) when X > Y ->
+ rbalance(C, A, Y, add_element1(X, B));
+add_element1(_, {_,_,_,_}=T) -> T.
+
+%% Expanding out l/rbalance is slower!
+%% add_element1(X, empty) -> {r,empty,X,empty};
+%% add_element1(X, {r,Left,Y,Right}) ->
+%% if X < Y -> {r,add_element1(X, Left),Y,Right};
+%% X > Y -> {r,Left,Y,add_element1(X, Right)};
+%% true -> {r,Left,X,Right}
+%% end;
+%% add_element1(X, {b,Left,Y,Right}) ->
+%% if X < Y ->
+%% lbalance(add_element1(X, Left), Y, Right);
+%% X > Y ->
+%% rbalance(Left, Y, add_element1(X, Right));
+%% true -> {b,Left,X,Right}
+%% end.
+
+%% lbalance(Colour, Left, Key, Val, Right).
+%% rbalance(Colour, Left, Key, Val, Right).
+%% Balance a tree afer (possibly) adding a node to the left/right.
+
+lbalance(b, {r,{r,A,X,B},Y,C}, Z, D) ->
+ {r,{b,A,X,B},Y,{b,C,Z,D}};
+lbalance(b, {r,A,X,{r,B,Y,C}}, Z, D) ->
+ {r,{b,A,X,B},Y,{b,C,Z,D}};
+lbalance(C, A, X, B) -> {C,A,X,B}.
+
+rbalance(b, A, X, {r,{r,B,Y,C},Z,D}) ->
+ {r,{b,A,X,B},Y,{b,C,Z,D}};
+rbalance(b, A, X, {r,B,Y,{r,C,Z,D}}) ->
+ {r,{b,A,X,B},Y,{b,C,Z,D}};
+rbalance(C, A, X, B) -> {C,A,X,B}.
+
+%% del_element(Element, Set) -> Set.
+
+del_element(K, T) ->
+ {T1,_} = del_aux(K, T),
+ T1.
+
+%% del_aux(Key, Node) -> {Node,Decreased}.
+
+del_aux(_, empty) -> {empty,false};
+del_aux(K, {b,A,X,B}) ->
+ if K < X ->
+ {A1,Dec} = del_aux(K, A),
+ if Dec -> unbalright(b, A1, X, B);
+ true -> {{b,A1,X,B},false}
+ end;
+ K > X ->
+ {B1,Dec} = del_aux(K, B),
+ if Dec -> unballeft(b, A, X, B1);
+ true -> {{b,A,X,B1},false}
+ end;
+ true ->
+ case B of
+ empty -> blackify(A);
+ _ ->
+ {B1,M,Dec} = del_min(B),
+ if Dec -> unballeft(b, A, M, B1);
+ true -> {{b,A,M,B1},false}
+ end
+ end
+ end;
+del_aux(K, {r,A,X,B}) ->
+ if K < X ->
+ {A1,Dec} = del_aux(K, A),
+ if Dec -> unbalright(r, A1, X, B);
+ true -> {{r,A1,X,B},false}
+ end;
+ K > X ->
+ {B1,Dec} = del_aux(K, B),
+ if Dec -> unballeft(r, A, X, B1);
+ true -> {{r,A,X,B1},false}
+ end;
+ true ->
+ case B of
+ empty -> {A,false};
+ _ ->
+ {B1,M,Dec} = del_min(B),
+ if Dec -> unballeft(r, A, M, B1);
+ true -> {{r,A,M,B1},false}
+ end
+ end
+ end.
+
+%% del_min(Node) -> {Node,{NodeKey,NodeVal},Decreased}.
+
+del_min({b,empty,X,empty}) ->
+ {empty,X,true};
+del_min({b,empty,X,{r,A,Y,B}}) ->
+ {{b,A,Y,B},X,false};
+del_min({b,empty,_,{b,_,_,_}}) -> exit(boom);
+del_min({r,empty,X,A}) ->
+ {A,X,false};
+%% Rec from left
+del_min({b,A,X,B}) ->
+ {A1,Min,Dec} = del_min(A),
+ if Dec ->
+ {T,Dec1} = unbalright(b, A1, X, B),
+ {T,Min,Dec1};
+ true -> {{b,A1,X,B},Min,false}
+ end;
+del_min({r,A,X,B}) ->
+ {A1,Min,Dec} = del_min(A),
+ if Dec ->
+ {T,Dec1} = unbalright(r, A1, X, B),
+ {T,Min,Dec1};
+ true -> {{r,A1,X,B},Min,false}
+ end.
+
+blackify({r,A,E,B}) -> {{b,A,E,B},false};
+blackify(Node) -> {Node,true}.
+
+unballeft(r, {b,A,X,B}, Y, C) ->
+ {lbalance(b, {r,A,X,B}, Y, C),false};
+unballeft(b, {b,A,X,B}, Y, C) ->
+ {lbalance(b, {r,A,X,B}, Y, C),true};
+unballeft(b, {r,A,X,{b,B,Y,C}}, Z, D) ->
+ {{b,A,X,lbalance(b, {r,B,Y,C}, Z, D)},false}.
+
+unbalright(r, A, X, {b,B,Y,C}) ->
+ {rbalance(b, A, X, {r,B,Y,C}),false};
+unbalright(b, A, X, {b,B,Y,C}) ->
+ {rbalance(b, A, X, {r,B,Y,C}),true};
+unbalright(b, A, X, {r,{b,B,Y,C},Z,D}) ->
+ {{b,rbalance(b, A, X, {r,B,Y,C}), Z, D},false}.
+
+%% union(Set1, Set2) -> Set.
+%% Return the union of Set1 and Set2.
+
+union(S1, S2) ->
+ fold(fun (E, S) -> add_element(E, S) end, S1, S2).
+
+%% union([Set]) -> Set.
+%% Return the union of the list of sets.
+
+union([S1,S2|Ss]) ->
+ union([union(S1, S2)|Ss]);
+union([S]) -> S;
+union([]) -> new().
+
+%% intersection(Set1, Set2) -> Set.
+%% Return the intersection of Set1 and Set2.
+
+intersection(S1, S2) ->
+ filter(fun (E) -> is_element(E, S2) end, S1).
+
+%% intersection([Set]) -> Set.
+%% Return the intersection of the list of sets.
+
+intersection([S1,S2|Ss]) ->
+ intersection([intersection(S1, S2)|Ss]);
+intersection([S]) -> S.
+
+%% subtract(Set1, Set2) -> Set.
+%% Return all and only the elements of Set1 which are not also in
+%% Set2.
+
+subtract(S1, S2) ->
+ filter(fun (E) -> not is_element(E, S2) end, S1).
+
+%% is_subset(Set1, Set2) -> bool().
+%% Return 'true' when every element of Set1 is also a member of
+%% Set2, else 'false'.
+
+is_subset(S1, S2) ->
+ all(fun (E) -> is_element(E, S2) end, S1).
+
+%% fold(Fun, Acc, Set) -> Acc.
+
+fold(_, Acc, empty) -> Acc;
+fold(F, Acc, {_,A,E,B}) ->
+ fold(F, F(E, fold(F, Acc, B)), A).
+
+%% filter(Pred, Set) -> Set.
+%% Filter Set with Pred.
+
+filter(P, T) -> filter(P, T, new()).
+
+filter(_, empty, New) -> New;
+filter(P, {_,A,X,B}, New0) ->
+ New1 = filter(P, A, New0),
+ New2 = case P(X) of
+ true -> add_element(X, New1);
+ false -> New1
+ end,
+ filter(P, B, New2).
+
+%% all(Pred, Set) -> bool().
+%% Return 'true' when Pred(Elem) is true for all elements, else 'false'.
+
+all(_, empty) -> true;
+all(P, {_,A,E,B}) ->
+ P(E) andalso all(P, A) andalso all(P, B).
+
+%% any(Pred, Set) -> bool().
+%% Return 'true' when Pred(Elem) is true for any element, else 'false'.
+
+any(_, empty) -> true;
+any(P, {_,A,E,B}) ->
+ P(E) orelse any(P, A) orelse any(P, B).
+
+%% foreach(Fun, Set) -> ok.
+%% Apply Fun to each element in Set.
+
+foreach(_, empty) -> ok;
+foreach(F, {_,A,X,B}) ->
+ foreach(F, A),
+ F(X),
+ foreach(F, B).
+
+%% partition(Pred, Set) -> {Set1,Set2}.
+%% Partition Set so Set1 contains all elements for which Pred(E) is true.
+
+partition(P, S) -> partition(P, S, new(), new()).
+
+partition(_, empty, T, F) -> {T,F};
+partition(P, {_,A,X,B}, T, F) ->
+ {T1,F1} = partition(P, A, T, F),
+ case P(X) of
+ true -> partition(P, B, add_element(X, T1), F1);
+ false -> partition(P, B, T1, add_element(X, F1))
+ end.
+
+%% fold(fun (X, {T,F}) ->
+%% case P(X) of
+%% true -> {add_element(X, T),F};
+%% false -> {T,add_element(X, F)}
+%% end
+%% end, {new(),new()}, S).
+
+%% Deprecated interface.
+
+new_set() -> new().
+
+set_to_list(S) -> to_list(S).
+
+list_to_set(L) -> from_list(L).
+
+subset(S1, S2) -> is_subset(S1, S2).
+
+-ifdef(DEBUG).
+%% Test functions.
+
+erase_check(K, T) ->
+ T1 = erase(K, T),
+ check(T1),
+ T1.
+
+check(T) -> check(T, r).
+
+check(empty, _) -> 1;
+check({r,A,X,B}, b) -> %Must have black parent
+ case {check(A, r),check(B, r)} of
+ {D,D}-> D;
+ {Dl,Dr} -> exit({depth,{r,Dl,X,Dr}})
+ end;
+check({r,_,X,_}, r) -> %Must have black parent
+ exit({parent,{r,'-',X,'-'}});
+check({b,A,X,B}, _) ->
+ case {check(A, b),check(B,b)} of
+ {D,D}-> D+1; %Increase depth
+ {Dl,Dr} -> exit({depth,{b,Dl,X,Dr}})
+ end.
+
+t(Ks) -> t(Ks, new()).
+
+t([K|Ks], D0) ->
+ D1 = store(K, K, D0),
+ t(Ks, D1);
+t([], D) -> D.
+
+%% Known error cases which have been fixed.
+
+r1() ->
+ {{b,{b,empty,37,empty},
+ 38,
+ {b,{r,empty,39,empty},40,empty}},
+ 39,
+ {b,{r,empty,37,empty},38,{b,empty,40,empty}}}.
+
+r2() ->
+ {{b,{r,{b,empty,43,empty},
+ 46,
+ {b,empty,48,empty}},
+ 50,
+ {b,empty,53,empty}},
+ 53,
+ {b,{b,empty,43,empty},
+ 46,
+ {r,{b,empty,48,empty},50,empty}}}.
+-endif.
Please sign in to comment.
Something went wrong with that request. Please try again.