Heimseite
Seitenübersicht
An/abmeldung
Anschlagbrett
Herunterladen(c) 2005-2024 XLOG Technologies AG
/**
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Dogelog is a deposited trademark of XLOG Technologies AG.
*/
:- ensure_loaded(library(compat)).
/************************************************************/
/* aggregate_all/3 and aggregate/ */
/************************************************************/
/**
* aggregate_all(A, G, S):
* The predicate aggregates A for the solutions of G and unifies the
* result with S. Works like findall/3, without witness grouping. See
* documentation for the supported aggregates functions.
*/
% aggregate_all(+Aggregate, +Goal, -Term)
aggregate_all(A, G, S) :-
sys_aggr_init(A, T, I),
findall(T, G, L),
sys_aggr_compute(L, A, I, S).
/**
* aggregate(A, G, S):
* The predicate aggregates A for the solutions of G and unifies the
* result with S. Works like bagof/3, with witness grouping. See
* documentation for the supported aggregates functions.
*/
% aggregate(+Aggregate, +Goal, -Term)
aggregate(A, G, S) :-
sys_aggr_init(A, T, I),
bagof(T, G, L),
sys_aggr_compute(L, A, I, S).
% sys_aggr_compute(+List, +Aggregate, +Term, -Term)
sys_aggr_compute([], A, I, S) :-
sys_aggr_fini(A, I, S).
sys_aggr_compute([T|L], A, I, S) :-
sys_aggr_next(A, I, T, J),
sys_aggr_compute(L, A, J, S).
% sys_aggr_init(+Aggregate, -Term, -Term)
sys_aggr_init(A, _, _) :- var(A),
throw(error(instantiation_error,_)).
sys_aggr_init(count, '', 0) :- !.
sys_aggr_init(sum(X), X, 0) :- !.
sys_aggr_init(mul(X), X, 1) :- !.
sys_aggr_init(min(X), X, sup) :- !.
sys_aggr_init(max(X), X, inf) :- !.
sys_aggr_init(bag(X), X, []) :- !.
sys_aggr_init(set(X), X, []) :- !.
sys_aggr_init((F,G), (X,Y), (C,D)) :- !,
sys_aggr_init(F, X, C),
sys_aggr_init(G, Y, D).
sys_aggr_init(A, _) :-
throw(error(type_error(aggregate,A),_)).
% sys_aggr_next(+Aggregate, +Term, +Term, -Term)
sys_aggr_next(count, A, '', C) :- C is A+1.
sys_aggr_next(sum(_), A, B, C) :- C is A+B.
sys_aggr_next(mul(_), A, B, C) :- C is A*B.
sys_aggr_next(min(_), A, B, C) :- sys_min(A, B, C).
sys_aggr_next(max(_), A, B, C) :- sys_max(A, B, C).
sys_aggr_next(bag(_), A, B, [B|A]).
sys_aggr_next(set(_), A, B, [B|A]).
sys_aggr_next((F,G), (A,B), (X,Y), (C,D)) :-
sys_aggr_next(F, A, X, C),
sys_aggr_next(G, B, Y, D).
% sys_aggr_fini(+Aggregate, +Term, -Term)
sys_aggr_fini(count, A, A).
sys_aggr_fini(sum(_), A, A).
sys_aggr_fini(mul(_), A, A).
sys_aggr_fini(min(_), A, A).
sys_aggr_fini(max(_), A, A).
sys_aggr_fini(bag(_), A, B) :- reverse(A, B).
sys_aggr_fini(set(_), A, B) :- reverse(A, H), sort(H, B).
sys_aggr_fini((F,G), (X,Y), (C,D)) :-
sys_aggr_fini(F, X, C),
sys_aggr_fini(G, Y, D).
% sys_min(+ExtNumber, +ExtNumber, -ExtNumber)
sys_min(sup, X, R) :- !, R = X.
sys_min(X, sup, R) :- !, R = X.
sys_min(inf, _, R) :- !, R = inf.
sys_min(_, inf, R) :- !, R = inf.
sys_min(X, Y, R) :- R is min(X, Y).
% sys_max(+ExtNumber, +ExtNumber, -ExtNumber)
sys_max(inf, X, R) :- !, R = X.
sys_max(X, inf, R) :- !, R = X.
sys_max(sup, _, R) :- !, R = sup.
sys_max(_, sup, R) :- !, R = sup.
sys_max(X, Y, R) :- R is max(X, Y).
/************************************************************/
/* bagof/3 and setof/3 */
/************************************************************/
/**
* bagof(T, X1^…^Xn^G, L): [ISO 8.10.2]
* The predicate determines all the solutions to the goal G,
* whereby collecting copies of the template T and the
* witness. The predicate then repeatedly succeeds for
* the witness and the list of associated templates.
*/
% bagof(+Term, +Goal, -List)
bagof(T, G, L) :-
sys_globals_kernel(T^G, W, H),
findall(W-T, H, J),
sys_same_vars(J, _),
keysort(J, K),
sys_enum_runs(K, W, L).
/**
* setof(T, X1^…^Xn^G, L): [ISO 8.10.3]
* The predicate determines all the solutions to the goal G,
* whereby collecting copies of the template T and the
* witness. The predicate then repeatedly succeeds for
* the witness and the set of associated templates.
*/
% setof(+Term, +Goal, -List)
setof(T, G, L) :-
sys_globals_kernel(T^G, W, H),
findall(W-T, H, J),
sys_same_vars(J, _),
sort(J, K),
sys_enum_runs(K, W, L).
% sys_same_vars(+Pairs, +List)
sys_same_vars([K-_|L], V) :-
term_variables(K, V, _),
sys_same_vars(L, V).
sys_same_vars([], _).
% sys_enum_runs(+Pairs, +Term, -List)
sys_enum_runs([K-V|L], W, Q) :-
sys_key_run(L, K, R, H),
(K = W, Q = [V|R], (H = [], !; true); sys_enum_runs(H, W, Q)).
% sys_key_run(+Pairs, +Term, -List, -Pairs)
sys_key_run([K-V|L], J, [V|R], H) :- K == J, !,
sys_key_run(L, J, R, H).
sys_key_run(L, _, [], L).
/********************************************************************/
/* Helpers */
/********************************************************************/
% sys_goal_split(+Goal, -List, -Goal)
sys_globals_kernel(G, W, H) :-
sys_goal_split(G, I, H),
term_variables(H, A),
term_variables(I, B),
sys_var_subtract(A, B, W).
% sys_goal_split(+Goal, -List, -Goal)
sys_goal_split(G, [], G) :- var(G), !.
sys_goal_split(V^G, [V|L], H) :- !,
sys_goal_split(G, L, H).
sys_goal_split(G, [], G).
% sys_var_subtract(+List, +List, -List)
sys_var_subtract([X|L], R, T) :-
member(Y, R), Y == X, !,
sys_var_subtract(L, R, T).
sys_var_subtract([X|L], R, [X|S]) :-
sys_var_subtract(L, R, S).
sys_var_subtract([], _, []).