kbest

This module performs reasoning over Logic Programs with Annotated Disjunctions and CP-Logic programs. It reads probabilistic program and computes the probability of queries using kbest inference.

author: - Stefano Bragaglia and Fabrizio Riguzzi
copyright: - Stefano Bragaglia and Fabrizio Riguzzi */
license: - Artistic License 2.0 https://opensource.org/licenses/Artistic-2.0

18:-use_module(library(pita)). 19 20:- thread_local kbest_input_mod/1. 21 22:-meta_predicate kbest(:,-,-). 23:-meta_predicate kbest(:,-,-,-). 24 25 26 27default_setting_kbest(epsilon_parsing, 1e-5). 28default_setting_kbest(k, 64). 29default_setting_kbest(prob_bound, 0.001). 30default_setting_kbest(prob_step, 0.001). 31 32 33 34% :- source. 35% :- yap_flag(single_var_warnings, on).

48kbest(M:Goals, K, P, Exps) :- 49 must_be(nonvar,Goals), 50 must_be(nonneg,K), 51 must_be(var,P), 52 must_be(var,Exps), 53 compute_exp(Goals,M,K,BestK), 54 convert_exps(BestK,M,Exps), 55 compute_prob(BestK,M,P).

63kbest(M:Goals, K, Exps) :- 64 must_be(nonvar,Goals), 65 must_be(nonneg,K), 66 must_be(var,Exps), 67 compute_exp(Goals,M,K,BestK), 68 convert_exps(BestK,M,Exps). 69 70compute_prob(Exps,M,P):- 71 init(Env), 72 retractall(M:v(_,_,_)), 73 maplist(exp2bdd(M,Env),Exps,LB), 74 or_list(LB,Env,BDD), 75 ret_prob(Env,BDD,P), 76 end(Env). 77 78exp2bdd(M,Env,_P-(Exp,_,_),BDD):- 79 one(Env,One), 80 foldl(choice2bdd(Env,M),Exp,One,BDD). 81 82choice2bdd(Env,M,(N,R,S),BDD0,BDD):- 83 M:rule_by_num(R, _S, _N, Head, _Body), 84 get_probs(Head,Probs), 85 get_var_n(M,Env,R,S,Probs,V), 86 equality(Env,V,N,B), 87 and(Env,BDD0,B,BDD). 88 89compute_exp(Goals,M,K,BestK):- 90 list2and(GL,Goals), 91 M:local_kbest_setting(prob_step, ProbStep), 92 ProbStepLog is log(ProbStep), 93 % NB: log(1.0) == 0.0 !!! 94 main([0.0-0.0-([], [], GL)], M, K, ProbStepLog, BestK). 95 96convert_exps([],_M,[]). 97 98convert_exps([LogP-(E, _, _)|T],M,[P-Exp|TE]):- 99 P is exp(LogP), 100 convert_exp(E,M,Exp), 101 convert_exps(T,M,TE). 102 103convert_exp([],_M,[]). 104 105convert_exp([(N,R,S)|T],M,[rule(R,Head,HeadList,Body)|TDelta]):- 106 M:rule(Head, _, N, R, S, _NH, HeadList, Body),!, 107 convert_exp(T,M,TDelta). 108 109 110 111 112/* main(Goals, K, ProbStep, Best) 113 * ------------------------------ 114 * This tail recursive predicate returns the Best K complete solutions to the 115 * given Goals. The probability bound is dinamically computed at each iteration. 116 * 117 * INPUT 118 * - Goals: list of goals to achive. 119 * - K: desired number of solutions. 120 * - ProbStep: value used to update the probability bound. 121 * 122 * OUTPUT 123 * - Best: list of best solutions (at most k). 124 */ 125main(Goals, M, K, ProbStep, Best) :- 126 K > 0, 127 main(Goals, M, ProbStep, K, 0.0, [], Best). 128 129main([], _M, _ProbStep, _Left, _Worst, Best, Best):-!. 130 131main(Goals, M, ProbStep, Left0, Worst0, Best0, Best1) :- 132 findall(Prob1-Bound-(Gnd1, Var1, Goals1), 133 (member(Prob0-Bound0-(Gnd0, Var0, Goals0), Goals), 134 Bound is Bound0+ ProbStep, 135 explore(Bound, M, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1))), 136 Found), 137 separate_main(Found, [], Complete, [], _UpperList, [], Incomplete), 138 keepbest(Complete, Left0, Left2, Worst0, Worst2, Best0, Best2), 139 main(Incomplete, M, ProbStep, Left2, Worst2, Best2, Best1). 140 141 142/* separate(List, Low, Up, Next) 143 * ----------------------------- 144 * This tail recursive predicate parses the input list and builds the list for 145 * the lower bound, the upper bound and the pending goals. 146 * The upper bound list contains both the items of the lower bound list and the 147 * incomplete ones. 148 * 149 * INPUT 150 * - List: input list. 151 * 152 * OUTPUT 153 * - Low: list for lower bound. 154 * - Up: list for upper bound. 155 * - Next: list of pending goals. 156 */ 157separate(List, Low, Up, Next) :-

