├── .gitignore ├── COPYRIGHT ├── Emakefile ├── README ├── doc ├── rbdict.txt └── rbsets.txt └── src ├── ChangeLog ├── rbdict.erl ├── rbdict1.erl └── rbsets.erl /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .rebar3 3 | _* 4 | .eunit 5 | *.o 6 | *.beam 7 | *.plt 8 | *.swp 9 | *.swo 10 | .erlang.cookie 11 | ebin/*.beam 12 | log 13 | erl_crash.dump 14 | .rebar 15 | logs 16 | _build 17 | .idea 18 | *.iml 19 | rebar3.crashdump 20 | src/luerl_scan.erl 21 | src/luerl_parse.erl 22 | *~ 23 | -------------------------------------------------------------------------------- /COPYRIGHT: -------------------------------------------------------------------------------- 1 | Copyright (c) 2008 Robert Virding. All rights reserved. 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions 5 | are met: 6 | 7 | 1. Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 2. Redistributions in binary form must reproduce the above copyright 10 | notice, this list of conditions and the following disclaimer in the 11 | documentation and/or other materials provided with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 14 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 15 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 16 | FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 17 | COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 18 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 19 | BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 20 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 22 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 23 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 | POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /Emakefile: -------------------------------------------------------------------------------- 1 | %% -*- erlang -*- 2 | 3 | {'src/*',[{outdir,ebin}]}. 4 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | These are implementations of sets and dictionaries based on Red-Black 2 | trees. 3 | 4 | The dict compatible dictionary implementation supports the full dict 5 | interface and is drop-in compatible with both dict and orddict. 6 | 7 | The sets compatible set implementation supports the full sets 8 | interface and is drop-in compatible with both sets and ordsets. 9 | 10 | Documentation is included. 11 | -------------------------------------------------------------------------------- /doc/rbdict.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rvirding/rb/90f540df01e8c6057a7965bc897523b4a7528a7d/doc/rbdict.txt -------------------------------------------------------------------------------- /doc/rbsets.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rvirding/rb/90f540df01e8c6057a7965bc897523b4a7528a7d/doc/rbsets.txt -------------------------------------------------------------------------------- /src/ChangeLog: -------------------------------------------------------------------------------- 1 | 2009-05-08 Robert Virding 2 | 3 | * rbdict.erl (find): Fixed loop bug. 4 | 5 | 2009-05-07 Robert Virding 6 | 7 | * rbdict.erl, rbsets.erl: Initial release. 8 | 9 | -------------------------------------------------------------------------------- /src/rbdict.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008 Robert Virding. All rights reserved. 2 | %% 3 | %% Redistribution and use in source and binary forms, with or without 4 | %% modification, are permitted provided that the following conditions 5 | %% are met: 6 | %% 7 | %% 1. Redistributions of source code must retain the above copyright 8 | %% notice, this list of conditions and the following disclaimer. 9 | %% 2. Redistributions in binary form must reproduce the above copyright 10 | %% notice, this list of conditions and the following disclaimer in the 11 | %% documentation and/or other materials provided with the distribution. 12 | %% 13 | %% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 14 | %% "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 15 | %% LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 16 | %% FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 17 | %% COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 18 | %% INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 19 | %% BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 20 | %% LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | %% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 22 | %% LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 23 | %% ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 | %% POSSIBILITY OF SUCH DAMAGE. 25 | 26 | -module(rbdict). 27 | 28 | %% Standard interface. 29 | -export([new/0,is_key/2,to_list/1,from_list/1,size/1]). 30 | -export([fetch/2,find/2,fetch_keys/1,erase/2]). 31 | -export([store/3,append/3,append_list/3]). 32 | -export([update_val/3,update/3,update/4,update_counter/3]). 33 | -export([fold/3,map/2,filter/2,merge/3]). 34 | 35 | %% Deprecated interface. 36 | -export([dict_to_list/1,list_to_dict/1]). 37 | -deprecated([{dict_to_list,1},{list_to_dict,1}]). 38 | 39 | -ifdef(DEBUG). 40 | -export([check/1,erase_check/2,t/1,r1/0,r2/0]). 41 | -endif. 42 | 43 | %% -compile([export_all]). 44 | 45 | %% The algorithms here are taken directly from Okasaki and Rbset in 46 | %% ML/Scheme. The interface is compatible with the standard dict 47 | %% interface. 48 | %% 49 | %% The following structures are used to build the the RB-dict: 50 | %% 51 | %% {r,Left,Key,Val,Right} 52 | %% {b,Left,Key,Val,Right} 53 | %% empty 54 | %% 55 | %% It is interesting to note that expanding out the first argument of 56 | %% l/rbalance, the colour, in store etc. is actually slower than not 57 | %% doing it. Measured. 58 | 59 | %% new() -> Dict. 60 | 61 | new() -> empty. 62 | 63 | %% is_key(Key, Dict) -> true | false. 64 | 65 | is_key(_, empty) -> false; 66 | is_key(K, {_,Left,K1,_,_}) when K < K1 -> 67 | is_key(K, Left); 68 | is_key(K, {_,_,K1,_,Right}) when K > K1 -> 69 | is_key(K, Right); 70 | is_key(_, {_,_,_,_,_}) -> true. 71 | 72 | %% to_list(Dict) -> [{Key,Value}]. 73 | 74 | to_list(T) -> to_list(T, []). 75 | 76 | to_list(empty, List) -> List; 77 | to_list({_,A,Xk,Xv,B}, List) -> 78 | to_list(A, [{Xk,Xv}|to_list(B, List)]). 79 | 80 | %% from_list([{Key,Value}]) -> Dict. 81 | 82 | from_list(L) -> 83 | lists:foldl(fun ({K,V}, D) -> store(K, V, D) end, new(), L). 84 | 85 | %% size(Dict) -> int(). 86 | 87 | size(T) -> size1(T). 88 | 89 | size1(empty) -> 0; 90 | size1({_,L,_,_,R}) -> 91 | size1(L) + size1(R) + 1. 92 | 93 | %% fetch(Key, Dict) -> Value. 94 | 95 | fetch(K, {_,Left,K1,_,_}) when K < K1 -> 96 | fetch(K, Left); 97 | fetch(K, {_,_,K1,_,Right}) when K > K1 -> 98 | fetch(K, Right); 99 | fetch(_, {_,_,_,Val,_}) -> Val. 100 | 101 | %% find(Key, Dict) -> {ok,Value} | error. 102 | 103 | find(_, empty) -> error; 104 | find(K, {_,Left,K1,_,_}) when K < K1 -> 105 | find(K, Left); 106 | find(K, {_,_,K1,_,Right}) when K > K1 -> 107 | find(K, Right); 108 | find(_, {_,_,_,Val,_}) -> {ok,Val}. 109 | 110 | %% fetch_keys(Dict) -> [Key]. 111 | 112 | fetch_keys(T) -> fetch_keys(T, []). 113 | 114 | fetch_keys(empty, Tail) -> Tail; 115 | fetch_keys({_,L,K,_,R}, Tail) -> 116 | fetch_keys(L, [K|fetch_keys(R, Tail)]). 117 | 118 | %% store(Key, Val, Dict) -> Dict. 119 | 120 | store(K, V, T) -> 121 | {_,L,K1,V1,R} = store1(K, V, T), 122 | {b,L,K1,V1,R}. %setelement(1, b, T1). 123 | 124 | store1(K, V, empty) -> {r,empty,K,V,empty}; 125 | store1(K, V, {C,Left,K1,V1,Right}) when K < K1 -> 126 | lbalance(C, store1(K, V, Left), K1, V1, Right); 127 | store1(K, V, {C,Left,K1,V1,Right}) when K > K1 -> 128 | rbalance(C, Left, K1, V1, store1(K, V, Right)); 129 | store1(K, V, {C,L,_,_,R}) -> 130 | {C,L,K,V,R}. 131 | 132 | %% Expanding out l/rbalance is slower! 133 | %% store1(K, V, empty) -> {r,empty,K,V,empty}; 134 | %% store1(K, V, {r,Left,K1,V1,Right}) -> 135 | %% if K < K1 -> {r,store1(K, V, Left),K1,V1,Right}; 136 | %% K > K1 -> {r,Left,K1,V1,store1(K, V, Right)}; 137 | %% true -> {r,Left,K,V,Right} 138 | %% end; 139 | %% store1(K, V, {b,Left,K1,V1,Right}) -> 140 | %% if K < K1 -> 141 | %% lbalance(store1(K, V, Left), K1, V1, Right); 142 | %% K > K1 -> 143 | %% rbalance(Left, K1, V1, store1(K, V, Right)); 144 | %% true -> {b,Left,K,V,Right} 145 | %% end. 146 | 147 | %% append(Key, Val, Dict) -> Dict. 148 | 149 | append(K, V, T) -> 150 | {_,L,K1,V1,R} = append1(K, V, T), 151 | {b,L,K1,V1,R}. %setelement(1, b, T1). 152 | 153 | append1(K, V, empty) -> {r,empty,K,[V],empty}; 154 | append1(K, V, {C,Left,K1,V1,Right}) when K < K1 -> 155 | lbalance(C, append1(K, V, Left), K1, V1, Right); 156 | append1(K, V, {C,Left,K1,V1,Right}) when K > K1 -> 157 | rbalance(C, Left, K1, V1, append1(K, V, Right)); 158 | append1(K, V, {C,L,_,V1,R}) -> {C,L,K,V1 ++ [V],R}. 159 | 160 | %% append(Key, [Val], Dict) -> Dict. 161 | 162 | append_list(K, V, T) -> 163 | {_,L,K1,V1,R} = append_list1(K, V, T), 164 | {b,L,K1,V1,R}. %setelement(1, b, T1). 165 | 166 | append_list1(K, V, empty) -> {r,empty,K,V,empty}; 167 | append_list1(K, V, {C,Left,K1,V1,Right}) when K < K1 -> 168 | lbalance(C, append_list1(K, V, Left), K1, V1, Right); 169 | append_list1(K, V, {C,Left,K1,V1,Right}) when K > K1 -> 170 | rbalance(C, Left, K1, V1, append_list1(K, V, Right)); 171 | append_list1(K, V, {C,L,_,V1,R}) -> {C,L,K,V1 ++ V,R}. 172 | 173 | %% update_val(Key, Val, Dict) -> Dict. 174 | 175 | update_val(K, V, {RB,A,Xk,Xv,B}) when K < Xk -> 176 | {RB,update_val(K, V, A),Xk,Xv,B}; 177 | update_val(K, V, {RB,A,Xk,Xv,B}) when K > Xk -> 178 | {RB,A,Xk,Xv,update_val(K, V, B)}; 179 | update_val(_, V, {RB,A,Xk,_,B}) -> 180 | {RB,A,Xk,V,B}. 181 | 182 | %% update(Key, Fun, Dict) -> Dict. 183 | 184 | update(K, F, {RB,A,Xk,Xv,B}) when K < Xk -> 185 | {RB,update(K, F, A),Xk,Xv,B}; 186 | update(K, F, {RB,A,Xk,Xv,B}) when K > Xk -> 187 | {RB,A,Xk,Xv,update(K, F, B)}; 188 | update(_, F, {RB,A,Xk,Xv,B}) -> 189 | {RB,A,Xk,F(Xv),B}. 190 | 191 | %% update(Key, Fun, Init, Dict) -> Dict. 192 | 193 | update(K, F, I, T) -> 194 | {_,L,K1,V1,R} = update1(K, F, I, T), 195 | {b,L,K1,V1,R}. %setelement(1, b, T1). 196 | 197 | update1(K, _, I, empty) -> {r,empty,K,I,empty}; 198 | update1(K, F, I, {RB,A,Xk,Xv,B}) when K < Xk -> 199 | lbalance(RB, update1(K, F, I, A), Xk, Xv, B); 200 | update1(K, F, I, {RB,A,Xk,Xv,B}) when K > Xk -> 201 | rbalance(RB, A, Xk, Xv, update1(K, F, I, B)); 202 | update1(_, F, _, {RB,A,Xk,Xv,B}) -> 203 | {RB,A,Xk,F(Xv),B}. 204 | 205 | %% update_counter(Key, Incr, Dict) -> Dict. 206 | 207 | update_counter(K, I, T) -> 208 | {_,L,K1,V1,R} = update_counter1(K, I, T), 209 | {b,L,K1,V1,R}. %setelement(1, b, T1). 210 | 211 | update_counter1(K, I, empty) -> {r,empty,K,I,empty}; 212 | update_counter1(K, I, {RB,A,Xk,Xv,B}) when K < Xk -> 213 | lbalance(RB, update_counter1(K, I, A), Xk, Xv, B); 214 | update_counter1(K, I, {RB,A,Xk,Xv,B}) when K > Xk -> 215 | rbalance(RB, A, Xk, Xv, update_counter1(K, I, B)); 216 | update_counter1(_, I, {RB,A,Xk,Xv,B}) -> 217 | {RB,A,Xk,Xv+I,B}. 218 | 219 | %% lbalance(Colour, Left, Key, Val, Right). 220 | %% rbalance(Colour, Left, Key, Val, Right). 221 | %% Balance a tree afer (possibly) adding a node to the left/right. 222 | 223 | lbalance(b, {r,{r,A,Xk,Xv,B},Yk,Yv,C}, Zk, Zv, D) -> 224 | {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 225 | lbalance(b, {r,A,Xk,Xv,{r,B,Yk,Yv,C}}, Zk, Zv, D) -> 226 | {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 227 | lbalance(C, A, Xk, Xv, B) -> {C,A,Xk,Xv,B}. 228 | 229 | rbalance(b, A, Xk, Xv, {r,{r,B,Yk,Yv,C},Zk,Zv,D}) -> 230 | {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 231 | rbalance(b, A, Xk, Xv, {r,B,Yk,Yv,{r,C,Zk,Zv,D}}) -> 232 | {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 233 | rbalance(C, A, Xk, Xv, B) -> {C,A,Xk,Xv,B}. 234 | 235 | %% erase(Key, Dict) -> Dict. 236 | 237 | erase(K, T) -> 238 | {T1,_} = erase_aux(K, T), 239 | T1. 240 | 241 | %% erase_aux(Key, Node) -> {Node,Decreased}. 242 | 243 | erase_aux(_, empty) -> {empty,false}; 244 | erase_aux(K, {b,A,Xk,Xv,B}) -> 245 | if K < Xk -> 246 | {A1,Dec} = erase_aux(K, A), 247 | if Dec -> unbalright(b, A1, Xk, Xv, B); 248 | true -> {{b,A1,Xk,Xv,B},false} 249 | end; 250 | K > Xk -> 251 | {B1,Dec} = erase_aux(K, B), 252 | if Dec -> unballeft(b, A, Xk, Xv, B1); 253 | true -> {{b,A,Xk,Xv,B1},false} 254 | end; 255 | true -> 256 | case B of 257 | empty -> blackify(A); 258 | _ -> 259 | {B1,{Mk,Mv},Dec} = erase_min(B), 260 | if Dec -> unballeft(b, A, Mk, Mv, B1); 261 | true -> {{b,A,Mk,Mv,B1},false} 262 | end 263 | end 264 | end; 265 | erase_aux(K, {r,A,Xk,Xv,B}) -> 266 | if K < Xk -> 267 | {A1,Dec} = erase_aux(K, A), 268 | if Dec -> unbalright(r, A1, Xk, Xv, B); 269 | true -> {{r,A1,Xk,Xv,B},false} 270 | end; 271 | K > Xk -> 272 | {B1,Dec} = erase_aux(K, B), 273 | if Dec -> unballeft(r, A, Xk, Xv, B1); 274 | true -> {{r,A,Xk,Xv,B1},false} 275 | end; 276 | true -> 277 | case B of 278 | empty -> {A,false}; 279 | _ -> 280 | {B1,{Mk,Mv},Dec} = erase_min(B), 281 | if Dec -> unballeft(r, A, Mk, Mv, B1); 282 | true -> {{r,A,Mk,Mv,B1},false} 283 | end 284 | end 285 | end. 286 | 287 | %% erase_min(Node) -> {Node,{NodeKey,NodeVal},Decreased}. 288 | 289 | erase_min({b,empty,Xk,Xv,empty}) -> 290 | {empty,{Xk,Xv},true}; 291 | erase_min({b,empty,Xk,Xv,{r,A,Yk,Yv,B}}) -> 292 | {{b,A,Yk,Yv,B},{Xk,Xv},false}; 293 | erase_min({b,empty,_,_,{b,_,_,_,_}}) -> exit(boom); 294 | erase_min({r,empty,Xk,Xv,A}) -> 295 | {A,{Xk,Xv},false}; 296 | %% Rec from left 297 | erase_min({b,A,Xk,Xv,B}) -> 298 | {A1,Min,Dec} = erase_min(A), 299 | if Dec -> 300 | {T,Dec1} = unbalright(b, A1, Xk, Xv, B), 301 | {T,Min,Dec1}; 302 | true -> {{b,A1,Xk,Xv,B},Min,false} 303 | end; 304 | erase_min({r,A,Xk,Xv,B}) -> 305 | {A1,Min,Dec} = erase_min(A), 306 | if Dec -> 307 | {T,Dec1} = unbalright(r, A1, Xk, Xv, B), 308 | {T,Min,Dec1}; 309 | true -> {{r,A1,Xk,Xv,B},Min,false} 310 | end. 311 | 312 | blackify({r,A,K,V,B}) -> {{b,A,K,V,B},false}; 313 | blackify(Node) -> {Node,true}. 314 | 315 | unballeft(r, {b,A,Xk,Xv,B}, Yk, Yv, C) -> 316 | {lbalance(b, {r,A,Xk,Xv,B}, Yk, Yv, C),false}; 317 | unballeft(b, {b,A,Xk,Xv,B}, Yk, Yv, C) -> 318 | {lbalance(b, {r,A,Xk,Xv,B},Yk, Yv, C),true}; 319 | unballeft(b, {r,A,Xk,Xv,{b,B,Yk,Yv,C}}, Zk, Zv, D) -> 320 | {{b,A,Xk,Xv,lbalance(b, {r,B,Yk,Yv,C}, Zk, Zv, D)},false}. 321 | 322 | unbalright(r, A, Xk, Xv, {b,B,Yk,Yv,C}) -> 323 | {rbalance(b, A, Xk, Xv, {r,B,Yk,Yv,C}),false}; 324 | unbalright(b, A, Xk, Xv, {b,B,Yk,Yv,C}) -> 325 | {rbalance(b, A, Xk, Xv, {r,B,Yk,Yv,C}),true}; 326 | unbalright(b, A, Xk, Xv, {r,{b,B,Yk,Yv,C},Zk,Zv,D}) -> 327 | {{b,rbalance(b, A, Xk, Xv, {r,B,Yk,Yv,C}), Zk, Zv, D},false}. 328 | 329 | %% fold(Fun, Acc, Dict) -> Acc. 330 | 331 | fold(_, Acc, empty) -> Acc; 332 | fold(F, Acc, {_,A,Xk,Xv,B}) -> 333 | fold(F, F(Xk, Xv, fold(F, Acc, B)), A). 334 | 335 | %% map(Fun, Dict) -> Dict. 336 | 337 | map(_, empty) -> empty; 338 | map(F, {RB,A,Xk,Xv,B}) -> 339 | {RB,map(F,A),Xk,F(Xk, Xv),map(F, B)}. 340 | 341 | %% filter(Fun, Dict) -> Dict. 342 | 343 | filter(F, T) -> filter(F, T, new()). 344 | 345 | filter(_, empty, New) -> New; 346 | filter(F, {_,A,Xk,Xv,B}, New0) -> 347 | New1 = filter(F, A, New0), 348 | New2 = case F(Xk, Xv) of 349 | true -> store(Xk, Xv, New1); 350 | false -> New1 351 | end, 352 | filter(F, B, New2). 353 | 354 | %% merge(Fun, Dict, Dict) -> Dict. 355 | 356 | merge(F, D1, D2) -> 357 | fold(fun (K, V2, D) -> 358 | update(K, fun(V1) -> F(K, V1, V2) end, V2, D) 359 | end, D1, D2). 360 | 361 | %% Deprecated interface. 362 | 363 | %% dict_to_list(Dictionary) -> [{Key,Value}]. 364 | 365 | dict_to_list(D) -> to_list(D). 366 | 367 | %% list_to_dict([{Key,Value}]) -> Dictionary. 368 | 369 | list_to_dict(L) -> from_list(L). 370 | 371 | -ifdef(DEBUG). 372 | %% Test functions. 373 | 374 | erase_check(K, T) -> 375 | T1 = erase(K, T), 376 | check(T1), 377 | T1. 378 | 379 | check(T) -> check(T, r). 380 | 381 | check(empty, _) -> 1; 382 | check({r,A,Xk,Xv,B}, b) -> %Must have black parent 383 | case {check(A, r),check(B, r)} of 384 | {D,D}-> D; 385 | {Dl,Dr} -> exit({depth,{r,Dl,Xk,Xv,Dr}}) 386 | end; 387 | check({r,_,Xk,Xv,_}, r) -> %Must have black parent 388 | exit({parent,{r,'-',Xk,Xv,'-'}}); 389 | check({b,A,Xk,Xv,B}, _) -> 390 | case {check(A, b),check(B,b)} of 391 | {D,D}-> D+1; %Increase depth 392 | {Dl,Dr} -> exit({depth,{b,Dl,Xk,Xv,Dr}}) 393 | end. 394 | 395 | t(Ks) -> t(Ks, new()). 396 | 397 | t([K|Ks], D0) -> 398 | D1 = store(K, K, D0), 399 | t(Ks, D1); 400 | t([], D) -> D. 401 | 402 | %% Known error cases which have been fixed. 403 | 404 | r1() -> 405 | {{b,{b,empty,37,37,empty}, 406 | 38, 407 | 38, 408 | {b,{r,empty,39,39,empty},40,40,empty}}, 409 | 39, 410 | {b,{r,empty,37,37,empty},38,38,{b,empty,40,40,empty}}}. 411 | 412 | r2() -> 413 | {{b,{r,{b,empty,43,43,empty}, 414 | 46, 415 | 46, 416 | {b,empty,48,48,empty}}, 417 | 50, 418 | 50, 419 | {b,empty,53,53,empty}}, 420 | 53, 421 | {b,{b,empty,43,43,empty}, 422 | 46, 423 | 46, 424 | {r,{b,empty,48,48,empty},50,50,empty}}}. 425 | -endif. 426 | -------------------------------------------------------------------------------- /src/rbdict1.erl: -------------------------------------------------------------------------------- 1 | -module(rbdict1). 2 | 3 | -export([new/0,is_key/2,to_list/1,from_list/1,size/1]). 4 | -export([fetch/2,find/2,fetch_keys/1,erase/2]). 5 | -export([store/3,append/3,append_list/3]). 6 | -export([update_val/3,update/3,update/4,update_counter/3]). 7 | -export([fold/3,map/2,filter/2,merge/3]). 8 | 9 | %% Deprecated interface. 10 | -export([dict_to_list/1,list_to_dict/1]). 11 | -deprecated([{dict_to_list,1},{list_to_dict,1}]). 12 | 13 | -ifdef(DEBUG). 14 | -export([check/1,erase_check/2,t/1,r1/0,r2/0]). 15 | -endif. 16 | 17 | %% -compile([export_all]). 18 | 19 | %% {r,Left,K,V,Right} 20 | %% {b,Left,K,V,Right} 21 | %% empty 22 | 23 | -define(IS_RED(N), (is_tuple(N) andalso element(1, N) == r)). 24 | %% -define(IS_BLACK(N), not (is_tuple(N) andalso element(1, N) == r)). 25 | -define(IS_BLACK(N), 26 | ((is_tuple(N) andalso (element(1, N) == b)) orelse (N == empty))). 27 | 28 | -define(DBLACK(N), [b|N]). 29 | 30 | %% new() -> Dict. 31 | 32 | new() -> empty. 33 | 34 | %% is_key(Key, Dict) -> true | false. 35 | 36 | is_key(_, empty) -> false; 37 | is_key(K, {_,Left,K1,_,_}) when K < K1 -> 38 | is_key(K, Left); 39 | is_key(K, {_,_,K1,_,Right}) when K > K1 -> 40 | is_key(K, Right); 41 | is_key(_, {_,_,_,_,_}) -> true. 42 | 43 | %% to_list(Dict) -> [{Key,Value}]. 44 | 45 | to_list(T) -> to_list(T, []). 46 | 47 | to_list(empty, List) -> List; 48 | to_list({_,A,Xk,Xv,B}, List) -> 49 | to_list(A, [{Xk,Xv}|to_list(B, List)]). 50 | 51 | %% from_list([{Key,Value}]) -> Dict. 52 | 53 | from_list(L) -> 54 | fold(fun ({K,V}, D) -> store(K, V, D) end, new(), L). 55 | 56 | %% size(Dict) -> int(). 57 | 58 | size(T) -> size1(T). 59 | 60 | size1(empty) -> 0; 61 | size1({_,L,_,_,R}) -> 62 | size1(L) + size1(R) + 1. 63 | 64 | %% fetch(Key, Dict) -> Value. 65 | 66 | fetch(K, {_,Left,K1,_,_}) when K < K1 -> 67 | fetch(K, Left); 68 | fetch(K, {_,_,K1,_,Right}) when K > K1 -> 69 | fetch(K, Right); 70 | fetch(_, {_,_,_,Val,_}) -> Val. 71 | 72 | %% find(Key, Dict) -> {ok,Value} | error. 73 | 74 | find(_, empty) -> error; 75 | find(K, {_,Left,K1,_,_}) when K < K1 -> 76 | find(K, Left); 77 | find(K, {_,_,K1,_,Right}) when K > K1 -> 78 | fetch(K, Right); 79 | find(_, {_,_,_,Val,_}) -> {ok,Val}. 80 | 81 | %% fetch_keys(Dict) -> [Key]. 82 | 83 | fetch_keys(T) -> fetch_keys(T, []). 84 | 85 | fetch_keys(empty, Tail) -> Tail; 86 | fetch_keys({_,L,K,_,R}, Tail) -> 87 | fetch_keys(L, [K|fetch_keys(R, Tail)]). 88 | 89 | %% store(Key, Val, Dict) -> Dict. 90 | 91 | store(K, V, T) -> 92 | {_,L,K1,V1,R} = store1(K, V, T), 93 | {b,L,K1,V1,R}. %setelement(1, b, T1). 94 | 95 | store1(K, V, empty) -> {r,empty,K,V,empty}; 96 | store1(K, V, {C,Left,K1,V1,Right}) when K < K1 -> 97 | lbalance(C, store1(K, V, Left), K1, V1, Right); 98 | store1(K, V, {C,Left,K1,V1,Right}) when K > K1 -> 99 | rbalance(C, Left, K1, V1, store1(K, V, Right)); 100 | store1(K, V, {C,L,_,_,R}) -> 101 | {C,L,K,V,R}. 102 | 103 | %% append(Key, Val, Dict) -> Dict. 104 | 105 | append(K, V, T) -> 106 | {_,L,K1,V1,R} = append1(K, V, T), 107 | {b,L,K1,V1,R}. %setelement(1, b, T1). 108 | 109 | append1(K, V, empty) -> {r,empty,K,[V],empty}; 110 | append1(K, V, {C,Left,K1,V1,Right}) when K < K1 -> 111 | lbalance(C, append1(K, V, Left), K1, V1, Right); 112 | append1(K, V, {C,Left,K1,V1,Right}) when K > K1 -> 113 | rbalance(C, Left, K1, V1, append1(K, V, Right)); 114 | append1(K, V, {C,L,_,V1,R}) -> {C,L,K,V1 ++ [V],R}. 115 | 116 | %% append(Key, [Val], Dict) -> Dict. 117 | 118 | append_list(K, V, T) -> 119 | {_,L,K1,V1,R} = append_list1(K, V, T), 120 | {b,L,K1,V1,R}. %setelement(1, b, T1). 121 | 122 | append_list1(K, V, empty) -> {r,empty,K,V,empty}; 123 | append_list1(K, V, {C,Left,K1,V1,Right}) when K < K1 -> 124 | lbalance(C, append_list1(K, V, Left), K1, V1, Right); 125 | append_list1(K, V, {C,Left,K1,V1,Right}) when K > K1 -> 126 | rbalance(C, Left, K1, V1, append_list1(K, V, Right)); 127 | append_list1(K, V, {C,L,_,V1,R}) -> {C,L,K,V1 ++ V,R}. 128 | 129 | %% update_val(Key, Val, Dict) -> Dict. 130 | 131 | update_val(K, V, {RB,A,Xk,Xv,B}) when K < Xk -> 132 | {RB,update_val(K, V, A),Xk,Xv,B}; 133 | update_val(K, V, {RB,A,Xk,Xv,B}) when K > Xk -> 134 | {RB,A,Xk,Xv,update_val(K, V, B)}; 135 | update_val(_, V, {RB,A,Xk,_,B}) -> 136 | {RB,A,Xk,V,B}. 137 | 138 | %% update(Key, Fun, Dict) -> Dict. 139 | 140 | update(K, F, {RB,A,Xk,Xv,B}) when K < Xk -> 141 | {RB,update(K, F, A),Xk,Xv,B}; 142 | update(K, F, {RB,A,Xk,Xv,B}) when K > Xk -> 143 | {RB,A,Xk,Xv,update(K, F, B)}; 144 | update(_, F, {RB,A,Xk,Xv,B}) -> 145 | {RB,A,Xk,F(Xv),B}. 146 | 147 | %% update(Key, Fun, Init, Dict) -> Dict. 148 | 149 | update(K, F, I, T) -> 150 | {_,L,K1,V1,R} = update1(K, F, I, T), 151 | {b,L,K1,V1,R}. %setelement(1, b, T1). 152 | 153 | update1(K, _, I, empty) -> {r,empty,K,I,empty}; 154 | update1(K, F, I, {RB,A,Xk,Xv,B}) when K < Xk -> 155 | lbalance(RB, update1(K, F, I, A), Xk, Xv, B); 156 | update1(K, F, I, {RB,A,Xk,Xv,B}) when K > Xk -> 157 | rbalance(RB, A, Xk, Xv, update1(K, F, I, B)); 158 | update1(_, F, _, {RB,A,Xk,Xv,B}) -> 159 | {RB,A,Xk,F(Xv),B}. 160 | 161 | %% update_counter(Key, Incr, Dict) -> Dict. 162 | 163 | update_counter(K, I, T) -> 164 | {_,L,K1,V1,R} = update_counter1(K, I, T), 165 | {b,L,K1,V1,R}. %setelement(1, b, T1). 166 | 167 | update_counter1(K, I, empty) -> {r,empty,K,I,empty}; 168 | update_counter1(K, I, {RB,A,Xk,Xv,B}) when K < Xk -> 169 | lbalance(RB, update_counter1(K, I, A), Xk, Xv, B); 170 | update_counter1(K, I, {RB,A,Xk,Xv,B}) when K > Xk -> 171 | rbalance(RB, A, Xk, Xv, update_counter1(K, I, B)); 172 | update_counter1(_, I, {RB,A,Xk,Xv,B}) -> 173 | {RB,A,Xk,Xv+I,B}. 174 | 175 | %% lbalance(Colour, Left, Key, Val, Right). 176 | %% rbalance(Colour, Left, Key, Val, Right). 177 | %% Balance a tree afer (possibly) adding a node to the left/right. 178 | 179 | lbalance(b, {r,{r,A,Xk,Xv,B},Yk,Yv,C}, Zk, Zv, D) -> 180 | {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 181 | lbalance(b, {r,A,Xk,Xv,{r,B,Yk,Yv,C}}, Zk, Zv, D) -> 182 | {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 183 | lbalance(C, A, Xk, Xv, B) -> {C,A,Xk,Xv,B}. 184 | 185 | rbalance(b, A, Xk, Xv, {r,{r,B,Yk,Yv,C},Zk,Zv,D}) -> 186 | {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 187 | rbalance(b, A, Xk, Xv, {r,B,Yk,Yv,{r,C,Zk,Zv,D}}) -> 188 | {r,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 189 | rbalance(C, A, Xk, Xv, B) -> {C,A,Xk,Xv,B}. 190 | 191 | add_token({r,L,K,V,R}) -> {b,L,K,V,R}; 192 | add_token(Node) -> ?DBLACK(Node). 193 | 194 | %% erase(Key, Dict) -> Dict. 195 | 196 | erase(K, T) -> 197 | case erase1(K, T) of 198 | {r,L1,K1,V1,R1} -> {b,L1,K1,V1,R1}; %setelement(1, b, T1). 199 | ?DBLACK(X) -> X; 200 | Node -> Node 201 | end. 202 | 203 | erase1(_, empty) -> empty; %Not found 204 | erase1(K, {r,empty,Xk,_,empty}=A) -> 205 | if K < Xk -> A; %Not found 206 | K > Xk -> A; %Not found 207 | true -> empty %Won't change balance 208 | end; 209 | erase1(K, {b,empty,Xk,_,empty}=A) -> 210 | if K < Xk -> A; %Not found 211 | K > Xk -> A; %Not found 212 | true -> add_token(empty) %This is it 213 | end; 214 | erase1(K, {r,A,Xk,Xv,B}=X) -> 215 | if K < Xk -> 216 | balleft(r, erase1(K, A), Xk, Xv, B); 217 | K > Xk -> 218 | balright(r, A, Xk, Xv, erase1(K, B)); 219 | true -> %This is it 220 | raise_pred_succ(X) 221 | end; 222 | erase1(K, {b,A,Xk,Xv,B}=X) -> 223 | if K < Xk -> 224 | balleft(b, erase1(K, A), Xk, Xv, B); 225 | K > Xk -> 226 | balright(b, A, Xk, Xv, erase1(K, B)); 227 | true -> %This is it 228 | raise_pred_succ(X) 229 | end. 230 | 231 | %% raise_pred_succ(Node) -> Node. 232 | 233 | %% Remove and raise the successor node if the left branch is empty 234 | %% else raise the predecessor node. Rebuild tree with removed node as 235 | %% head making sure the resulting tree balanced. We KNOW that both 236 | %% Left and Right cannot be empty. 237 | 238 | raise_pred_succ({C,empty,_,_,B}) -> 239 | {B1,{Xk1,Xv1}} = raise_succ(B), 240 | balright(C, empty, Xk1, Xv1, B1); 241 | raise_pred_succ({C,A,_,_,B}) -> 242 | {A1,{Xk1,Xv1}} = raise_pred(A), 243 | balleft(C, A1, Xk1, Xv1, B). 244 | 245 | %% raise_pred(Node) -> {PredTree,{NodeKey,NodeVal}}. 246 | %% raise_succ(Node) -> {SuccTree,{NodeKey,NodeVal}}. 247 | %% Remove and raise the predecessor/successor node rebalancing the 248 | %% tree when necessary. 249 | 250 | raise_pred({b,A,Xk,Xv,empty}) -> {add_token(A),{Xk,Xv}}; 251 | raise_pred({r,A,Xk,Xv,empty}) -> {A,{Xk,Xv}}; %Won't change balance 252 | raise_pred({b,A,Xk,Xv,B}) -> 253 | {B1,Pred} = raise_pred(B), 254 | {balright(b, A, Xk, Xv, B1),Pred}; 255 | raise_pred({r,A,Xk,Xv,B}) -> 256 | {B1,Pred} = raise_pred(B), 257 | {balright(r, A, Xk, Xv, B1),Pred}. 258 | 259 | raise_succ({b,empty,Xk,Xv,A}) -> {add_token(A),{Xk,Xv}}; 260 | raise_succ({r,empty,Xk,Xv,A}) -> {A,{Xk,Xv}}; %Won't change balance 261 | raise_succ({b,A,Xk,Xv,B}) -> 262 | {A1,Succ} = raise_succ(A), 263 | {balleft(b, A1, Xk, Xv, B),Succ}; 264 | raise_succ({r,A,Xk,Xv,B}) -> 265 | {A1,Succ} = raise_succ(A), 266 | {balleft(r, A1, Xk, Xv, B),Succ}. 267 | 268 | %% balleft(Colour, Left, Key, Val, Right) 269 | %% balright(Colour, Left, Key, Val, Right) 270 | %% Rebalance a tree knowing that the left/right tree may have been 271 | %% made smaller. 272 | 273 | balleft(RB, ?DBLACK(A), Xk, Xv, {b,{r,B,Yk,Yv,C},Zk,Zv,D}) 274 | when ?IS_BLACK(A) -> 275 | %%io:fwrite("LA(~w)\n", [Xk]), 276 | {RB,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 277 | balleft(RB, ?DBLACK(A), Xk, Xv, {b,B,Yk,Yv,{r,C,Zk,Zv,D}}) 278 | when ?IS_BLACK(A) -> 279 | {RB,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 280 | balleft(RB, ?DBLACK(A), Xk, Xv, {b,B,Yk,Yv,C}) 281 | when ?IS_BLACK(A) and ?IS_BLACK(B) and ?IS_BLACK(C) -> 282 | add_token({RB,A,Xk,Xv,{r,B,Yk,Yv,C}}); 283 | balleft(b, ?DBLACK(A), Xk, Xv, {r,B,Yk,Yv,C}) 284 | when ?IS_BLACK(A) and ?IS_BLACK(B) and ?IS_BLACK(C) -> 285 | balleft(b, balleft(r, ?DBLACK(A), Xk, Xv, B), Yk, Yv, C); 286 | %% No rule matches, just pass double black up the tree. 287 | balleft(RB, ?DBLACK(A), Xk, Xv, B) -> add_token({RB,A,Xk,Xv,B}); 288 | balleft(RB, A, Xk, Xv, B) -> {RB,A,Xk,Xv,B}. 289 | 290 | balright(RB, {b,{r,A,Xk,Xv,B},Yk,Yv,C}, Zk, Zv, ?DBLACK(D)) 291 | when ?IS_BLACK(D) -> 292 | %%io:fwrite("RA(~w)\n", [Zk]), 293 | {RB,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 294 | balright(RB, {b,A,Xk,Xv,{r,B,Yk,Yv,C}}, Zk, Zv, ?DBLACK(D)) 295 | when ?IS_BLACK(D) -> 296 | {RB,{b,A,Xk,Xv,B},Yk,Yv,{b,C,Zk,Zv,D}}; 297 | balright(RB, {b,A,Xk,Xv,B}, Yk, Yv, ?DBLACK(C)) 298 | when ?IS_BLACK(A) and ?IS_BLACK(B) and ?IS_BLACK(C) -> 299 | add_token({RB,{r,A,Xk,Xv,B},Yk,Yv,C}); 300 | balright(b, {r,A,Xk,Xv,B}, Yk, Yv, ?DBLACK(C)) 301 | when ?IS_BLACK(A) and ?IS_BLACK(B) and ?IS_BLACK(C) -> 302 | balright(b, A, Xk, Xv, balright(r, B, Yk, Yv, ?DBLACK(C))); 303 | %% No rule matches, just pass double black up the tree. 304 | balright(RB, A, Xk, Xv, ?DBLACK(B)) -> add_token({RB,A,Xk,Xv,B}); 305 | balright(RB, A, Xk, Xv, B) -> {RB,A,Xk,Xv,B}. 306 | 307 | %% fold(Fun, Acc, Dict) -> Acc. 308 | 309 | fold(_, Acc, empty) -> Acc; 310 | fold(F, Acc, {_,A,Xk,Xv,B}) -> 311 | fold(F, F(Xk, Xv, fold(F, Acc, B)), A). 312 | 313 | %% map(Fun, Dict) -> Dict. 314 | 315 | map(_, empty) -> empty; 316 | map(F, {RB,A,Xk,Xv,B}) -> 317 | {RB,map(F,A),Xk,F(Xk, Xv),map(F, B)}. 318 | 319 | %% filter(Fun, Dict) -> Dict. 320 | 321 | filter(F, T) -> filter(F, T, new()). 322 | 323 | filter(_, empty, New) -> New; 324 | filter(F, {_,A,Xk,Xv,B}, New0) -> 325 | New1 = filter(F, A, New0), 326 | New2 = case F(Xk, Xv) of 327 | true -> store(Xk, Xv, New1); 328 | false -> New1 329 | end, 330 | filter(F, B, New2). 331 | 332 | %% merge(Fun, Dict, Dict) -> Dict. 333 | 334 | merge(F, D1, D2) -> 335 | fold(fun (K, V2, D) -> 336 | update(K, fun(V1) -> F(K, V1, V2) end, V2, D) 337 | end, D1, D2). 338 | 339 | %% Deprecated interface. 340 | 341 | %% dict_to_list(Dictionary) -> [{Key,Value}]. 342 | 343 | dict_to_list(D) -> to_list(D). 344 | 345 | %% list_to_dict([{Key,Value}]) -> Dictionary. 346 | 347 | list_to_dict(L) -> from_list(L). 348 | 349 | -ifdef(DEBUG). 350 | %% Test functions. 351 | 352 | erase_check(K, T) -> 353 | T1 = erase(K, T), 354 | check(T1), 355 | T1. 356 | 357 | check(T) -> check(T, r). 358 | 359 | check(empty, _) -> 1; 360 | check({r,A,Xk,Xv,B}, b) -> %Must have black parent 361 | case {check(A, r),check(B, r)} of 362 | {D,D}-> D; 363 | {Dl,Dr} -> exit({depth,{r,Dl,Xk,Xv,Dr}}) 364 | end; 365 | check({r,_,Xk,Xv,_}, r) -> %Must have black parent 366 | exit({parent,{r,'-',Xk,Xv,'-'}}); 367 | check({b,A,Xk,Xv,B}, _) -> 368 | case {check(A, b),check(B,b)} of 369 | {D,D}-> D+1; %Increase depth 370 | {Dl,Dr} -> exit({depth,{b,Dl,Xk,Xv,Dr}}) 371 | end. 372 | 373 | t(Ks) -> t(Ks, new()). 374 | 375 | t([K|Ks], D0) -> 376 | D1 = store(K, K, D0), 377 | t(Ks, D1); 378 | t([], D) -> D. 379 | 380 | %% Known error cases which have been fixed. 381 | 382 | r1() -> 383 | {{b,{b,empty,37,37,empty}, 384 | 38, 385 | 38, 386 | {b,{r,empty,39,39,empty},40,40,empty}}, 387 | 39, 388 | {b,{r,empty,37,37,empty},38,38,{b,empty,40,40,empty}}}. 389 | 390 | r2() -> 391 | {{b,{r,{b,empty,43,43,empty}, 392 | 46, 393 | 46, 394 | {b,empty,48,48,empty}}, 395 | 50, 396 | 50, 397 | {b,empty,53,53,empty}}, 398 | 53, 399 | {b,{b,empty,43,43,empty}, 400 | 46, 401 | 46, 402 | {r,{b,empty,48,48,empty},50,50,empty}}}. 403 | -endif. 404 | -------------------------------------------------------------------------------- /src/rbsets.erl: -------------------------------------------------------------------------------- 1 | %% Copyright (c) 2008 Robert Virding. All rights reserved. 2 | %% 3 | %% Redistribution and use in source and binary forms, with or without 4 | %% modification, are permitted provided that the following conditions 5 | %% are met: 6 | %% 7 | %% 1. Redistributions of source code must retain the above copyright 8 | %% notice, this list of conditions and the following disclaimer. 9 | %% 2. Redistributions in binary form must reproduce the above copyright 10 | %% notice, this list of conditions and the following disclaimer in the 11 | %% documentation and/or other materials provided with the distribution. 12 | %% 13 | %% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 14 | %% "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 15 | %% LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 16 | %% FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 17 | %% COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 18 | %% INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 19 | %% BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 20 | %% LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | %% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 22 | %% LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 23 | %% ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 | %% POSSIBILITY OF SUCH DAMAGE. 25 | 26 | -module(rbsets). 27 | 28 | %% Standard interface. 29 | -export([new/0,is_set/1,size/1,to_list/1,from_list/1]). 30 | -export([is_element/2,add_element/2,del_element/2]). 31 | -export([union/2,union/1,intersection/2,intersection/1]). 32 | -export([subtract/2,is_subset/2]). 33 | -export([fold/3,filter/2]). 34 | 35 | %% Extended interface. 36 | -export([all/2,any/2,foreach/2,partition/2]). 37 | 38 | %% Deprecated interface. 39 | 40 | -export([new_set/0,set_to_list/1,list_to_set/1,subset/2]). 41 | -deprecated([{new_set,0},{set_to_list,1},{list_to_set,1},{subset,2}]). 42 | 43 | -ifdef(DEBUG). 44 | -export([check/1,erase_check/2,t/1,r1/0,r2/0]). 45 | -endif. 46 | 47 | %% The algorithms here are taken directly from Okasaki and Rbset in 48 | %% ML/Scheme. The interface is compatible with the standard dict 49 | %% interface. 50 | %% 51 | %% The following structures are used to build the the RB-set: 52 | %% 53 | %% {r,Left,Element,Right} 54 | %% {b,Left,Element,Right} 55 | %% empty 56 | %% 57 | %% It is interesting to note that expanding out the first argument of 58 | %% l/rbalance, the colour, in store etc. is actually slower than not 59 | %% doing it. Measured. 60 | 61 | %% new() -> Set. 62 | 63 | new() -> empty. 64 | 65 | %% is_set(Set) -> bool(). 66 | %% Return 'true' if Set is a set of elements, else 'false'. 67 | 68 | is_set({r,Left,_,Right}) -> 69 | is_set(Left) andalso is_set(Right); 70 | is_set({b,Left,_,Right}) -> 71 | is_set(Left) andalso is_set(Right); 72 | is_set(empty) -> true. 73 | 74 | %% size(Set) -> int(). 75 | 76 | size(S) -> size1(S). 77 | 78 | size1({r,Left,_,Right}) -> 79 | size1(Left) + 1 + size1(Right); 80 | size1({b,Left,_,Right}) -> 81 | size1(Left) + 1 + size1(Right); 82 | size1(empty) -> 0. 83 | 84 | %% to_list(Set) -> [Element]. 85 | 86 | to_list(T) -> to_list(T, []). 87 | 88 | to_list(empty, List) -> List; 89 | to_list({_,A,X,B}, List) -> 90 | to_list(A, [X|to_list(B, List)]). 91 | 92 | %% from_list([Element]) -> Set. 93 | 94 | from_list(L) -> 95 | lists:foldl(fun (E, S) -> add_element(E, S) end, new(), L). 96 | 97 | %% is_element(Element, Set) -> true | false. 98 | 99 | is_element(_, empty) -> false; 100 | is_element(X, {_,A,Y,_}) when X < Y -> 101 | is_element(X, A); 102 | is_element(X, {_,_,Y,B}) when X > Y -> 103 | is_element(X, B); 104 | is_element(_, {_,_,_,_}) -> true. 105 | 106 | %% add_element(Element, Set) -> Set. 107 | 108 | add_element(E, T) -> 109 | {_,L,E1,R} = add_element1(E, T), 110 | {b,L,E1,R}. %setelement(1, b, T1). 111 | 112 | add_element1(X, empty) -> {r,empty,X,empty}; 113 | add_element1(X, {C,A,Y,B}) when X < Y -> 114 | lbalance(C, add_element1(X, A), Y, B); 115 | add_element1(X, {C,A,Y,B}) when X > Y -> 116 | rbalance(C, A, Y, add_element1(X, B)); 117 | add_element1(_, {_,_,_,_}=T) -> T. 118 | 119 | %% Expanding out l/rbalance is slower! 120 | %% add_element1(X, empty) -> {r,empty,X,empty}; 121 | %% add_element1(X, {r,Left,Y,Right}) -> 122 | %% if X < Y -> {r,add_element1(X, Left),Y,Right}; 123 | %% X > Y -> {r,Left,Y,add_element1(X, Right)}; 124 | %% true -> {r,Left,X,Right} 125 | %% end; 126 | %% add_element1(X, {b,Left,Y,Right}) -> 127 | %% if X < Y -> 128 | %% lbalance(add_element1(X, Left), Y, Right); 129 | %% X > Y -> 130 | %% rbalance(Left, Y, add_element1(X, Right)); 131 | %% true -> {b,Left,X,Right} 132 | %% end. 133 | 134 | %% lbalance(Colour, Left, Key, Val, Right). 135 | %% rbalance(Colour, Left, Key, Val, Right). 136 | %% Balance a tree afer (possibly) adding a node to the left/right. 137 | 138 | lbalance(b, {r,{r,A,X,B},Y,C}, Z, D) -> 139 | {r,{b,A,X,B},Y,{b,C,Z,D}}; 140 | lbalance(b, {r,A,X,{r,B,Y,C}}, Z, D) -> 141 | {r,{b,A,X,B},Y,{b,C,Z,D}}; 142 | lbalance(C, A, X, B) -> {C,A,X,B}. 143 | 144 | rbalance(b, A, X, {r,{r,B,Y,C},Z,D}) -> 145 | {r,{b,A,X,B},Y,{b,C,Z,D}}; 146 | rbalance(b, A, X, {r,B,Y,{r,C,Z,D}}) -> 147 | {r,{b,A,X,B},Y,{b,C,Z,D}}; 148 | rbalance(C, A, X, B) -> {C,A,X,B}. 149 | 150 | %% del_element(Element, Set) -> Set. 151 | 152 | del_element(K, T) -> 153 | {T1,_} = del_aux(K, T), 154 | T1. 155 | 156 | %% del_aux(Key, Node) -> {Node,Decreased}. 157 | 158 | del_aux(_, empty) -> {empty,false}; 159 | del_aux(K, {b,A,X,B}) -> 160 | if K < X -> 161 | {A1,Dec} = del_aux(K, A), 162 | if Dec -> unbalright(b, A1, X, B); 163 | true -> {{b,A1,X,B},false} 164 | end; 165 | K > X -> 166 | {B1,Dec} = del_aux(K, B), 167 | if Dec -> unballeft(b, A, X, B1); 168 | true -> {{b,A,X,B1},false} 169 | end; 170 | true -> 171 | case B of 172 | empty -> blackify(A); 173 | _ -> 174 | {B1,M,Dec} = del_min(B), 175 | if Dec -> unballeft(b, A, M, B1); 176 | true -> {{b,A,M,B1},false} 177 | end 178 | end 179 | end; 180 | del_aux(K, {r,A,X,B}) -> 181 | if K < X -> 182 | {A1,Dec} = del_aux(K, A), 183 | if Dec -> unbalright(r, A1, X, B); 184 | true -> {{r,A1,X,B},false} 185 | end; 186 | K > X -> 187 | {B1,Dec} = del_aux(K, B), 188 | if Dec -> unballeft(r, A, X, B1); 189 | true -> {{r,A,X,B1},false} 190 | end; 191 | true -> 192 | case B of 193 | empty -> {A,false}; 194 | _ -> 195 | {B1,M,Dec} = del_min(B), 196 | if Dec -> unballeft(r, A, M, B1); 197 | true -> {{r,A,M,B1},false} 198 | end 199 | end 200 | end. 201 | 202 | %% del_min(Node) -> {Node,{NodeKey,NodeVal},Decreased}. 203 | 204 | del_min({b,empty,X,empty}) -> 205 | {empty,X,true}; 206 | del_min({b,empty,X,{r,A,Y,B}}) -> 207 | {{b,A,Y,B},X,false}; 208 | del_min({b,empty,_,{b,_,_,_}}) -> exit(boom); 209 | del_min({r,empty,X,A}) -> 210 | {A,X,false}; 211 | %% Rec from left 212 | del_min({b,A,X,B}) -> 213 | {A1,Min,Dec} = del_min(A), 214 | if Dec -> 215 | {T,Dec1} = unbalright(b, A1, X, B), 216 | {T,Min,Dec1}; 217 | true -> {{b,A1,X,B},Min,false} 218 | end; 219 | del_min({r,A,X,B}) -> 220 | {A1,Min,Dec} = del_min(A), 221 | if Dec -> 222 | {T,Dec1} = unbalright(r, A1, X, B), 223 | {T,Min,Dec1}; 224 | true -> {{r,A1,X,B},Min,false} 225 | end. 226 | 227 | blackify({r,A,E,B}) -> {{b,A,E,B},false}; 228 | blackify(Node) -> {Node,true}. 229 | 230 | unballeft(r, {b,A,X,B}, Y, C) -> 231 | {lbalance(b, {r,A,X,B}, Y, C),false}; 232 | unballeft(b, {b,A,X,B}, Y, C) -> 233 | {lbalance(b, {r,A,X,B}, Y, C),true}; 234 | unballeft(b, {r,A,X,{b,B,Y,C}}, Z, D) -> 235 | {{b,A,X,lbalance(b, {r,B,Y,C}, Z, D)},false}. 236 | 237 | unbalright(r, A, X, {b,B,Y,C}) -> 238 | {rbalance(b, A, X, {r,B,Y,C}),false}; 239 | unbalright(b, A, X, {b,B,Y,C}) -> 240 | {rbalance(b, A, X, {r,B,Y,C}),true}; 241 | unbalright(b, A, X, {r,{b,B,Y,C},Z,D}) -> 242 | {{b,rbalance(b, A, X, {r,B,Y,C}), Z, D},false}. 243 | 244 | %% union(Set1, Set2) -> Set. 245 | %% Return the union of Set1 and Set2. 246 | 247 | union(S1, S2) -> 248 | fold(fun (E, S) -> add_element(E, S) end, S1, S2). 249 | 250 | %% union([Set]) -> Set. 251 | %% Return the union of the list of sets. 252 | 253 | union([S1,S2|Ss]) -> 254 | union([union(S1, S2)|Ss]); 255 | union([S]) -> S; 256 | union([]) -> new(). 257 | 258 | %% intersection(Set1, Set2) -> Set. 259 | %% Return the intersection of Set1 and Set2. 260 | 261 | intersection(S1, S2) -> 262 | filter(fun (E) -> is_element(E, S2) end, S1). 263 | 264 | %% intersection([Set]) -> Set. 265 | %% Return the intersection of the list of sets. 266 | 267 | intersection([S1,S2|Ss]) -> 268 | intersection([intersection(S1, S2)|Ss]); 269 | intersection([S]) -> S. 270 | 271 | %% subtract(Set1, Set2) -> Set. 272 | %% Return all and only the elements of Set1 which are not also in 273 | %% Set2. 274 | 275 | subtract(S1, S2) -> 276 | filter(fun (E) -> not is_element(E, S2) end, S1). 277 | 278 | %% is_subset(Set1, Set2) -> bool(). 279 | %% Return 'true' when every element of Set1 is also a member of 280 | %% Set2, else 'false'. 281 | 282 | is_subset(S1, S2) -> 283 | all(fun (E) -> is_element(E, S2) end, S1). 284 | 285 | %% fold(Fun, Acc, Set) -> Acc. 286 | 287 | fold(_, Acc, empty) -> Acc; 288 | fold(F, Acc, {_,A,E,B}) -> 289 | fold(F, F(E, fold(F, Acc, B)), A). 290 | 291 | %% filter(Pred, Set) -> Set. 292 | %% Filter Set with Pred. 293 | 294 | filter(P, T) -> filter(P, T, new()). 295 | 296 | filter(_, empty, New) -> New; 297 | filter(P, {_,A,X,B}, New0) -> 298 | New1 = filter(P, A, New0), 299 | New2 = case P(X) of 300 | true -> add_element(X, New1); 301 | false -> New1 302 | end, 303 | filter(P, B, New2). 304 | 305 | %% all(Pred, Set) -> bool(). 306 | %% Return 'true' when Pred(Elem) is true for all elements, else 'false'. 307 | 308 | all(_, empty) -> true; 309 | all(P, {_,A,E,B}) -> 310 | P(E) andalso all(P, A) andalso all(P, B). 311 | 312 | %% any(Pred, Set) -> bool(). 313 | %% Return 'true' when Pred(Elem) is true for any element, else 'false'. 314 | 315 | any(_, empty) -> true; 316 | any(P, {_,A,E,B}) -> 317 | P(E) orelse any(P, A) orelse any(P, B). 318 | 319 | %% foreach(Fun, Set) -> ok. 320 | %% Apply Fun to each element in Set. 321 | 322 | foreach(_, empty) -> ok; 323 | foreach(F, {_,A,X,B}) -> 324 | foreach(F, A), 325 | F(X), 326 | foreach(F, B). 327 | 328 | %% partition(Pred, Set) -> {Set1,Set2}. 329 | %% Partition Set so Set1 contains all elements for which Pred(E) is true. 330 | 331 | partition(P, S) -> partition(P, S, new(), new()). 332 | 333 | partition(_, empty, T, F) -> {T,F}; 334 | partition(P, {_,A,X,B}, T, F) -> 335 | {T1,F1} = partition(P, A, T, F), 336 | case P(X) of 337 | true -> partition(P, B, add_element(X, T1), F1); 338 | false -> partition(P, B, T1, add_element(X, F1)) 339 | end. 340 | 341 | %% fold(fun (X, {T,F}) -> 342 | %% case P(X) of 343 | %% true -> {add_element(X, T),F}; 344 | %% false -> {T,add_element(X, F)} 345 | %% end 346 | %% end, {new(),new()}, S). 347 | 348 | %% Deprecated interface. 349 | 350 | new_set() -> new(). 351 | 352 | set_to_list(S) -> to_list(S). 353 | 354 | list_to_set(L) -> from_list(L). 355 | 356 | subset(S1, S2) -> is_subset(S1, S2). 357 | 358 | -ifdef(DEBUG). 359 | %% Test functions. 360 | 361 | erase_check(K, T) -> 362 | T1 = erase(K, T), 363 | check(T1), 364 | T1. 365 | 366 | check(T) -> check(T, r). 367 | 368 | check(empty, _) -> 1; 369 | check({r,A,X,B}, b) -> %Must have black parent 370 | case {check(A, r),check(B, r)} of 371 | {D,D}-> D; 372 | {Dl,Dr} -> exit({depth,{r,Dl,X,Dr}}) 373 | end; 374 | check({r,_,X,_}, r) -> %Must have black parent 375 | exit({parent,{r,'-',X,'-'}}); 376 | check({b,A,X,B}, _) -> 377 | case {check(A, b),check(B,b)} of 378 | {D,D}-> D+1; %Increase depth 379 | {Dl,Dr} -> exit({depth,{b,Dl,X,Dr}}) 380 | end. 381 | 382 | t(Ks) -> t(Ks, new()). 383 | 384 | t([K|Ks], D0) -> 385 | D1 = store(K, K, D0), 386 | t(Ks, D1); 387 | t([], D) -> D. 388 | 389 | %% Known error cases which have been fixed. 390 | 391 | r1() -> 392 | {{b,{b,empty,37,empty}, 393 | 38, 394 | {b,{r,empty,39,empty},40,empty}}, 395 | 39, 396 | {b,{r,empty,37,empty},38,{b,empty,40,empty}}}. 397 | 398 | r2() -> 399 | {{b,{r,{b,empty,43,empty}, 400 | 46, 401 | {b,empty,48,empty}}, 402 | 50, 403 | {b,empty,53,empty}}, 404 | 53, 405 | {b,{b,empty,43,empty}, 406 | 46, 407 | {r,{b,empty,48,empty},50,empty}}}. 408 | -endif. 409 | --------------------------------------------------------------------------------