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