164separate([Prob0-(Gnd0, [], [])|Tail], Low0, [Gnd0|Low1], Up0, [Prob0-(Gnd0, [], [])|Up1], Next0, Next1) :- !, 165 separate(Tail, Low0, Low1, Up0, Up1, Next0, Next1). 166 167separate([Prob0-(Gnd0, Var0, Goals)|Tail], Low0, Low1, Up0, [Prob0-(Gnd0, Var0, Goals)|Up1], Next0, [Prob0-(Gnd0, Var0, Goals)|Next1]) :- 168 separate(Tail, Low0, Low1, Up0, Up1, Next0, Next1). 169 170separate_main([], Low, Low, Up, Up, Next, Next) :- !.

173separate_main([Prob0-_Bound0-(Gnd0, [], [])|Tail], Low0, [Prob0-(Gnd0, [], [])|Low1], Up0, [Prob0-(Gnd0, [], [])|Up1], Next0, Next1) :- !, 174 separate_main(Tail, Low0, Low1, Up0, Up1, Next0, Next1). 175 176separate_main([Prob0-Bound0-(Gnd0, Var0, Goals)|Tail], Low0, Low1, Up0, [Prob0-Bound0-(Gnd0, Var0, Goals)|Up1], Next0, [Prob0-Bound0-(Gnd0, Var0, Goals)|Next1]) :- 177 separate_main(Tail, Low0, Low1, Up0, Up1, Next0, Next1). 178 179 180 181/* explore(ProbBound, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1)) 182 * -------------------------------------------------------------------------- 183 * This tail recursive predicate reads current explanation and returns the 184 * explanation after the current iteration without dropping below the given 185 * probability bound. 186 * 187 * INPUT 188 * - ProbBound: the desired probability bound; 189 * - Prob0-(Gnd0, Var0, Goals0): current explanation 190 * - Gnd0: list of current ground choices, 191 * - Var0: list of current non-ground choices, 192 * - Prob0: probability of Gnd0, 193 * - Goals0: list of current goals. 194 * 195 * OUTPUT 196 * - Prob1-(Gnd1, Var1, Prob1, Goals1): explanation after current iteration 197 * - Gnd1: list of final ground choices, 198 * - Var1: list of final non-ground choices, 199 * - Prob1: probability of Gnd1, 200 * - Goals1: list of final goals. 201 */ 202explore(_ProbBound, _M, Prob-(Gnd, Var, []), Prob-(Gnd, Var, [])) :- !.

