1/* 2 LPAD and CP-Logic reasoning suite 3 File semlpad.pl 4 Program for building the semantics of an LPAD 5 Queries are answered by using SLG in every instance 6 Copyright (c) 2007, Fabrizio Riguzzi 7*/ 8 9:-module(semlpad,[p/1,s/2,sc/3,set/2]). 10:-use_module(library(lists)). 11:-dynamic setting/2. 12:-set_prolog_flag(unknown,fail). 13:- dynamic new_number/1. 14 15:-[library(slg)]. 16:-retract('slg$default'(_D)),assert('slg$default'(tabled)). 17 18setting(epsilon,0.00001). 19%setting(ground_body,true). 20setting(ground_body,false). 21/* available values: true, false 22if true, both the head and the body of each clause will be grounded, otherwise 23only the head is grounded. In the case in which the body contains variables 24not appearing in the head, the body represents an existential event */ 25 26%setting(grounding,variables). 27setting(grounding,modes). 28/* available values: variables, modes 29if set to variables, the universe facts from the .uni file are used 30if set to modes, the mode and type declaration from the .uni file are used 31*/ 32 33setting(verbose,false). 34 35new_number(0). 36/* sc(Goal,Evidence,Probability) 37 computes a conditional probability 38*/ 39sc(Goals,Evidence,Prob):- 40 s(Evidence,ProbE), 41 append(Goals,Evidence,GE), 42 s(GE,ProbGE), 43 Prob is ProbGE/ProbE. 44 45/* s(GoalsList,Prob) 46 computes the probability of a query in the form of a list of literals 47*/ 48s(GoalsList,Prob):- 49 program_names(L), 50 convert_to_goal(GoalsList,Goal,L), 51 run_query(L,Goal,0,Prob). 52 53run_query([],_G,P,P). 54 55run_query([Prog|T],Goal,PIn,POut):- 56 elab_conj(Prog,Goal,Goal1), 57 slg(Goal1),!, 58 prob(Prog,P), 59 P1 is PIn+P, 60 run_query(T,Goal,P1,POut). 61 62run_query([_Prog|T],Goal,PIn,POut):- 63 run_query(T,Goal,PIn,POut). 64 65 66convert_to_goal([Goal],Goal,_Pr):-!. 67 68convert_to_goal(GoalsList,Head,Pr):- 69 get_new_atom(Atom), 70 extract_vars(GoalsList,[],V), 71 Head=..[Atom|V], 72 list2and(GoalsList,Body), 73 elab_conj(Prog,Head,HeadP), 74 elab_conj(Prog,Body,BodyP), 75 do_term_expansion((HeadP:-BodyP),LC), 76 assert_in_all_prog(LC,Prog,Pr). 77 78 79get_new_atom(Atom):- 80 retract(new_number(N)), 81 N1 is N+1, 82 assert(new_number(N1)), 83 number_atom(N,NA), 84 atom_concat('$call',NA,Atom). 85 86 87assert_in_all_prog(_LC,_Prog,[]). 88 89assert_in_all_prog(LC,Prog,[PrH|PrT]):- 90 copy_term((LC,Prog),(LC1,Prog1)), 91 Prog1=PrH, 92 assert_all(LC1), 93 assert_in_all_prog(LC,Prog,PrT). 94 95/* predicate for parsing the program file */ 96p(File):- 97 clean_db, 98 atom_concat(File,'.cpl',FilePl), 99 open(FilePl,read,S), 100 read_clauses(S,C), 101 close(S), 102 atom_concat(File,'.uni',FileUni), 103 reconsult(FileUni), 104 process_clauses(C,ClausesVar), 105 instantiate(ClausesVar,[],Clauses), 106 assert(program(1)), 107 assert(program_names([])), 108 create_programs(Clauses). 109 110clean_db:- 111 findall((P/A),(mode(Atom),functor(Atom,P,A0),A is A0+1),L), 112 findall((P/A),(mode(Atom),functor(Atom,P0,A0),A is A0+2, 113 name(P0,Pl), 114 name(P,[115,108,103,36|Pl]) % 'slg$' 115 ),Lslg), 116 abolish_all(L), 117 abolish_all(Lslg), 118 abolish(program/1), 119 abolish(program_names/1), 120 abolish(prob/2). 121 122 123abolish_all([]). 124 125abolish_all([(P/A)|T]):- 126 abolish(P/A), 127 abolish_all(T). 128 129/* create_programs(Clauses) 130 create the instances of the ground LPAD composed by Clauses 131 Each instance is identified by an atom of the form P<Number> where <Number> is an 132 increasing number. An extra argument is added to each atom in the clauses to represent 133 the identifier of the instance. 134*/ 135create_programs(Clauses):- 136 create_single_program(Clauses,1,Program), 137 retract(program(N)), 138 number_codes(N,NC), 139 atom_codes(NA,NC), 140 atom_concat(p,NA,Name), 141 N1 is N+1, 142 assert(program(N1)), 143 (setting(verbose,true)-> 144 format("Writing instance ~d~n",[N]) 145 ; 146 true 147 ), 148 write_program(Name,Program), 149 retract(program_names(L)), 150 append(L,[Name],L1), 151 assert(program_names(L1)), 152 fail. 153 154create_programs(_). 155 156write_program(Name,[(prob(P):-true)]):-!, 157 elab_conj(Name,prob(P),Pr), 158 assertz(Pr). 159 160 161write_program(Name,[(H:-B)|T]):- 162 elab_conj(Name,H,H1), 163 elab_conj(Name,B,B1), 164 do_term_expansion((H1:-B1),LC), 165 assert_all(LC), 166 write_program(Name,T). 167 168/* elab_conj(Name,Conj0,Conj) 169 adds the extra argument Name to the conjunction Conj0 resulting in Conj 170*/ 171elab_conj(_Name,true,true):-!. 172 173elab_conj(Name,\+(B),\+(B1)):-!, 174 elab_conj(Name,B,B1). 175 176elab_conj(Name,(BL,Rest),(BL1,Rest1)):-!, 177 elab_conj(Name,BL,BL1), 178 elab_conj(Name,Rest,Rest1). 179 180elab_conj(Name,bagof(V,EV^G,L),bagof(V,EV^GL,L)):-!, 181 elab_conj(Name,G,GL). 182 183elab_conj(Name,bagof(V,G,L),bagof(V,GL,L)):-!, 184 elab_conj(Name,G,GL). 185 186elab_conj(Name,setof(V,EV^G,L),setof(V,EV^GL,L)):-!, 187 elab_conj(Name,G,GL). 188 189elab_conj(Name,setof(V,G,L),setof(V,GL,L)):-!, 190 elab_conj(Name,G,GL). 191 192elab_conj(Name,findall(V,G,L),findall(V,GL,L)):-!, 193 elab_conj(Name,G,GL). 194 195elab_conj(_Name,A,A):- 196 bg(A),!. 197 198elab_conj(_Name,A,A):- 199 builtin(A),!. 200 201elab_conj(Name,Lit,Lit1):- 202 Lit\=(_,_), 203 Lit=..[Pred|Args], 204 Lit1=..[Pred,Name|Args]. 205 206 207create_single_program([],P,[(prob(P):-true)]). 208 209create_single_program([r(H,B)|T],PIn,[(HA:-B)|T1]):- 210 member((HA:P),H), 211 P1 is PIn*P, 212 create_single_program(T,P1,T1). 213 214/* predicates for producing the ground instances of program clauses */ 215 216/* instantiate(Clauses,C0,C) 217 returns in C the set of clauses obtained by grounding Clauses 218*/ 219instantiate([],C,C). 220 221instantiate([r(_V,[H:1],B)|T],CIn,COut):-!, 222 append(CIn,[r([H:1],B)],C1), 223 instantiate(T,C1,COut). 224 225instantiate([r(V,H,B)|T],CIn,COut):- 226 (setting(grounding,variables)-> 227 findall(r(H,BOut),instantiate_clause_variables(V,H,B,BOut),L) 228 ; 229 findall(r(H,BOut),instantiate_clause_modes(H,B,BOut),L) 230 ), 231 append(CIn,L,C1), 232 instantiate(T,C1,COut). 233 234 235instantiate_clause_modes(H,B,BOut):- 236 instantiate_head_modes(H), 237 list2and(BL,B), 238 instantiate_body_modes(BL,BLOut), 239 list2and(BLOut,BOut). 240 241 242instantiate_head_modes([]):-!. 243 244instantiate_head_modes([H:_P|T]):- 245 instantiate_atom_modes(H), 246 instantiate_head_modes(T). 247 248 249instantiate_body_modes(BL,BL):- 250 setting(ground_body,false),!. 251 252instantiate_body_modes(BL0,BL):- 253 instantiate_list_modes(BL0,BL). 254 255 256instantiate_list_modes([],[]). 257 258instantiate_list_modes([H|T0],T):- 259 builtin(H),!, 260 call(H), 261 instantiate_list_modes(T0,T). 262 263instantiate_list_modes([\+ H|T0],T):- 264 builtin(H),!, 265 \+ call(H), 266 instantiate_list_modes(T0,T). 267 268instantiate_list_modes([\+ H|T0],[\+ H|T]):-!, 269 instantiate_atom_modes(H), 270 instantiate_list_modes(T0,T). 271 272instantiate_list_modes([H|T0],[H|T]):- 273 instantiate_atom_modes(H), 274 instantiate_list_modes(T0,T). 275 276 277instantiate_atom_modes(''):-!. 278 279instantiate_atom_modes(A):- 280 functor(A,F,NArgs), 281 functor(TA,F,NArgs), 282 A=..[F|Args], 283 mode(TA), 284 TA=..[F|Types], 285 instantiate_args_modes(Args,Types). 286 287 288instantiate_args_modes([],[]):-!. 289 290instantiate_args_modes([H|T],[TH|TT]):- 291 type(TH,Constants), 292 member(H,Constants), 293 instantiate_args_modes(T,TT). 294 295 296instantiate_clause_variables([],_H,B,BOut):- 297 list2and(BL,B), 298 (setting(ground_body,true)-> 299 check_body(BL,BLOut) 300 ; 301 BLOut=BL 302 ), 303 list2and(BLOut,BOut). 304 305instantiate_clause_variables([VarName=Var|T],H,BIn,BOut):- 306 universe(VarNames,U), 307 member(VarName,VarNames), 308 member(Var,U), 309 instantiate_clause_variables(T,H,BIn,BOut). 310 311instantiate_clause_variables([VarName=_Var|T],H,BIn,BOut):- 312 \+ varName_present_variables(VarName),!, 313 instantiate_clause_variables(T,H,BIn,BOut). 314 315 316varName_present_variables(VarName):- 317 universe(VarNames,_U), member(VarName,VarNames). 318 319/* check_body(Body0,Body) 320 removes the true builtin literals from Body0. Fails if there is a false builtin literal. 321*/ 322check_body([],[]). 323 324check_body([H|T],TOut):- 325 builtin(H),!, 326 call(H), 327 check_body(T,TOut). 328 329check_body([H|T],[H|TOut]):- 330 check_body(T,TOut). 331 332 333/* predicates for processing the clauses read from the file */ 334/* process_clauses(Terms,Clauses) 335 processes Terms to produce Clauses 336 Terms is a list contatining elements of the form 337 ((H:-B),V) 338 Clauses is a list containing elements of the form 339 r(V,HL,BL) 340 where HL is the list of disjuncts in H and BL is the list 341 of literals in B 342*/ 343process_clauses([(end_of_file,[])],[]). 344 345process_clauses([((H:-B),V)|T],[r(V,HL,B)|T1]):- 346 H=(_;_),!, 347 list2or(HL1,H), 348 process_head(HL1,0,HL), 349 process_clauses(T,T1). 350 351process_clauses([((H:-B),V)|T],[r(V,HL,B)|T1]):- 352 H=(_:_),!, 353 list2or(HL1,H), 354 process_head(HL1,0,HL), 355 process_clauses(T,T1). 356 357process_clauses([((H:-B),V)|T],[r(V,[H:1],B)|T1]):-!, 358 process_clauses(T,T1). 359 360process_clauses([(H,V)|T],[r(V,HL,true)|T1]):- 361 H=(_;_),!, 362 list2or(HL1,H), 363 process_head(HL1,0,HL), 364 process_clauses(T,T1). 365 366process_clauses([(H,V)|T],[r(V,HL,true)|T1]):- 367 H=(_:_),!, 368 list2or(HL1,H), 369 process_head(HL1,0,HL), 370 process_clauses(T,T1). 371 372process_clauses([(H,V)|T],[r(V,[H:1],true)|T1]):- 373 process_clauses(T,T1). 374 375process_head([H:PH],P,[H:PH1|Null]):- 376 PH1 is PH, 377 PNull is 1-P-PH1, 378 setting(epsilon,Eps), 379 EpsNeg is - Eps, 380 PNull > EpsNeg, 381 (PNull>Eps-> 382 Null=['':PNull] 383 ; 384 Null=[] 385 ). 386 387process_head([H:PH|T],P,[H:PH1|NT]):- 388 PH1 is PH, 389 P1 is P+PH1, 390 process_head(T,P1,NT). 391 392/* predicates for reading in the program clauses */ 393/* read_clauses(S,Clauses) 394 read Clauses from stream S 395*/ 396read_clauses(S,Clauses):- 397 (setting(ground_body,true)-> 398 read_clauses_ground_body(S,Clauses) 399 ; 400 read_clauses_exist_body(S,Clauses) 401 ). 402 403 404read_clauses_ground_body(S,[(Cl,V)|Out]):- 405 read_term(S,Cl,[variable_names(V)]), 406 (Cl=end_of_file-> 407 Out=[] 408 ; 409 read_clauses_ground_body(S,Out) 410 ). 411 412 413read_clauses_exist_body(S,[(Cl,V)|Out]):- 414 read_term(S,Cl,[variable_names(VN)]), 415 extract_vars_cl(Cl,VN,V), 416 (Cl=end_of_file-> 417 Out=[] 418 ; 419 read_clauses_exist_body(S,Out) 420 ). 421 422 423/* extract_vars_cl(Clause,VariableNames,Couples) 424 extract from Clause couples of the form VariableName=Variable 425*/ 426extract_vars_cl(end_of_file,[]). 427 428extract_vars_cl(Cl,VN,Couples):- 429 (Cl=(H:-_B)-> 430 true 431 ; 432 H=Cl 433 ), 434 extract_vars(H,[],V), 435 pair(VN,V,Couples). 436 437 438pair(_VN,[],[]). 439 440pair([VN= _V|TVN],[V|TV],[VN=V|T]):- 441 pair(TVN,TV,T). 442 443 444extract_vars(Var,V0,V):- 445 var(Var),!, 446 (member_eq(Var,V0)-> 447 V=V0 448 ; 449 append(V0,[Var],V) 450 ). 451 452extract_vars(Term,V0,V):- 453 Term=..[_F|Args], 454 extract_vars_list(Args,V0,V). 455 456 457extract_vars_list([],V,V). 458 459extract_vars_list([Term|T],V0,V):- 460 extract_vars(Term,V0,V1), 461 extract_vars_list(T,V1,V). 462 463 464/* auxiliary predicates */ 465list2or([X],X):- 466 X\=;(_,_),!. 467 468list2or([H|T],(H ; Ta)):-!, 469 list2or(T,Ta). 470 471 472list2and([],true):-!. 473 474list2and([X],X):- 475 X\=(_,_),!. 476 477list2and([H|T],(H,Ta)):-!, 478 list2and(T,Ta). 479 480 481builtin(_A is _B). 482builtin(_A > _B). 483builtin(_A < _B). 484builtin(_A >= _B). 485builtin(_A =< _B). 486builtin(_A =:= _B). 487builtin(_A =\= _B). 488builtin(true). 489builtin(false). 490builtin(_A = _B). 491builtin(_A==_B). 492builtin(_A\=_B). 493builtin(_A\==_B). 494 495 496bg(member(_El,_L)). 497bg(average(_L,_Av)). 498bg(max_list(_L,_Max)). 499bg(min_list(_L,_Max)). 500 501 502average(L,Av):- 503 sum_list(L,Sum), 504 length(L,N), 505 Av is Sum/N. 506 507assert_all([]):-!. 508 509assert_all([(:- G)|T]):-!, 510 call(G), 511 assert_all(T). 512 513assert_all([H|T]):-!, 514 assertz((H)), 515 assert_all(T). 516 517assert_all(C):- 518 assertz((C)). 519 520member_eq(A,[H|_T]):- 521 A==H,!. 522 523member_eq(A,[_H|T]):- 524 member_eq(A,T). 525 526/* set(Par,Value) can be used to set the value of a parameter */ 527set(Parameter,Value):- 528 retract(setting(Parameter,_)), 529 assert(setting(Parameter,Value)). 530