1:-module(models,[]). 2:- use_module(util(math)). 3:- use_module(util(misc)). 4:- use_module(pac(basic)). 5:- use_module(pac(meta)). 6
44
64
65start(F,Q,R):- split(F,F1), remove([],F1,F2),
66 maplist(herbrand,F2,Facts),
67 herbrand(Q,Query),
68 individuals(Facts,Inds),
69 (models(Inds,Facts,[],Query)-> R1=true; R1=false),
70 term_smash0(["<font color=\"red\">", R1, "</font>\n"], R).
71
72set_of_individuals(F,R):- split(F,F1), remove([],F1,F2),
73 maplist(herbrand,F2,Facts),
74 individuals(Facts,Inds),
75 insert(",", Inds, Inds0),
76 term_smash0(Inds0,R).
77
78individuals(F,S):- maplist(atoms,F,F1),
79 append(F1,F2),
80 sort(F2,S).
81
82atoms(X,[X]):-atomic(X),!.
83atoms(X,Y):- is_list(X),!,
84 maplist(atoms, X, Z),
85 append(Z, Y).
86atoms(X,Y):- X=..[_|A],
87 maplist(atoms, A, B),
88 append(B, Y).
89
93
97
100:- op(1100,xfx, <=>). 101
102def_macro(false, not(true)).
105def_macro(imply(X,Y), or(not(X), Y)).
106def_macro(iff(X,Y), and(imply(X,Y), imply(Y,X))).
107def_macro(all(X,P), not(some(X, not(P)))).
110models(_,_,_,true) :-!.
111models(X,Y,M,and(P,Q)) :-!, models(X,Y,M,P), models(X,Y,M,Q).
112models(X,Y,M,or(P,Q)) :-!, (models(X,Y,M,P); models(X,Y,M,Q)).
113models(X,Y,M,not(P)) :-!, \+ models(X,Y,M,P). 114models(I,F,M,some(X,P)):-!, member(A,I), models(I,F,[X=A|M],P).
115models(I,F,M,P):- def_macro(P,P1), !, models(I,F,M,P1).
116models(_,F,M,P):- substitute(P,M,Q), member(Q,F).
117
118
121substitute(X,M,Y):-atomic(X), member(X=Y,M), !.
122substitute(X,_,X):-atomic(X),!.
123substitute(X,M,Y):-
124 functor(X,F,N),
125 functor(Y,F,N),
126 substitute(1,X,M,Y).
128substitute(J,X,M,Y):-
129 arg(J,X,A),
130 !,
131 substitute(A,M,B),
132 arg(J,Y,B),
133 K is J+1,
134 substitute(K,X,M,Y).
135substitute(_,_,_,_).
136
138run :- prompt(A,''),
139 (sample(S), get0(_), format("~w.",[S]),
140 call(models:S, X), get0(_), nl,
141 format("~w~n~n",[X]), fail; prompt(_, A)).
142
143sample(semantics(pn, [john],
144 [male(j),male(b),female(m),unicorn(u),
145 find(m,u),walk(j),walk(b),walk(m)])).
146sample(semantics(np, [a, unicorn],
147 [male(j),male(b),female(m),unicorn(u),
148 find(m,u),walk(j),walk(b),walk(m)])).
149sample(semantics(s, [a, unicorn, walk],
150 [male(j),male(b),female(m),
151 unicorn(u), find(m,u),walk(j),walk(b),walk(m)])).
152sample(semantics(vp, [find, a, unicorn],
153 [male(j),male(b),female(m),unicorn(u),
154 find(m,u),walk(j),walk(b),walk(m)])).
155sample(semantics(s, [john,find, a, unicorn],
156 [male(j),male(b),female(m),unicorn(u),
157 find(m,u),walk(j),walk(b),walk(m)])).
158sample(semantics(pn, [john], [man(a),find(j,a),walk(j)])).
159sample(semantics(pn, [john], [man(a),find(j,a),walk(j)])).
160sample(semantics(tv, [find], [man(a),find(j,a),walk(j)])).
161sample(semantics(itv, [walk], [man(a),find(j,a),walk(j)])).
162sample(semantics(vp, [find, a, unicorn], [unicorn(a),find(j,a),walk(j)])).
163sample(semantics(s, [john, walk], [man(a),find(j,a),walk(j)])).
164sample(semantics(s, [every, man, walk], [man(a),find(j,a),walk(j)])).
165sample(semantics(s, [every, man, walk], [man(j),find(j,a),walk(j)])).
167s(member(VP,NP)) --> np(NP), vp(VP).
169np(apply(currify(A), CN)) --> determiner(A), cn(CN).
170np(PN) --> pn(PN).
172vp(ITV) --> itv(ITV).
173vp(inverse(currify(TV), NP)) --> tv(TV), np(NP).
175itv(ext(walk))-->[walk].
177tv(ext(find)) --> [find].
178tv(ext(kick)) --> [kick].
180pn(filter(j)) --> [john].
181pn(filter(b)) --> [bill].
182pn(filter(m)) --> [mary].
184cn(ext(unicorn)) --> [unicorn].
185cn(ext(man)) --> [man].
186cn(ext(woman)) --> [woman].
188determiner(q_sem(a)) --> [a].
189determiner(q_sem(a)) --> [some]. 190determiner(q_sem(every)) --> [every].
191
200semantics(S, Facts, V) :- semantics(s, S, Facts, V).
202semantics(C, S, F, V):- call(C, E, S, []),
203 individuals(F, Inds),
204 sem(Inds, F, E, V).
205semantics(_,_,_,'** Category mismatch ?').
207sem(_, Fac, ext(R), V) :- !, extension(Fac,R,V1), sort(V1,V).
208sem(D, _, filter(S), V) :- !, math:principal_filter(D, S, V).
209sem(D, _, q_sem(Q), V) :- !, q_sem(Q, D, V).
210sem(D, F, E, V) :- compound(E), !,
211 functor(E, G, N),
212 functor(E0, G, N),
213 sem_args(1, D, F, E, E0),
214 call(E0, V).
216sem_args(I, D, F, E, E0):- arg(I, E, A), !,
217 arg(I, E0, B),
218 sem(D, F, A, B),
219 J is I + 1,
220 sem_args(J, D, F, E, E0).
221sem_args(_, _, _, _, _).
222
224extension([],_, []).
225extension([A|B],R, [A1|B1]):- A=..[R|L], !,
226 convert(L,A1),
227 extension(B,R,B1).
228extension([_|B],R, B1):- extension(B,R,B1).
230convert([], void):-!.
231convert([X], X):- !.
232convert([X|Y], (X,Y1)):- convert(Y,Y1).
233
235apply(F,A,V):- member(B-V,F), subset(A, B), subset(B, A).
236
238member(X,Y,true) :- member(X,Y),!.
239member(_,_,false).
241currify --> math:rel_to_fun.
242
245q_sem(a, D, R):- !, powerset(D,PowD),
246 ( setof((X,Y), (member(X,PowD), member(Y,PowD), meet(X,Y)), R)
247 -> true
248 ; R=[]
249 ).
250q_sem(every, D, R):- powerset(D,PowD),
251 ( setof((X,Y), (member(X,PowD), member(Y,PowD), subset(X,Y)), R)
252 -> true
253 ; R=[]
254 ).
255
257meet(X,Y):- member(A,X), member(A,Y).
259inverse(F, R, S):- inverse_image(F,R,S)