1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 2001-2017. All Rights Reserved. 5%% 6%% Licensed under the Apache License, Version 2.0 (the "License"); 7%% you may not use this file except in compliance with the License. 8%% You may obtain a copy of the License at 9%% 10%% http://www.apache.org/licenses/LICENSE-2.0 11%% 12%% Unless required by applicable law or agreed to in writing, software 13%% distributed under the License is distributed on an "AS IS" BASIS, 14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15%% See the License for the specific language governing permissions and 16%% limitations under the License. 17%% 18%% %CopyrightEnd% 19%% 20-module(sofs). 21 22-export([from_term/1, from_term/2, from_external/2, empty_set/0, 23 is_type/1, set/1, set/2, from_sets/1, relation/1, relation/2, 24 a_function/1, a_function/2, family/1, family/2, 25 to_external/1, type/1, to_sets/1, no_elements/1, 26 specification/2, union/2, intersection/2, difference/2, 27 symdiff/2, symmetric_partition/2, product/1, product/2, 28 constant_function/2, is_equal/2, is_subset/2, is_sofs_set/1, 29 is_set/1, is_empty_set/1, is_disjoint/2]). 30 31-export([union/1, intersection/1, canonical_relation/1]). 32 33-export([relation_to_family/1, domain/1, range/1, field/1, 34 relative_product/1, relative_product/2, relative_product1/2, 35 converse/1, image/2, inverse_image/2, strict_relation/1, 36 weak_relation/1, extension/3, is_a_function/1]). 37 38-export([composite/2, inverse/1]). 39 40-export([restriction/2, restriction/3, drestriction/2, drestriction/3, 41 substitution/2, projection/2, partition/1, partition/2, 42 partition/3, multiple_relative_product/2, join/4]). 43 44-export([family_to_relation/1, family_specification/2, 45 union_of_family/1, intersection_of_family/1, 46 family_union/1, family_intersection/1, 47 family_domain/1, family_range/1, family_field/1, 48 family_union/2, family_intersection/2, family_difference/2, 49 partition_family/2, family_projection/2]). 50 51-export([family_to_digraph/1, family_to_digraph/2, 52 digraph_to_family/1, digraph_to_family/2]). 53 54%% Shorter names of some functions. 55-export([fam2rel/1, rel2fam/1]). 56 57-import(lists, 58 [any/2, append/1, flatten/1, foreach/2, 59 keysort/2, last/1, map/2, mapfoldl/3, member/2, merge/2, 60 reverse/1, reverse/2, sort/1, umerge/1, umerge/2, usort/1]). 61 62-compile({inline, [{family_to_relation,1}, {relation_to_family,1}]}). 63 64-compile({inline, [{rel,2},{a_func,2},{fam,2},{term2set,2}]}). 65 66-compile({inline, [{external_fun,1},{element_type,1}]}). 67 68-compile({inline, 69 [{unify_types,2}, {match_types,2}, 70 {test_rel,3}, {symdiff,3}, 71 {subst,3}]}). 72 73-compile({inline, [{fam_binop,3}]}). 74 75%% Nope, no is_member, del_member or add_member. 76%% 77%% See also "Naive Set Theory" by Paul R. Halmos. 78%% 79%% By convention, erlang:error/1 is called from exported functions. 80 81-define(TAG, 'Set'). 82-define(ORDTAG, 'OrdSet'). 83 84-record(?TAG, {data = [] :: list(), type = type :: term()}). 85-record(?ORDTAG, {orddata = {} :: tuple() | atom(), 86 ordtype = type :: term()}). 87 88-define(LIST(S), (S)#?TAG.data). 89-define(TYPE(S), (S)#?TAG.type). 90-define(SET(L, T), #?TAG{data = L, type = T}). 91-define(IS_SET(S), is_record(S, ?TAG)). 92-define(IS_UNTYPED_SET(S), ?TYPE(S) =:= ?ANYTYPE). 93 94%% Ordered sets and atoms: 95-define(ORDDATA(S), (S)#?ORDTAG.orddata). 96-define(ORDTYPE(S), (S)#?ORDTAG.ordtype). 97-define(ORDSET(L, T), #?ORDTAG{orddata = L, ordtype = T}). 98-define(IS_ORDSET(S), is_record(S, ?ORDTAG)). 99-define(ATOM_TYPE, atom). 100-define(IS_ATOM_TYPE(T), is_atom(T)). % true for ?ANYTYPE... 101 102%% When IS_SET is true: 103-define(ANYTYPE, '_'). 104-define(BINREL(X, Y), {X, Y}). 105-define(IS_RELATION(R), is_tuple(R)). 106-define(REL_ARITY(R), tuple_size(R)). 107-define(REL_TYPE(I, R), element(I, R)). 108-define(SET_OF(X), [X]). 109-define(IS_SET_OF(X), is_list(X)). 110-define(FAMILY(X, Y), ?BINREL(X, ?SET_OF(Y))). 111 112-export_type([anyset/0, binary_relation/0, external_set/0, a_function/0, 113 family/0, relation/0, set_of_sets/0, set_fun/0, spec_fun/0, 114 type/0]). 115-export_type([ordset/0, a_set/0]). 116 117-type(anyset() :: ordset() | a_set()). 118-type(binary_relation() :: relation()). 119-type(external_set() :: term()). 120-type(a_function() :: relation()). 121-type(family() :: a_function()). 122-opaque(ordset() :: #?ORDTAG{}). 123-type(relation() :: a_set()). 124-opaque(a_set() :: #?TAG{}). 125-type(set_of_sets() :: a_set()). 126-type(set_fun() :: pos_integer() 127 | {external, fun((external_set()) -> external_set())} 128 | fun((anyset()) -> anyset())). 129-type(spec_fun() :: {external, fun((external_set()) -> boolean())} 130 | fun((anyset()) -> boolean())). 131-type(type() :: term()). 132 133-type(tuple_of(_T) :: tuple()). 134 135%% 136%% Exported functions 137%% 138 139%%% 140%%% Create sets 141%%% 142 143-spec(from_term(Term) -> AnySet when 144 AnySet :: anyset(), 145 Term :: term()). 146from_term(T) -> 147 Type = case T of 148 _ when is_list(T) -> [?ANYTYPE]; 149 _ -> ?ANYTYPE 150 end, 151 try setify(T, Type) 152 catch _:_ -> erlang:error(badarg) 153 end. 154 155-spec(from_term(Term, Type) -> AnySet when 156 AnySet :: anyset(), 157 Term :: term(), 158 Type :: type()). 159from_term(L, T) -> 160 case is_type(T) of 161 true -> 162 try setify(L, T) 163 catch _:_ -> erlang:error(badarg) 164 end; 165 false -> 166 erlang:error(badarg) 167 end. 168 169-spec(from_external(ExternalSet, Type) -> AnySet when 170 ExternalSet :: external_set(), 171 AnySet :: anyset(), 172 Type :: type()). 173from_external(L, ?SET_OF(Type)) -> 174 ?SET(L, Type); 175from_external(T, Type) -> 176 ?ORDSET(T, Type). 177 178-spec(empty_set() -> Set when 179 Set :: a_set()). 180empty_set() -> 181 ?SET([], ?ANYTYPE). 182 183-spec(is_type(Term) -> Bool when 184 Bool :: boolean(), 185 Term :: term()). 186is_type(Atom) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE -> 187 true; 188is_type(?SET_OF(T)) -> 189 is_element_type(T); 190is_type(T) when tuple_size(T) > 0 -> 191 is_types(tuple_size(T), T); 192is_type(_T) -> 193 false. 194 195-spec(set(Terms) -> Set when 196 Set :: a_set(), 197 Terms :: [term()]). 198set(L) -> 199 try usort(L) of 200 SL -> ?SET(SL, ?ATOM_TYPE) 201 catch _:_ -> erlang:error(badarg) 202 end. 203 204-spec(set(Terms, Type) -> Set when 205 Set :: a_set(), 206 Terms :: [term()], 207 Type :: type()). 208set(L, ?SET_OF(Type)) when ?IS_ATOM_TYPE(Type), Type =/= ?ANYTYPE -> 209 try usort(L) of 210 SL -> ?SET(SL, Type) 211 catch _:_ -> erlang:error(badarg) 212 end; 213set(L, ?SET_OF(_) = T) -> 214 try setify(L, T) 215 catch _:_ -> erlang:error(badarg) 216 end; 217set(_, _) -> 218 erlang:error(badarg). 219 220-spec(from_sets(ListOfSets) -> Set when 221 Set :: a_set(), 222 ListOfSets :: [anyset()]; 223 (TupleOfSets) -> Ordset when 224 Ordset :: ordset(), 225 TupleOfSets :: tuple_of(anyset())). 226from_sets(Ss) when is_list(Ss) -> 227 case set_of_sets(Ss, [], ?ANYTYPE) of 228 {error, Error} -> 229 erlang:error(Error); 230 Set -> 231 Set 232 end; 233from_sets(Tuple) when is_tuple(Tuple) -> 234 case ordset_of_sets(tuple_to_list(Tuple), [], []) of 235 error -> 236 erlang:error(badarg); 237 Set -> 238 Set 239 end; 240from_sets(_) -> 241 erlang:error(badarg). 242 243-spec(relation(Tuples) -> Relation when 244 Relation :: relation(), 245 Tuples :: [tuple()]). 246relation([]) -> 247 ?SET([], ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)); 248relation(Ts = [T | _]) when is_tuple(T) -> 249 try rel(Ts, tuple_size(T)) 250 catch _:_ -> erlang:error(badarg) 251 end; 252relation(_) -> 253 erlang:error(badarg). 254 255-spec(relation(Tuples, Type) -> Relation when 256 N :: integer(), 257 Type :: N | type(), 258 Relation :: relation(), 259 Tuples :: [tuple()]). 260relation(Ts, TS) -> 261 try rel(Ts, TS) 262 catch _:_ -> erlang:error(badarg) 263 end. 264 265-spec(a_function(Tuples) -> Function when 266 Function :: a_function(), 267 Tuples :: [tuple()]). 268a_function(Ts) -> 269 try func(Ts, ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)) of 270 Bad when is_atom(Bad) -> 271 erlang:error(Bad); 272 Set -> 273 Set 274 catch _:_ -> erlang:error(badarg) 275 end. 276 277-spec(a_function(Tuples, Type) -> Function when 278 Function :: a_function(), 279 Tuples :: [tuple()], 280 Type :: type()). 281a_function(Ts, T) -> 282 try a_func(Ts, T) of 283 Bad when is_atom(Bad) -> 284 erlang:error(Bad); 285 Set -> 286 Set 287 catch _:_ -> erlang:error(badarg) 288 end. 289 290-spec(family(Tuples) -> Family when 291 Family :: family(), 292 Tuples :: [tuple()]). 293family(Ts) -> 294 try fam2(Ts, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) of 295 Bad when is_atom(Bad) -> 296 erlang:error(Bad); 297 Set -> 298 Set 299 catch _:_ -> erlang:error(badarg) 300 end. 301 302-spec(family(Tuples, Type) -> Family when 303 Family :: family(), 304 Tuples :: [tuple()], 305 Type :: type()). 306family(Ts, T) -> 307 try fam(Ts, T) of 308 Bad when is_atom(Bad) -> 309 erlang:error(Bad); 310 Set -> 311 Set 312 catch _:_ -> erlang:error(badarg) 313 end. 314 315%%% 316%%% Functions on sets. 317%%% 318 319-spec(to_external(AnySet) -> ExternalSet when 320 ExternalSet :: external_set(), 321 AnySet :: anyset()). 322to_external(S) when ?IS_SET(S) -> 323 ?LIST(S); 324to_external(S) when ?IS_ORDSET(S) -> 325 ?ORDDATA(S). 326 327-spec(type(AnySet) -> Type when 328 AnySet :: anyset(), 329 Type :: type()). 330type(S) when ?IS_SET(S) -> 331 ?SET_OF(?TYPE(S)); 332type(S) when ?IS_ORDSET(S) -> 333 ?ORDTYPE(S). 334 335-spec(to_sets(ASet) -> Sets when 336 ASet :: a_set() | ordset(), 337 Sets :: tuple_of(AnySet) | [AnySet], 338 AnySet :: anyset()). 339to_sets(S) when ?IS_SET(S) -> 340 case ?TYPE(S) of 341 ?SET_OF(Type) -> list_of_sets(?LIST(S), Type, []); 342 Type -> list_of_ordsets(?LIST(S), Type, []) 343 end; 344to_sets(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) -> 345 tuple_of_sets(tuple_to_list(?ORDDATA(S)), tuple_to_list(?ORDTYPE(S)), []); 346to_sets(S) when ?IS_ORDSET(S) -> 347 erlang:error(badarg). 348 349-spec(no_elements(ASet) -> NoElements when 350 ASet :: a_set() | ordset(), 351 NoElements :: non_neg_integer()). 352no_elements(S) when ?IS_SET(S) -> 353 length(?LIST(S)); 354no_elements(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) -> 355 tuple_size(?ORDDATA(S)); 356no_elements(S) when ?IS_ORDSET(S) -> 357 erlang:error(badarg). 358 359-spec(specification(Fun, Set1) -> Set2 when 360 Fun :: spec_fun(), 361 Set1 :: a_set(), 362 Set2 :: a_set()). 363specification(Fun, S) when ?IS_SET(S) -> 364 Type = ?TYPE(S), 365 R = case external_fun(Fun) of 366 false -> 367 spec(?LIST(S), Fun, element_type(Type), []); 368 XFun -> 369 specification(?LIST(S), XFun, []) 370 end, 371 case R of 372 SL when is_list(SL) -> 373 ?SET(SL, Type); 374 Bad -> 375 erlang:error(Bad) 376 end. 377 378-spec(union(Set1, Set2) -> Set3 when 379 Set1 :: a_set(), 380 Set2 :: a_set(), 381 Set3 :: a_set()). 382union(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 383 case unify_types(?TYPE(S1), ?TYPE(S2)) of 384 [] -> erlang:error(type_mismatch); 385 Type -> ?SET(umerge(?LIST(S1), ?LIST(S2)), Type) 386 end. 387 388-spec(intersection(Set1, Set2) -> Set3 when 389 Set1 :: a_set(), 390 Set2 :: a_set(), 391 Set3 :: a_set()). 392intersection(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 393 case unify_types(?TYPE(S1), ?TYPE(S2)) of 394 [] -> erlang:error(type_mismatch); 395 Type -> ?SET(intersection(?LIST(S1), ?LIST(S2), []), Type) 396 end. 397 398-spec(difference(Set1, Set2) -> Set3 when 399 Set1 :: a_set(), 400 Set2 :: a_set(), 401 Set3 :: a_set()). 402difference(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 403 case unify_types(?TYPE(S1), ?TYPE(S2)) of 404 [] -> erlang:error(type_mismatch); 405 Type -> ?SET(difference(?LIST(S1), ?LIST(S2), []), Type) 406 end. 407 408-spec(symdiff(Set1, Set2) -> Set3 when 409 Set1 :: a_set(), 410 Set2 :: a_set(), 411 Set3 :: a_set()). 412symdiff(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 413 case unify_types(?TYPE(S1), ?TYPE(S2)) of 414 [] -> erlang:error(type_mismatch); 415 Type -> ?SET(symdiff(?LIST(S1), ?LIST(S2), []), Type) 416 end. 417 418-spec(symmetric_partition(Set1, Set2) -> {Set3, Set4, Set5} when 419 Set1 :: a_set(), 420 Set2 :: a_set(), 421 Set3 :: a_set(), 422 Set4 :: a_set(), 423 Set5 :: a_set()). 424symmetric_partition(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 425 case unify_types(?TYPE(S1), ?TYPE(S2)) of 426 [] -> erlang:error(type_mismatch); 427 Type -> sympart(?LIST(S1), ?LIST(S2), [], [], [], Type) 428 end. 429 430-spec(product(Set1, Set2) -> BinRel when 431 BinRel :: binary_relation(), 432 Set1 :: a_set(), 433 Set2 :: a_set()). 434product(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 435 if 436 ?TYPE(S1) =:= ?ANYTYPE -> S1; 437 ?TYPE(S2) =:= ?ANYTYPE -> S2; 438 true -> 439 F = fun(E) -> {0, E} end, 440 T = ?BINREL(?TYPE(S1), ?TYPE(S2)), 441 ?SET(relprod(map(F, ?LIST(S1)), map(F, ?LIST(S2))), T) 442 end. 443 444-spec(product(TupleOfSets) -> Relation when 445 Relation :: relation(), 446 TupleOfSets :: tuple_of(a_set())). 447product({S1, S2}) -> 448 product(S1, S2); 449product(T) when is_tuple(T) -> 450 Ss = tuple_to_list(T), 451 try sets_to_list(Ss) of 452 [] -> 453 erlang:error(badarg); 454 L -> 455 Type = types(Ss, []), 456 case member([], L) of 457 true -> 458 empty_set(); 459 false -> 460 ?SET(reverse(prod(L, [], [])), Type) 461 end 462 catch _:_ -> erlang:error(badarg) 463 end. 464 465-spec(constant_function(Set, AnySet) -> Function when 466 AnySet :: anyset(), 467 Function :: a_function(), 468 Set :: a_set()). 469constant_function(S, E) when ?IS_SET(S) -> 470 case {?TYPE(S), is_sofs_set(E)} of 471 {?ANYTYPE, true} -> S; 472 {Type, true} -> 473 NType = ?BINREL(Type, type(E)), 474 ?SET(constant_function(?LIST(S), to_external(E), []), NType); 475 _ -> erlang:error(badarg) 476 end; 477constant_function(S, _) when ?IS_ORDSET(S) -> 478 erlang:error(badarg). 479 480-spec(is_equal(AnySet1, AnySet2) -> Bool when 481 AnySet1 :: anyset(), 482 AnySet2 :: anyset(), 483 Bool :: boolean()). 484is_equal(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 485 case match_types(?TYPE(S1), ?TYPE(S2)) of 486 true -> ?LIST(S1) == ?LIST(S2); 487 false -> erlang:error(type_mismatch) 488 end; 489is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_ORDSET(S2) -> 490 case match_types(?ORDTYPE(S1), ?ORDTYPE(S2)) of 491 true -> ?ORDDATA(S1) == ?ORDDATA(S2); 492 false -> erlang:error(type_mismatch) 493 end; 494is_equal(S1, S2) when ?IS_SET(S1), ?IS_ORDSET(S2) -> 495 erlang:error(type_mismatch); 496is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) -> 497 erlang:error(type_mismatch). 498 499-spec(is_subset(Set1, Set2) -> Bool when 500 Bool :: boolean(), 501 Set1 :: a_set(), 502 Set2 :: a_set()). 503is_subset(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 504 case match_types(?TYPE(S1), ?TYPE(S2)) of 505 true -> subset(?LIST(S1), ?LIST(S2)); 506 false -> erlang:error(type_mismatch) 507 end. 508 509-spec(is_sofs_set(Term) -> Bool when 510 Bool :: boolean(), 511 Term :: term()). 512is_sofs_set(S) when ?IS_SET(S) -> 513 true; 514is_sofs_set(S) when ?IS_ORDSET(S) -> 515 true; 516is_sofs_set(_S) -> 517 false. 518 519-spec(is_set(AnySet) -> Bool when 520 AnySet :: anyset(), 521 Bool :: boolean()). 522is_set(S) when ?IS_SET(S) -> 523 true; 524is_set(S) when ?IS_ORDSET(S) -> 525 false. 526 527-spec(is_empty_set(AnySet) -> Bool when 528 AnySet :: anyset(), 529 Bool :: boolean()). 530is_empty_set(S) when ?IS_SET(S) -> 531 ?LIST(S) =:= []; 532is_empty_set(S) when ?IS_ORDSET(S) -> 533 false. 534 535-spec(is_disjoint(Set1, Set2) -> Bool when 536 Bool :: boolean(), 537 Set1 :: a_set(), 538 Set2 :: a_set()). 539is_disjoint(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 540 case match_types(?TYPE(S1), ?TYPE(S2)) of 541 true -> 542 case ?LIST(S1) of 543 [] -> true; 544 [A | As] -> disjoint(?LIST(S2), A, As) 545 end; 546 false -> erlang:error(type_mismatch) 547 end. 548 549%%% 550%%% Functions on set-of-sets. 551%%% 552 553-spec(union(SetOfSets) -> Set when 554 Set :: a_set(), 555 SetOfSets :: set_of_sets()). 556union(Sets) when ?IS_SET(Sets) -> 557 case ?TYPE(Sets) of 558 ?SET_OF(Type) -> ?SET(lunion(?LIST(Sets)), Type); 559 ?ANYTYPE -> Sets; 560 _ -> erlang:error(badarg) 561 end. 562 563-spec(intersection(SetOfSets) -> Set when 564 Set :: a_set(), 565 SetOfSets :: set_of_sets()). 566intersection(Sets) when ?IS_SET(Sets) -> 567 case ?LIST(Sets) of 568 [] -> erlang:error(badarg); 569 [L | Ls] -> 570 case ?TYPE(Sets) of 571 ?SET_OF(Type) -> 572 ?SET(lintersection(Ls, L), Type); 573 _ -> erlang:error(badarg) 574 end 575 end. 576 577-spec(canonical_relation(SetOfSets) -> BinRel when 578 BinRel :: binary_relation(), 579 SetOfSets :: set_of_sets()). 580canonical_relation(Sets) when ?IS_SET(Sets) -> 581 ST = ?TYPE(Sets), 582 case ST of 583 ?SET_OF(?ANYTYPE) -> empty_set(); 584 ?SET_OF(Type) -> 585 ?SET(can_rel(?LIST(Sets), []), ?BINREL(Type, ST)); 586 ?ANYTYPE -> Sets; 587 _ -> erlang:error(badarg) 588 end. 589 590%%% 591%%% Functions on binary relations only. 592%%% 593 594-spec(rel2fam(BinRel) -> Family when 595 Family :: family(), 596 BinRel :: binary_relation()). 597rel2fam(R) -> 598 relation_to_family(R). 599 600-spec(relation_to_family(BinRel) -> Family when 601 Family :: family(), 602 BinRel :: binary_relation()). 603%% Inlined. 604relation_to_family(R) when ?IS_SET(R) -> 605 case ?TYPE(R) of 606 ?BINREL(DT, RT) -> 607 ?SET(rel2family(?LIST(R)), ?FAMILY(DT, RT)); 608 ?ANYTYPE -> R; 609 _Else -> erlang:error(badarg) 610 end. 611 612-spec(domain(BinRel) -> Set when 613 BinRel :: binary_relation(), 614 Set :: a_set()). 615domain(R) when ?IS_SET(R) -> 616 case ?TYPE(R) of 617 ?BINREL(DT, _) -> ?SET(dom(?LIST(R)), DT); 618 ?ANYTYPE -> R; 619 _Else -> erlang:error(badarg) 620 end. 621 622-spec(range(BinRel) -> Set when 623 BinRel :: binary_relation(), 624 Set :: a_set()). 625range(R) when ?IS_SET(R) -> 626 case ?TYPE(R) of 627 ?BINREL(_, RT) -> ?SET(ran(?LIST(R), []), RT); 628 ?ANYTYPE -> R; 629 _ -> erlang:error(badarg) 630 end. 631 632-spec(field(BinRel) -> Set when 633 BinRel :: binary_relation(), 634 Set :: a_set()). 635%% In "Introduction to LOGIC", Suppes defines the field of a binary 636%% relation to be the union of the domain and the range (or 637%% counterdomain). 638field(R) -> 639 union(domain(R), range(R)). 640 641-spec(relative_product(ListOfBinRels) -> BinRel2 when 642 ListOfBinRels :: [BinRel, ...], 643 BinRel :: binary_relation(), 644 BinRel2 :: binary_relation()). 645%% The following clause is kept for backward compatibility. 646%% The list is due to Dialyzer's specs. 647relative_product(RT) when is_tuple(RT) -> 648 relative_product(tuple_to_list(RT)); 649relative_product(RL) when is_list(RL) -> 650 case relprod_n(RL, foo, false, false) of 651 {error, Reason} -> 652 erlang:error(Reason); 653 Reply -> 654 Reply 655 end. 656 657-spec(relative_product(ListOfBinRels, BinRel1) -> BinRel2 when 658 ListOfBinRels :: [BinRel, ...], 659 BinRel :: binary_relation(), 660 BinRel1 :: binary_relation(), 661 BinRel2 :: binary_relation(); 662 (BinRel1, BinRel2) -> BinRel3 when 663 BinRel1 :: binary_relation(), 664 BinRel2 :: binary_relation(), 665 BinRel3 :: binary_relation()). 666relative_product(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) -> 667 relative_product1(converse(R1), R2); 668%% The following clause is kept for backward compatibility. 669%% The list is due to Dialyzer's specs. 670relative_product(RT, R) when is_tuple(RT), ?IS_SET(R) -> 671 relative_product(tuple_to_list(RT), R); 672relative_product(RL, R) when is_list(RL), ?IS_SET(R) -> 673 EmptyR = case ?TYPE(R) of 674 ?BINREL(_, _) -> ?LIST(R) =:= []; 675 ?ANYTYPE -> true; 676 _ -> erlang:error(badarg) 677 end, 678 case relprod_n(RL, R, EmptyR, true) of 679 {error, Reason} -> 680 erlang:error(Reason); 681 Reply -> 682 Reply 683 end. 684 685-spec(relative_product1(BinRel1, BinRel2) -> BinRel3 when 686 BinRel1 :: binary_relation(), 687 BinRel2 :: binary_relation(), 688 BinRel3 :: binary_relation()). 689relative_product1(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) -> 690 {DTR1, RTR1} = case ?TYPE(R1) of 691 ?BINREL(_, _) = R1T -> R1T; 692 ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; 693 _ -> erlang:error(badarg) 694 end, 695 {DTR2, RTR2} = case ?TYPE(R2) of 696 ?BINREL(_, _) = R2T -> R2T; 697 ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; 698 _ -> erlang:error(badarg) 699 end, 700 case match_types(DTR1, DTR2) of 701 true when DTR1 =:= ?ANYTYPE -> R1; 702 true when DTR2 =:= ?ANYTYPE -> R2; 703 true -> ?SET(relprod(?LIST(R1), ?LIST(R2)), ?BINREL(RTR1, RTR2)); 704 false -> erlang:error(type_mismatch) 705 end. 706 707-spec(converse(BinRel1) -> BinRel2 when 708 BinRel1 :: binary_relation(), 709 BinRel2 :: binary_relation()). 710converse(R) when ?IS_SET(R) -> 711 case ?TYPE(R) of 712 ?BINREL(DT, RT) -> ?SET(converse(?LIST(R), []), ?BINREL(RT, DT)); 713 ?ANYTYPE -> R; 714 _ -> erlang:error(badarg) 715 end. 716 717-spec(image(BinRel, Set1) -> Set2 when 718 BinRel :: binary_relation(), 719 Set1 :: a_set(), 720 Set2 :: a_set()). 721image(R, S) when ?IS_SET(R), ?IS_SET(S) -> 722 case ?TYPE(R) of 723 ?BINREL(DT, RT) -> 724 case match_types(DT, ?TYPE(S)) of 725 true -> 726 ?SET(usort(restrict(?LIST(S), ?LIST(R))), RT); 727 false -> 728 erlang:error(type_mismatch) 729 end; 730 ?ANYTYPE -> R; 731 _ -> erlang:error(badarg) 732 end. 733 734-spec(inverse_image(BinRel, Set1) -> Set2 when 735 BinRel :: binary_relation(), 736 Set1 :: a_set(), 737 Set2 :: a_set()). 738inverse_image(R, S) when ?IS_SET(R), ?IS_SET(S) -> 739 case ?TYPE(R) of 740 ?BINREL(DT, RT) -> 741 case match_types(RT, ?TYPE(S)) of 742 true -> 743 NL = restrict(?LIST(S), converse(?LIST(R), [])), 744 ?SET(usort(NL), DT); 745 false -> 746 erlang:error(type_mismatch) 747 end; 748 ?ANYTYPE -> R; 749 _ -> erlang:error(badarg) 750 end. 751 752-spec(strict_relation(BinRel1) -> BinRel2 when 753 BinRel1 :: binary_relation(), 754 BinRel2 :: binary_relation()). 755strict_relation(R) when ?IS_SET(R) -> 756 case ?TYPE(R) of 757 Type = ?BINREL(_, _) -> 758 ?SET(strict(?LIST(R), []), Type); 759 ?ANYTYPE -> R; 760 _ -> erlang:error(badarg) 761 end. 762 763-spec(weak_relation(BinRel1) -> BinRel2 when 764 BinRel1 :: binary_relation(), 765 BinRel2 :: binary_relation()). 766weak_relation(R) when ?IS_SET(R) -> 767 case ?TYPE(R) of 768 ?BINREL(DT, RT) -> 769 case unify_types(DT, RT) of 770 [] -> 771 erlang:error(badarg); 772 Type -> 773 ?SET(weak(?LIST(R)), ?BINREL(Type, Type)) 774 end; 775 ?ANYTYPE -> R; 776 _ -> erlang:error(badarg) 777 end. 778 779-spec(extension(BinRel1, Set, AnySet) -> BinRel2 when 780 AnySet :: anyset(), 781 BinRel1 :: binary_relation(), 782 BinRel2 :: binary_relation(), 783 Set :: a_set()). 784extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) -> 785 case {?TYPE(R), ?TYPE(S), is_sofs_set(E)} of 786 {T=?BINREL(DT, RT), ST, true} -> 787 case match_types(DT, ST) and match_types(RT, type(E)) of 788 false -> 789 erlang:error(type_mismatch); 790 true -> 791 RL = ?LIST(R), 792 case extc([], ?LIST(S), to_external(E), RL) of 793 [] -> 794 R; 795 L -> 796 ?SET(merge(RL, reverse(L)), T) 797 end 798 end; 799 {?ANYTYPE, ?ANYTYPE, true} -> 800 R; 801 {?ANYTYPE, ST, true} -> 802 case type(E) of 803 ?SET_OF(?ANYTYPE) -> 804 R; 805 ET -> 806 ?SET([], ?BINREL(ST, ET)) 807 end; 808 {_, _, true} -> 809 erlang:error(badarg) 810 end. 811 812-spec(is_a_function(BinRel) -> Bool when 813 Bool :: boolean(), 814 BinRel :: binary_relation()). 815is_a_function(R) when ?IS_SET(R) -> 816 case ?TYPE(R) of 817 ?BINREL(_, _) -> 818 case ?LIST(R) of 819 [] -> true; 820 [{V,_} | Es] -> is_a_func(Es, V) 821 end; 822 ?ANYTYPE -> true; 823 _ -> erlang:error(badarg) 824 end. 825 826-spec(restriction(BinRel1, Set) -> BinRel2 when 827 BinRel1 :: binary_relation(), 828 BinRel2 :: binary_relation(), 829 Set :: a_set()). 830restriction(Relation, Set) -> 831 restriction(1, Relation, Set). 832 833-spec(drestriction(BinRel1, Set) -> BinRel2 when 834 BinRel1 :: binary_relation(), 835 BinRel2 :: binary_relation(), 836 Set :: a_set()). 837drestriction(Relation, Set) -> 838 drestriction(1, Relation, Set). 839 840%%% 841%%% Functions on functions only. 842%%% 843 844-spec(composite(Function1, Function2) -> Function3 when 845 Function1 :: a_function(), 846 Function2 :: a_function(), 847 Function3 :: a_function()). 848composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) -> 849 ?BINREL(DTF1, RTF1) = case ?TYPE(Fn1)of 850 ?BINREL(_, _) = F1T -> F1T; 851 ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; 852 _ -> erlang:error(badarg) 853 end, 854 ?BINREL(DTF2, RTF2) = case ?TYPE(Fn2) of 855 ?BINREL(_, _) = F2T -> F2T; 856 ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; 857 _ -> erlang:error(badarg) 858 end, 859 case match_types(RTF1, DTF2) of 860 true when DTF1 =:= ?ANYTYPE -> Fn1; 861 true when DTF2 =:= ?ANYTYPE -> Fn2; 862 true -> 863 case comp(?LIST(Fn1), ?LIST(Fn2)) of 864 SL when is_list(SL) -> 865 ?SET(sort(SL), ?BINREL(DTF1, RTF2)); 866 Bad -> 867 erlang:error(Bad) 868 end; 869 false -> erlang:error(type_mismatch) 870 end. 871 872-spec(inverse(Function1) -> Function2 when 873 Function1 :: a_function(), 874 Function2 :: a_function()). 875inverse(Fn) when ?IS_SET(Fn) -> 876 case ?TYPE(Fn) of 877 ?BINREL(DT, RT) -> 878 case inverse1(?LIST(Fn)) of 879 SL when is_list(SL) -> 880 ?SET(SL, ?BINREL(RT, DT)); 881 Bad -> 882 erlang:error(Bad) 883 end; 884 ?ANYTYPE -> Fn; 885 _ -> erlang:error(badarg) 886 end. 887 888%%% 889%%% Functions on relations (binary or other). 890%%% 891 892-spec(restriction(SetFun, Set1, Set2) -> Set3 when 893 SetFun :: set_fun(), 894 Set1 :: a_set(), 895 Set2 :: a_set(), 896 Set3 :: a_set()). 897%% Equivalent to range(restriction(inverse(substitution(Fun, S1)), S2)). 898restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> 899 RT = ?TYPE(R), 900 ST = ?TYPE(S), 901 case check_for_sort(RT, I) of 902 empty -> 903 R; 904 error -> 905 erlang:error(badarg); 906 Sort -> 907 RL = ?LIST(R), 908 case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of 909 {true, _SL} when RL =:= [] -> 910 R; 911 {true, []} -> 912 ?SET([], RT); 913 {true, [E | Es]} when Sort =:= false -> % I =:= 1 914 ?SET(reverse(restrict_n(I, RL, E, Es, [])), RT); 915 {true, [E | Es]} -> 916 ?SET(sort(restrict_n(I, keysort(I, RL), E, Es, [])), RT); 917 {false, _SL} -> 918 erlang:error(type_mismatch) 919 end 920 end; 921restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 922 Type1 = ?TYPE(S1), 923 Type2 = ?TYPE(S2), 924 SL1 = ?LIST(S1), 925 case external_fun(SetFun) of 926 false when Type2 =:= ?ANYTYPE -> 927 S2; 928 false -> 929 case subst(SL1, SetFun, element_type(Type1)) of 930 {NSL, NewType} -> % NewType can be ?ANYTYPE 931 case match_types(NewType, Type2) of 932 true -> 933 NL = sort(restrict(?LIST(S2), converse(NSL, []))), 934 ?SET(NL, Type1); 935 false -> 936 erlang:error(type_mismatch) 937 end; 938 Bad -> 939 erlang:error(Bad) 940 end; 941 _ when Type1 =:= ?ANYTYPE -> 942 S1; 943 _XFun when ?IS_SET_OF(Type1) -> 944 erlang:error(badarg); 945 XFun -> 946 FunT = XFun(Type1), 947 try check_fun(Type1, XFun, FunT) of 948 Sort -> 949 case match_types(FunT, Type2) of 950 true -> 951 R1 = inverse_substitution(SL1, XFun, Sort), 952 ?SET(sort(Sort, restrict(?LIST(S2), R1)), Type1); 953 false -> 954 erlang:error(type_mismatch) 955 end 956 catch _:_ -> erlang:error(badarg) 957 end 958 end. 959 960-spec(drestriction(SetFun, Set1, Set2) -> Set3 when 961 SetFun :: set_fun(), 962 Set1 :: a_set(), 963 Set2 :: a_set(), 964 Set3 :: a_set()). 965drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> 966 RT = ?TYPE(R), 967 ST = ?TYPE(S), 968 case check_for_sort(RT, I) of 969 empty -> 970 R; 971 error -> 972 erlang:error(badarg); 973 Sort -> 974 RL = ?LIST(R), 975 case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of 976 {true, []} -> 977 R; 978 {true, _SL} when RL =:= [] -> 979 R; 980 {true, [E | Es]} when Sort =:= false -> % I =:= 1 981 ?SET(diff_restrict_n(I, RL, E, Es, []), RT); 982 {true, [E | Es]} -> 983 ?SET(diff_restrict_n(I, keysort(I, RL), E, Es, []), RT); 984 {false, _SL} -> 985 erlang:error(type_mismatch) 986 end 987 end; 988drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 989 Type1 = ?TYPE(S1), 990 Type2 = ?TYPE(S2), 991 SL1 = ?LIST(S1), 992 case external_fun(SetFun) of 993 false when Type2 =:= ?ANYTYPE -> 994 S1; 995 false -> 996 case subst(SL1, SetFun, element_type(Type1)) of 997 {NSL, NewType} -> % NewType can be ?ANYTYPE 998 case match_types(NewType, Type2) of 999 true -> 1000 SL2 = ?LIST(S2), 1001 NL = sort(diff_restrict(SL2, converse(NSL, []))), 1002 ?SET(NL, Type1); 1003 false -> 1004 erlang:error(type_mismatch) 1005 end; 1006 Bad -> 1007 erlang:error(Bad) 1008 end; 1009 _ when Type1 =:= ?ANYTYPE -> 1010 S1; 1011 _XFun when ?IS_SET_OF(Type1) -> 1012 erlang:error(badarg); 1013 XFun -> 1014 FunT = XFun(Type1), 1015 try check_fun(Type1, XFun, FunT) of 1016 Sort -> 1017 case match_types(FunT, Type2) of 1018 true -> 1019 R1 = inverse_substitution(SL1, XFun, Sort), 1020 SL2 = ?LIST(S2), 1021 ?SET(sort(Sort, diff_restrict(SL2, R1)), Type1); 1022 false -> 1023 erlang:error(type_mismatch) 1024 end 1025 catch _:_ -> erlang:error(badarg) 1026 end 1027 end. 1028 1029-spec(projection(SetFun, Set1) -> Set2 when 1030 SetFun :: set_fun(), 1031 Set1 :: a_set(), 1032 Set2 :: a_set()). 1033projection(I, Set) when is_integer(I), ?IS_SET(Set) -> 1034 Type = ?TYPE(Set), 1035 case check_for_sort(Type, I) of 1036 empty -> 1037 Set; 1038 error -> 1039 erlang:error(badarg); 1040 _ when I =:= 1 -> 1041 ?SET(projection1(?LIST(Set)), ?REL_TYPE(I, Type)); 1042 _ -> 1043 ?SET(projection_n(?LIST(Set), I, []), ?REL_TYPE(I, Type)) 1044 end; 1045projection(Fun, Set) -> 1046 range(substitution(Fun, Set)). 1047 1048-spec(substitution(SetFun, Set1) -> Set2 when 1049 SetFun :: set_fun(), 1050 Set1 :: a_set(), 1051 Set2 :: a_set()). 1052substitution(I, Set) when is_integer(I), ?IS_SET(Set) -> 1053 Type = ?TYPE(Set), 1054 case check_for_sort(Type, I) of 1055 empty -> 1056 Set; 1057 error -> 1058 erlang:error(badarg); 1059 _Sort -> 1060 NType = ?REL_TYPE(I, Type), 1061 NSL = substitute_element(?LIST(Set), I, []), 1062 ?SET(NSL, ?BINREL(Type, NType)) 1063 end; 1064substitution(SetFun, Set) when ?IS_SET(Set) -> 1065 Type = ?TYPE(Set), 1066 L = ?LIST(Set), 1067 case external_fun(SetFun) of 1068 false when L =/= [] -> 1069 case subst(L, SetFun, element_type(Type)) of 1070 {SL, NewType} -> 1071 ?SET(reverse(SL), ?BINREL(Type, NewType)); 1072 Bad -> 1073 erlang:error(Bad) 1074 end; 1075 false -> 1076 empty_set(); 1077 _ when Type =:= ?ANYTYPE -> 1078 empty_set(); 1079 _XFun when ?IS_SET_OF(Type) -> 1080 erlang:error(badarg); 1081 XFun -> 1082 FunT = XFun(Type), 1083 try check_fun(Type, XFun, FunT) of 1084 _Sort -> 1085 SL = substitute(L, XFun, []), 1086 ?SET(SL, ?BINREL(Type, FunT)) 1087 catch _:_ -> erlang:error(badarg) 1088 end 1089 end. 1090 1091-spec(partition(SetOfSets) -> Partition when 1092 SetOfSets :: set_of_sets(), 1093 Partition :: a_set()). 1094partition(Sets) -> 1095 F1 = relation_to_family(canonical_relation(Sets)), 1096 F2 = relation_to_family(converse(F1)), 1097 range(F2). 1098 1099-spec(partition(SetFun, Set) -> Partition when 1100 SetFun :: set_fun(), 1101 Partition :: a_set(), 1102 Set :: a_set()). 1103partition(I, Set) when is_integer(I), ?IS_SET(Set) -> 1104 Type = ?TYPE(Set), 1105 case check_for_sort(Type, I) of 1106 empty -> 1107 Set; 1108 error -> 1109 erlang:error(badarg); 1110 false -> % I =:= 1 1111 ?SET(partition_n(I, ?LIST(Set)), ?SET_OF(Type)); 1112 true -> 1113 ?SET(partition_n(I, keysort(I, ?LIST(Set))), ?SET_OF(Type)) 1114 end; 1115partition(Fun, Set) -> 1116 range(partition_family(Fun, Set)). 1117 1118-spec(partition(SetFun, Set1, Set2) -> {Set3, Set4} when 1119 SetFun :: set_fun(), 1120 Set1 :: a_set(), 1121 Set2 :: a_set(), 1122 Set3 :: a_set(), 1123 Set4 :: a_set()). 1124partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> 1125 RT = ?TYPE(R), 1126 ST = ?TYPE(S), 1127 case check_for_sort(RT, I) of 1128 empty -> 1129 {R, R}; 1130 error -> 1131 erlang:error(badarg); 1132 Sort -> 1133 RL = ?LIST(R), 1134 case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of 1135 {true, _SL} when RL =:= [] -> 1136 {R, R}; 1137 {true, []} -> 1138 {?SET([], RT), R}; 1139 {true, [E | Es]} when Sort =:= false -> % I =:= 1 1140 [L1 | L2] = partition3_n(I, RL, E, Es, [], []), 1141 {?SET(L1, RT), ?SET(L2, RT)}; 1142 {true, [E | Es]} -> 1143 [L1 | L2] = partition3_n(I, keysort(I,RL), E, Es, [], []), 1144 {?SET(L1, RT), ?SET(L2, RT)}; 1145 {false, _SL} -> 1146 erlang:error(type_mismatch) 1147 end 1148 end; 1149partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> 1150 Type1 = ?TYPE(S1), 1151 Type2 = ?TYPE(S2), 1152 SL1 = ?LIST(S1), 1153 case external_fun(SetFun) of 1154 false when Type2 =:= ?ANYTYPE -> 1155 {S2, S1}; 1156 false -> 1157 case subst(SL1, SetFun, element_type(Type1)) of 1158 {NSL, NewType} -> % NewType can be ?ANYTYPE 1159 case match_types(NewType, Type2) of 1160 true -> 1161 R1 = converse(NSL, []), 1162 [L1 | L2] = partition3(?LIST(S2), R1), 1163 {?SET(sort(L1), Type1), ?SET(sort(L2), Type1)}; 1164 false -> 1165 erlang:error(type_mismatch) 1166 end; 1167 Bad -> 1168 erlang:error(Bad) 1169 end; 1170 _ when Type1 =:= ?ANYTYPE -> 1171 {S1, S1}; 1172 _XFun when ?IS_SET_OF(Type1) -> 1173 erlang:error(badarg); 1174 XFun -> 1175 FunT = XFun(Type1), 1176 try check_fun(Type1, XFun, FunT) of 1177 Sort -> 1178 case match_types(FunT, Type2) of 1179 true -> 1180 R1 = inverse_substitution(SL1, XFun, Sort), 1181 [L1 | L2] = partition3(?LIST(S2), R1), 1182 {?SET(sort(L1), Type1), ?SET(sort(L2), Type1)}; 1183 false -> 1184 erlang:error(type_mismatch) 1185 end 1186 catch _:_ -> erlang:error(badarg) 1187 end 1188 end. 1189 1190-spec(multiple_relative_product(TupleOfBinRels, BinRel1) -> BinRel2 when 1191 TupleOfBinRels :: tuple_of(BinRel), 1192 BinRel :: binary_relation(), 1193 BinRel1 :: binary_relation(), 1194 BinRel2 :: binary_relation()). 1195multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) -> 1196 case test_rel(R, tuple_size(T), eq) of 1197 true when ?TYPE(R) =:= ?ANYTYPE -> 1198 empty_set(); 1199 true -> 1200 MProd = mul_relprod(tuple_to_list(T), 1, R), 1201 relative_product(MProd); 1202 false -> 1203 erlang:error(badarg) 1204 end. 1205 1206-spec(join(Relation1, I, Relation2, J) -> Relation3 when 1207 Relation1 :: relation(), 1208 Relation2 :: relation(), 1209 Relation3 :: relation(), 1210 I :: pos_integer(), 1211 J :: pos_integer()). 1212join(R1, I1, R2, I2) 1213 when ?IS_SET(R1), ?IS_SET(R2), is_integer(I1), is_integer(I2) -> 1214 case test_rel(R1, I1, lte) and test_rel(R2, I2, lte) of 1215 false -> erlang:error(badarg); 1216 true when ?TYPE(R1) =:= ?ANYTYPE -> R1; 1217 true when ?TYPE(R2) =:= ?ANYTYPE -> R2; 1218 true -> 1219 L1 = ?LIST(raise_element(R1, I1)), 1220 L2 = ?LIST(raise_element(R2, I2)), 1221 T = relprod1(L1, L2), 1222 F = case (I1 =:= 1) and (I2 =:= 1) of 1223 true -> 1224 fun({X,Y}) -> join_element(X, Y) end; 1225 false -> 1226 fun({X,Y}) -> 1227 list_to_tuple(join_element(X, Y, I2)) 1228 end 1229 end, 1230 ?SET(replace(T, F, []), F({?TYPE(R1), ?TYPE(R2)})) 1231 end. 1232 1233%% Inlined. 1234test_rel(R, I, C) -> 1235 case ?TYPE(R) of 1236 Rel when ?IS_RELATION(Rel), C =:= eq, I =:= ?REL_ARITY(Rel) -> true; 1237 Rel when ?IS_RELATION(Rel), C =:= lte, I>=1, I =< ?REL_ARITY(Rel) -> 1238 true; 1239 ?ANYTYPE -> true; 1240 _ -> false 1241 end. 1242 1243%%% 1244%%% Family functions 1245%%% 1246 1247-spec(fam2rel(Family) -> BinRel when 1248 Family :: family(), 1249 BinRel :: binary_relation()). 1250fam2rel(F) -> 1251 family_to_relation(F). 1252 1253-spec(family_to_relation(Family) -> BinRel when 1254 Family :: family(), 1255 BinRel :: binary_relation()). 1256%% Inlined. 1257family_to_relation(F) when ?IS_SET(F) -> 1258 case ?TYPE(F) of 1259 ?FAMILY(DT, RT) -> 1260 ?SET(family2rel(?LIST(F), []), ?BINREL(DT, RT)); 1261 ?ANYTYPE -> F; 1262 _ -> erlang:error(badarg) 1263 end. 1264 1265-spec(family_specification(Fun, Family1) -> Family2 when 1266 Fun :: spec_fun(), 1267 Family1 :: family(), 1268 Family2 :: family()). 1269family_specification(Fun, F) when ?IS_SET(F) -> 1270 case ?TYPE(F) of 1271 ?FAMILY(_DT, Type) = FType -> 1272 R = case external_fun(Fun) of 1273 false -> 1274 fam_spec(?LIST(F), Fun, Type, []); 1275 XFun -> 1276 fam_specification(?LIST(F), XFun, []) 1277 end, 1278 case R of 1279 SL when is_list(SL) -> 1280 ?SET(SL, FType); 1281 Bad -> 1282 erlang:error(Bad) 1283 end; 1284 ?ANYTYPE -> F; 1285 _ -> erlang:error(badarg) 1286 end. 1287 1288-spec(union_of_family(Family) -> Set when 1289 Family :: family(), 1290 Set :: a_set()). 1291union_of_family(F) when ?IS_SET(F) -> 1292 case ?TYPE(F) of 1293 ?FAMILY(_DT, Type) -> 1294 ?SET(un_of_fam(?LIST(F), []), Type); 1295 ?ANYTYPE -> F; 1296 _ -> erlang:error(badarg) 1297 end. 1298 1299-spec(intersection_of_family(Family) -> Set when 1300 Family :: family(), 1301 Set :: a_set()). 1302intersection_of_family(F) when ?IS_SET(F) -> 1303 case ?TYPE(F) of 1304 ?FAMILY(_DT, Type) -> 1305 case int_of_fam(?LIST(F)) of 1306 FU when is_list(FU) -> 1307 ?SET(FU, Type); 1308 Bad -> 1309 erlang:error(Bad) 1310 end; 1311 _ -> erlang:error(badarg) 1312 end. 1313 1314-spec(family_union(Family1) -> Family2 when 1315 Family1 :: family(), 1316 Family2 :: family()). 1317family_union(F) when ?IS_SET(F) -> 1318 case ?TYPE(F) of 1319 ?FAMILY(DT, ?SET_OF(Type)) -> 1320 ?SET(fam_un(?LIST(F), []), ?FAMILY(DT, Type)); 1321 ?ANYTYPE -> F; 1322 _ -> erlang:error(badarg) 1323 end. 1324 1325-spec(family_intersection(Family1) -> Family2 when 1326 Family1 :: family(), 1327 Family2 :: family()). 1328family_intersection(F) when ?IS_SET(F) -> 1329 case ?TYPE(F) of 1330 ?FAMILY(DT, ?SET_OF(Type)) -> 1331 case fam_int(?LIST(F), []) of 1332 FU when is_list(FU) -> 1333 ?SET(FU, ?FAMILY(DT, Type)); 1334 Bad -> 1335 erlang:error(Bad) 1336 end; 1337 ?ANYTYPE -> F; 1338 _ -> erlang:error(badarg) 1339 end. 1340 1341-spec(family_domain(Family1) -> Family2 when 1342 Family1 :: family(), 1343 Family2 :: family()). 1344family_domain(F) when ?IS_SET(F) -> 1345 case ?TYPE(F) of 1346 ?FAMILY(FDT, ?BINREL(DT, _)) -> 1347 ?SET(fam_dom(?LIST(F), []), ?FAMILY(FDT, DT)); 1348 ?ANYTYPE -> F; 1349 ?FAMILY(_, ?ANYTYPE) -> F; 1350 _ -> erlang:error(badarg) 1351 end. 1352 1353-spec(family_range(Family1) -> Family2 when 1354 Family1 :: family(), 1355 Family2 :: family()). 1356family_range(F) when ?IS_SET(F) -> 1357 case ?TYPE(F) of 1358 ?FAMILY(DT, ?BINREL(_, RT)) -> 1359 ?SET(fam_ran(?LIST(F), []), ?FAMILY(DT, RT)); 1360 ?ANYTYPE -> F; 1361 ?FAMILY(_, ?ANYTYPE) -> F; 1362 _ -> erlang:error(badarg) 1363 end. 1364 1365-spec(family_field(Family1) -> Family2 when 1366 Family1 :: family(), 1367 Family2 :: family()). 1368family_field(F) -> 1369 family_union(family_domain(F), family_range(F)). 1370 1371-spec(family_union(Family1, Family2) -> Family3 when 1372 Family1 :: family(), 1373 Family2 :: family(), 1374 Family3 :: family()). 1375family_union(F1, F2) -> 1376 fam_binop(F1, F2, fun fam_union/3). 1377 1378-spec(family_intersection(Family1, Family2) -> Family3 when 1379 Family1 :: family(), 1380 Family2 :: family(), 1381 Family3 :: family()). 1382family_intersection(F1, F2) -> 1383 fam_binop(F1, F2, fun fam_intersect/3). 1384 1385-spec(family_difference(Family1, Family2) -> Family3 when 1386 Family1 :: family(), 1387 Family2 :: family(), 1388 Family3 :: family()). 1389family_difference(F1, F2) -> 1390 fam_binop(F1, F2, fun fam_difference/3). 1391 1392%% Inlined. 1393fam_binop(F1, F2, FF) when ?IS_SET(F1), ?IS_SET(F2) -> 1394 case unify_types(?TYPE(F1), ?TYPE(F2)) of 1395 [] -> 1396 erlang:error(type_mismatch); 1397 ?ANYTYPE -> 1398 F1; 1399 Type = ?FAMILY(_, _) -> 1400 ?SET(FF(?LIST(F1), ?LIST(F2), []), Type); 1401 _ -> erlang:error(badarg) 1402 end. 1403 1404-spec(partition_family(SetFun, Set) -> Family when 1405 Family :: family(), 1406 SetFun :: set_fun(), 1407 Set :: a_set()). 1408partition_family(I, Set) when is_integer(I), ?IS_SET(Set) -> 1409 Type = ?TYPE(Set), 1410 case check_for_sort(Type, I) of 1411 empty -> 1412 Set; 1413 error -> 1414 erlang:error(badarg); 1415 false -> % when I =:= 1 1416 ?SET(fam_partition_n(I, ?LIST(Set)), 1417 ?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type))); 1418 true -> 1419 ?SET(fam_partition_n(I, keysort(I, ?LIST(Set))), 1420 ?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type))) 1421 end; 1422partition_family(SetFun, Set) when ?IS_SET(Set) -> 1423 Type = ?TYPE(Set), 1424 SL = ?LIST(Set), 1425 case external_fun(SetFun) of 1426 false when SL =/= [] -> 1427 case subst(SL, SetFun, element_type(Type)) of 1428 {NSL, NewType} -> 1429 P = fam_partition(converse(NSL, []), true), 1430 ?SET(reverse(P), ?BINREL(NewType, ?SET_OF(Type))); 1431 Bad -> 1432 erlang:error(Bad) 1433 end; 1434 false -> 1435 empty_set(); 1436 _ when Type =:= ?ANYTYPE -> 1437 empty_set(); 1438 _XFun when ?IS_SET_OF(Type) -> 1439 erlang:error(badarg); 1440 XFun -> 1441 DType = XFun(Type), 1442 try check_fun(Type, XFun, DType) of 1443 Sort -> 1444 Ts = inverse_substitution(?LIST(Set), XFun, Sort), 1445 P = fam_partition(Ts, Sort), 1446 ?SET(reverse(P), ?BINREL(DType, ?SET_OF(Type))) 1447 catch _:_ -> erlang:error(badarg) 1448 end 1449 end. 1450 1451-spec(family_projection(SetFun, Family1) -> Family2 when 1452 SetFun :: set_fun(), 1453 Family1 :: family(), 1454 Family2 :: family()). 1455family_projection(SetFun, F) when ?IS_SET(F) -> 1456 case ?TYPE(F) of 1457 ?FAMILY(_, _) when [] =:= ?LIST(F) -> 1458 empty_set(); 1459 ?FAMILY(DT, Type) -> 1460 case external_fun(SetFun) of 1461 false -> 1462 case fam_proj(?LIST(F), SetFun, Type, ?ANYTYPE, []) of 1463 {SL, NewType} -> 1464 ?SET(SL, ?BINREL(DT, NewType)); 1465 Bad -> 1466 erlang:error(Bad) 1467 end; 1468 _ -> 1469 erlang:error(badarg) 1470 end; 1471 ?ANYTYPE -> F; 1472 _ -> erlang:error(badarg) 1473 end. 1474 1475%%% 1476%%% Digraph functions 1477%%% 1478 1479-spec(family_to_digraph(Family) -> Graph when 1480 Graph :: digraph:graph(), 1481 Family :: family()). 1482family_to_digraph(F) when ?IS_SET(F) -> 1483 case ?TYPE(F) of 1484 ?FAMILY(_, _) -> fam2digraph(F, digraph:new()); 1485 ?ANYTYPE -> digraph:new(); 1486 _Else -> erlang:error(badarg) 1487 end. 1488 1489-spec(family_to_digraph(Family, GraphType) -> Graph when 1490 Graph :: digraph:graph(), 1491 Family :: family(), 1492 GraphType :: [digraph:d_type()]). 1493family_to_digraph(F, Type) when ?IS_SET(F) -> 1494 case ?TYPE(F) of 1495 ?FAMILY(_, _) -> ok; 1496 ?ANYTYPE -> ok; 1497 _Else -> erlang:error(badarg) 1498 end, 1499 try digraph:new(Type) of 1500 G -> case catch fam2digraph(F, G) of 1501 {error, Reason} -> 1502 true = digraph:delete(G), 1503 erlang:error(Reason); 1504 _ -> 1505 G 1506 end 1507 catch 1508 error:badarg -> erlang:error(badarg) 1509 end. 1510 1511-spec(digraph_to_family(Graph) -> Family when 1512 Graph :: digraph:graph(), 1513 Family :: family()). 1514digraph_to_family(G) -> 1515 try digraph_family(G) of 1516 L -> ?SET(L, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) 1517 catch _:_ -> erlang:error(badarg) 1518 end. 1519 1520-spec(digraph_to_family(Graph, Type) -> Family when 1521 Graph :: digraph:graph(), 1522 Family :: family(), 1523 Type :: type()). 1524digraph_to_family(G, T) -> 1525 case {is_type(T), T} of 1526 {true, ?SET_OF(?FAMILY(_,_) = Type)} -> 1527 try digraph_family(G) of 1528 L -> ?SET(L, Type) 1529 catch _:_ -> erlang:error(badarg) 1530 end; 1531 _ -> 1532 erlang:error(badarg) 1533 end. 1534 1535%% 1536%% Local functions 1537%% 1538 1539%% Type = OrderedSetType 1540%% | SetType 1541%% | atom() except '_' 1542%% OrderedSetType = {Type, ..., Type} 1543%% SetType = [ElementType] % list of exactly one element 1544%% ElementType = '_' % any type (implies empty set) 1545%% | Type 1546 1547is_types(0, _T) -> 1548 true; 1549is_types(I, T) -> 1550 case is_type(?REL_TYPE(I, T)) of 1551 true -> is_types(I-1, T); 1552 false -> false 1553 end. 1554 1555is_element_type(?ANYTYPE) -> 1556 true; 1557is_element_type(T) -> 1558 is_type(T). 1559 1560set_of_sets([S | Ss], L, T0) when ?IS_SET(S) -> 1561 case unify_types([?TYPE(S)], T0) of 1562 [] -> {error, type_mismatch}; 1563 Type -> set_of_sets(Ss, [?LIST(S) | L], Type) 1564 end; 1565set_of_sets([S | Ss], L, T0) when ?IS_ORDSET(S) -> 1566 case unify_types(?ORDTYPE(S), T0) of 1567 [] -> {error, type_mismatch}; 1568 Type -> set_of_sets(Ss, [?ORDDATA(S) | L], Type) 1569 end; 1570set_of_sets([], L, T) -> 1571 ?SET(usort(L), T); 1572set_of_sets(_, _L, _T) -> 1573 {error, badarg}. 1574 1575ordset_of_sets([S | Ss], L, T) when ?IS_SET(S) -> 1576 ordset_of_sets(Ss, [?LIST(S) | L], [[?TYPE(S)] | T]); 1577ordset_of_sets([S | Ss], L, T) when ?IS_ORDSET(S) -> 1578 ordset_of_sets(Ss, [?ORDDATA(S) | L], [?ORDTYPE(S) | T]); 1579ordset_of_sets([], L, T) -> 1580 ?ORDSET(list_to_tuple(reverse(L)), list_to_tuple(reverse(T))); 1581ordset_of_sets(_, _L, _T) -> 1582 error. 1583 1584%% Inlined. 1585rel(Ts, [Type]) -> 1586 case is_type(Type) and atoms_only(Type, 1) of 1587 true -> 1588 rel(Ts, tuple_size(Type), Type); 1589 false -> 1590 rel_type(Ts, [], Type) 1591 end; 1592rel(Ts, Sz) -> 1593 rel(Ts, Sz, erlang:make_tuple(Sz, ?ATOM_TYPE)). 1594 1595atoms_only(Type, I) when ?IS_ATOM_TYPE(?REL_TYPE(I, Type)) -> 1596 atoms_only(Type, I+1); 1597atoms_only(Type, I) when I > tuple_size(Type), ?IS_RELATION(Type) -> 1598 true; 1599atoms_only(_Type, _I) -> 1600 false. 1601 1602rel(Ts, Sz, Type) when Sz >= 1 -> 1603 SL = usort(Ts), 1604 rel(SL, SL, Sz, Type). 1605 1606rel([T | Ts], L, Sz, Type) when tuple_size(T) =:= Sz -> 1607 rel(Ts, L, Sz, Type); 1608rel([], L, _Sz, Type) -> 1609 ?SET(L, Type). 1610 1611rel_type([E | Ts], L, Type) -> 1612 {NType, NE} = make_element(E, Type, Type), 1613 rel_type(Ts, [NE | L], NType); 1614rel_type([], [], ?ANYTYPE) -> 1615 empty_set(); 1616rel_type([], SL, Type) when ?IS_RELATION(Type) -> 1617 ?SET(usort(SL), Type). 1618 1619%% Inlined. 1620a_func(Ts, T) -> 1621 case {T, is_type(T)} of 1622 {[?BINREL(DT, RT) = Type], true} when ?IS_ATOM_TYPE(DT), 1623 ?IS_ATOM_TYPE(RT) -> 1624 func(Ts, Type); 1625 {[Type], true} -> 1626 func_type(Ts, [], Type, fun(?BINREL(_,_)) -> true end) 1627 end. 1628 1629func(L0, Type) -> 1630 L = usort(L0), 1631 func(L, L, L, Type). 1632 1633func([{X,_} | Ts], X0, L, Type) when X /= X0 -> 1634 func(Ts, X, L, Type); 1635func([{X,_} | _Ts], X0, _L, _Type) when X == X0 -> 1636 bad_function; 1637func([], _X0, L, Type) -> 1638 ?SET(L, Type). 1639 1640%% Inlined. 1641fam(Ts, T) -> 1642 case {T, is_type(T)} of 1643 {[?FAMILY(DT, RT) = Type], true} when ?IS_ATOM_TYPE(DT), 1644 ?IS_ATOM_TYPE(RT) -> 1645 fam2(Ts, Type); 1646 {[Type], true} -> 1647 func_type(Ts, [], Type, fun(?FAMILY(_,_)) -> true end) 1648 end. 1649 1650fam2([], Type) -> 1651 ?SET([], Type); 1652fam2(Ts, Type) -> 1653 fam2(sort(Ts), Ts, [], Type). 1654 1655fam2([{I,L} | T], I0, SL, Type) when I /= I0 -> 1656 fam2(T, I, [{I,usort(L)} | SL], Type); 1657fam2([{I,L} | T], I0, SL, Type) when I == I0 -> 1658 case {usort(L), SL} of 1659 {NL, [{_I,NL1} | _]} when NL == NL1 -> 1660 fam2(T, I0, SL, Type); 1661 _ -> 1662 bad_function 1663 end; 1664fam2([], _I0, SL, Type) -> 1665 ?SET(reverse(SL), Type). 1666 1667func_type([E | T], SL, Type, F) -> 1668 {NType, NE} = make_element(E, Type, Type), 1669 func_type(T, [NE | SL], NType, F); 1670func_type([], [], ?ANYTYPE, _F) -> 1671 empty_set(); 1672func_type([], SL, Type, F) -> 1673 true = F(Type), 1674 NL = usort(SL), 1675 check_function(NL, ?SET(NL, Type)). 1676 1677setify(L, ?SET_OF(Atom)) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE -> 1678 ?SET(usort(L), Atom); 1679setify(L, ?SET_OF(Type0)) -> 1680 try is_no_lists(Type0) of 1681 N when is_integer(N) -> 1682 rel(L, N, Type0); 1683 Sizes -> 1684 make_oset(L, Sizes, L, Type0) 1685 catch 1686 _:_ -> 1687 {?SET_OF(Type), Set} = create(L, Type0, Type0, []), 1688 ?SET(Set, Type) 1689 end; 1690setify(E, Type0) -> 1691 {Type, OrdSet} = make_element(E, Type0, Type0), 1692 ?ORDSET(OrdSet, Type). 1693 1694is_no_lists(T) when is_tuple(T) -> 1695 Sz = tuple_size(T), 1696 is_no_lists(T, Sz, Sz, []). 1697 1698is_no_lists(_T, 0, Sz, []) -> 1699 Sz; 1700is_no_lists(_T, 0, Sz, L) -> 1701 {Sz, L}; 1702is_no_lists(T, I, Sz, L) when ?IS_ATOM_TYPE(?REL_TYPE(I, T)) -> 1703 is_no_lists(T, I-1, Sz, L); 1704is_no_lists(T, I, Sz, L) -> 1705 is_no_lists(T, I-1, Sz, [{I,is_no_lists(?REL_TYPE(I, T))} | L]). 1706 1707create([E | Es], T, T0, L) -> 1708 {NT, S} = make_element(E, T, T0), 1709 create(Es, NT, T0, [S | L]); 1710create([], T, _T0, L) -> 1711 {?SET_OF(T), usort(L)}. 1712 1713make_element(C, ?ANYTYPE, _T0) -> 1714 make_element(C); 1715make_element(C, Atom, ?ANYTYPE) when ?IS_ATOM_TYPE(Atom), 1716 not is_list(C), not is_tuple(C) -> 1717 {Atom, C}; 1718make_element(C, Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> 1719 {Atom, C}; 1720make_element(T, TT, ?ANYTYPE) when tuple_size(T) =:= tuple_size(TT) -> 1721 make_tuple(tuple_to_list(T), tuple_to_list(TT), [], [], ?ANYTYPE); 1722make_element(T, TT, T0) when tuple_size(T) =:= tuple_size(TT) -> 1723 make_tuple(tuple_to_list(T), tuple_to_list(TT), [], [], tuple_to_list(T0)); 1724make_element(L, [LT], ?ANYTYPE) when is_list(L) -> 1725 create(L, LT, ?ANYTYPE, []); 1726make_element(L, [LT], [T0]) when is_list(L) -> 1727 create(L, LT, T0, []). 1728 1729make_tuple([E | Es], [T | Ts], NT, L, T0) when T0 =:= ?ANYTYPE -> 1730 {ET, ES} = make_element(E, T, T0), 1731 make_tuple(Es, Ts, [ET | NT], [ES | L], T0); 1732make_tuple([E | Es], [T | Ts], NT, L, [T0 | T0s]) -> 1733 {ET, ES} = make_element(E, T, T0), 1734 make_tuple(Es, Ts, [ET | NT], [ES | L], T0s); 1735make_tuple([], [], NT, L, _T0s) when NT =/= [] -> 1736 {list_to_tuple(reverse(NT)), list_to_tuple(reverse(L))}. 1737 1738%% Derive type. 1739make_element(C) when not is_list(C), not is_tuple(C) -> 1740 {?ATOM_TYPE, C}; 1741make_element(T) when is_tuple(T) -> 1742 make_tuple(tuple_to_list(T), [], []); 1743make_element(L) when is_list(L) -> 1744 create(L, ?ANYTYPE, ?ANYTYPE, []). 1745 1746make_tuple([E | Es], T, L) -> 1747 {ET, ES} = make_element(E), 1748 make_tuple(Es, [ET | T], [ES | L]); 1749make_tuple([], T, L) when T =/= [] -> 1750 {list_to_tuple(reverse(T)), list_to_tuple(reverse(L))}. 1751 1752make_oset([T | Ts], Szs, L, Type) -> 1753 true = test_oset(Szs, T, T), 1754 make_oset(Ts, Szs, L, Type); 1755make_oset([], _Szs, L, Type) -> 1756 ?SET(usort(L), Type). 1757 1758%% Optimization. Avoid re-building (nested) tuples. 1759test_oset({Sz,Args}, T, T0) when tuple_size(T) =:= Sz -> 1760 test_oset_args(Args, T, T0); 1761test_oset(Sz, T, _T0) when tuple_size(T) =:= Sz -> 1762 true. 1763 1764test_oset_args([{Arg,Szs} | Ss], T, T0) -> 1765 true = test_oset(Szs, ?REL_TYPE(Arg, T), T0), 1766 test_oset_args(Ss, T, T0); 1767test_oset_args([], _T, _T0) -> 1768 true. 1769 1770list_of_sets([S | Ss], Type, L) -> 1771 list_of_sets(Ss, Type, [?SET(S, Type) | L]); 1772list_of_sets([], _Type, L) -> 1773 reverse(L). 1774 1775list_of_ordsets([S | Ss], Type, L) -> 1776 list_of_ordsets(Ss, Type, [?ORDSET(S, Type) | L]); 1777list_of_ordsets([], _Type, L) -> 1778 reverse(L). 1779 1780tuple_of_sets([S | Ss], [?SET_OF(Type) | Types], L) -> 1781 tuple_of_sets(Ss, Types, [?SET(S, Type) | L]); 1782tuple_of_sets([S | Ss], [Type | Types], L) -> 1783 tuple_of_sets(Ss, Types, [?ORDSET(S, Type) | L]); 1784tuple_of_sets([], [], L) -> 1785 list_to_tuple(reverse(L)). 1786 1787spec([E | Es], Fun, Type, L) -> 1788 case Fun(term2set(E, Type)) of 1789 true -> 1790 spec(Es, Fun, Type, [E | L]); 1791 false -> 1792 spec(Es, Fun, Type, L); 1793 _ -> 1794 badarg 1795 end; 1796spec([], _Fun, _Type, L) -> 1797 reverse(L). 1798 1799specification([E | Es], Fun, L) -> 1800 case Fun(E) of 1801 true -> 1802 specification(Es, Fun, [E | L]); 1803 false -> 1804 specification(Es, Fun, L); 1805 _ -> 1806 badarg 1807 end; 1808specification([], _Fun, L) -> 1809 reverse(L). 1810 1811%% Elements from the first list are kept. 1812intersection([H1 | T1], [H2 | T2], L) when H1 < H2 -> 1813 intersection1(T1, T2, L, H2); 1814intersection([H1 | T1], [H2 | T2], L) when H1 == H2 -> 1815 intersection(T1, T2, [H1 | L]); 1816intersection([H1 | T1], [_H2 | T2], L) -> 1817 intersection2(T1, T2, L, H1); 1818intersection(_, _, L) -> 1819 reverse(L). 1820 1821intersection1([H1 | T1], T2, L, H2) when H1 < H2 -> 1822 intersection1(T1, T2, L, H2); 1823intersection1([H1 | T1], T2, L, H2) when H1 == H2 -> 1824 intersection(T1, T2, [H1 | L]); 1825intersection1([H1 | T1], T2, L, _H2) -> 1826 intersection2(T1, T2, L, H1); 1827intersection1(_, _, L, _) -> 1828 reverse(L). 1829 1830intersection2(T1, [H2 | T2], L, H1) when H1 > H2 -> 1831 intersection2(T1, T2, L, H1); 1832intersection2(T1, [H2 | T2], L, H1) when H1 == H2 -> 1833 intersection(T1, T2, [H1 | L]); 1834intersection2(T1, [H2 | T2], L, _H1) -> 1835 intersection1(T1, T2, L, H2); 1836intersection2(_, _, L, _) -> 1837 reverse(L). 1838 1839difference([H1 | T1], [H2 | T2], L) when H1 < H2 -> 1840 diff(T1, T2, [H1 | L], H2); 1841difference([H1 | T1], [H2 | T2], L) when H1 == H2 -> 1842 difference(T1, T2, L); 1843difference([H1 | T1], [_H2 | T2], L) -> 1844 diff2(T1, T2, L, H1); 1845difference(L1, _, L) -> 1846 reverse(L, L1). 1847 1848diff([H1 | T1], T2, L, H2) when H1 < H2 -> 1849 diff(T1, T2, [H1 | L], H2); 1850diff([H1 | T1], T2, L, H2) when H1 == H2 -> 1851 difference(T1, T2, L); 1852diff([H1 | T1], T2, L, _H2) -> 1853 diff2(T1, T2, L, H1); 1854diff(_, _, L, _) -> 1855 reverse(L). 1856 1857diff2(T1, [H2 | T2], L, H1) when H1 > H2 -> 1858 diff2(T1, T2, L, H1); 1859diff2(T1, [H2 | T2], L, H1) when H1 == H2 -> 1860 difference(T1, T2, L); 1861diff2(T1, [H2 | T2], L, H1) -> 1862 diff(T1, T2, [H1 | L], H2); 1863diff2(T1, _, L, H1) -> 1864 reverse(L, [H1 | T1]). 1865 1866symdiff([H1 | T1], T2, L) -> 1867 symdiff2(T1, T2, L, H1); 1868symdiff(_, T2, L) -> 1869 reverse(L, T2). 1870 1871symdiff1([H1 | T1], T2, L, H2) when H1 < H2 -> 1872 symdiff1(T1, T2, [H1 | L], H2); 1873symdiff1([H1 | T1], T2, L, H2) when H1 == H2 -> 1874 symdiff(T1, T2, L); 1875symdiff1([H1 | T1], T2, L, H2) -> 1876 symdiff2(T1, T2, [H2 | L], H1); 1877symdiff1(_, T2, L, H2) -> 1878 reverse(L, [H2 | T2]). 1879 1880symdiff2(T1, [H2 | T2], L, H1) when H1 > H2 -> 1881 symdiff2(T1, T2, [H2 | L], H1); 1882symdiff2(T1, [H2 | T2], L, H1) when H1 == H2 -> 1883 symdiff(T1, T2, L); 1884symdiff2(T1, [H2 | T2], L, H1) -> 1885 symdiff1(T1, T2, [H1 | L], H2); 1886symdiff2(T1, _, L, H1) -> 1887 reverse(L, [H1 | T1]). 1888 1889sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) when H1 < H2 -> 1890 sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); 1891sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) when H1 == H2 -> 1892 sympart(T1, T2, L1, [H1 | L12], L2, T); 1893sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) -> 1894 sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); 1895sympart(S1, [], L1, L12, L2, T) -> 1896 {?SET(reverse(L1, S1), T), 1897 ?SET(reverse(L12), T), 1898 ?SET(reverse(L2), T)}; 1899sympart(_, S2, L1, L12, L2, T) -> 1900 {?SET(reverse(L1), T), 1901 ?SET(reverse(L12), T), 1902 ?SET(reverse(L2, S2), T)}. 1903 1904sympart1([H1 | T1], T2, L1, L12, L2, T, H2) when H1 < H2 -> 1905 sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); 1906sympart1([H1 | T1], T2, L1, L12, L2, T, H2) when H1 == H2 -> 1907 sympart(T1, T2, L1, [H1 | L12], L2, T); 1908sympart1([H1 | T1], T2, L1, L12, L2, T, H2) -> 1909 sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); 1910sympart1(_, T2, L1, L12, L2, T, H2) -> 1911 {?SET(reverse(L1), T), 1912 ?SET(reverse(L12), T), 1913 ?SET(reverse(L2, [H2 | T2]), T)}. 1914 1915sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) when H1 > H2 -> 1916 sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); 1917sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) when H1 == H2 -> 1918 sympart(T1, T2, L1, [H1 | L12], L2, T); 1919sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) -> 1920 sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); 1921sympart2(T1, _, L1, L12, L2, T, H1) -> 1922 {?SET(reverse(L1, [H1 | T1]), T), 1923 ?SET(reverse(L12), T), 1924 ?SET(reverse(L2), T)}. 1925 1926prod([[E | Es] | Xs], T, L) -> 1927 prod(Es, Xs, T, prod(Xs, [E | T], L)); 1928prod([], T, L) -> 1929 [list_to_tuple(reverse(T)) | L]. 1930 1931prod([E | Es], Xs, T, L) -> 1932 prod(Es, Xs, T, prod(Xs, [E | T], L)); 1933prod([], _Xs, _E, L) -> 1934 L. 1935 1936constant_function([E | Es], X, L) -> 1937 constant_function(Es, X, [{E,X} | L]); 1938constant_function([], _X, L) -> 1939 reverse(L). 1940 1941subset([H1 | T1], [H2 | T2]) when H1 > H2 -> 1942 subset(T1, T2, H1); 1943subset([H1 | T1], [H2 | T2]) when H1 == H2 -> 1944 subset(T1, T2); 1945subset(L1, _) -> 1946 L1 =:= []. 1947 1948subset(T1, [H2 | T2], H1) when H1 > H2 -> 1949 subset(T1, T2, H1); 1950subset(T1, [H2 | T2], H1) when H1 == H2 -> 1951 subset(T1, T2); 1952subset(_, _, _) -> 1953 false. 1954 1955disjoint([B | Bs], A, As) when A < B -> 1956 disjoint(As, B, Bs); 1957disjoint([B | _Bs], A, _As) when A == B -> 1958 false; 1959disjoint([_B | Bs], A, As) -> 1960 disjoint(Bs, A, As); 1961disjoint(_Bs, _A, _As) -> 1962 true. 1963 1964%% Append sets that come in order, then "merge". 1965lunion([[_] = S]) -> % optimization 1966 S; 1967lunion([[] | Ls]) -> 1968 lunion(Ls); 1969lunion([S | Ss]) -> 1970 umerge(lunion(Ss, last(S), [S], [])); 1971lunion([]) -> 1972 []. 1973 1974lunion([[E] = S | Ss], Last, SL, Ls) when E > Last -> % optimization 1975 lunion(Ss, E, [S | SL], Ls); 1976lunion([S | Ss], Last, SL, Ls) when hd(S) > Last -> 1977 lunion(Ss, last(S), [S | SL], Ls); 1978lunion([S | Ss], _Last, SL, Ls) -> 1979 lunion(Ss, last(S), [S], [append(reverse(SL)) | Ls]); 1980lunion([], _Last, SL, Ls) -> 1981 [append(reverse(SL)) | Ls]. 1982 1983%% The empty list is always the first list, if present. 1984lintersection(_, []) -> 1985 []; 1986lintersection([S | Ss], S0) -> 1987 lintersection(Ss, intersection(S, S0, [])); 1988lintersection([], S) -> 1989 S. 1990 1991can_rel([S | Ss], L) -> 1992 can_rel(Ss, L, S, S); 1993can_rel([], L) -> 1994 sort(L). 1995 1996can_rel(Ss, L, [E | Es], S) -> 1997 can_rel(Ss, [{E, S} | L], Es, S); 1998can_rel(Ss, L, _, _S) -> 1999 can_rel(Ss, L). 2000 2001rel2family([{X,Y} | S]) -> 2002 rel2fam(S, X, [Y], []); 2003rel2family([]) -> 2004 []. 2005 2006rel2fam([{X,Y} | S], X0, YL, L) when X0 == X -> 2007 rel2fam(S, X0, [Y | YL], L); 2008rel2fam([{X,Y} | S], X0, [A,B | YL], L) -> % optimization 2009 rel2fam(S, X, [Y], [{X0,reverse(YL,[B,A])} | L]); 2010rel2fam([{X,Y} | S], X0, YL, L) -> 2011 rel2fam(S, X, [Y], [{X0,YL} | L]); 2012rel2fam([], X, YL, L) -> 2013 reverse([{X,reverse(YL)} | L]). 2014 2015dom([{X,_} | Es]) -> 2016 dom([], X, Es); 2017dom([] = L) -> 2018 L. 2019 2020dom(L, X, [{X1,_} | Es]) when X == X1 -> 2021 dom(L, X, Es); 2022dom(L, X, [{Y,_} | Es]) -> 2023 dom([X | L], Y, Es); 2024dom(L, X, []) -> 2025 reverse(L, [X]). 2026 2027ran([{_,Y} | Es], L) -> 2028 ran(Es, [Y | L]); 2029ran([], L) -> 2030 usort(L). 2031 2032relprod(A, B) -> 2033 usort(relprod1(A, B)). 2034 2035relprod1([{Ay,Ax} | A], B) -> 2036 relprod1(B, Ay, Ax, A, []); 2037relprod1(_A, _B) -> 2038 []. 2039 2040relprod1([{Bx,_By} | B], Ay, Ax, A, L) when Ay > Bx -> 2041 relprod1(B, Ay, Ax, A, L); 2042relprod1([{Bx,By} | B], Ay, Ax, A, L) when Ay == Bx -> 2043 relprod(B, Bx, By, A, [{Ax,By} | L], Ax, B, Ay); 2044relprod1([{Bx,By} | B], _Ay, _Ax, A, L) -> 2045 relprod2(B, Bx, By, A, L); 2046relprod1(_B, _Ay, _Ax, _A, L) -> 2047 L. 2048 2049relprod2(B, Bx, By, [{Ay, _Ax} | A], L) when Ay < Bx -> 2050 relprod2(B, Bx, By, A, L); 2051relprod2(B, Bx, By, [{Ay, Ax} | A], L) when Ay == Bx -> 2052 relprod(B, Bx, By, A, [{Ax,By} | L], Ax, B, Ay); 2053relprod2(B, _Bx, _By, [{Ay, Ax} | A], L) -> 2054 relprod1(B, Ay, Ax, A, L); 2055relprod2(_, _, _, _, L) -> 2056 L. 2057 2058relprod(B0, Bx0, By0, A0, L, Ax, [{Bx,By} | B], Ay) when Ay == Bx -> 2059 relprod(B0, Bx0, By0, A0, [{Ax,By} | L], Ax, B, Ay); 2060relprod(B0, Bx0, By0, A0, L, _Ax, _B, _Ay) -> 2061 relprod2(B0, Bx0, By0, A0, L). 2062 2063relprod_n([], _R, _EmptyG, _IsR) -> 2064 {error, badarg}; 2065relprod_n(RL, R, EmptyR, IsR) -> 2066 case domain_type(RL, ?ANYTYPE) of 2067 Error = {error, _Reason} -> 2068 Error; 2069 DType -> 2070 Empty = any(fun is_empty_set/1, RL) or EmptyR, 2071 RType = range_type(RL, []), 2072 Type = ?BINREL(DType, RType), 2073 Prod = 2074 case Empty of 2075 true when DType =:= ?ANYTYPE; RType =:= ?ANYTYPE -> 2076 empty_set(); 2077 true -> 2078 ?SET([], Type); 2079 false -> 2080 TL = ?LIST((relprod_n(RL))), 2081 Sz = length(RL), 2082 Fun = fun({X,A}) -> {X, flat(Sz, A, [])} end, 2083 ?SET(map(Fun, TL), Type) 2084 end, 2085 case IsR of 2086 true -> relative_product(Prod, R); 2087 false -> Prod 2088 end 2089 end. 2090 2091relprod_n([R | Rs]) -> 2092 relprod_n(Rs, R). 2093 2094relprod_n([], R) -> 2095 R; 2096relprod_n([R | Rs], R0) -> 2097 T = raise_element(R0, 1), 2098 R1 = relative_product1(T, R), 2099 NR = projection({external, fun({{X,A},AS}) -> {X,{A,AS}} end}, R1), 2100 relprod_n(Rs, NR). 2101 2102flat(1, A, L) -> 2103 list_to_tuple([A | L]); 2104flat(N, {T,A}, L) -> 2105 flat(N-1, T, [A | L]). 2106 2107domain_type([T | Ts], T0) when ?IS_SET(T) -> 2108 case ?TYPE(T) of 2109 ?BINREL(DT, _RT) -> 2110 case unify_types(DT, T0) of 2111 [] -> {error, type_mismatch}; 2112 T1 -> domain_type(Ts, T1) 2113 end; 2114 ?ANYTYPE -> 2115 domain_type(Ts, T0); 2116 _ -> {error, badarg} 2117 end; 2118domain_type([], T0) -> 2119 T0. 2120 2121range_type([T | Ts], L) -> 2122 case ?TYPE(T) of 2123 ?BINREL(_DT, RT) -> 2124 range_type(Ts, [RT | L]); 2125 ?ANYTYPE -> 2126 ?ANYTYPE 2127 end; 2128range_type([], L) -> 2129 list_to_tuple(reverse(L)). 2130 2131converse([{A,B} | X], L) -> 2132 converse(X, [{B,A} | L]); 2133converse([], L) -> 2134 sort(L). 2135 2136strict([{E1,E2} | Es], L) when E1 == E2 -> 2137 strict(Es, L); 2138strict([E | Es], L) -> 2139 strict(Es, [E | L]); 2140strict([], L) -> 2141 reverse(L). 2142 2143weak(Es) -> 2144 %% Not very efficient... 2145 weak(Es, ran(Es, []), []). 2146 2147weak(Es=[{X,_} | _], [Y | Ys], L) when X > Y -> 2148 weak(Es, Ys, [{Y,Y} | L]); 2149weak(Es=[{X,_} | _], [Y | Ys], L) when X == Y -> 2150 weak(Es, Ys, L); 2151weak([E={X,Y} | Es], Ys, L) when X > Y -> 2152 weak1(Es, Ys, [E | L], X); 2153weak([E={X,Y} | Es], Ys, L) when X == Y -> 2154 weak2(Es, Ys, [E | L], X); 2155weak([E={X,_Y} | Es], Ys, L) -> % when X < _Y 2156 weak2(Es, Ys, [E, {X,X} | L], X); 2157weak([], [Y | Ys], L) -> 2158 weak([], Ys, [{Y,Y} | L]); 2159weak([], [], L) -> 2160 reverse(L). 2161 2162weak1([E={X,Y} | Es], Ys, L, X0) when X > Y, X == X0 -> 2163 weak1(Es, Ys, [E | L], X); 2164weak1([E={X,Y} | Es], Ys, L, X0) when X == Y, X == X0 -> 2165 weak2(Es, Ys, [E | L], X); 2166weak1([E={X,_Y} | Es], Ys, L, X0) when X == X0 -> % when X < Y 2167 weak2(Es, Ys, [E, {X,X} | L], X); 2168weak1(Es, Ys, L, X) -> 2169 weak(Es, Ys, [{X,X} | L]). 2170 2171weak2([E={X,_Y} | Es], Ys, L, X0) when X == X0 -> % when X < _Y 2172 weak2(Es, Ys, [E | L], X); 2173weak2(Es, Ys, L, _X) -> 2174 weak(Es, Ys, L). 2175 2176extc(L, [D | Ds], C, Ts) -> 2177 extc(L, Ds, C, Ts, D); 2178extc(L, [], _C, _Ts) -> 2179 L. 2180 2181extc(L, Ds, C, [{X,_Y} | Ts], D) when X < D -> 2182 extc(L, Ds, C, Ts, D); 2183extc(L, Ds, C, [{X,_Y} | Ts], D) when X == D -> 2184 extc(L, Ds, C, Ts); 2185extc(L, Ds, C, [{X,_Y} | Ts], D) -> 2186 extc2([{D,C} | L], Ds, C, Ts, X); 2187extc(L, Ds, C, [], D) -> 2188 extc_tail([{D,C} | L], Ds, C). 2189 2190extc2(L, [D | Ds], C, Ts, X) when X > D -> 2191 extc2([{D,C} | L], Ds, C, Ts, X); 2192extc2(L, [D | Ds], C, Ts, X) when X == D -> 2193 extc(L, Ds, C, Ts); 2194extc2(L, [D | Ds], C, Ts, _X) -> 2195 extc(L, Ds, C, Ts, D); 2196extc2(L, [], _C, _Ts, _X) -> 2197 L. 2198 2199extc_tail(L, [D | Ds], C) -> 2200 extc_tail([{D,C} | L], Ds, C); 2201extc_tail(L, [], _C) -> 2202 L. 2203 2204is_a_func([{E,_} | Es], E0) when E /= E0 -> 2205 is_a_func(Es, E); 2206is_a_func(L, _E) -> 2207 L =:= []. 2208 2209restrict_n(I, [T | Ts], Key, Keys, L) -> 2210 case element(I, T) of 2211 K when K < Key -> 2212 restrict_n(I, Ts, Key, Keys, L); 2213 K when K == Key -> 2214 restrict_n(I, Ts, Key, Keys, [T | L]); 2215 K -> 2216 restrict_n(I, K, Ts, Keys, L, T) 2217 end; 2218restrict_n(_I, _Ts, _Key, _Keys, L) -> 2219 L. 2220 2221restrict_n(I, K, Ts, [Key | Keys], L, E) when K > Key -> 2222 restrict_n(I, K, Ts, Keys, L, E); 2223restrict_n(I, K, Ts, [Key | Keys], L, E) when K == Key -> 2224 restrict_n(I, Ts, Key, Keys, [E | L]); 2225restrict_n(I, _K, Ts, [Key | Keys], L, _E) -> 2226 restrict_n(I, Ts, Key, Keys, L); 2227restrict_n(_I, _K, _Ts, _Keys, L, _E) -> 2228 L. 2229 2230restrict([Key | Keys], Tuples) -> 2231 restrict(Tuples, Key, Keys, []); 2232restrict(_Keys, _Tuples) -> 2233 []. 2234 2235restrict([{K,_E} | Ts], Key, Keys, L) when K < Key -> 2236 restrict(Ts, Key, Keys, L); 2237restrict([{K,E} | Ts], Key, Keys, L) when K == Key -> 2238 restrict(Ts, Key, Keys, [E | L]); 2239restrict([{K,E} | Ts], _Key, Keys, L) -> 2240 restrict(Ts, K, Keys, L, E); 2241restrict(_Ts, _Key, _Keys, L) -> 2242 L. 2243 2244restrict(Ts, K, [Key | Keys], L, E) when K > Key -> 2245 restrict(Ts, K, Keys, L, E); 2246restrict(Ts, K, [Key | Keys], L, E) when K == Key -> 2247 restrict(Ts, Key, Keys, [E | L]); 2248restrict(Ts, _K, [Key | Keys], L, _E) -> 2249 restrict(Ts, Key, Keys, L); 2250restrict(_Ts, _K, _Keys, L, _E) -> 2251 L. 2252 2253diff_restrict_n(I, [T | Ts], Key, Keys, L) -> 2254 case element(I, T) of 2255 K when K < Key -> 2256 diff_restrict_n(I, Ts, Key, Keys, [T | L]); 2257 K when K == Key -> 2258 diff_restrict_n(I, Ts, Key, Keys, L); 2259 K -> 2260 diff_restrict_n(I, K, Ts, Keys, L, T) 2261 end; 2262diff_restrict_n(I, _Ts, _Key, _Keys, L) when I =:= 1 -> 2263 reverse(L); 2264diff_restrict_n(_I, _Ts, _Key, _Keys, L) -> 2265 sort(L). 2266 2267diff_restrict_n(I, K, Ts, [Key | Keys], L, T) when K > Key -> 2268 diff_restrict_n(I, K, Ts, Keys, L, T); 2269diff_restrict_n(I, K, Ts, [Key | Keys], L, _T) when K == Key -> 2270 diff_restrict_n(I, Ts, Key, Keys, L); 2271diff_restrict_n(I, _K, Ts, [Key | Keys], L, T) -> 2272 diff_restrict_n(I, Ts, Key, Keys, [T | L]); 2273diff_restrict_n(I, _K, Ts, _Keys, L, T) when I =:= 1 -> 2274 reverse(L, [T | Ts]); 2275diff_restrict_n(_I, _K, Ts, _Keys, L, T) -> 2276 sort([T | Ts ++ L]). 2277 2278diff_restrict([Key | Keys], Tuples) -> 2279 diff_restrict(Tuples, Key, Keys, []); 2280diff_restrict(_Keys, Tuples) -> 2281 diff_restrict_tail(Tuples, []). 2282 2283diff_restrict([{K,E} | Ts], Key, Keys, L) when K < Key -> 2284 diff_restrict(Ts, Key, Keys, [E | L]); 2285diff_restrict([{K,_E} | Ts], Key, Keys, L) when K == Key -> 2286 diff_restrict(Ts, Key, Keys, L); 2287diff_restrict([{K,E} | Ts], _Key, Keys, L) -> 2288 diff_restrict(Ts, K, Keys, L, E); 2289diff_restrict(_Ts, _Key, _Keys, L) -> 2290 L. 2291 2292diff_restrict(Ts, K, [Key | Keys], L, E) when K > Key -> 2293 diff_restrict(Ts, K, Keys, L, E); 2294diff_restrict(Ts, K, [Key | Keys], L, _E) when K == Key -> 2295 diff_restrict(Ts, Key, Keys, L); 2296diff_restrict(Ts, _K, [Key | Keys], L, E) -> 2297 diff_restrict(Ts, Key, Keys, [E | L]); 2298diff_restrict(Ts, _K, _Keys, L, E) -> 2299 diff_restrict_tail(Ts, [E | L]). 2300 2301diff_restrict_tail([{_K,E} | Ts], L) -> 2302 diff_restrict_tail(Ts, [E | L]); 2303diff_restrict_tail(_Ts, L) -> 2304 L. 2305 2306comp([], B) -> 2307 check_function(B, []); 2308comp(_A, []) -> 2309 bad_function; 2310comp(A0, [{Bx,By} | B]) -> 2311 A = converse(A0, []), 2312 check_function(A0, comp1(A, B, [], Bx, By)). 2313 2314comp1([{Ay,Ax} | A], B, L, Bx, By) when Ay == Bx -> 2315 comp1(A, B, [{Ax,By} | L], Bx, By); 2316comp1([{Ay,Ax} | A], B, L, Bx, _By) when Ay > Bx -> 2317 comp2(A, B, L, Bx, Ay, Ax); 2318comp1([{Ay,_Ax} | _A], _B, _L, Bx, _By) when Ay < Bx -> 2319 bad_function; 2320comp1([], B, L, Bx, _By) -> 2321 check_function(Bx, B, L). 2322 2323comp2(A, [{Bx,_By} | B], L, Bx0, Ay, Ax) when Ay > Bx, Bx /= Bx0 -> 2324 comp2(A, B, L, Bx, Ay, Ax); 2325comp2(A, [{Bx,By} | B], L, _Bx0, Ay, Ax) when Ay == Bx -> 2326 comp1(A, B, [{Ax,By} | L], Bx, By); 2327comp2(_A, _B, _L, _Bx0, _Ay, _Ax) -> 2328 bad_function. 2329 2330inverse1([{A,B} | X]) -> 2331 inverse(X, A, [{B,A}]); 2332inverse1([]) -> 2333 []. 2334 2335inverse([{A,B} | X], A0, L) when A0 /= A -> 2336 inverse(X, A, [{B,A} | L]); 2337inverse([{A,_B} | _X], A0, _L) when A0 == A -> 2338 bad_function; 2339inverse([], _A0, L) -> 2340 SL = [{V,_} | Es] = sort(L), 2341 case is_a_func(Es, V) of 2342 true -> SL; 2343 false -> bad_function 2344 end. 2345 2346%% Inlined. 2347external_fun({external, Function}) when is_atom(Function) -> 2348 false; 2349external_fun({external, Fun}) -> 2350 Fun; 2351external_fun(_) -> 2352 false. 2353 2354%% Inlined. 2355element_type(?SET_OF(Type)) -> Type; 2356element_type(Type) -> Type. 2357 2358subst(Ts, Fun, Type) -> 2359 subst(Ts, Fun, Type, ?ANYTYPE, []). 2360 2361subst([T | Ts], Fun, Type, NType, L) -> 2362 case setfun(T, Fun, Type, NType) of 2363 {SD, ST} -> subst(Ts, Fun, Type, ST, [{T, SD} | L]); 2364 Bad -> Bad 2365 end; 2366subst([], _Fun, _Type, NType, L) -> 2367 {L, NType}. 2368 2369projection1([E | Es]) -> 2370 projection1([], element(1, E), Es); 2371projection1([] = L) -> 2372 L. 2373 2374projection1(L, X, [E | Es]) -> 2375 case element(1, E) of 2376 X1 when X == X1 -> projection1(L, X, Es); 2377 X1 -> projection1([X | L], X1, Es) 2378 end; 2379projection1(L, X, []) -> 2380 reverse(L, [X]). 2381 2382projection_n([E | Es], I, L) -> 2383 projection_n(Es, I, [element(I, E) | L]); 2384projection_n([], _I, L) -> 2385 usort(L). 2386 2387substitute_element([T | Ts], I, L) -> 2388 substitute_element(Ts, I, [{T, element(I, T)} | L]); 2389substitute_element(_, _I, L) -> 2390 reverse(L). 2391 2392substitute([T | Ts], Fun, L) -> 2393 substitute(Ts, Fun, [{T, Fun(T)} | L]); 2394substitute(_, _Fun, L) -> 2395 reverse(L). 2396 2397partition_n(I, [E | Ts]) -> 2398 partition_n(I, Ts, element(I, E), [E], []); 2399partition_n(_I, []) -> 2400 []. 2401 2402partition_n(I, [E | Ts], K, Es, P) -> 2403 case {element(I, E), Es} of 2404 {K1, _} when K == K1 -> 2405 partition_n(I, Ts, K, [E | Es], P); 2406 {K1, [_]} -> % optimization 2407 partition_n(I, Ts, K1, [E], [Es | P]); 2408 {K1, _} -> 2409 partition_n(I, Ts, K1, [E], [reverse(Es) | P]) 2410 end; 2411partition_n(I, [], _K, Es, P) when I > 1 -> 2412 sort([reverse(Es) | P]); 2413partition_n(_I, [], _K, [_] = Es, P) -> % optimization 2414 reverse(P, [Es]); 2415partition_n(_I, [], _K, Es, P) -> 2416 reverse(P, [reverse(Es)]). 2417 2418partition3_n(I, [T | Ts], Key, Keys, L1, L2) -> 2419 case element(I, T) of 2420 K when K < Key -> 2421 partition3_n(I, Ts, Key, Keys, L1, [T | L2]); 2422 K when K == Key -> 2423 partition3_n(I, Ts, Key, Keys, [T | L1], L2); 2424 K -> 2425 partition3_n(I, K, Ts, Keys, L1, L2, T) 2426 end; 2427partition3_n(I, _Ts, _Key, _Keys, L1, L2) when I =:= 1 -> 2428 [reverse(L1) | reverse(L2)]; 2429partition3_n(_I, _Ts, _Key, _Keys, L1, L2) -> 2430 [sort(L1) | sort(L2)]. 2431 2432partition3_n(I, K, Ts, [Key | Keys], L1, L2, T) when K > Key -> 2433 partition3_n(I, K, Ts, Keys, L1, L2, T); 2434partition3_n(I, K, Ts, [Key | Keys], L1, L2, T) when K == Key -> 2435 partition3_n(I, Ts, Key, Keys, [T | L1], L2); 2436partition3_n(I, _K, Ts, [Key | Keys], L1, L2, T) -> 2437 partition3_n(I, Ts, Key, Keys, L1, [T | L2]); 2438partition3_n(I, _K, Ts, _Keys, L1, L2, T) when I =:= 1 -> 2439 [reverse(L1) | reverse(L2, [T | Ts])]; 2440partition3_n(_I, _K, Ts, _Keys, L1, L2, T) -> 2441 [sort(L1) | sort([T | Ts ++ L2])]. 2442 2443partition3([Key | Keys], Tuples) -> 2444 partition3(Tuples, Key, Keys, [], []); 2445partition3(_Keys, Tuples) -> 2446 partition3_tail(Tuples, [], []). 2447 2448partition3([{K,E} | Ts], Key, Keys, L1, L2) when K < Key -> 2449 partition3(Ts, Key, Keys, L1, [E | L2]); 2450partition3([{K,E} | Ts], Key, Keys, L1, L2) when K == Key -> 2451 partition3(Ts, Key, Keys, [E | L1], L2); 2452partition3([{K,E} | Ts], _Key, Keys, L1, L2) -> 2453 partition3(Ts, K, Keys, L1, L2, E); 2454partition3(_Ts, _Key, _Keys, L1, L2) -> 2455 [L1 | L2]. 2456 2457partition3(Ts, K, [Key | Keys], L1, L2, E) when K > Key -> 2458 partition3(Ts, K, Keys, L1, L2, E); 2459partition3(Ts, K, [Key | Keys], L1, L2, E) when K == Key -> 2460 partition3(Ts, Key, Keys, [E | L1], L2); 2461partition3(Ts, _K, [Key | Keys], L1, L2, E) -> 2462 partition3(Ts, Key, Keys, L1, [E | L2]); 2463partition3(Ts, _K, _Keys, L1, L2, E) -> 2464 partition3_tail(Ts, L1, [E | L2]). 2465 2466partition3_tail([{_K,E} | Ts], L1, L2) -> 2467 partition3_tail(Ts, L1, [E | L2]); 2468partition3_tail(_Ts, L1, L2) -> 2469 [L1 | L2]. 2470 2471replace([E | Es], F, L) -> 2472 replace(Es, F, [F(E) | L]); 2473replace(_, _F, L) -> 2474 sort(L). 2475 2476mul_relprod([T | Ts], I, R) when ?IS_SET(T) -> 2477 P = raise_element(R, I), 2478 F = relative_product1(P, T), 2479 [F | mul_relprod(Ts, I+1, R)]; 2480mul_relprod([], _I, _R) -> 2481 []. 2482 2483raise_element(R, I) -> 2484 L = sort(I =/= 1, rearr(?LIST(R), I, [])), 2485 Type = ?TYPE(R), 2486 ?SET(L, ?BINREL(?REL_TYPE(I, Type), Type)). 2487 2488rearr([E | Es], I, L) -> 2489 rearr(Es, I, [{element(I, E), E} | L]); 2490rearr([], _I, L) -> 2491 L. 2492 2493join_element(E1, E2) -> 2494 [_ | L2] = tuple_to_list(E2), 2495 list_to_tuple(tuple_to_list(E1) ++ L2). 2496 2497join_element(E1, E2, I2) -> 2498 tuple_to_list(E1) ++ join_element2(tuple_to_list(E2), 1, I2). 2499 2500join_element2([B | Bs], C, I2) when C =/= I2 -> 2501 [B | join_element2(Bs, C+1, I2)]; 2502join_element2([_ | Bs], _C, _I2) -> 2503 Bs. 2504 2505family2rel([{X,S} | F], L) -> 2506 fam2rel(F, L, X, S); 2507family2rel([], L) -> 2508 reverse(L). 2509 2510fam2rel(F, L, X, [Y | Ys]) -> 2511 fam2rel(F, [{X,Y} | L], X, Ys); 2512fam2rel(F, L, _X, _) -> 2513 family2rel(F, L). 2514 2515fam_spec([{_,S}=E | F], Fun, Type, L) -> 2516 case Fun(?SET(S, Type)) of 2517 true -> 2518 fam_spec(F, Fun, Type, [E | L]); 2519 false -> 2520 fam_spec(F, Fun, Type, L); 2521 _ -> 2522 badarg 2523 end; 2524fam_spec([], _Fun, _Type, L) -> 2525 reverse(L). 2526 2527fam_specification([{_,S}=E | F], Fun, L) -> 2528 case Fun(S) of 2529 true -> 2530 fam_specification(F, Fun, [E | L]); 2531 false -> 2532 fam_specification(F, Fun, L); 2533 _ -> 2534 badarg 2535 end; 2536fam_specification([], _Fun, L) -> 2537 reverse(L). 2538 2539un_of_fam([{_X,S} | F], L) -> 2540 un_of_fam(F, [S | L]); 2541un_of_fam([], L) -> 2542 lunion(sort(L)). 2543 2544int_of_fam([{_,S} | F]) -> 2545 int_of_fam(F, [S]); 2546int_of_fam([]) -> 2547 badarg. 2548 2549int_of_fam([{_,S} | F], L) -> 2550 int_of_fam(F, [S | L]); 2551int_of_fam([], [L | Ls]) -> 2552 lintersection(Ls, L). 2553 2554fam_un([{X,S} | F], L) -> 2555 fam_un(F, [{X, lunion(S)} | L]); 2556fam_un([], L) -> 2557 reverse(L). 2558 2559fam_int([{X, [S | Ss]} | F], L) -> 2560 fam_int(F, [{X, lintersection(Ss, S)} | L]); 2561fam_int([{_X,[]} | _F], _L) -> 2562 badarg; 2563fam_int([], L) -> 2564 reverse(L). 2565 2566fam_dom([{X,S} | F], L) -> 2567 fam_dom(F, [{X, dom(S)} | L]); 2568fam_dom([], L) -> 2569 reverse(L). 2570 2571fam_ran([{X,S} | F], L) -> 2572 fam_ran(F, [{X, ran(S, [])} | L]); 2573fam_ran([], L) -> 2574 reverse(L). 2575 2576fam_union(F1 = [{A,_AS} | _AL], [B1={B,_BS} | BL], L) when A > B -> 2577 fam_union(F1, BL, [B1 | L]); 2578fam_union([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> 2579 fam_union(AL, BL, [{A, umerge(AS, BS)} | L]); 2580fam_union([A1 | AL], F2, L) -> 2581 fam_union(AL, F2, [A1 | L]); 2582fam_union(_, F2, L) -> 2583 reverse(L, F2). 2584 2585fam_intersect(F1 = [{A,_AS} | _AL], [{B,_BS} | BL], L) when A > B -> 2586 fam_intersect(F1, BL, L); 2587fam_intersect([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> 2588 fam_intersect(AL, BL, [{A, intersection(AS, BS, [])} | L]); 2589fam_intersect([_A1 | AL], F2, L) -> 2590 fam_intersect(AL, F2, L); 2591fam_intersect(_, _, L) -> 2592 reverse(L). 2593 2594fam_difference(F1 = [{A,_AS} | _AL], [{B,_BS} | BL], L) when A > B -> 2595 fam_difference(F1, BL, L); 2596fam_difference([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> 2597 fam_difference(AL, BL, [{A, difference(AS, BS, [])} | L]); 2598fam_difference([A1 | AL], F2, L) -> 2599 fam_difference(AL, F2, [A1 | L]); 2600fam_difference(F1, _, L) -> 2601 reverse(L, F1). 2602 2603check_function([{X,_} | XL], R) -> 2604 check_function(X, XL, R); 2605check_function([], R) -> 2606 R. 2607 2608check_function(X0, [{X,_} | XL], R) when X0 /= X -> 2609 check_function(X, XL, R); 2610check_function(X0, [{X,_} | _XL], _R) when X0 == X -> 2611 bad_function; 2612check_function(_X0, [], R) -> 2613 R. 2614 2615fam_partition_n(I, [E | Ts]) -> 2616 fam_partition_n(I, Ts, element(I, E), [E], []); 2617fam_partition_n(_I, []) -> 2618 []. 2619 2620fam_partition_n(I, [E | Ts], K, Es, P) -> 2621 case {element(I, E), Es} of 2622 {K1, _} when K == K1 -> 2623 fam_partition_n(I, Ts, K, [E | Es], P); 2624 {K1, [_]} -> % optimization 2625 fam_partition_n(I, Ts, K1, [E], [{K,Es} | P]); 2626 {K1, _} -> 2627 fam_partition_n(I, Ts, K1, [E], [{K,reverse(Es)} | P]) 2628 end; 2629fam_partition_n(_I, [], K, [_] = Es, P) -> % optimization 2630 reverse(P, [{K,Es}]); 2631fam_partition_n(_I, [], K, Es, P) -> 2632 reverse(P, [{K,reverse(Es)}]). 2633 2634fam_partition([{K,Vs} | Ts], Sort) -> 2635 fam_partition(Ts, K, [Vs], [], Sort); 2636fam_partition([], _Sort) -> 2637 []. 2638 2639fam_partition([{K1,V} | Ts], K, Vs, P, S) when K1 == K -> 2640 fam_partition(Ts, K, [V | Vs], P, S); 2641fam_partition([{K1,V} | Ts], K, [_] = Vs, P, S) -> % optimization 2642 fam_partition(Ts, K1, [V], [{K, Vs} | P], S); 2643fam_partition([{K1,V} | Ts], K, Vs, P, S) -> 2644 fam_partition(Ts, K1, [V], [{K, sort(S, Vs)} | P], S); 2645fam_partition([], K, [_] = Vs, P, _S) -> % optimization 2646 [{K, Vs} | P]; 2647fam_partition([], K, Vs, P, S) -> 2648 [{K, sort(S, Vs)} | P]. 2649 2650fam_proj([{X,S} | F], Fun, Type, NType, L) -> 2651 case setfun(S, Fun, Type, NType) of 2652 {SD, ST} -> fam_proj(F, Fun, Type, ST, [{X, SD} | L]); 2653 Bad -> Bad 2654 end; 2655fam_proj([], _Fun, _Type, NType, L) -> 2656 {reverse(L), NType}. 2657 2658setfun(T, Fun, Type, NType) -> 2659 case Fun(term2set(T, Type)) of 2660 NS when ?IS_SET(NS) -> 2661 case unify_types(NType, ?SET_OF(?TYPE(NS))) of 2662 [] -> type_mismatch; 2663 NT -> {?LIST(NS), NT} 2664 end; 2665 NS when ?IS_ORDSET(NS) -> 2666 case unify_types(NType, NT = ?ORDTYPE(NS)) of 2667 [] -> type_mismatch; 2668 NT -> {?ORDDATA(NS), NT} 2669 end; 2670 _ -> 2671 badarg 2672 end. 2673 2674%% Inlined. 2675term2set(L, Type) when is_list(L) -> 2676 ?SET(L, Type); 2677term2set(T, Type) -> 2678 ?ORDSET(T, Type). 2679 2680fam2digraph(F, G) -> 2681 Fun = fun({From, ToL}) -> 2682 digraph:add_vertex(G, From), 2683 Fun2 = fun(To) -> 2684 digraph:add_vertex(G, To), 2685 case digraph:add_edge(G, From, To) of 2686 {error, {bad_edge, _}} -> 2687 throw({error, cyclic}); 2688 _ -> 2689 true 2690 end 2691 end, 2692 foreach(Fun2, ToL) 2693 end, 2694 foreach(Fun, to_external(F)), 2695 G. 2696 2697digraph_family(G) -> 2698 Vs = sort(digraph:vertices(G)), 2699 digraph_fam(Vs, Vs, G, []). 2700 2701digraph_fam([V | Vs], V0, G, L) when V /= V0 -> 2702 Ns = sort(digraph:out_neighbours(G, V)), 2703 digraph_fam(Vs, V, G, [{V,Ns} | L]); 2704digraph_fam([], _V0, _G, L) -> 2705 reverse(L). 2706 2707%% -> boolean() 2708check_fun(T, F, FunT) -> 2709 true = is_type(FunT), 2710 {NT, _MaxI} = number_tuples(T, 1), 2711 L = flatten(tuple2list(F(NT))), 2712 has_hole(L, 1). 2713 2714number_tuples(T, N) when is_tuple(T) -> 2715 {L, NN} = mapfoldl(fun number_tuples/2, N, tuple_to_list(T)), 2716 {list_to_tuple(L), NN}; 2717number_tuples(_, N) -> 2718 {N, N+1}. 2719 2720tuple2list(T) when is_tuple(T) -> 2721 map(fun tuple2list/1, tuple_to_list(T)); 2722tuple2list(C) -> 2723 [C]. 2724 2725has_hole([I | Is], I0) when I =< I0 -> has_hole(Is, erlang:max(I+1, I0)); 2726has_hole(Is, _I) -> Is =/= []. 2727 2728%% Optimization. Same as check_fun/3, but for integers. 2729check_for_sort(T, _I) when T =:= ?ANYTYPE -> 2730 empty; 2731check_for_sort(T, I) when ?IS_RELATION(T), I =< ?REL_ARITY(T), I >= 1 -> 2732 I > 1; 2733check_for_sort(_T, _I) -> 2734 error. 2735 2736inverse_substitution(L, Fun, Sort) -> 2737 %% One easily sees that the inverse of the tuples created by 2738 %% applying Fun need to be sorted iff the tuples created by Fun 2739 %% need to be sorted. 2740 sort(Sort, fun_rearr(L, Fun, [])). 2741 2742fun_rearr([E | Es], Fun, L) -> 2743 fun_rearr(Es, Fun, [{Fun(E), E} | L]); 2744fun_rearr([], _Fun, L) -> 2745 L. 2746 2747sets_to_list(Ss) -> 2748 map(fun(S) when ?IS_SET(S) -> ?LIST(S) end, Ss). 2749 2750types([], L) -> 2751 list_to_tuple(reverse(L)); 2752types([S | _Ss], _L) when ?TYPE(S) =:= ?ANYTYPE -> 2753 ?ANYTYPE; 2754types([S | Ss], L) -> 2755 types(Ss, [?TYPE(S) | L]). 2756 2757%% Inlined. 2758unify_types(T, T) -> T; 2759unify_types(Type1, Type2) -> 2760 catch unify_types1(Type1, Type2). 2761 2762unify_types1(Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> 2763 Atom; 2764unify_types1(?ANYTYPE, Type) -> 2765 Type; 2766unify_types1(Type, ?ANYTYPE) -> 2767 Type; 2768unify_types1(?SET_OF(Type1), ?SET_OF(Type2)) -> 2769 [unify_types1(Type1, Type2)]; 2770unify_types1(T1, T2) when tuple_size(T1) =:= tuple_size(T2) -> 2771 unify_typesl(tuple_size(T1), T1, T2, []); 2772unify_types1(_T1, _T2) -> 2773 throw([]). 2774 2775unify_typesl(0, _T1, _T2, L) -> 2776 list_to_tuple(L); 2777unify_typesl(N, T1, T2, L) -> 2778 T = unify_types1(?REL_TYPE(N, T1), ?REL_TYPE(N, T2)), 2779 unify_typesl(N-1, T1, T2, [T | L]). 2780 2781%% inlined. 2782match_types(T, T) -> true; 2783match_types(Type1, Type2) -> match_types1(Type1, Type2). 2784 2785match_types1(Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> 2786 true; 2787match_types1(?ANYTYPE, _) -> 2788 true; 2789match_types1(_, ?ANYTYPE) -> 2790 true; 2791match_types1(?SET_OF(Type1), ?SET_OF(Type2)) -> 2792 match_types1(Type1, Type2); 2793match_types1(T1, T2) when tuple_size(T1) =:= tuple_size(T2) -> 2794 match_typesl(tuple_size(T1), T1, T2); 2795match_types1(_T1, _T2) -> 2796 false. 2797 2798match_typesl(0, _T1, _T2) -> 2799 true; 2800match_typesl(N, T1, T2) -> 2801 case match_types1(?REL_TYPE(N, T1), ?REL_TYPE(N, T2)) of 2802 true -> match_typesl(N-1, T1, T2); 2803 false -> false 2804 end. 2805 2806sort(true, L) -> 2807 sort(L); 2808sort(false, L) -> 2809 reverse(L). 2810