1011 lines
29 KiB
Prolog
1011 lines
29 KiB
Prolog
/*
|
|
|
|
EMBLEM and SLIPCASE
|
|
|
|
Copyright (c) 2011, Fabrizio Riguzzi and Elena Bellodi
|
|
|
|
*/
|
|
:-use_module(library(lists)).
|
|
:-load_foreign_files(['bddem'],[],init_my_predicates).
|
|
|
|
:-dynamic p/2,rule_n/1,setting/2.
|
|
|
|
|
|
rule_n(0).
|
|
|
|
setting(epsilon_parsing, 1e-10).
|
|
setting(tabling, off).
|
|
/* on, off */
|
|
|
|
setting(bagof,false).
|
|
/* values: false, intermediate, all, extra */
|
|
|
|
setting(compiling,off).
|
|
|
|
:-yap_flag(unknown,fail).
|
|
|
|
setting(depth_bound,false). %if true, it limits the derivation of the example to the value of 'depth'
|
|
setting(depth,2).
|
|
setting(single_var,false). %false:1 variable for every grounding of a rule; true: 1 variable for rule (even if a rule has more groundings),simpler.
|
|
|
|
:- yap_flag(single_var_warnings, on).
|
|
|
|
|
|
load(FileIn,C1,R):-
|
|
open(FileIn,read,SI),
|
|
read_clauses_dir(SI,C),
|
|
close(SI),
|
|
process_clauses(C,[],C1,[],R).
|
|
|
|
|
|
add_inter_cl(CL):-
|
|
%findall(A,(input(A);output(A)),L),
|
|
findall(A,(input(A)),L),
|
|
gen_cl(L,CL).
|
|
|
|
|
|
gen_cl([],[]).
|
|
|
|
gen_cl([H/A|T],[C|T1]):-
|
|
functor(F,H,A),
|
|
add_mod_arg(F,Module,F1),
|
|
add_bdd_arg(F,BDD,Module,F2),
|
|
C=(F2:-(F1,one(BDD))),
|
|
gen_cl(T,T1).
|
|
|
|
|
|
assert_all([]).
|
|
|
|
assert_all([H|T]):-
|
|
assert(H),
|
|
assert_all(T).
|
|
|
|
|
|
retract_all([]):-!.
|
|
|
|
retract_all([H|T]):-
|
|
retract(H),
|
|
retract_all(T).
|
|
|
|
|
|
read_clauses_dir(S,[Cl|Out]):-
|
|
read_term(S,Cl,[]),
|
|
(Cl=end_of_file->
|
|
Out=[]
|
|
;
|
|
read_clauses_dir(S,Out)
|
|
).
|
|
|
|
|
|
process_clauses([],C,C,R,R):-!.
|
|
|
|
process_clauses([end_of_file],C,C,R,R):-!.
|
|
|
|
process_clauses([H|T],C0,C1,R0,R1):-
|
|
(term_expansion(H,H1)->
|
|
true
|
|
;
|
|
H1=(H,[])
|
|
),
|
|
(H1=([_|_],R)->
|
|
H1=(List,R),
|
|
append(C0,List,C2),
|
|
append(R0,R,R2)
|
|
;
|
|
(H1=([],_R)->
|
|
C2=C0,
|
|
R2=R0
|
|
;
|
|
H1=(H2,R),
|
|
append(C0,[H2],C2),
|
|
append(R0,R,R2)
|
|
)
|
|
),
|
|
process_clauses(T,C2,C1,R2,R1).
|
|
|
|
|
|
get_next_rule_number(R):-
|
|
retract(rule_n(R)),
|
|
R1 is R+1,
|
|
assert(rule_n(R1)).
|
|
|
|
|
|
get_node(\+ Goal,BDD):-
|
|
setting(depth_bound,true),!,
|
|
setting(depth,DB),
|
|
retractall(v(_,_,_)),
|
|
add_bdd_arg_db(Goal,BDD,DB,Goal1),
|
|
(bagof(BDD,Goal1,L)->
|
|
or_list(L,B)
|
|
;
|
|
zero(B)
|
|
),
|
|
bdd_not(B,BDD).
|
|
|
|
get_node(\+ Goal,BDD):-!,
|
|
retractall(v(_,_,_)),
|
|
add_bdd_arg(Goal,BDD,Goal1),
|
|
(bagof(BDD,Goal1,L)->
|
|
or_list(L,B)
|
|
;
|
|
zero(B)
|
|
),
|
|
bdd_not(B,BDD).
|
|
|
|
get_node(Goal,B):-
|
|
setting(depth_bound,true),!,
|
|
setting(depth,DB),
|
|
retractall(v(_,_,_)),
|
|
add_bdd_arg_db(Goal,BDD,DB,Goal1),%DB=depth bound
|
|
(bagof(BDD,Goal1,L)->
|
|
or_list(L,B)
|
|
;
|
|
zero(B)
|
|
).
|
|
|
|
get_node(Goal,B):- %with DB=false
|
|
retractall(v(_,_,_)),
|
|
add_bdd_arg(Goal,BDD,Goal1),
|
|
(bagof(BDD,Goal1,L)->
|
|
or_list(L,B)
|
|
;
|
|
zero(B)
|
|
).
|
|
|
|
|
|
s(Goal,P,CPUTime1,0,WallTime1,0):-
|
|
statistics(cputime,[_,_]),
|
|
statistics(walltime,[_,_]),
|
|
init,
|
|
retractall(v(_,_,_)),
|
|
abolish_all_tables,
|
|
add_bdd_arg(Goal,BDD,Goal1),
|
|
(bagof(BDD,Goal1,L)->
|
|
or_list(L,B),
|
|
ret_prob(B,P)
|
|
;
|
|
P=0.0
|
|
),
|
|
end,
|
|
statistics(cputime,[_,CT1]),
|
|
CPUTime1 is CT1/1000,
|
|
statistics(walltime,[_,WT1]),
|
|
WallTime1 is WT1/1000.
|
|
|
|
|
|
get_var_n(R,S,Probs,V):-
|
|
(v(R,S,V)->
|
|
true
|
|
;
|
|
length(Probs,L),
|
|
add_var(L,Probs,R,V),
|
|
assert(v(R,S,V))
|
|
).
|
|
|
|
|
|
generate_rules_fact([],_VC,_R,_Probs,_N,[],_Module).
|
|
|
|
generate_rules_fact([Head:_P1,'':_P2],VC,R,Probs,N,[Clause],Module):-!,
|
|
add_bdd_arg(Head,BDD,Module,Head1),
|
|
Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))).
|
|
|
|
generate_rules_fact([Head:_P|T],VC,R,Probs,N,[Clause|Clauses],Module):-
|
|
add_bdd_arg(Head,BDD,Module,Head1),
|
|
Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))),
|
|
N1 is N+1,
|
|
generate_rules_fact(T,VC,R,Probs,N1,Clauses,Module).
|
|
|
|
|
|
generate_rules_fact_db([],_VC,_R,_Probs,_N,[],_Module).
|
|
|
|
generate_rules_fact_db([Head:_P1,'':_P2],VC,R,Probs,N,[Clause],Module):-!,
|
|
add_bdd_arg_db(Head,BDD,_DB,Module,Head1),
|
|
Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))).
|
|
|
|
generate_rules_fact_db([Head:_P|T],VC,R,Probs,N,[Clause|Clauses],Module):-
|
|
add_bdd_arg_db(Head,BDD,_DB,Module,Head1),
|
|
Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))),
|
|
N1 is N+1,
|
|
generate_rules_fact_db(T,VC,R,Probs,N1,Clauses,Module).
|
|
|
|
|
|
generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module):-
|
|
add_bdd_arg(Head,BDD,Module,Head1),
|
|
Clause=(Head1:-(Body,get_var_n(R,VC,Probs,V),equality(V,N,B),and(BDDAnd,B,BDD))).
|
|
|
|
|
|
generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module):-
|
|
add_bdd_arg_db(Head,BDD,DBH,Module,Head1),
|
|
Clause=(Head1:-(DBH>=1,DB is DBH-1,Body,get_var_n(R,VC,Probs,V),equality(V,N,B),and(BDDAnd,B,BDD))).
|
|
|
|
|
|
generate_rules([],_Body,_VC,_R,_Probs,_BDDAnd,_N,[],_Module).
|
|
|
|
generate_rules([Head:_P1,'':_P2],Body,VC,R,Probs,BDDAnd,N,[Clause],Module):-!,
|
|
generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module).
|
|
|
|
generate_rules([Head:_P|T],Body,VC,R,Probs,BDDAnd,N,[Clause|Clauses],Module):-
|
|
generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module),
|
|
N1 is N+1,
|
|
generate_rules(T,Body,VC,R,Probs,BDDAnd,N1,Clauses,Module).
|
|
|
|
|
|
generate_rules_db([],_Body,_VC,_R,_Probs,_DB,_BDDAnd,_N,[],_Module):-!.
|
|
|
|
generate_rules_db([Head:_P1,'':_P2],Body,VC,R,Probs,DB,BDDAnd,N,[Clause],Module):-!,
|
|
generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module).
|
|
|
|
generate_rules_db([Head:_P|T],Body,VC,R,Probs,DB,BDDAnd,N,[Clause|Clauses],Module):-
|
|
generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module),!,%agg.cut
|
|
N1 is N+1,
|
|
generate_rules_db(T,Body,VC,R,Probs,DB,BDDAnd,N1,Clauses,Module).
|
|
|
|
|
|
process_body_database([],[],_Module).
|
|
|
|
process_body_database([H|T],[H1|T1],Module):-
|
|
add_mod_arg(H,H1,Module),
|
|
process_body_database(T,T1,Module).
|
|
|
|
|
|
process_body_db([],BDD,BDD,_DB,Vars,Vars,[],_Module):-!.
|
|
|
|
process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):-
|
|
builtin(H),!,
|
|
process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):-
|
|
db(H),!,
|
|
process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[
|
|
(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))),
|
|
and(BDD,BDDN,BDD2)
|
|
|Rest],Module):-
|
|
given(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
add_bdd_arg_db(H,BDDH,DB,Module,H2),
|
|
process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[
|
|
neg(H1)|Rest],Module):-
|
|
given_cw(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_db([\+ H|T],BDD,BDD1,DB,Vars,[BDDH,BDDN,L,BDDL,BDD2|Vars1],
|
|
[(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)),
|
|
and(BDD,BDDN,BDD2)|Rest],Module):-!,
|
|
add_bdd_arg_db(H,BDDH,DB,Module,H1),
|
|
process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):-
|
|
builtin(H),!,
|
|
process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):-
|
|
db(H),!,
|
|
process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,
|
|
[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):-
|
|
given(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
add_bdd_arg_db(H,BDDH,DB,Module,H2),
|
|
process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,
|
|
[H1|Rest],Module):-
|
|
given_cw(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_db([H|T],BDD,BDD1,DB,Vars,[BDDH,BDD2|Vars1],
|
|
[H1,and(BDD,BDDH,BDD2)|Rest],Module):-!, %agg. cut
|
|
add_bdd_arg_db(H,BDDH,DB,Module,H1),
|
|
process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
|
|
process_body_def_db([],BDD,BDD,_DB,Vars,Vars,[],_Module).
|
|
|
|
process_body_def_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):-
|
|
builtin(H),!,
|
|
process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):-
|
|
db(H),!,
|
|
process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def_db([\+H|T],BDD,BDD1,DB,Vars,Vars1,
|
|
[(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))),
|
|
and(BDD,BDDN,BDD2)|Rest],
|
|
Module):-
|
|
given(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
add_bdd_arg_db(H,BDDH,DB,Module,H2),
|
|
process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def_db([\+H|T],BDD,BDD1,DB,Vars,Vars1,
|
|
[neg(H1)|Rest],
|
|
Module):-
|
|
given_cw(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def_db([\+H|T],BDD,BDD1,DB,Vars,[BDD,BDDH,L,BDDL,BDDN|Vars1],
|
|
[(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)),
|
|
and(BDD,BDDN,BDD2)|Rest],Module):-!,
|
|
add_bdd_arg_db(H,BDDH,DB,Module,H1),
|
|
process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):-
|
|
builtin(H),!,
|
|
process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):-
|
|
db(H),!,
|
|
process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):-
|
|
given(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
add_bdd_arg_db(H,BDDH,DB,Module,H2),
|
|
process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H1|Rest],Module):-
|
|
given_cw(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def_db([H|T],BDD,BDD1,DB,Vars,[BDD,BDDH|Vars1],[H1,and(BDD,BDDH,BDD2)|Rest],Module):-!,
|
|
add_bdd_arg_db(H,BDDH,DB,Module,H1),
|
|
process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
|
|
|
|
|
|
|
|
|
|
process_body_def([],BDD,BDD,Vars,Vars,[],_Module).
|
|
|
|
process_body_def([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):-
|
|
builtin(H),!,
|
|
process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):-
|
|
db(H),!,
|
|
process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def([\+H|T],BDD,BDD1,Vars,Vars1,
|
|
[(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))),
|
|
and(BDD,BDDN,BDD2)|Rest],
|
|
Module):-
|
|
given(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
add_bdd_arg(H,BDDH,Module,H2),
|
|
process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def([\+H|T],BDD,BDD1,Vars,Vars1,
|
|
[neg(H1)|Rest],
|
|
Module):-
|
|
given_cw(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def([\+H|T],BDD,BDD1,Vars,[BDD,BDDH,L,BDDL,BDDN|Vars1],
|
|
[(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)),
|
|
and(BDD,BDDN,BDD2)|Rest],Module):-!,
|
|
add_bdd_arg(H,BDDH,Module,H1),
|
|
process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):-
|
|
builtin(H),!,
|
|
process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):-
|
|
db(H),!,
|
|
process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def([H|T],BDD,BDD1,Vars,Vars1,[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):-
|
|
given(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
add_bdd_arg(H,BDDH,Module,H2),
|
|
process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def([H|T],BDD,BDD1,Vars,Vars1,[H1|Rest],Module):-
|
|
given_cw(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body_def([H|T],BDD,BDD1,Vars,[BDD,BDDH|Vars1],[H1,and(BDD,BDDH,BDD2)|Rest],Module):-!,
|
|
add_bdd_arg(H,BDDH,Module,H1),
|
|
process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
|
|
process_body([],BDD,BDD,Vars,Vars,[],_Module).
|
|
|
|
process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):-
|
|
builtin(H),!,
|
|
process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):-
|
|
db(H),!,
|
|
process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[
|
|
(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))),
|
|
and(BDD,BDDN,BDD2)
|
|
|Rest],Module):-
|
|
given(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
add_bdd_arg(H,BDDH,Module,H2),
|
|
process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[
|
|
neg(H1)|Rest],Module):-
|
|
given_cw(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body([\+ H|T],BDD,BDD1,Vars,[BDDH,BDDN,L,BDDL,BDD2|Vars1],
|
|
[(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)),
|
|
and(BDD,BDDN,BDD2)|Rest],Module):-!,
|
|
add_bdd_arg(H,BDDH,Module,H1),
|
|
process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):-
|
|
builtin(H),!,
|
|
process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):-
|
|
db(H),!,
|
|
process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body([H|T],BDD,BDD1,Vars,Vars1,
|
|
[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):-
|
|
given(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
add_bdd_arg(H,BDDH,Module,H2),
|
|
process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body([H|T],BDD,BDD1,Vars,Vars1,
|
|
[H1|Rest],Module):-
|
|
given_cw(H),!,
|
|
add_mod_arg(H,Module,H1),
|
|
process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body([H|T],BDD,BDD1,Vars,Vars1,[H1|Rest],Module):-
|
|
add_mod_arg(H,Module,H1),
|
|
db(H1),!,
|
|
process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
process_body([H|T],BDD,BDD1,Vars,[BDDH,BDD2|Vars1],
|
|
[H1,and(BDD,BDDH,BDD2)|Rest],Module):-
|
|
add_bdd_arg(H,BDDH,Module,H1),
|
|
process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
|
|
|
|
|
|
given(H):-
|
|
functor(H,P,Ar),
|
|
(input(P/Ar)).
|
|
|
|
|
|
given_cw(H):-
|
|
functor(H,P,Ar),
|
|
(input_cw(P/Ar)).
|
|
|
|
|
|
and_list([],B,B).
|
|
|
|
and_list([H|T],B0,B1):-
|
|
and(B0,H,B2),
|
|
and_list(T,B2,B1).
|
|
|
|
|
|
or_list([H],H):-!.
|
|
|
|
or_list([H|T],B):-
|
|
or_list1(T,H,B).
|
|
|
|
|
|
or_list1([],B,B).
|
|
|
|
or_list1([H|T],B0,B1):-
|
|
or(B0,H,B2),
|
|
or_list1(T,B2,B1).
|
|
|
|
|
|
/* set(Par,Value) can be used to set the value of a parameter */
|
|
set(Parameter,Value):-
|
|
retract(setting(Parameter,_)),
|
|
assert(setting(Parameter,Value)).
|
|
|
|
|
|
|
|
extract_vars(Variable, Var0, Var1) :-
|
|
var(Variable), !,
|
|
(member_eq(Variable, Var0) ->
|
|
Var1 = Var0
|
|
;
|
|
append(Var0, [Variable], Var1)
|
|
).
|
|
|
|
extract_vars(Term, Var0, Var1) :-
|
|
Term=..[_F|Args],
|
|
extract_vars_list(Args, Var0, Var1).
|
|
|
|
|
|
|
|
extract_vars_list([], Var, Var).
|
|
|
|
extract_vars_list([Term|Tail], Var0, Var1) :-
|
|
extract_vars(Term, Var0, Var),
|
|
extract_vars_list(Tail, Var, Var1).
|
|
|
|
|
|
difference([],_,[]).
|
|
|
|
difference([H|T],L2,L3):-
|
|
member_eq(H,L2),!,
|
|
difference(T,L2,L3).
|
|
|
|
difference([H|T],L2,[H|L3]):-
|
|
difference(T,L2,L3).
|
|
|
|
|
|
member_eq(E,[H|_T]):-
|
|
E==H,!.
|
|
|
|
member_eq(E,[_H|T]):-
|
|
member_eq(E,T).
|
|
|
|
|
|
add_bdd_arg(A,BDD,A1):-
|
|
A=..[P|Args],
|
|
append(Args,[BDD],Args1),
|
|
A1=..[P|Args1],
|
|
(setting(tabling,on)->
|
|
table_pred(A)
|
|
;
|
|
true
|
|
).
|
|
|
|
|
|
add_bdd_arg_db(A,BDD,DB,A1):-
|
|
A=..[P|Args],
|
|
append(Args,[DB,BDD],Args1),
|
|
A1=..[P|Args1],
|
|
(setting(tabling,on)->
|
|
table_pred(A)
|
|
;
|
|
true
|
|
).
|
|
|
|
|
|
add_bdd_arg(A,BDD,Module,A1):-
|
|
A=..[P|Args],
|
|
append(Args,[BDD],Args1),
|
|
A1=..[P,Module|Args1],
|
|
(setting(tabling,on)->
|
|
table_pred(A)
|
|
;
|
|
true
|
|
).
|
|
|
|
|
|
add_bdd_arg_db(A,BDD,DB,Module,A1):-
|
|
A=..[P|Args],
|
|
append(Args,[DB,BDD],Args1),
|
|
A1=..[P,Module|Args1],
|
|
(setting(tabling,on)->
|
|
table_pred(A)
|
|
;
|
|
true
|
|
).
|
|
|
|
|
|
add_mod_arg(A,Module,A1):-
|
|
A=..[P|Args],
|
|
A1=..[P,Module|Args].
|
|
|
|
|
|
table_pred(A):-
|
|
functor(A,P,Arity),
|
|
Arity1 is Arity +1,
|
|
(is_tabled((P/Arity1))->
|
|
true
|
|
;
|
|
call(table(P/Arity1))
|
|
).
|
|
|
|
|
|
process_head(HeadList, GroundHeadList) :-
|
|
ground_prob(HeadList), !,
|
|
process_head_ground(HeadList, 0, GroundHeadList).
|
|
|
|
process_head(HeadList, HeadList).
|
|
|
|
|
|
|
|
/* process_head_ground([Head:ProbHead], Prob, [Head:ProbHead|Null])
|
|
* ----------------------------------------------------------------
|
|
*/
|
|
process_head_ground([Head:ProbHead], Prob, [Head:ProbHead1|Null]) :-!,
|
|
ProbHead1 is ProbHead,
|
|
ProbLast is 1 - Prob - ProbHead1,
|
|
setting(epsilon_parsing, Eps),
|
|
EpsNeg is - Eps,
|
|
ProbLast > EpsNeg,
|
|
(ProbLast > Eps ->
|
|
Null = ['':ProbLast]
|
|
;
|
|
Null = []
|
|
).
|
|
|
|
process_head_ground([Head:ProbHead|Tail], Prob, [Head:ProbHead1|Next]) :-
|
|
ProbHead1 is ProbHead,
|
|
ProbNext is Prob + ProbHead1,
|
|
process_head_ground(Tail, ProbNext, Next).
|
|
|
|
|
|
ground_prob([]).
|
|
|
|
ground_prob([_Head:ProbHead|Tail]) :-
|
|
ground(ProbHead), % Succeeds if there are no free variables in the term ProbHead.
|
|
ground_prob(Tail).
|
|
|
|
|
|
get_probs([], []).
|
|
|
|
get_probs([_H:P|T], [P1|T1]) :-
|
|
P1 is P,
|
|
get_probs(T, T1).
|
|
|
|
|
|
generate_clauses([],[],_N,C,C):-!.
|
|
|
|
generate_clauses([H|T],[H1|T1],N,C0,C):-
|
|
gen_clause(H,N,N1,H1,CL),!, %agg.cut
|
|
append(C0,CL,C1),
|
|
generate_clauses(T,T1,N1,C1,C).
|
|
|
|
|
|
gen_clause((H :- Body),N,N,(H :- Body),[(H :- Body)]):-!.
|
|
|
|
gen_clause(rule(_R,HeadList,BodyList),N,N1,
|
|
rule(N,HeadList,BodyList),Clauses):-
|
|
setting(depth_bound,true),!,
|
|
% disjunctive clause with more than one head atom e depth_bound
|
|
process_body_db(BodyList,BDD,BDDAnd, DB,[],_Vars,BodyList1,Module),
|
|
append([one(BDD)],BodyList1,BodyList2),
|
|
list2and(BodyList2,Body1),
|
|
extract_vars((HeadList,BodyList),[],VC),
|
|
get_probs(HeadList,Probs),
|
|
(setting(single_var,true)->
|
|
generate_rules_db(HeadList,Body1,[],N,Probs,DB,BDDAnd,0,Clauses,Module)
|
|
;
|
|
generate_rules_db(HeadList,Body1,VC,N,Probs,DB,BDDAnd,0,Clauses,Module)
|
|
),
|
|
N1 is N+1.
|
|
|
|
gen_clause(rule(_R,HeadList,BodyList),N,N1,
|
|
rule(N,HeadList,BodyList),Clauses):-!,
|
|
% disjunctive clause with more than one head atom senza depth_bound
|
|
process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList1,Module),
|
|
append([one(BDD)],BodyList1,BodyList2),
|
|
list2and(BodyList2,Body1),
|
|
extract_vars((HeadList,BodyList),[],VC),
|
|
get_probs(HeadList,Probs),
|
|
(setting(single_var,true)->
|
|
generate_rules(HeadList,Body1,[],N,Probs,BDDAnd,0,Clauses,Module)
|
|
;
|
|
generate_rules(HeadList,Body1,VC,N,Probs,BDDAnd,0,Clauses,Module)
|
|
),
|
|
N1 is N+1.
|
|
|
|
gen_clause(def_rule(H,BodyList),N,N,def_rule(H,BodyList),Clauses) :-
|
|
% disjunctive clause with a single head atom e depth_bound
|
|
setting(depth_bound,true),!,
|
|
process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module),
|
|
append([one(BDD)],BodyList2,BodyList3),
|
|
list2and(BodyList3,Body1),
|
|
add_bdd_arg_db(H,BDDAnd,DB,Module,Head1),
|
|
Clauses=[(Head1 :- Body1)].
|
|
|
|
gen_clause(def_rule(H,BodyList),N,N,def_rule(H,BodyList),Clauses) :- !,%agg. cut
|
|
% disjunctive clause with a single head atom senza depth_bound con prob =1
|
|
process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module),
|
|
append([one(BDD)],BodyList2,BodyList3),
|
|
list2and(BodyList3,Body1),
|
|
add_bdd_arg(H,BDDAnd,Module,Head1),
|
|
Clauses=[(Head1 :- Body1)].
|
|
|
|
|
|
user:term_expansion((Head :- Body), ((H :- Body),[])):-
|
|
Head=db(H),!.
|
|
|
|
user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])):-
|
|
setting(compiling,on),
|
|
setting(depth_bound,true),
|
|
% disjunctive clause with more than one head atom e depth_bound
|
|
Head = (_;_), !,
|
|
list2or(HeadListOr, Head),
|
|
process_head(HeadListOr, HeadList),
|
|
list2and(BodyList, Body),
|
|
process_body_db(BodyList,BDD,BDDAnd, DB,[],_Vars,BodyList1,Module),
|
|
append([one(BDD)],BodyList1,BodyList2),
|
|
list2and(BodyList2,Body1),
|
|
extract_vars((Head:-Body),[],VC),
|
|
get_next_rule_number(R),
|
|
get_probs(HeadList,Probs),
|
|
(setting(single_var,true)->
|
|
generate_rules_db(HeadList,Body1,[],R,Probs,DB,BDDAnd,0,Clauses,Module)
|
|
;
|
|
generate_rules_db(HeadList,Body1,VC,R,Probs,DB,BDDAnd,0,Clauses,Module)
|
|
).
|
|
|
|
user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])):-
|
|
setting(compiling,on),
|
|
% disjunctive clause with more than one head atom senza depth_bound
|
|
Head = (_;_), !,
|
|
list2or(HeadListOr, Head),
|
|
process_head(HeadListOr, HeadList),
|
|
list2and(BodyList, Body),
|
|
process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList1,Module),
|
|
append([one(BDD)],BodyList1,BodyList2),
|
|
list2and(BodyList2,Body1),
|
|
extract_vars((Head:-Body),[],VC),
|
|
get_next_rule_number(R),
|
|
get_probs(HeadList,Probs),
|
|
(setting(single_var,true)->
|
|
generate_rules(HeadList,Body1,[],R,Probs,BDDAnd,0,Clauses,Module)
|
|
;
|
|
generate_rules(HeadList,Body1,VC,R,Probs,BDDAnd,0,Clauses,Module)
|
|
).
|
|
|
|
user:term_expansion((Head :- Body), ([],[])) :-
|
|
% disjunctive clause with a single head atom con prob. 0 senza depth_bound --> la regola non è caricata nella teoria e non è conteggiata in NR
|
|
setting(compiling,on),
|
|
((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )),
|
|
Head = (_H:P),P=:=0.0, !.
|
|
|
|
user:term_expansion((Head :- Body), (Clauses,[def_rule(H,BodyList)])) :-
|
|
% disjunctive clause with a single head atom e depth_bound
|
|
setting(compiling,on),
|
|
setting(depth_bound,true),
|
|
((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )),
|
|
list2or(HeadListOr, Head),
|
|
process_head(HeadListOr, HeadList),
|
|
HeadList=[H:_],!,
|
|
list2and(BodyList, Body),
|
|
process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module),
|
|
append([one(BDD)],BodyList2,BodyList3),
|
|
list2and(BodyList3,Body1),
|
|
add_bdd_arg_db(H,BDDAnd,DB,Module,Head1),
|
|
Clauses=(Head1 :- Body1).
|
|
|
|
user:term_expansion((Head :- Body), (Clauses,[def_rule(H,BodyList)])) :-
|
|
% disjunctive clause with a single head atom senza depth_bound con prob =1
|
|
setting(compiling,on),
|
|
((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )),
|
|
list2or(HeadListOr, Head),
|
|
process_head(HeadListOr, HeadList),
|
|
HeadList=[H:_],!,
|
|
list2and(BodyList, Body),
|
|
process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module),
|
|
append([one(BDD)],BodyList2,BodyList3),
|
|
list2and(BodyList3,Body1),
|
|
add_bdd_arg(H,BDDAnd,Module,Head1),
|
|
Clauses=(Head1 :- Body1).
|
|
|
|
user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])) :-
|
|
% disjunctive clause with a single head atom e DB, con prob. diversa da 1
|
|
setting(compiling,on),
|
|
setting(depth_bound,true),
|
|
((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )),
|
|
Head = (H:_), !,
|
|
list2or(HeadListOr, Head),
|
|
process_head(HeadListOr, HeadList),
|
|
list2and(BodyList, Body),
|
|
process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module),
|
|
append([one(BDD)],BodyList2,BodyList3),
|
|
list2and(BodyList3,Body2),
|
|
extract_vars((Head:-Body),[],VC),
|
|
get_next_rule_number(R),
|
|
get_probs(HeadList,Probs),%***test single_var
|
|
(setting(single_var,true)->
|
|
generate_clause_db(H,Body2,[],R,Probs,DB,BDDAnd,0,Clauses,Module)
|
|
;
|
|
generate_clause_db(H,Body2,VC,R,Probs,DB,BDDAnd,0,Clauses,Module)
|
|
).
|
|
|
|
user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])) :-
|
|
% disjunctive clause with a single head atom senza DB, con prob. diversa da 1
|
|
setting(compiling,on),
|
|
((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )),
|
|
Head = (H:_), !,
|
|
list2or(HeadListOr, Head),
|
|
process_head(HeadListOr, HeadList),
|
|
list2and(BodyList, Body),
|
|
process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module),
|
|
append([one(BDD)],BodyList2,BodyList3),
|
|
list2and(BodyList3,Body2),
|
|
extract_vars((Head:-Body),[],VC),
|
|
get_next_rule_number(R),
|
|
get_probs(HeadList,Probs),%***test single_vars
|
|
(setting(single_var,true)->
|
|
generate_clause(H,Body2,[],R,Probs,BDDAnd,0,Clauses,Module)
|
|
;
|
|
generate_clause(H,Body2,VC,R,Probs,BDDAnd,0,Clauses,Module)
|
|
).
|
|
|
|
user:term_expansion((Head :- Body),(Clauses,[])) :-
|
|
% definite clause for db facts
|
|
setting(compiling,on),
|
|
((Head:-Body) \= ((user:term_expansion(_,_)) :- _ )),
|
|
Head=db(Head1),!,
|
|
Clauses=(Head1 :- Body).
|
|
|
|
user:term_expansion((Head :- Body),(Clauses,[def_rule(Head,BodyList)])) :-
|
|
% definite clause with depth_bound
|
|
setting(compiling,on),
|
|
setting(depth_bound,true),
|
|
((Head:-Body) \= ((user:term_expansion(_,_)) :- _ )),!,
|
|
list2and(BodyList, Body),
|
|
process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module),
|
|
append([one(BDD)],BodyList2,BodyList3),
|
|
list2and(BodyList3,Body1),
|
|
add_bdd_arg_db(Head,BDDAnd,DB,Module,Head1),
|
|
Clauses=(Head1 :- Body1).
|
|
|
|
user:term_expansion((Head :- Body),(Clauses,[def_rule(Head,BodyList)])) :-
|
|
% definite clause senza DB
|
|
setting(compiling,on),
|
|
((Head:-Body) \= ((user:term_expansion(_,_)) :- _ )),!,
|
|
list2and(BodyList, Body),
|
|
process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module),
|
|
append([one(BDD)],BodyList2,BodyList3),
|
|
list2and(BodyList3,Body2),
|
|
add_bdd_arg(Head,BDDAnd,Module,Head1),
|
|
Clauses=(Head1 :- Body2).
|
|
|
|
user:term_expansion(Head,(Clauses,[rule(R,HeadList,[])])) :-
|
|
setting(compiling,on),
|
|
setting(depth_bound,true),
|
|
% disjunctive FACT with more than one head atom e db
|
|
Head=(_;_), !,
|
|
list2or(HeadListOr, Head),
|
|
process_head(HeadListOr, HeadList),
|
|
extract_vars((Head),[],VC),
|
|
get_next_rule_number(R),
|
|
get_probs(HeadList,Probs),
|
|
(setting(single_var,true)->
|
|
generate_rules_fact_db(HeadList,[],R,Probs,0,Clauses,_Module)
|
|
;
|
|
generate_rules_fact_db(HeadList,VC,R,Probs,0,Clauses,_Module)
|
|
).
|
|
|
|
user:term_expansion(Head,(Clauses,[rule(R,HeadList,[])])) :-
|
|
setting(compiling,on),
|
|
% disjunctive fact with more than one head atom senza db
|
|
Head=(_;_), !,
|
|
list2or(HeadListOr, Head),
|
|
process_head(HeadListOr, HeadList),
|
|
extract_vars((Head),[],VC),
|
|
get_next_rule_number(R),
|
|
get_probs(HeadList,Probs), %**** test single_var
|
|
(setting(single_var,true)->
|
|
generate_rules_fact(HeadList,[],R,Probs,0,Clauses,_Module)
|
|
;
|
|
generate_rules_fact(HeadList,VC,R,Probs,0,Clauses,_Module)
|
|
).
|
|
|
|
user:term_expansion(Head,([],[])) :-
|
|
setting(compiling,on),
|
|
% disjunctive fact with a single head atom con prob. 0
|
|
(Head \= ((user:term_expansion(_,_)) :- _ )),
|
|
Head = (_H:P),P=:=0.0, !.
|
|
|
|
user:term_expansion(Head,(Clause,[def_rule(H,[])])) :-
|
|
setting(compiling,on),
|
|
setting(depth_bound,true),
|
|
% disjunctive fact with a single head atom con prob.1 e db
|
|
(Head \= ((user:term_expansion(_,_)) :- _ )),
|
|
Head = (H:P),P=:=1.0, !,
|
|
list2and([one(BDD)],Body1),
|
|
add_bdd_arg_db(H,BDD,_DB,_Module,Head1),
|
|
Clause=(Head1 :- Body1).
|
|
|
|
user:term_expansion(Head,(Clause,[def_rule(H,[])])) :-
|
|
setting(compiling,on),
|
|
% disjunctive fact with a single head atom con prob. 1, senza db
|
|
(Head \= ((user:term_expansion(_,_)) :- _ )),
|
|
Head = (H:P),P=:=1.0, !,
|
|
list2and([one(BDD)],Body1),
|
|
add_bdd_arg(H,BDD,_Module,Head1),
|
|
Clause=(Head1 :- Body1).
|
|
|
|
user:term_expansion(Head,(Clause,[rule(R,HeadList,[])])) :-
|
|
setting(compiling,on),
|
|
setting(depth_bound,true),
|
|
% disjunctive fact with a single head atom e prob. generiche, con db
|
|
(Head \= ((user:term_expansion(_,_)) :- _ )),
|
|
Head=(H:_), !,
|
|
list2or(HeadListOr, Head),
|
|
process_head(HeadListOr, HeadList),
|
|
extract_vars((Head),[],VC),
|
|
get_next_rule_number(R),
|
|
get_probs(HeadList,Probs),
|
|
add_bdd_arg_db(H,BDD,_DB,_Module,Head1),
|
|
(setting(single_var,true)->
|
|
Clause=(Head1:-(get_var_n(R,[],Probs,V),equality(V,0,BDD)))
|
|
;
|
|
Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,0,BDD)))
|
|
).
|
|
|
|
user:term_expansion(Head,(Clause,[rule(R,HeadList,[])])) :-
|
|
setting(compiling,on),
|
|
% disjunctive fact with a single head atom e prob. generiche, senza db
|
|
(Head \= ((user:term_expansion(_,_)) :- _ )),
|
|
Head=(H:_), !,
|
|
list2or(HeadListOr, Head),
|
|
process_head(HeadListOr, HeadList),
|
|
extract_vars((Head),[],VC),
|
|
get_next_rule_number(R),
|
|
get_probs(HeadList,Probs),
|
|
add_bdd_arg(H,BDD,_Module,Head1),%***test single_var
|
|
(setting(single_var,true)->
|
|
Clause=(Head1:-(get_var_n(R,[],Probs,V),equality(V,0,BDD)))
|
|
;
|
|
Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,0,BDD)))
|
|
).
|
|
|
|
user:term_expansion(Head, ((Head1:-one(One)),[def_rule(Head,[])])) :-
|
|
setting(compiling,on),
|
|
setting(depth_bound,true),
|
|
% definite fact with db
|
|
(Head \= ((user:term_expansion(_,_) ):- _ )),
|
|
(Head\= end_of_file),!,
|
|
add_bdd_arg_db(Head,One,_DB,_Module,Head1).
|
|
|
|
user:term_expansion(Head, ((Head1:-one(One)),[def_rule(Head,[])])) :-
|
|
setting(compiling,on),
|
|
% definite fact without db
|
|
(Head \= ((user:term_expansion(_,_) ):- _ )),
|
|
(Head\= end_of_file),!,
|
|
add_bdd_arg(Head,One,_Module,Head1).
|
|
|
|
|
|
builtin(_A is _B).
|
|
builtin(_A > _B).
|
|
builtin(_A < _B).
|
|
builtin(_A >= _B).
|
|
builtin(_A =< _B).
|
|
builtin(_A =:= _B).
|
|
builtin(_A =\= _B).
|
|
builtin(true).
|
|
builtin(false).
|
|
builtin(_A = _B).
|
|
builtin(_A==_B).
|
|
builtin(_A\=_B).
|
|
builtin(_A\==_B).
|
|
builtin('!').
|
|
builtin(length(_L,_N)).
|
|
builtin(member(_El,_L)).
|
|
builtin(average(_L,_Av)).
|
|
builtin(max_list(_L,_Max)).
|
|
builtin(min_list(_L,_Max)).
|
|
builtin(nth0(_,_,_)).
|
|
builtin(nth(_,_,_)).
|
|
builtin(name(_,_)).
|
|
builtin(float(_)).
|
|
builtin(integer(_)).
|
|
builtin(var(_)).
|
|
builtin(_ @> _).
|
|
builtin(memberchk(_,_)).
|
|
|
|
|
|
average(L,Av):-
|
|
sum_list(L,Sum),
|
|
length(L,N),
|
|
Av is Sum/N.
|
|
|