sofs.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 2,315 行 · 第 1/5 页

%%% Functions on binary relations only.
%%% 

rel2fam(R) ->
    relation_to_family(R).

%% Inlined.
relation_to_family(R) when ?IS_SET(R) ->
    case ?TYPE(R) of
        ?BINREL(DT, RT) -> 
            ?SET(rel2family(?LIST(R)), ?FAMILY(DT, RT));
        ?ANYTYPE -> R;
        _Else    -> erlang:fault(badarg, [R])
    end.

domain(R) when ?IS_SET(R) ->
    case ?TYPE(R) of
        ?BINREL(DT, _)  -> ?SET(dom(?LIST(R)), DT);
        ?ANYTYPE -> R;
        _Else    -> erlang:fault(badarg, [R])
    end.

range(R) when ?IS_SET(R) ->
    case ?TYPE(R) of
        ?BINREL(_, RT)  -> ?SET(ran(?LIST(R),  []), RT);
        ?ANYTYPE -> R;
        _ -> erlang:fault(badarg, [R])
    end.

%% In "Introduction to LOGIC", Suppes defines the field of a binary
%% relation to be the union of the domain and the range (or
%% counterdomain).
field(R) ->
    union(domain(R), range(R)).

relative_product(RT) when is_tuple(RT) ->
    case relprod_n(RT, foo, false, false) of
        {error, Reason} -> 
            erlang:fault(Reason, [RT]);
        Reply ->
            Reply
    end.

relative_product(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) ->
    relative_product1(converse(R1), R2);
relative_product(RT, R) when is_tuple(RT), ?IS_SET(R) ->
    EmptyR = case ?TYPE(R) of
                 ?BINREL(_, _) -> ?LIST(R) =:= [];
                 ?ANYTYPE -> true;
                 _ -> erlang:fault(badarg, [RT, R])
             end,
    case relprod_n(RT, R, EmptyR, true) of
        {error, Reason} -> 
            erlang:fault(Reason, [RT, R]);
        Reply ->
            Reply
    end.

relative_product1(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) ->
    {DTR1, RTR1} = case ?TYPE(R1) of
                     ?BINREL(_, _) = R1T -> R1T;
                     ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
                     _ -> erlang:fault(badarg, [R1, R2])
                 end,
    {DTR2, RTR2} = case ?TYPE(R2) of
                     ?BINREL(_, _) = R2T -> R2T;
                     ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
                     _ -> erlang:fault(badarg, [R1, R2])
                 end,
    case match_types(DTR1, DTR2) of
        true when DTR1 =:= ?ANYTYPE -> R1;
        true when DTR2 =:= ?ANYTYPE -> R2;
        true -> ?SET(relprod(?LIST(R1), ?LIST(R2)), ?BINREL(RTR1, RTR2));
        false -> erlang:fault(type_mismatch, [R1, R2])
    end.

converse(R) when ?IS_SET(R) ->
    case ?TYPE(R) of
        ?BINREL(DT, RT) -> ?SET(converse(?LIST(R), []), ?BINREL(RT, DT));
        ?ANYTYPE -> R;
        _ -> erlang:fault(badarg, [R])
    end.
    
image(R, S) when ?IS_SET(R), ?IS_SET(S) ->
    case ?TYPE(R) of
        ?BINREL(DT, RT) -> 
	    case match_types(DT, ?TYPE(S)) of
		true ->
		    ?SET(usort(restrict(?LIST(S), ?LIST(R))), RT);
		false ->
		    erlang:fault(type_mismatch, [R, S])
	    end;
        ?ANYTYPE -> R;
        _ -> erlang:fault(badarg, [R, S])
    end.

inverse_image(R, S) when ?IS_SET(R), ?IS_SET(S) ->
    case ?TYPE(R) of
        ?BINREL(DT, RT) -> 
	    case match_types(RT, ?TYPE(S)) of
		true ->
		    NL = restrict(?LIST(S), converse(?LIST(R), [])),
		    ?SET(usort(NL), DT);
		false ->
		    erlang:fault(type_mismatch, [R, S])
	    end;
        ?ANYTYPE -> R;
        _ -> erlang:fault(badarg, [R, S])
    end.