207. 208 209% Negation, builtin 210explore(ProbBound, M, Prob0-(Gnd0, Var0, [\+ Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :- 211 builtin(Head), !, 212 call((\+ Head)), 213 explore(ProbBound, M, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)).

216% Negation 217explore(ProbBound, M, Prob0-(Gnd0, Var0, [\+ Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :- 218 !, 219 list2and(HeadList, Head), 220 findall(Prob-(Gnd, Var, CurrentGoals), 221 explore(ProbBound, M, 0.0-([], [], HeadList), 222 Prob-(Gnd, Var, CurrentGoals)), 223 List), 224 separate(List, [], LowerBound, [], _UpperBound, [], PendingGoals), 225 (PendingGoals \= [] -> 226 Var2 = Var0, 227 Gnd2 = Gnd0, 228 Goals1 = [\+ Head|Goals], 229 explore(ProbBound, M, Prob0-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals)) 230 ;

232 choose_clausesc(Gnd0, M, Var0, LowerBound, Var), 233 get_prob(Var, M, 1.0, Prob), 234 append(Gnd0, Var, Gnd2), 235 Prob2 is Prob0 + log(Prob), 236 explore(ProbBound, M, Prob2-(Gnd2, [], Tail), Prob1-(Gnd1, Var1, Goals1)) 237 )

240% Main, builtin 241explore(ProbBound, M, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :- 242 builtin(Head), !, 243 call(Head), 244 explore(ProbBound, M, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)). 245 % Recursive call: consider next goal (building next values) 246 247% Main, def_rule 248explore(ProbBound, M, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :- 249 M:def_rule(Head, Goals0), 250 append(Goals0, Tail, Goals2), 251 explore(ProbBound, M, Prob0-(Gnd0, Var0, Goals2), Prob1-(Gnd1, Var1, Goals1)). 252 % Recursive call: consider next goal (building next values) 253 254% Main, find_rulec 255explore(ProbBound, M, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :- 256 find_rulec(Head, M, (R, S, N), Goals, Var0, _Prob), 257 explore_pres(ProbBound, M, R, S, N, Goals, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)). 258 259explore_pres(ProbBound, M, R, S, N, Goals, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals)) :- 260 (member_eq((N, R, S), Var0); 261 member_eq((N, R, S), Gnd0)), !, 262 append(Goals, Goals0, Goals2), 263 explore(ProbBound, M, Prob0-(Gnd0, Var0, Goals2), Prob1-(Gnd1, Var1, Goals)). 264 % Recursive call: consider next goal (building next values) 265 266explore_pres(ProbBound, M, R, S, N, Goals, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1)) :- 267 append(Var0, [(N, R, S)], Var), 268 append(Goals, Goals0, Goals2), 269 get_prob(Var, M, 1.0, Prob), 270 append(Gnd0, Var, Gnd2), 271 Prob2 is Prob0 + log(Prob), 272 explore(ProbBound, M, Prob2-(Gnd2, [], Goals2), Prob1-(Gnd1, Var1, Goals1)). 273 % Recursive call: consider next goal (building next values) 274 275 276 277/* keepbest(List, K, BestK) 278 * ------------------------ 279 * This tail recursive predicate parses the given list of quads and returns the 280 * list of its best k quads. If the given list of quads contains less than k 281 * items, the predicate returns them all. 282 * 283 * INPUT 284 * - List: list of quads to parse. 285 * - K: desired number of quads. 286 * 287 * OUTPUT 288 * - BestK: final list of (at most) best k quads. 289 */ 290keepbest(List, K, BestK) :- 291 K > 0, 292 keepbest(List, K, _Left, 0.0, _Worst, [], BestK). 293 294/*keepbest([], _Left, _Worst, List, List). 295 296keepbest([Prob-(_Gnd, _Var, _Goals)|Tail], 0, Worst, List0, List1) :- 297 Prob =< Worst, !, 298 keepbest(Tail, 0, Worst, List0, List1). 299 300keepbest([Prob-(Gnd, Var, Goals)|Tail], 0, Worst, List0, List1) :- 301 Prob > Worst, !, 302 discard(Prob-(Gnd, Var, Goals), List0, List2, Worst2), 303 keepbest(Tail, 0, Worst2, List2, List1). 304 305keepbest([Prob-(Gnd, Var, Goals)|Tail], Left, Worst, List0, List1) :- 306 insert(Prob-(Gnd, Var, Goals), List0, Worst, List2, Worst2), 307 Left2 is Left - 1, 308 keepbest(Tail, Left2, Worst2, List2, List1).*/ 309 310 311 312keepbest([], Left, Left, Worst, Worst, List, List). 313 314keepbest([Prob-(_Gnd, _Var, _Goals)|Tail], 0, Left1, Worst0, Worst1, List0, List1) :- 315 Prob =< Worst0, !, 316 keepbest(Tail, 0, Left1, Worst0, Worst1, List0, List1). 317 318keepbest([Prob-(Gnd, Var, Goals)|Tail], 0, Left1, Worst0, Worst1, List0, List1) :- 319 Prob > Worst0, !, 320 discard(Prob-(Gnd, Var, Goals), List0, List2, Worst2), 321 keepbest(Tail, 0, Left1, Worst2, Worst1, List2, List1). 322 323keepbest([Prob-(Gnd, Var, Goals)|Tail], Left0, Left1, Worst0, Worst1, List0, List1) :- 324 insert(Prob-(Gnd, Var, Goals), List0, Worst0, List2, Worst2), 325 Left2 is Left0 - 1, 326 keepbest(Tail, Left2, Left1, Worst2, Worst1, List2, List1). 327 328 329 330/* insert(Prob-(Gnd, Var, Goals), Sorted0, Worst0, Sorted1, Worst1) 331 * ---------------------------------------------------------------- 332 * This tail recursive predicate inserts the given quad into the given sorted 333 * list and returns the final sorted list. The input list must be sorted. 334 * It also updates the prob value of the worst quad. 335 * 336 * INPUT 337 * - Prob-(Gnd, Var, Goals): quad to insert. 338 * - Sorted0: sorted list to insert the quad into. 339 * - Worst0: current worst prob value. 340 * 341 * OUTPUT 342 * - Sorted1: the final sorted list. 343 * - Worst1: the final worst prob value. 344 */ 345insert(Prob-(Gnd, Var, Goals), [], _Worst, [Prob-(Gnd, Var, Goals)], Prob):-!. 346 347insert(Prob-(Gnd, Var, Goals), [Prob_i-(Gnd_i, Var_i, Goals_i)|Tail], Worst, [Prob-(Gnd, Var, Goals), Prob_i-(Gnd_i, Var_i, Goals_i)|Tail], Worst) :- 348 Prob >= Prob_i, !. 349 350insert(Prob-(Gnd, Var, Goals), [Prob_i-(Gnd_i, Var_i, Goals_i)|Tail], Worst0, [Prob_i-(Gnd_i, Var_i, Goals_i)|Next], Worst1) :- 351 Prob < Prob_i, !, 352 insert(Prob-(Gnd, Var, Goals), Tail, Worst0, Next, Worst1). 353 354 355 356/* discard(Prob-(Gnd, Var, Goals), Sorted0, Sorted1, Worst) 357 * -------------------------------------------------------- 358 * This tail recursive predicate inserts the given quad into the given sorted 359 * list, removes the last quad from it and returns the final sorted list. 360 * The given sorted list contains at least one quad and must be sorted. 361 * Previous worst prob value is not needed because it necessarely changes and 362 * the new value is not known in advance. 363 * It also updates the prob value of the worst quad. 364 * 365 * INPUT 366 * - Prob-(Gnd, Var, Goals): quad to insert. 367 * - Sorted0: sorted list to insert the quad into. 368 * 369 * OUTPUT 370 * - Sorted1: the final sorted list. 371 * - Worst: the final worst prob value. 372 */ 373discard(Prob-(Gnd, Var, Goals), [_Prob_i-(_Gnd_i, _Var_i, _Goals_i)], [Prob-(Gnd, Var, Goals)], Prob) :- !. 374 375discard(Prob-(Gnd, Var, Goals), [Prob_i-(Gnd_i, Var_i, Goals_i), Prob_l-(Gnd_l, Var_l, Goals_l)|Tail], [Prob-(Gnd, Var, Goals)|Next], Worst) :- 376 Prob >= Prob_i, !, 377 discard(Prob_i-(Gnd_i, Var_i, Goals_i), [Prob_l-(Gnd_l, Var_l, Goals_l)|Tail], Next, Worst). 378 379discard(Prob-(Gnd, Var, Goals), [Prob_i-(Gnd_i, Var_i, Goals_i), Prob_l-(Gnd_l, Var_l, Goals_l)|Tail], [Prob_i-(Gnd_i, Var_i, Goals_i)|Next], Worst) :- 380 Prob < Prob_i, !, 381 discard(Prob-(Gnd, Var, Goals), [Prob_l-(Gnd_l, Var_l, Goals_l)|Tail], Next, Worst). 382 383find_rulec(H, M, (R, S, N), Body, C, P) :- 384 M:rule(H, P, N, R, S, _NH, _Head, Body), 385 not_already_present_with_a_different_head(N, R, S, C). 386 387 388not_already_present_with_a_different_head(_HeadId, _RuleId, _Subst, []). 389 390not_already_present_with_a_different_head(HeadId, RuleId, Subst, [(HeadId1, RuleId, Subst1)|Tail]) :- 391 not_different(HeadId, HeadId1, Subst, Subst1), !, 392 not_already_present_with_a_different_head(HeadId, RuleId, Subst, Tail). 393 394not_already_present_with_a_different_head(HeadId, RuleId, Subst, [(_HeadId1, RuleId1, _Subst1)|Tail]) :- 395 RuleId \== RuleId1, 396 not_already_present_with_a_different_head(HeadId, RuleId, Subst, Tail). 397 398 399 400not_different(_HeadId, _HeadId1, Subst, Subst1) :- 401 Subst \= Subst1, !. 402 403not_different(HeadId, HeadId1, Subst, Subst1) :- 404 HeadId \= HeadId1, !, 405 dif(Subst, Subst1). 406 407not_different(HeadId, HeadId, Subst, Subst). 408 409get_groundc([], _M, [], [], P, P) :- !. 410 411get_groundc([H|T], M, [H|T1], TV, P0, P1) :- 412 ground(H), !, 413 H=(N, R, S), 414 M:rule_by_num(R, S, _N, Head, _Body), 415 (nth0(N, Head, (_A:P)); 416 nth0(N, Head, (_A::P))),!, 417 P2 is P0*P, 418 get_groundc(T, M, T1, TV, P2, P1). 419 420get_groundc([H|T], M, T1, [H|TV], P0, P1) :- 421 get_groundc(T, M, T1, TV, P0, P1). 422 423get_prob([], _M, P, P) :- !. 424 425get_prob([H|T], M, P0, P1) :- 426 H=(N, R, S), 427 M:rule_by_num(R, S, _N, Head, _Body), 428 (nth0(N, Head, (_A:P)); 429 nth0(N, Head, (_A::P))),!, 430 P2 is P0*P, 431 get_prob(T, M, P2, P1). 432 433 434 435choose_clausesc(_G, _M, C, [], C). 436 437choose_clausesc(CG0, M, CIn, [D|T], COut) :- 438 member((N, R, S), D), 439 choose_clauses_present(M, N, R, S, CG0, CIn, COut, T). 440 441choose_clausesc(G0, M, CIn, [D|T], COut) :- 442 member((N, R, S), D), 443 new_head(M,N, R, S, N1), 444 \+ already_present(N1, R, S, CIn), 445 \+ already_present(N1, R, S, G0), 446 impose_dif_cons(R, S, CIn), 447 choose_clausesc(G0, M, [(N1, R, S)|CIn], T, COut). 448 449 450 451choose_clauses_present(M, N, R, S, CG0, CIn, COut, T) :- 452 already_present_with_a_different_head_ground(N, R, S, CG0), !, 453 choose_clausesc(CG0, M, CIn, T, COut). 454 455choose_clauses_present(M, N, R, S, CG0, CIn, COut, T) :- 456 already_present_with_a_different_head(N, R, S, CIn), 457 choose_a_head(N, R, S, CIn, C1), 458 choose_clausesc(CG0, M, C1, T, COut). 459 460 461 462/* new_head(N, R, S, N1) 463 * --------------------- 464 * This predicate selects an head for rule R different from N with substitution 465 * S and returns it in N1. 466 */ 467new_head(M, N, R, S, N1) :- 468 M:rule_by_num(R, S, Numbers, _Head, _Body), 469 nth0(N, Numbers, _Elem, Rest), 470 member(N1, Rest). 471 472 473 474 475/* already_present(N, R, S, [(N, R, SH)|_T]) 476 * ----------------------------------------- 477 * This predicate checks if a rule R with head N and selection S (or one of its 478 * generalizations is in C) is already present in C. 479 */ 480already_present(N, R, S, [(N, R, SH)|_T]) :- 481 S=SH. 482 483already_present(N, R, S, [_H|T]) :- 484 already_present(N, R, S, T). 485 486 487 488already_present_with_a_different_head(N, R, S, [(NH, R, SH)|_T]) :- 489 \+ \+ S=SH, NH \= N. 490 491already_present_with_a_different_head(N, R, S, [_H|T]) :- 492 already_present_with_a_different_head(N, R, S, T). 493 494already_present_with_a_different_head_ground(N, R, S, [(NH, R, SH)|_T]) :- 495 S=SH, NH \= N. 496 497already_present_with_a_different_head_ground(N, R, S, [_H|T]) :- 498 already_present_with_a_different_head_ground(N, R, S, T). 499 500 501 502impose_dif_cons(_R, _S, []) :- !. 503 504impose_dif_cons(R, S, [(_NH, R, SH)|T]) :- !, 505 dif(S, SH), 506 impose_dif_cons(R, S, T). 507 508impose_dif_cons(R, S, [_H|T]) :- 509 impose_dif_cons(R, S, T). 510 511 512 513/* choose_a_head(N, R, S, [(NH, R, SH)|T], [(NH, R, SH)|T]) 514 * -------------------------------------------------------- 515 * This predicate chooses and returns an head. 516 * It instantiates a more general rule if it is contained in C with a different 517 * head. 518 */ 519choose_a_head(N, R, S, [(NH, R, SH)|T], [(NH, R, SH)|T]) :- 520 S=SH, 521 dif(N, NH). 522 523/* choose_a_head(N, R, S, [(NH, R, SH)|T], [(NH, R, S), (NH, R, SH)|T]) 524 * -------------------------------------------------------------------- 525 * This predicate chooses and returns an head. 526 * It instantiates a more general rule if it is contained in C with a different 527 * head. 528 * It ensures the same ground clause is not generated again. 529 */ 530choose_a_head(N, R, S, [(NH, R, SH)|T], [(NH, R, S), (NH, R, SH)|T]) :- 531 \+ \+ S=SH, S\==SH, 532 dif(N, NH), 533 dif(S, SH). 534 535choose_a_head(N, R, S, [H|T], [H|T1]) :- 536 choose_a_head(N, R, S, T, T1). 537 538 539builtin(average(_L,_Av)) :- !. 540builtin(prob(_,_)) :- !. 541builtin(G) :- 542 swi_builtin(G). 543 544listN(N, N, []) :- !. 545 546listN(NIn, N, [NIn|T]) :- 547 N1 is NIn+1, 548 listN(N1, N, T). 549 550/* assert_rules() 551 * -------------- 552 * This tail recursive predicate parses the given list of (Head:Prob) couples 553 * and stores them incrementally as rules along with the other parameters. 554 * 555 * INPUT 556 * - Head: current head part. 557 * - Prob: probability of the current head part. 558 * - Index: index of the current head part. 559 * - Subst: substitution for the current head part. 560 * - Choices: list of current head parts indexes. 561 * - HeadList: complete head or list of its parts. 562 * - BodyList: complete body or list of its parts. 563 */ 564assert_rules([],_M, _Index, _HeadList, _BodyList, _Choices, _Id, _Subst) :- !. % Closing condition. 565 566assert_rules(['':_Prob], _M,_Index, _HeadList, _BodyList, _Choices, _Id, _Subst) :- !. 567 568assert_rules([Head:Prob|Tail],M, Index, HeadList, BodyList, Choices, Id, Subst) :- 569 assertz(M:rule(Head, Prob, Index, Id, Subst, Choices, HeadList, BodyList)), 570 Next is Index + 1, 571 assert_rules(Tail,M, Next, HeadList, BodyList,Choices,Id,Subst). 572 573 574list2and([],true):-!. 575 576list2and([X],X):- 577 X\=(_,_),!. 578 579list2and([H|T],(H,Ta)):-!, 580 list2and(T,Ta). 581 582member_eq(Item, [Head|_Tail]) :- 583 Item==Head, !. 584 585member_eq(Item, [_Head|Tail]) :- 586 member_eq(Item, Tail). 587 588process_head(HeadList, GroundHeadList) :- 589 ground_prob(HeadList), !, 590 process_head_ground(HeadList, 0, GroundHeadList). 591 592process_head(HeadList0, HeadList):- 593 get_probs(HeadList0,PL), 594 foldl(minus,PL,1.0,PNull), 595 append(HeadList0,['':PNull],HeadList). 596 597minus(A,B,B-A). 598 599prob_ann(_:P,P):-!. 600prob_ann(P::_,P). 601 602 603gen_head(H,P,V,V1,H1:P):-copy_term((H,V),(H1,V1)). 604gen_head_disc(H,V,V1:P,H1:P):-copy_term((H,V),(H1,V1)). 605 606 607/* process_head_ground([Head:ProbHead], Prob, [Head:ProbHead|Null]) 608 * ---------------------------------------------------------------- 609 */ 610process_head_ground([H], Prob, [Head:ProbHead1|Null]) :- 611 (H=Head:ProbHead;H=ProbHead::Head),!, 612 ProbHead1 is float(ProbHead), 613 ProbLast is 1.0 - Prob - ProbHead1, 614 prolog_load_context(module, M),kbest_input_mod(M), 615 M:local_kbest_setting(epsilon_parsing, Eps), 616 EpsNeg is - Eps, 617 ProbLast > EpsNeg, 618 (ProbLast > Eps -> 619 Null = ['':ProbLast] 620 ; 621 Null = [] 622 ). 623 624process_head_ground([H|Tail], Prob, [Head:ProbHead1|Next]) :- 625 (H=Head:ProbHead;H=ProbHead::Head), 626 ProbHead1 is float(ProbHead), 627 ProbNext is Prob + ProbHead1, 628 process_head_ground(Tail, ProbNext, Next). 629 630 631ground_prob([]). 632 633ground_prob([_Head:ProbHead|Tail]) :-!, 634 ground(ProbHead), % Succeeds if there are no free variables in the term ProbHead. 635 ground_prob(Tail). 636 637ground_prob([ProbHead::_Head|Tail]) :- 638 ground(ProbHead), % Succeeds if there are no free variables in the term ProbHead. 639 ground_prob(Tail). 640 641 642get_probs(Head, PL):- 643 maplist(prob_ann,Head,PL). 644 645/*get_probs([], []). 646 647get_probs([_H:P|T], [P1|T1]) :- 648 P1 is P, 649 get_probs(T, T1). 650*/ 651 652 653list2or([],true):-!. 654 655list2or([X],X):- 656 X\=;(_,_),!. 657 658list2or([H|T],(H ; Ta)):-!, 659 list2or(T,Ta).

681setting_vit(M:P,V):- 682 M:local_kbest_setting(P,V). 683 684assert_all([],_M,[]). 685 686assert_all([H|T],M,[HRef|TRef]):- 687 assertz(M:H,HRef), 688 assert_all(T,M,TRef). 689 690 691get_next_rule_number(PName,R):- 692 retract(PName:rule_n(R)), 693 R1 is R+1, 694 assert(PName:rule_n(R1)). 695 696 697kbest_expansion((:- begin_plp), []) :- 698 prolog_load_context(module, M), 699 kbest_input_mod(M),!, 700 assert(M:kbest_on). 701 702kbest_expansion((:- end_plp), []) :- 703 prolog_load_context(module, M), 704 kbest_input_mod(M),!, 705 retractall(M:kbest_on). 706 707kbest_expansion((:- begin_lpad), []) :- 708 prolog_load_context(module, M), 709 kbest_input_mod(M),!, 710 assert(M:kbest_on). 711 712kbest_expansion((:- end_lpad), []) :- 713 prolog_load_context(module, M), 714 kbest_input_mod(M),!, 715 retractall(M:kbest_on). 716 717kbest_expansion((Head :- Body), []):- 718 prolog_load_context(module, M),kbest_input_mod(M),M:kbest_on, 719% disjunctive clause with more than one head atom 720 Head = (_;_), !, 721 list2or(HeadListOr, Head), 722 process_head(HeadListOr, HeadList), 723 list2and(BodyList, Body), 724 length(HeadList, LH), 725 listN(0, LH, NH), 726 get_next_rule_number(M,R), 727 append(HeadList,BodyList,List), 728 term_variables(List,VC), 729 assert_rules(HeadList, M, 0, HeadList, BodyList, NH, R, VC), 730 assertz(M:rule_by_num(R, VC, NH, HeadList, BodyList)). 731 732 733kbest_expansion((Head :- Body), []):- 734 prolog_load_context(module, M),kbest_input_mod(M),M:kbest_on, 735 (Head=(_:_); Head=(_::_)), !, 736 list2or(HeadListOr, Head), 737 process_head(HeadListOr, HeadList), 738 list2and(BodyList, Body), 739 length(HeadList, LH), 740 listN(0, LH, NH), 741 get_next_rule_number(M,R), 742 append(HeadList,BodyList,List), 743 term_variables(List,VC), 744 assert_rules(HeadList, M,0, HeadList, BodyList, NH, R, VC), 745 assertz(M:rule_by_num(R, VC, NH, HeadList, BodyList)). 746 747kbest_expansion((Head :- Body), []):- 748 prolog_load_context(module, M),kbest_input_mod(M),M:kbest_on,!, 749 list2and(BodyList, Body), 750 assert(M:def_rule(Head, BodyList)). 751 752kbest_expansion(Head , []):- 753 prolog_load_context(module, M),kbest_input_mod(M),M:kbest_on, 754 Head=(_;_), !, 755 list2or(HeadListOr, Head), 756 process_head(HeadListOr, HeadList), 757 length(HeadList, LH), 758 listN(0, LH, NH), 759 get_next_rule_number(M,R), 760 term_variables(HeadList,VC), 761 assert_rules(HeadList, M, 0, HeadList, [], NH, R, VC), 762 assertz(M:rule_by_num(R, VC, NH, HeadList, [])). 763 764kbest_expansion(Head , []):- 765 prolog_load_context(module, M),kbest_input_mod(M),M:kbest_on, 766 (Head=(_:_); Head=(_::_)), !, 767 list2or(HeadListOr, Head), 768 process_head(HeadListOr, HeadList), 769 length(HeadList, LH), 770 listN(0, LH, NH), 771 get_next_rule_number(M,R), 772 term_variables(HeadList,VC), 773 assert_rules(HeadList, M, 0, HeadList, [], NH, R, VC), 774 assertz(M:rule_by_num(R, VC, NH, HeadList, [])). 775 776kbest_expansion(Head, []):- 777 prolog_load_context(module, M),kbest_input_mod(M),M:kbest_on,!, 778 assert(M:def_rule(Head, [])). 779 780:- multifile sandbox:safe_meta/2. 781 782sandbox:safe_meta(kbest:kbest(_,_,_), []). 783sandbox:safe_meta(kbest:kbest(_,_,_,_), []). 784 785:- thread_local kbest_file/1. 786 787user:term_expansion((:- kbest), []) :-!, 788 prolog_load_context(source, Source), 789 asserta(kbest_file(Source)), 790 prolog_load_context(module, M), 791 retractall(M:local_kbest_setting(_,_)), 792 findall(local_kbest_setting(P,V),default_setting_kbest(P,V),L), 793 assert_all(L,M,_), 794 assert(kbest_input_mod(M)), 795 retractall(M:rule_n(_)), 796 assert(M:rule_n(0)), 797 M:(dynamic rule_by_num/5, rule/8, rule/4, query_rule/4), 798 retractall(M:rule_by_num(_,_,_,_,_)), 799 retractall(M:rule(_,_,_,_,_,_,_,_)), 800 style_check(-discontiguous). 801 802 803user:term_expansion(end_of_file, end_of_file) :- 804 kbest_file(Source), 805 prolog_load_context(source, Source), 806 retractall(kbest_file(Source)), 807 prolog_load_context(module, M), 808 kbest_input_mod(M),!, 809 retractall(kbest_input_mod(M)), 810 style_check(+discontiguous). 811 812 813user:term_expansion(In, Out) :- 814 \+ current_prolog_flag(xref, true), 815 kbest_file(Source), 816 prolog_load_context(source, Source), 817 kbest_expansion(In, Out)