1/* 2 3EMBLEM and SLIPCASE 4 5Copyright (c) 2011, Fabrizio Riguzzi and Elena Bellodi 6 7*/ 8:-use_module(library(lists)). 9:-load_foreign_files(['bddem'],[],init_my_predicates). 10 11:-dynamic p/2,rule_n/1,setting/2. 12 13 14rule_n(0). 15 16setting(epsilon_parsing, 1e-10). 17setting(tabling, off). 18/* on, off */ 19 20setting(bagof,false). 21/* values: false, intermediate, all, extra */ 22 23setting(compiling,off). 24 25:-yap_flag(unknown,fail). 26 27setting(depth_bound,false). %if true, it limits the derivation of the example to the value of 'depth' 28setting(depth,2). 29setting(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. 30 31:- yap_flag(single_var_warnings, on). 32 33 34load(FileIn,C1,R):- 35 open(FileIn,read,SI), 36 read_clauses_dir(SI,C), 37 close(SI), 38 process_clauses(C,[],C1,[],R). 39 40 41add_inter_cl(CL):- 42 %findall(A,(input(A);output(A)),L), 43 findall(A,(input(A)),L), 44 gen_cl(L,CL). 45 46 47gen_cl([],[]). 48 49gen_cl([H/A|T],[C|T1]):- 50 functor(F,H,A), 51 add_mod_arg(F,Module,F1), 52 add_bdd_arg(F,BDD,Module,F2), 53 C=(F2:-(F1,one(BDD))), 54 gen_cl(T,T1). 55 56 57assert_all([]). 58 59assert_all([H|T]):- 60 assert(H), 61 assert_all(T). 62 63 64retract_all([]):-!. 65 66retract_all([H|T]):- 67 retract(H), 68 retract_all(T). 69 70 71read_clauses_dir(S,[Cl|Out]):- 72 read_term(S,Cl,[]), 73 (Cl=end_of_file-> 74 Out=[] 75 ; 76 read_clauses_dir(S,Out) 77 ). 78 79 80process_clauses([],C,C,R,R):-!. 81 82process_clauses([end_of_file],C,C,R,R):-!. 83 84process_clauses([H|T],C0,C1,R0,R1):- 85 (term_expansion(H,H1)-> 86 true 87 ; 88 H1=(H,[]) 89 ), 90 (H1=([_|_],R)-> 91 H1=(List,R), 92 append(C0,List,C2), 93 append(R0,R,R2) 94 ; 95 (H1=([],_R)-> 96 C2=C0, 97 R2=R0 98 ; 99 H1=(H2,R), 100 append(C0,[H2],C2), 101 append(R0,R,R2) 102 ) 103 ), 104 process_clauses(T,C2,C1,R2,R1). 105 106 107get_next_rule_number(R):- 108 retract(rule_n(R)), 109 R1 is R+1, 110 assert(rule_n(R1)). 111 112 113get_node(\+ Goal,BDD):- 114 setting(depth_bound,true),!, 115 setting(depth,DB), 116 retractall(v(_,_,_)), 117 add_bdd_arg_db(Goal,BDD,DB,Goal1), 118 (bagof(BDD,Goal1,L)-> 119 or_list(L,B) 120 ; 121 zero(B) 122 ), 123 bdd_not(B,BDD). 124 125get_node(\+ Goal,BDD):-!, 126 retractall(v(_,_,_)), 127 add_bdd_arg(Goal,BDD,Goal1), 128 (bagof(BDD,Goal1,L)-> 129 or_list(L,B) 130 ; 131 zero(B) 132 ), 133 bdd_not(B,BDD). 134 135get_node(Goal,B):- 136 setting(depth_bound,true),!, 137 setting(depth,DB), 138 retractall(v(_,_,_)), 139 add_bdd_arg_db(Goal,BDD,DB,Goal1),%DB=depth bound 140 (bagof(BDD,Goal1,L)-> 141 or_list(L,B) 142 ; 143 zero(B) 144 ). 145 146get_node(Goal,B):- %with DB=false 147 retractall(v(_,_,_)), 148 add_bdd_arg(Goal,BDD,Goal1), 149 (bagof(BDD,Goal1,L)-> 150 or_list(L,B) 151 ; 152 zero(B) 153 ). 154 155 156s(Goal,P,CPUTime1,0,WallTime1,0):- 157 statistics(cputime,[_,_]), 158 statistics(walltime,[_,_]), 159 init, 160 retractall(v(_,_,_)), 161 abolish_all_tables, 162 add_bdd_arg(Goal,BDD,Goal1), 163 (bagof(BDD,Goal1,L)-> 164 or_list(L,B), 165 ret_prob(B,P) 166 ; 167 P=0.0 168 ), 169 end, 170 statistics(cputime,[_,CT1]), 171 CPUTime1 is CT1/1000, 172 statistics(walltime,[_,WT1]), 173 WallTime1 is WT1/1000. 174 175 176get_var_n(R,S,Probs,V):- 177 (v(R,S,V)-> 178 true 179 ; 180 length(Probs,L), 181 add_var(L,Probs,R,V), 182 assert(v(R,S,V)) 183 ). 184 185 186generate_rules_fact([],_VC,_R,_Probs,_N,[],_Module). 187 188generate_rules_fact([Head:_P1,'':_P2],VC,R,Probs,N,[Clause],Module):-!, 189 add_bdd_arg(Head,BDD,Module,Head1), 190 Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))). 191 192generate_rules_fact([Head:_P|T],VC,R,Probs,N,[Clause|Clauses],Module):- 193 add_bdd_arg(Head,BDD,Module,Head1), 194 Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))), 195 N1 is N+1, 196 generate_rules_fact(T,VC,R,Probs,N1,Clauses,Module). 197 198 199generate_rules_fact_db([],_VC,_R,_Probs,_N,[],_Module). 200 201generate_rules_fact_db([Head:_P1,'':_P2],VC,R,Probs,N,[Clause],Module):-!, 202 add_bdd_arg_db(Head,BDD,_DB,Module,Head1), 203 Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))). 204 205generate_rules_fact_db([Head:_P|T],VC,R,Probs,N,[Clause|Clauses],Module):- 206 add_bdd_arg_db(Head,BDD,_DB,Module,Head1), 207 Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))), 208 N1 is N+1, 209 generate_rules_fact_db(T,VC,R,Probs,N1,Clauses,Module). 210 211 212generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module):- 213 add_bdd_arg(Head,BDD,Module,Head1), 214 Clause=(Head1:-(Body,get_var_n(R,VC,Probs,V),equality(V,N,B),and(BDDAnd,B,BDD))). 215 216 217generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module):- 218 add_bdd_arg_db(Head,BDD,DBH,Module,Head1), 219 Clause=(Head1:-(DBH>=1,DB is DBH-1,Body,get_var_n(R,VC,Probs,V),equality(V,N,B),and(BDDAnd,B,BDD))). 220 221 222generate_rules([],_Body,_VC,_R,_Probs,_BDDAnd,_N,[],_Module). 223 224generate_rules([Head:_P1,'':_P2],Body,VC,R,Probs,BDDAnd,N,[Clause],Module):-!, 225 generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module). 226 227generate_rules([Head:_P|T],Body,VC,R,Probs,BDDAnd,N,[Clause|Clauses],Module):- 228 generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module), 229 N1 is N+1, 230 generate_rules(T,Body,VC,R,Probs,BDDAnd,N1,Clauses,Module). 231 232 233generate_rules_db([],_Body,_VC,_R,_Probs,_DB,_BDDAnd,_N,[],_Module):-!. 234 235generate_rules_db([Head:_P1,'':_P2],Body,VC,R,Probs,DB,BDDAnd,N,[Clause],Module):-!, 236 generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module). 237 238generate_rules_db([Head:_P|T],Body,VC,R,Probs,DB,BDDAnd,N,[Clause|Clauses],Module):- 239 generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module),!,%agg.cut 240 N1 is N+1, 241 generate_rules_db(T,Body,VC,R,Probs,DB,BDDAnd,N1,Clauses,Module). 242 243 244process_body_database([],[],_Module). 245 246process_body_database([H|T],[H1|T1],Module):- 247 add_mod_arg(H,H1,Module), 248 process_body_database(T,T1,Module). 249 250 251process_body_db([],BDD,BDD,_DB,Vars,Vars,[],_Module):-!. 252 253process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):- 254 builtin(H),!, 255 process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 256 257process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):- 258 db(H),!, 259 process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 260 261process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[ 262(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))), 263 and(BDD,BDDN,BDD2) 264 |Rest],Module):- 265 given(H),!, 266 add_mod_arg(H,Module,H1), 267 add_bdd_arg_db(H,BDDH,DB,Module,H2), 268 process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module). 269 270process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[ 271 neg(H1)|Rest],Module):- 272 given_cw(H),!, 273 add_mod_arg(H,Module,H1), 274 process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 275 276process_body_db([\+ H|T],BDD,BDD1,DB,Vars,[BDDH,BDDN,L,BDDL,BDD2|Vars1], 277[(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)), 278 and(BDD,BDDN,BDD2)|Rest],Module):-!, 279 add_bdd_arg_db(H,BDDH,DB,Module,H1), 280 process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module). 281 282process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):- 283 builtin(H),!, 284 process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 285 286process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):- 287 db(H),!, 288 process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 289 290process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1, 291[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):- 292 given(H),!, 293 add_mod_arg(H,Module,H1), 294 add_bdd_arg_db(H,BDDH,DB,Module,H2), 295 process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module). 296 297process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1, 298[H1|Rest],Module):- 299 given_cw(H),!, 300 add_mod_arg(H,Module,H1), 301 process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 302 303process_body_db([H|T],BDD,BDD1,DB,Vars,[BDDH,BDD2|Vars1], 304[H1,and(BDD,BDDH,BDD2)|Rest],Module):-!, %agg. cut 305 add_bdd_arg_db(H,BDDH,DB,Module,H1), 306 process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module). 307 308 309process_body_def_db([],BDD,BDD,_DB,Vars,Vars,[],_Module). 310 311process_body_def_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):- 312 builtin(H),!, 313 process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 314 315process_body_def_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):- 316 db(H),!, 317 process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 318 319process_body_def_db([\+H|T],BDD,BDD1,DB,Vars,Vars1, 320[(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))), 321 and(BDD,BDDN,BDD2)|Rest], 322Module):- 323 given(H),!, 324 add_mod_arg(H,Module,H1), 325 add_bdd_arg_db(H,BDDH,DB,Module,H2), 326 process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module). 327 328process_body_def_db([\+H|T],BDD,BDD1,DB,Vars,Vars1, 329[neg(H1)|Rest], 330Module):- 331 given_cw(H),!, 332 add_mod_arg(H,Module,H1), 333 process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 334 335process_body_def_db([\+H|T],BDD,BDD1,DB,Vars,[BDD,BDDH,L,BDDL,BDDN|Vars1], 336 [(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)), 337 and(BDD,BDDN,BDD2)|Rest],Module):-!, 338 add_bdd_arg_db(H,BDDH,DB,Module,H1), 339 process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module). 340 341process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):- 342 builtin(H),!, 343 process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 344 345process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):- 346 db(H),!, 347 process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 348 349process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):- 350 given(H),!, 351 add_mod_arg(H,Module,H1), 352 add_bdd_arg_db(H,BDDH,DB,Module,H2), 353 process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module). 354 355process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H1|Rest],Module):- 356 given_cw(H),!, 357 add_mod_arg(H,Module,H1), 358 process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 359 360process_body_def_db([H|T],BDD,BDD1,DB,Vars,[BDD,BDDH|Vars1],[H1,and(BDD,BDDH,BDD2)|Rest],Module):-!, 361 add_bdd_arg_db(H,BDDH,DB,Module,H1), 362 process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module). 363 364 365 366 367process_body_def([],BDD,BDD,Vars,Vars,[],_Module). 368 369process_body_def([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):- 370 builtin(H),!, 371 process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module). 372 373process_body_def([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):- 374 db(H),!, 375 process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module). 376 377process_body_def([\+H|T],BDD,BDD1,Vars,Vars1, 378[(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))), 379 and(BDD,BDDN,BDD2)|Rest], 380 Module):- 381 given(H),!, 382 add_mod_arg(H,Module,H1), 383 add_bdd_arg(H,BDDH,Module,H2), 384 process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module). 385 386process_body_def([\+H|T],BDD,BDD1,Vars,Vars1, 387[neg(H1)|Rest], 388Module):- 389 given_cw(H),!, 390 add_mod_arg(H,Module,H1), 391 process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module). 392 393process_body_def([\+H|T],BDD,BDD1,Vars,[BDD,BDDH,L,BDDL,BDDN|Vars1], 394 [(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)), 395 and(BDD,BDDN,BDD2)|Rest],Module):-!, 396 add_bdd_arg(H,BDDH,Module,H1), 397 process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module). 398 399process_body_def([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):- 400 builtin(H),!, 401 process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module). 402 403process_body_def([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):- 404 db(H),!, 405 process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module). 406 407process_body_def([H|T],BDD,BDD1,Vars,Vars1,[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):- 408 given(H),!, 409 add_mod_arg(H,Module,H1), 410 add_bdd_arg(H,BDDH,Module,H2), 411 process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module). 412 413process_body_def([H|T],BDD,BDD1,Vars,Vars1,[H1|Rest],Module):- 414 given_cw(H),!, 415 add_mod_arg(H,Module,H1), 416 process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module). 417 418process_body_def([H|T],BDD,BDD1,Vars,[BDD,BDDH|Vars1],[H1,and(BDD,BDDH,BDD2)|Rest],Module):-!, 419 add_bdd_arg(H,BDDH,Module,H1), 420 process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module). 421 422 423process_body([],BDD,BDD,Vars,Vars,[],_Module). 424 425process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):- 426 builtin(H),!, 427 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 428 429process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):- 430 db(H),!, 431 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 432 433process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[ 434(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))), 435 and(BDD,BDDN,BDD2) 436 |Rest],Module):- 437 given(H),!, 438 add_mod_arg(H,Module,H1), 439 add_bdd_arg(H,BDDH,Module,H2), 440 process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module). 441 442process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[ 443 neg(H1)|Rest],Module):- 444 given_cw(H),!, 445 add_mod_arg(H,Module,H1), 446 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 447 448process_body([\+ H|T],BDD,BDD1,Vars,[BDDH,BDDN,L,BDDL,BDD2|Vars1], 449[(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)), 450 and(BDD,BDDN,BDD2)|Rest],Module):-!, 451 add_bdd_arg(H,BDDH,Module,H1), 452 process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module). 453 454process_body([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):- 455 builtin(H),!, 456 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 457 458process_body([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):- 459 db(H),!, 460 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 461 462process_body([H|T],BDD,BDD1,Vars,Vars1, 463[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):- 464 given(H),!, 465 add_mod_arg(H,Module,H1), 466 add_bdd_arg(H,BDDH,Module,H2), 467 process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module). 468 469process_body([H|T],BDD,BDD1,Vars,Vars1, 470[H1|Rest],Module):- 471 given_cw(H),!, 472 add_mod_arg(H,Module,H1), 473 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 474 475process_body([H|T],BDD,BDD1,Vars,Vars1,[H1|Rest],Module):- 476 add_mod_arg(H,Module,H1), 477 db(H1),!, 478 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 479 480process_body([H|T],BDD,BDD1,Vars,[BDDH,BDD2|Vars1], 481[H1,and(BDD,BDDH,BDD2)|Rest],Module):- 482 add_bdd_arg(H,BDDH,Module,H1), 483 process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module). 484 485 486given(H):- 487 functor(H,P,Ar), 488 (input(P/Ar)). 489 490 491given_cw(H):- 492 functor(H,P,Ar), 493 (input_cw(P/Ar)). 494 495 496and_list([],B,B). 497 498and_list([H|T],B0,B1):- 499 and(B0,H,B2), 500 and_list(T,B2,B1). 501 502 503or_list([H],H):-!. 504 505or_list([H|T],B):- 506 or_list1(T,H,B). 507 508 509or_list1([],B,B). 510 511or_list1([H|T],B0,B1):- 512 or(B0,H,B2), 513 or_list1(T,B2,B1). 514 515 516/* set(Par,Value) can be used to set the value of a parameter */ 517set(Parameter,Value):- 518 retract(setting(Parameter,_)), 519 assert(setting(Parameter,Value)). 520 521 522 523extract_vars(Variable, Var0, Var1) :- 524 var(Variable), !, 525 (member_eq(Variable, Var0) -> 526 Var1 = Var0 527 ; 528 append(Var0, [Variable], Var1) 529 ). 530 531extract_vars(Term, Var0, Var1) :- 532 Term=..[_F|Args], 533 extract_vars_list(Args, Var0, Var1). 534 535 536 537extract_vars_list([], Var, Var). 538 539extract_vars_list([Term|Tail], Var0, Var1) :- 540 extract_vars(Term, Var0, Var), 541 extract_vars_list(Tail, Var, Var1). 542 543 544difference([],_,[]). 545 546difference([H|T],L2,L3):- 547 member_eq(H,L2),!, 548 difference(T,L2,L3). 549 550difference([H|T],L2,[H|L3]):- 551 difference(T,L2,L3). 552 553 554member_eq(E,[H|_T]):- 555 E==H,!. 556 557member_eq(E,[_H|T]):- 558 member_eq(E,T). 559 560 561add_bdd_arg(A,BDD,A1):- 562 A=..[P|Args], 563 append(Args,[BDD],Args1), 564 A1=..[P|Args1], 565 (setting(tabling,on)-> 566 table_pred(A) 567 ; 568 true 569 ). 570 571 572add_bdd_arg_db(A,BDD,DB,A1):- 573 A=..[P|Args], 574 append(Args,[DB,BDD],Args1), 575 A1=..[P|Args1], 576 (setting(tabling,on)-> 577 table_pred(A) 578 ; 579 true 580 ). 581 582 583add_bdd_arg(A,BDD,Module,A1):- 584 A=..[P|Args], 585 append(Args,[BDD],Args1), 586 A1=..[P,Module|Args1], 587 (setting(tabling,on)-> 588 table_pred(A) 589 ; 590 true 591 ). 592 593 594add_bdd_arg_db(A,BDD,DB,Module,A1):- 595 A=..[P|Args], 596 append(Args,[DB,BDD],Args1), 597 A1=..[P,Module|Args1], 598 (setting(tabling,on)-> 599 table_pred(A) 600 ; 601 true 602 ). 603 604 605add_mod_arg(A,Module,A1):- 606 A=..[P|Args], 607 A1=..[P,Module|Args]. 608 609 610table_pred(A):- 611 functor(A,P,Arity), 612 Arity1 is Arity +1, 613 (is_tabled((P/Arity1))-> 614 true 615 ; 616 call(table(P/Arity1)) 617 ). 618 619 620process_head(HeadList, GroundHeadList) :- 621 ground_prob(HeadList), !, 622 process_head_ground(HeadList, 0, GroundHeadList). 623 624process_head(HeadList, HeadList). 625 626 627 628/* process_head_ground([Head:ProbHead], Prob, [Head:ProbHead|Null]) 629 * ---------------------------------------------------------------- 630 */ 631process_head_ground([Head:ProbHead], Prob, [Head:ProbHead1|Null]) :-!, 632 ProbHead1 is ProbHead, 633 ProbLast is 1 - Prob - ProbHead1, 634 setting(epsilon_parsing, Eps), 635 EpsNeg is - Eps, 636 ProbLast > EpsNeg, 637 (ProbLast > Eps -> 638 Null = ['':ProbLast] 639 ; 640 Null = [] 641 ). 642 643process_head_ground([Head:ProbHead|Tail], Prob, [Head:ProbHead1|Next]) :- 644 ProbHead1 is ProbHead, 645 ProbNext is Prob + ProbHead1, 646 process_head_ground(Tail, ProbNext, Next). 647 648 649ground_prob([]). 650 651ground_prob([_Head:ProbHead|Tail]) :- 652 ground(ProbHead), % Succeeds if there are no free variables in the term ProbHead. 653 ground_prob(Tail). 654 655 656get_probs([], []). 657 658get_probs([_H:P|T], [P1|T1]) :- 659 P1 is P, 660 get_probs(T, T1). 661 662 663generate_clauses([],[],_N,C,C):-!. 664 665generate_clauses([H|T],[H1|T1],N,C0,C):- 666 gen_clause(H,N,N1,H1,CL),!, %agg.cut 667 append(C0,CL,C1), 668 generate_clauses(T,T1,N1,C1,C). 669 670 671gen_clause((H :- Body),N,N,(H :- Body),[(H :- Body)]):-!. 672 673gen_clause(rule(_R,HeadList,BodyList),N,N1, 674 rule(N,HeadList,BodyList),Clauses):- 675 setting(depth_bound,true),!, 676% disjunctive clause with more than one head atom e depth_bound 677 process_body_db(BodyList,BDD,BDDAnd, DB,[],_Vars,BodyList1,Module), 678 append([one(BDD)],BodyList1,BodyList2), 679 list2and(BodyList2,Body1), 680 extract_vars((HeadList,BodyList),[],VC), 681 get_probs(HeadList,Probs), 682 (setting(single_var,true)-> 683 generate_rules_db(HeadList,Body1,[],N,Probs,DB,BDDAnd,0,Clauses,Module) 684 ; 685 generate_rules_db(HeadList,Body1,VC,N,Probs,DB,BDDAnd,0,Clauses,Module) 686 ), 687 N1 is N+1. 688 689gen_clause(rule(_R,HeadList,BodyList),N,N1, 690 rule(N,HeadList,BodyList),Clauses):-!, 691% disjunctive clause with more than one head atom senza depth_bound 692 process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList1,Module), 693 append([one(BDD)],BodyList1,BodyList2), 694 list2and(BodyList2,Body1), 695 extract_vars((HeadList,BodyList),[],VC), 696 get_probs(HeadList,Probs), 697 (setting(single_var,true)-> 698 generate_rules(HeadList,Body1,[],N,Probs,BDDAnd,0,Clauses,Module) 699 ; 700 generate_rules(HeadList,Body1,VC,N,Probs,BDDAnd,0,Clauses,Module) 701 ), 702 N1 is N+1. 703 704gen_clause(def_rule(H,BodyList),N,N,def_rule(H,BodyList),Clauses) :- 705% disjunctive clause with a single head atom e depth_bound 706 setting(depth_bound,true),!, 707 process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module), 708 append([one(BDD)],BodyList2,BodyList3), 709 list2and(BodyList3,Body1), 710 add_bdd_arg_db(H,BDDAnd,DB,Module,Head1), 711 Clauses=[(Head1 :- Body1)]. 712 713gen_clause(def_rule(H,BodyList),N,N,def_rule(H,BodyList),Clauses) :- !,%agg. cut 714% disjunctive clause with a single head atom senza depth_bound con prob =1 715 process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module), 716 append([one(BDD)],BodyList2,BodyList3), 717 list2and(BodyList3,Body1), 718 add_bdd_arg(H,BDDAnd,Module,Head1), 719 Clauses=[(Head1 :- Body1)]. 720 721 722user:term_expansion((Head :- Body), ((H :- Body),[])):- 723 Head=db(H),!. 724 725user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])):- 726 setting(compiling,on), 727 setting(depth_bound,true), 728% disjunctive clause with more than one head atom e depth_bound 729 Head = (_;_), !, 730 list2or(HeadListOr, Head), 731 process_head(HeadListOr, HeadList), 732 list2and(BodyList, Body), 733 process_body_db(BodyList,BDD,BDDAnd, DB,[],_Vars,BodyList1,Module), 734 append([one(BDD)],BodyList1,BodyList2), 735 list2and(BodyList2,Body1), 736 extract_vars((Head:-Body),[],VC), 737 get_next_rule_number(R), 738 get_probs(HeadList,Probs), 739 (setting(single_var,true)-> 740 generate_rules_db(HeadList,Body1,[],R,Probs,DB,BDDAnd,0,Clauses,Module) 741 ; 742 generate_rules_db(HeadList,Body1,VC,R,Probs,DB,BDDAnd,0,Clauses,Module) 743 ). 744 745user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])):- 746 setting(compiling,on), 747% disjunctive clause with more than one head atom senza depth_bound 748 Head = (_;_), !, 749 list2or(HeadListOr, Head), 750 process_head(HeadListOr, HeadList), 751 list2and(BodyList, Body), 752 process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList1,Module), 753 append([one(BDD)],BodyList1,BodyList2), 754 list2and(BodyList2,Body1), 755 extract_vars((Head:-Body),[],VC), 756 get_next_rule_number(R), 757 get_probs(HeadList,Probs), 758 (setting(single_var,true)-> 759 generate_rules(HeadList,Body1,[],R,Probs,BDDAnd,0,Clauses,Module) 760 ; 761 generate_rules(HeadList,Body1,VC,R,Probs,BDDAnd,0,Clauses,Module) 762 ). 763 764user:term_expansion((Head :- Body), ([],[])) :- 765% disjunctive clause with a single head atom con prob. 0 senza depth_bound --> la regola non è caricata nella teoria e non è conteggiata in NR 766 setting(compiling,on), 767 ((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )), 768 Head = (_H:P),P=:=0.0, !. 769 770user:term_expansion((Head :- Body), (Clauses,[def_rule(H,BodyList)])) :- 771% disjunctive clause with a single head atom e depth_bound 772 setting(compiling,on), 773 setting(depth_bound,true), 774 ((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )), 775 list2or(HeadListOr, Head), 776 process_head(HeadListOr, HeadList), 777 HeadList=[H:_],!, 778 list2and(BodyList, Body), 779 process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module), 780 append([one(BDD)],BodyList2,BodyList3), 781 list2and(BodyList3,Body1), 782 add_bdd_arg_db(H,BDDAnd,DB,Module,Head1), 783 Clauses=(Head1 :- Body1). 784 785user:term_expansion((Head :- Body), (Clauses,[def_rule(H,BodyList)])) :- 786% disjunctive clause with a single head atom senza depth_bound con prob =1 787 setting(compiling,on), 788 ((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )), 789 list2or(HeadListOr, Head), 790 process_head(HeadListOr, HeadList), 791 HeadList=[H:_],!, 792 list2and(BodyList, Body), 793 process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module), 794 append([one(BDD)],BodyList2,BodyList3), 795 list2and(BodyList3,Body1), 796 add_bdd_arg(H,BDDAnd,Module,Head1), 797 Clauses=(Head1 :- Body1). 798 799user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])) :- 800% disjunctive clause with a single head atom e DB, con prob. diversa da 1 801 setting(compiling,on), 802 setting(depth_bound,true), 803 ((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )), 804 Head = (H:_), !, 805 list2or(HeadListOr, Head), 806 process_head(HeadListOr, HeadList), 807 list2and(BodyList, Body), 808 process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module), 809 append([one(BDD)],BodyList2,BodyList3), 810 list2and(BodyList3,Body2), 811 extract_vars((Head:-Body),[],VC), 812 get_next_rule_number(R), 813 get_probs(HeadList,Probs),%***test single_var 814 (setting(single_var,true)-> 815 generate_clause_db(H,Body2,[],R,Probs,DB,BDDAnd,0,Clauses,Module) 816 ; 817 generate_clause_db(H,Body2,VC,R,Probs,DB,BDDAnd,0,Clauses,Module) 818 ). 819 820user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])) :- 821% disjunctive clause with a single head atom senza DB, con prob. diversa da 1 822 setting(compiling,on), 823 ((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )), 824 Head = (H:_), !, 825 list2or(HeadListOr, Head), 826 process_head(HeadListOr, HeadList), 827 list2and(BodyList, Body), 828 process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module), 829 append([one(BDD)],BodyList2,BodyList3), 830 list2and(BodyList3,Body2), 831 extract_vars((Head:-Body),[],VC), 832 get_next_rule_number(R), 833 get_probs(HeadList,Probs),%***test single_vars 834 (setting(single_var,true)-> 835 generate_clause(H,Body2,[],R,Probs,BDDAnd,0,Clauses,Module) 836 ; 837 generate_clause(H,Body2,VC,R,Probs,BDDAnd,0,Clauses,Module) 838 ). 839 840user:term_expansion((Head :- Body),(Clauses,[])) :- 841% definite clause for db facts 842 setting(compiling,on), 843 ((Head:-Body) \= ((user:term_expansion(_,_)) :- _ )), 844 Head=db(Head1),!, 845 Clauses=(Head1 :- Body). 846 847user:term_expansion((Head :- Body),(Clauses,[def_rule(Head,BodyList)])) :- 848% definite clause with depth_bound 849 setting(compiling,on), 850 setting(depth_bound,true), 851 ((Head:-Body) \= ((user:term_expansion(_,_)) :- _ )),!, 852 list2and(BodyList, Body), 853 process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module), 854 append([one(BDD)],BodyList2,BodyList3), 855 list2and(BodyList3,Body1), 856 add_bdd_arg_db(Head,BDDAnd,DB,Module,Head1), 857 Clauses=(Head1 :- Body1). 858 859user:term_expansion((Head :- Body),(Clauses,[def_rule(Head,BodyList)])) :- 860% definite clause senza DB 861 setting(compiling,on), 862 ((Head:-Body) \= ((user:term_expansion(_,_)) :- _ )),!, 863 list2and(BodyList, Body), 864 process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module), 865 append([one(BDD)],BodyList2,BodyList3), 866 list2and(BodyList3,Body2), 867 add_bdd_arg(Head,BDDAnd,Module,Head1), 868 Clauses=(Head1 :- Body2). 869 870user:term_expansion(Head,(Clauses,[rule(R,HeadList,[])])) :- 871 setting(compiling,on), 872 setting(depth_bound,true), 873% disjunctive FACT with more than one head atom e db 874 Head=(_;_), !, 875 list2or(HeadListOr, Head), 876 process_head(HeadListOr, HeadList), 877 extract_vars((Head),[],VC), 878 get_next_rule_number(R), 879 get_probs(HeadList,Probs), 880 (setting(single_var,true)-> 881 generate_rules_fact_db(HeadList,[],R,Probs,0,Clauses,_Module) 882 ; 883 generate_rules_fact_db(HeadList,VC,R,Probs,0,Clauses,_Module) 884 ). 885 886user:term_expansion(Head,(Clauses,[rule(R,HeadList,[])])) :- 887 setting(compiling,on), 888% disjunctive fact with more than one head atom senza db 889 Head=(_;_), !, 890 list2or(HeadListOr, Head), 891 process_head(HeadListOr, HeadList), 892 extract_vars((Head),[],VC), 893 get_next_rule_number(R), 894 get_probs(HeadList,Probs), %**** test single_var 895 (setting(single_var,true)-> 896 generate_rules_fact(HeadList,[],R,Probs,0,Clauses,_Module) 897 ; 898 generate_rules_fact(HeadList,VC,R,Probs,0,Clauses,_Module) 899 ). 900 901user:term_expansion(Head,([],[])) :- 902 setting(compiling,on), 903% disjunctive fact with a single head atom con prob. 0 904 (Head \= ((user:term_expansion(_,_)) :- _ )), 905 Head = (_H:P),P=:=0.0, !. 906 907user:term_expansion(Head,(Clause,[def_rule(H,[])])) :- 908 setting(compiling,on), 909 setting(depth_bound,true), 910% disjunctive fact with a single head atom con prob.1 e db 911 (Head \= ((user:term_expansion(_,_)) :- _ )), 912 Head = (H:P),P=:=1.0, !, 913 list2and([one(BDD)],Body1), 914 add_bdd_arg_db(H,BDD,_DB,_Module,Head1), 915 Clause=(Head1 :- Body1). 916 917user:term_expansion(Head,(Clause,[def_rule(H,[])])) :- 918 setting(compiling,on), 919% disjunctive fact with a single head atom con prob. 1, senza db 920 (Head \= ((user:term_expansion(_,_)) :- _ )), 921 Head = (H:P),P=:=1.0, !, 922 list2and([one(BDD)],Body1), 923 add_bdd_arg(H,BDD,_Module,Head1), 924 Clause=(Head1 :- Body1). 925 926user:term_expansion(Head,(Clause,[rule(R,HeadList,[])])) :- 927 setting(compiling,on), 928 setting(depth_bound,true), 929% disjunctive fact with a single head atom e prob. generiche, con db 930 (Head \= ((user:term_expansion(_,_)) :- _ )), 931 Head=(H:_), !, 932 list2or(HeadListOr, Head), 933 process_head(HeadListOr, HeadList), 934 extract_vars((Head),[],VC), 935 get_next_rule_number(R), 936 get_probs(HeadList,Probs), 937 add_bdd_arg_db(H,BDD,_DB,_Module,Head1), 938 (setting(single_var,true)-> 939 Clause=(Head1:-(get_var_n(R,[],Probs,V),equality(V,0,BDD))) 940 ; 941 Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,0,BDD))) 942 ). 943 944user:term_expansion(Head,(Clause,[rule(R,HeadList,[])])) :- 945 setting(compiling,on), 946% disjunctive fact with a single head atom e prob. generiche, senza db 947 (Head \= ((user:term_expansion(_,_)) :- _ )), 948 Head=(H:_), !, 949 list2or(HeadListOr, Head), 950 process_head(HeadListOr, HeadList), 951 extract_vars((Head),[],VC), 952 get_next_rule_number(R), 953 get_probs(HeadList,Probs), 954 add_bdd_arg(H,BDD,_Module,Head1),%***test single_var 955 (setting(single_var,true)-> 956 Clause=(Head1:-(get_var_n(R,[],Probs,V),equality(V,0,BDD))) 957 ; 958 Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,0,BDD))) 959 ). 960 961user:term_expansion(Head, ((Head1:-one(One)),[def_rule(Head,[])])) :- 962 setting(compiling,on), 963 setting(depth_bound,true), 964% definite fact with db 965 (Head \= ((user:term_expansion(_,_) ):- _ )), 966 (Head\= end_of_file),!, 967 add_bdd_arg_db(Head,One,_DB,_Module,Head1). 968 969user:term_expansion(Head, ((Head1:-one(One)),[def_rule(Head,[])])) :- 970 setting(compiling,on), 971% definite fact without db 972 (Head \= ((user:term_expansion(_,_) ):- _ )), 973 (Head\= end_of_file),!, 974 add_bdd_arg(Head,One,_Module,Head1). 975 976 977builtin(_A is _B). 978builtin(_A > _B). 979builtin(_A < _B). 980builtin(_A >= _B). 981builtin(_A =< _B). 982builtin(_A =:= _B). 983builtin(_A =\= _B). 984builtin(true). 985builtin(false). 986builtin(_A = _B). 987builtin(_A==_B). 988builtin(_A\=_B). 989builtin(_A\==_B). 990builtin('!'). 991builtin(length(_L,_N)). 992builtin(member(_El,_L)). 993builtin(average(_L,_Av)). 994builtin(max_list(_L,_Max)). 995builtin(min_list(_L,_Max)). 996builtin(nth0(_,_,_)). 997builtin(nth(_,_,_)). 998builtin(name(_,_)). 999builtin(float(_)). 1000builtin(integer(_)). 1001builtin(var(_)). 1002builtin(_ @> _). 1003builtin(memberchk(_,_)). 1004 1005 1006average(L,Av):- 1007 sum_list(L,Sum), 1008 length(L,N), 1009 Av is Sum/N. 1010 1011