strict_relation(R) when ?IS_SET(R) ->
    case ?TYPE(R) of
        Type = ?BINREL(_, _) -> 
            ?SET(strict(?LIST(R), []), Type);
        ?ANYTYPE -> R;
        _ -> erlang:fault(badarg, [R])
    end.
    
weak_relation(R) when ?IS_SET(R) ->
    case ?TYPE(R) of
        ?BINREL(DT, RT) -> 
            case unify_types(DT, RT) of
                [] ->
                    erlang:fault(badarg, [R]);
                Type ->
                    ?SET(weak(?LIST(R)), ?BINREL(Type, Type))
            end;
        ?ANYTYPE -> R;
        _ -> erlang:fault(badarg, [R])
    end.
    
extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) ->
    case {?TYPE(R), ?TYPE(S), is_sofs_set(E)} of
	{T=?BINREL(DT, RT), ST, true} ->
	    case match_types(DT, ST) and match_types(RT, type(E)) of
		false ->
		    erlang:fault(type_mismatch, [R, S, E]);
		true ->
		    RL = ?LIST(R),
		    case extc([], ?LIST(S), to_external(E), RL) of
			[] ->
			    R;
			L ->
			    ?SET(merge(RL, reverse(L)), T)
		    end
	    end;
	{?ANYTYPE, ?ANYTYPE, true} ->
	    R;
	{?ANYTYPE, ST, true} ->
	    case type(E) of
		?SET_OF(?ANYTYPE) ->
		    R;
		ET ->
		    ?SET([], ?BINREL(ST, ET))
	    end;
	{_, _, true} ->
	    erlang:fault(badarg, [R, S, E])
    end.

is_a_function(R) when ?IS_SET(R) ->
    case ?TYPE(R) of
        ?BINREL(_, _) -> 
            case ?LIST(R) of
                [] -> true;
                [{V,_} | Es] -> is_a_func(Es, V)
            end;
        ?ANYTYPE -> true;
        _ -> erlang:fault(badarg, [R])
    end.

restriction(Relation, Set) ->
    restriction(1, Relation, Set).

drestriction(Relation, Set) ->
    drestriction(1, Relation, Set).

%%% 
%%% Functions on functions only.
%%% 

composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) ->
    ?BINREL(DTF1, RTF1) = case ?TYPE(Fn1)of
			      ?BINREL(_, _) = F1T -> F1T;
			      ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
			      _ -> erlang:fault(badarg, [Fn1, Fn2])
			  end,
    ?BINREL(DTF2, RTF2) = case ?TYPE(Fn2) of
			      ?BINREL(_, _) = F2T -> F2T;
			      ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
			      _ -> erlang:fault(badarg, [Fn1, Fn2])
			  end,
    case match_types(RTF1, DTF2) of
        true when DTF1 =:= ?ANYTYPE -> Fn1;
        true when DTF2 =:= ?ANYTYPE -> Fn2;
        true -> 
	    case comp(?LIST(Fn1), ?LIST(Fn2)) of
		SL when is_list(SL) ->
		    ?SET(sort(SL), ?BINREL(DTF1, RTF2));
		Bad ->
		    erlang:fault(Bad, [Fn1, Fn2])
	    end;
        false -> erlang:fault(type_mismatch, [Fn1, Fn2])
    end.

inverse(Fn) when ?IS_SET(Fn) ->
    case ?TYPE(Fn) of
        ?BINREL(DT, RT) -> 
	    case inverse1(?LIST(Fn)) of
		SL when is_list(SL) ->
		    ?SET(SL, ?BINREL(RT, DT));
		Bad ->
		    erlang:fault(Bad, [Fn])
	    end;
        ?ANYTYPE -> Fn;
        _ -> erlang:fault(badarg, [Fn])
    end.
    
%%% 
%%% Functions on relations (binary or other).
%%% 

%% Equivalent to range(restriction(inverse(substitution(Fun, S1)), S2)).
restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
    RT = ?TYPE(R),
    ST = ?TYPE(S),
    case check_for_sort(RT, I) of
	empty ->
	    R;
	error ->
	    erlang:fault(badarg, [I, R, S]);
	Sort ->
	    RL = ?LIST(R),
	    case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
		{true, _SL} when RL =:= [] ->
		    R;
		{true, []} ->
                    ?SET([], RT);
		{true, [E | Es]} when Sort =:= false -> % I =:= 1
		    ?SET(reverse(restrict_n(I, RL, E, Es, [])), RT);
		{true, [E | Es]} ->
		    ?SET(sort(restrict_n(I, keysort(I, RL), E, Es, [])), RT);
		{false, _SL} ->
		    erlang:fault(type_mismatch, [I, R, S])
	    end
    end;
restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
    Type1 = ?TYPE(S1),
    Type2 = ?TYPE(S2),
    SL1 = ?LIST(S1),
    case external_fun(SetFun) of
	false when Type2 =:= ?ANYTYPE ->
	    S2;
	false ->
	    case subst(SL1, SetFun, element_type(Type1)) of
		{NSL, NewType} -> % NewType can be ?ANYTYPE
		    case match_types(NewType, Type2) of
			true ->
			    NL = sort(restrict(?LIST(S2), converse(NSL, []))),
			    ?SET(NL, Type1);
			false ->
			    erlang:fault(type_mismatch, [SetFun, S1, S2])
		    end;
		Bad ->
		    erlang:fault(Bad, [SetFun, S1, S2])
	    end;
	_ when Type1 =:= ?ANYTYPE ->
	    S1;
	_XFun when ?IS_SET_OF(Type1) ->
            erlang:fault(badarg, [SetFun, S1, S2]);
	XFun ->
	    FunT = XFun(Type1),
	    case catch check_fun(Type1, XFun, FunT) of
		{'EXIT', _} ->
		    erlang:fault(badarg, [SetFun, S1, S2]);
		Sort ->
		    case match_types(FunT, Type2) of
			true ->
			    R1 = inverse_substitution(SL1, XFun, Sort),
			    ?SET(sort(Sort, restrict(?LIST(S2), R1)), Type1);
			false ->
			    erlang:fault(type_mismatch, [SetFun, S1, S2])
		    end
	    end
    end.

drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
    RT = ?TYPE(R),
    ST = ?TYPE(S),
    case check_for_sort(RT, I) of
	empty ->
	    R;
	error ->
	    erlang:fault(badarg, [I, R, S]);
	Sort ->
	    RL = ?LIST(R),
	    case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
		{true, []} ->
		    R;
		{true, _SL} when RL =:= [] ->
		    R;
		{true, [E | Es]} when Sort =:= false -> % I =:= 1
		    ?SET(diff_restrict_n(I, RL, E, Es, []), RT);
		{true, [E | Es]} ->
		    ?SET(diff_restrict_n(I, keysort(I, RL), E, Es, []), RT);
		{false, _SL} ->
		    erlang:fault(type_mismatch, [I, R, S])
	    end
    end;
drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
    Type1 = ?TYPE(S1),
    Type2 = ?TYPE(S2),
    SL1 = ?LIST(S1),
    case external_fun(SetFun) of
	false when Type2 =:= ?ANYTYPE ->
	    S1;
	false ->
	    case subst(SL1, SetFun, element_type(Type1)) of
		{NSL, NewType} -> % NewType can be ?ANYTYPE
		    case match_types(NewType, Type2) of
			true ->
			    SL2 = ?LIST(S2),
			    NL = sort(diff_restrict(SL2, converse(NSL, []))),
			    ?SET(NL, Type1);
			false ->
			    erlang:fault(type_mismatch, [SetFun, S1, S2])
		    end;
		Bad ->
		    erlang:fault(Bad, [SetFun, S1, S2])
	    end;
	_ when Type1 =:= ?ANYTYPE ->
	    S1;
	_XFun when ?IS_SET_OF(Type1) ->
            erlang:fault(badarg, [SetFun, S1, S2]);
	XFun ->
	    FunT = XFun(Type1),
	    case catch check_fun(Type1, XFun, FunT) of
		{'EXIT', _} ->
		    erlang:fault(badarg, [SetFun, S1, S2]);
		Sort ->
		    case match_types(FunT, Type2) of
			true ->
			    R1 = inverse_substitution(SL1, XFun, Sort),
			    SL2 = ?LIST(S2),
			    ?SET(sort(Sort, diff_restrict(SL2, R1)), Type1);
			false ->
			    erlang:fault(type_mismatch, [SetFun, S1, S2])
		    end
	    end
    end.

projection(I, Set) when is_integer(I), ?IS_SET(Set) ->
    Type = ?TYPE(Set),
    case check_for_sort(Type, I) of
        empty ->
            Set;
        error ->
            erlang:fault(badarg, [I, Set]);
	_ when I =:= 1 ->
	    ?SET(projection1(?LIST(Set)), ?REL_TYPE(I, Type));
        _ ->
	    ?SET(projection_n(?LIST(Set), I, []), ?REL_TYPE(I, Type))
    end;
projection(Fun, Set) ->
    range(substitution(Fun, Set)).

substitution(I, Set) when is_integer(I), ?IS_SET(Set) ->
    Type = ?TYPE(Set),
    case check_for_sort(Type, I) of
	empty ->
	    Set;
	error ->
	    erlang:fault(badarg, [I, Set]);
	_Sort ->
	    NType = ?REL_TYPE(I, Type),
	    NSL = substitute_element(?LIST(Set), I, []),
	    ?SET(NSL, ?BINREL(Type, NType))
    end;
substitution(SetFun, Set) when ?IS_SET(Set) ->
    Type = ?TYPE(Set),
    L = ?LIST(Set),
    case external_fun(SetFun) of
	false when L =/= [] ->
	    case subst(L, SetFun, element_type(Type)) of
		{SL, NewType} ->
		    ?SET(reverse(SL), ?BINREL(Type, NewType));
		Bad ->
		    erlang:fault(Bad, [SetFun, Set])
	    end;
	false ->
	    empty_set();
	_ when Type =:= ?ANYTYPE ->
	    empty_set();
	_XFun when ?IS_SET_OF(Type) ->
            erlang:fault(badarg, [SetFun, Set]);
	XFun ->
	    FunT = XFun(Type),
	    case catch check_fun(Type, XFun, FunT) of
		{'EXIT', _} ->
		    erlang:fault(badarg, [SetFun, Set]);
		_Sort ->
		    SL = substitute(L, XFun, []),
		    ?SET(SL, ?BINREL(Type, FunT))
	    end
    end.

partition(Sets) ->
    F1 = relation_to_family(canonical_relation(Sets)),
    F2 = relation_to_family(converse(F1)),
    range(F2).

partition(I, Set) when is_integer(I), ?IS_SET(Set) ->
    Type = ?TYPE(Set),
    case check_for_sort(Type, I) of
        empty ->
            Set;
        error ->
            erlang:fault(badarg, [I, Set]);
	false -> % I =:= 1
	    ?SET(partition_n(I, ?LIST(Set)), ?SET_OF(Type));
        true ->
	    ?SET(partition_n(I, keysort(I, ?LIST(Set))), ?SET_OF(Type))
    end;
partition(Fun, Set) ->
    range(partition_family(Fun, Set)).

partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
    RT = ?TYPE(R),
    ST = ?TYPE(S),
    case check_for_sort(RT, I) of
	empty ->
	    {R, R};
	error ->
	    erlang:fault(badarg, [I, R, S]);
	Sort ->
	    RL = ?LIST(R),
	    case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
		{true, _SL} when RL =:= [] ->
		    {R, R};
		{true, []} ->
		    {?SET([], RT), R};
		{true, [E | Es]} when Sort =:= false -> % I =:= 1
		    [L1 | L2] = partition3_n(I, RL, E, Es, [], []),
		    {?SET(L1, RT), ?SET(L2, RT)};
		{true, [E | Es]} ->
		    [L1 | L2] = partition3_n(I, keysort(I,RL), E, Es, [], []),
		    {?SET(L1, RT), ?SET(L2, RT)};
		{false, _SL} ->
		    erlang:fault(type_mismatch, [I, R, S])
	    end
    end;
partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
    Type1 = ?TYPE(S1),
    Type2 = ?TYPE(S2),
    SL1 = ?LIST(S1),
    case external_fun(SetFun) of
	false when Type2 =:= ?ANYTYPE ->
	    {S2, S1};
	false ->
	    case subst(SL1, SetFun, element_type(Type1)) of
		{NSL, NewType} -> % NewType can be ?ANYTYPE
		    case match_types(NewType, Type2) of
			true ->
			    R1 = converse(NSL, []),