/* Alpha and Beta conversion for lambda calculus. Version 5. * * Syntax: * - lam(Var, Expr). Eg. lam(X, foo(X)). * - app(LambdaExpr, Substitution). Eg. app(lam(X, foo(X)), 1) == foo(1). * * Example to clarify order of arguments: ?- betaconv(app(app(lam(X1,lam(X2, foo(X1,X2))),1),2),Res,[]). X1 = _G183 X2 = _G184 Res = foo(1, 2) Yes %*/ % Set this to "true" to enable showing the stack at each step of betaconversion debugstack :- fail. % % Set this to "true" to enable printing intermediate output of betaconversion debugconv :- fail. :- nl, writeln('run \'kb\' to print the complete knowledgebase'), writeln('run \'kb(X)\' to print the knowledgebase with regard to \X'), writeln('run \'add(X)\' or \'remove(X)\' to assert or remove a fact \X'), writeln('run \'go\' to demonstrate all working sentences'), writeln('run \'go#\' to demonstrate only the sentences from assignment #'). %Test all working sentences (sort of a "unit test"). go :- go1, go2, go3, go4, go5. % go1 :- ex0, ex1, ex2. go2 :- ex3, ex4, ex5, ex6, ex7, ex8, ex9. go3 :- ex10, ex11, ex12, ex13, ex14, ex15. go4 :- ex16, ex17, ex18, ex19, ex20, ex21, ex22, ex23, ex24, ex25, ex26. go5 :- ex27. %Assignment 1: ex0 :- ex([vincent, likes, mia]). ex1 :- ex([vincent, walks, and, vincent, likes, mia]). ex2 :- ex([vincent, walks, and, mia, walks]). %Assignment 2: ex3 :- ex([some, woman, likes, vincent]). ex4 :- ex([vincent, likes, some, woman]). ex5 :- ex([some, woman, likes, every, foot, massage]). ex6 :- ex([mia, walks, and, likes, vincent]). ex7 :- ex([mia, and, vincent, walk]). ex8 :- ex([mia,likes, john, and, vincent]). ex9 :- ex([every, man, likes, some, woman]). %Ditransitive verbs, not yet working. Quantifier should end up outside of the give-predicate: ex100 :- ex([vincent, gives, mia, a, foot, massage]). %Assignment 3: ex10 :- ex([the,boys,dance,with,the,girls]). ex11 :- ex([the,dogs,chase,the,cats]). ex12 :- ex([the,dogs,killed,the,cats]). ex13 :- ex([the,men,like,the,women]). ex14 :- ex([the,men,walk]). ex15 :- ex([the,boys,gather,in,the,yard]). %Assignment 4: ex16 :- ex([does,john,walk, and,talk]). ex17 :- ex([does,john,like,sue]). ex18 :- ex([does,john,walk,and,like,sue,or,talk,and,like,sue]). ex19 :- ex([does,every,boy,run]). ex20 :- ex([does,some,boy,run]). ex21 :- ex([who, runs]). ex22 :- ex([which, boy, runs]). ex23 :- ex([who, does, chase,the, cats]). ex24 :- ex([who,does,mia,like]). ex25 :- ex([who,does,like,mia]). ex26 :- ex([which, girl, likes, lee, and, who, does ,lee, like]). %Assignment 5: ex27 :- ex([ [every,boy,walks], [vincent,likes,mia],[vincent,likes,her],[does,he,walk], [does,she,walk],[who,does,vincent,like] ]). ex(Sentences) :- retractall(referent(_,_)), retractall(referrer(_,_,_)), retractall(discourse(_)), (exd([Sentences]) ; (exd(Sentences), writeln('The current discourse:'), listing(discourse))). exd([]). exd([Sentence|SList]) :- write('Sentence: '), writeln(Sentence), s(Sem, Sentence, []), %!, %%this shows extra debug info %write('Parsed: '), writeln(Sem), %listing(referent), listing(referrer), betaconv(Sem, Result, []), ( query(Result, Result2), Result2 =..[Q,S], resolve(S, Resolved), nl, Res =..[Q,Resolved], evaluateList([Res]) %findall(Out, (decollectivize(S, O), Out =.. [Q,O]), List); ; write('Reduced: '), writeln(Result), findall(Out, decollectivize(Result, Out), List), %only show decollectivizations when applicable: length(List, L), (L > 1 -> writeln('Decollectivizations: '), writelist(List), nl ; true), resolve(Result, Resolved), nl, add_discourse(Resolved) ), exd(SList). % ( % query(Result, Result2),!, % (\+ member(S, List), % evaluateList([Result2]); % true), % evaluateList(List) % ; % true). %Some syntatic sugar: %Quantifiers :- op(900, fx, 'A'). :- op(900, fx, 'E'). %Implication :- op(800,xfx, =>). %Conjunction :- op(500,xfy, ^). %Disjunction :- op(600,xfy, v). :- dynamic(fact/1). :- dynamic(discourse/1). :- dynamic(referrer/3). %A referrer refers, eg. he :- dynamic(referent/2). %A referent is what a referrer refers to, eg. vincent %Syntactic grammar % % s --> np,vp. % s --> s, con, s. % np --> pn. % np --> det, noun. % np --> np con np. % vp --> iv. % vp --> tv, np. % vp --> dtv, np. % vp --> vp con vp. % pn --> [mia]. % pn --> [vincent]. % pn --> [john]. % iv --> [walks]. % iv --> [talks]. % tv --> [likes]. % con --> [and]. % con --> [or]. % con --> [implies]. %semantic grammar (order matters, both that of the rules and of their conditions!) % Sentences s(ynq(YNQ)) --> ynq(YNQ). s(whq(WHQ)) --> whq(WHQ,_). s(S) --> s1(S). s(app(app(CON, S1), S2)) --> s1(S1), cons(CON), s(S2). %s(app(app(CON, S1), S2), Attr) --> s1(S1, A1), cons(CON), s(S2, A2), { append(A1, A2, Attr) }. % ?? s1(app(NP, VP)) --> np(NP, [N, G1, D1], Referrer1), vp(VP, [N, G2, D2], Referrer2), { %If NP is definite, then this NP must be a referent: ( (nonvar(Referrer1), Referrer1 = nil) -> (\+ referent(NP, [N,G1,D1]) -> asserta(referent(NP, [N,G1,D1])) ; true) ; ( \+ referrer(NP, Referrer1, [N,G1,D1]) -> asserta(referrer(NP, Referrer1, [N,G1,D1])) ; true)), ( (nonvar(Referrer2), Referrer2 = nil) -> (VP = app(NP2, _), (\+ referent(NP2, [N,G2,D2]) -> asserta(referent(NP2, [N,G2,D2])) ; true); true) ; ( \+ referrer(NP2, Referrer2, [N,G2,D2]) -> asserta(referrer(NP2, Referrer2, [N,G2,D2])) ; true)) }. %YesNo Question ynq(app(NP,VP)) --> yndet, np(NP,[_N,_G,_D], Referrer1), vp(VP, [_,_,_], Referrer2), { ((nonvar(Referrer1), Referrer1 \= nil) -> pron(NP,[N,G1,D1],Referrer1, [Referrer1],[]), asserta(referrer(NP, Referrer1, [N,G1,D1])) ; true), ((nonvar(Referrer2), Referrer2 \= nil) -> pron(PRON,[Nn,Gg,Dd],Referrer2, [Referrer2],[]), asserta(referrer(PRON, Referrer2, [Nn,Gg,Dd])) ; true) }. ynq(app(app(CON, S1), S2)) --> yndet, s1(S1), cons(CON), yndet,s(S2). ynq(app(app(CON, S1), S2)) --> yndet, s1(S1), cons(CON), s(S2). %does [+t] like john? ynqt(app(NPt,VP),Var) --> yndet, npt(NPt,Var), vp(VP,[_N,_,_], _). %does john like [+t]? ynqt(app(NP,VPt),Var) --> yndet, np(NP,[_N,_G,_D], _), vpt(VPt,Var,[_,_,_]). %Wh Question whq(WHQ,Var) --> whq1(WHQ,Var). whq(app(app(CON,WHQ1),WHQ2),_) --> whq1(WHQ1,_), cons(CON), whq(WHQ2,_). whq1(app(WHNP, lam(Var, YNQt)),Var) --> whnp(WHNP), ynqt(YNQt, Var). whq1(app(WHNP,VP),_) --> whnp(WHNP), vp(VP,[_N,_,_], _). %FIXME: agreement whnp+vp %VP %vp = vp1 + recursion. vp(VP, Attr, Referrer) --> vp1(VP,Attr, Referrer). vp(app(app(CON,VP1),VP2), Attr, Referrer) --> vp1(VP1, Attr, Referrer), con(CON), vp(VP2, Attr, _). %NP conjunction after a transitive verb: vp(app(app(CON, app(NP1,TV )),app(NP2, TV)), [N,G,D], Referrer) --> tv(TV,[N,_,_]),np1(NP1,[_,G,D],Referrer),con(CON),np(NP2,_,_). %this one works for "mia gives vincent mia": %vp(app(NP1, app(NP2, DTV))) --> dtv(DTV), np1(NP1), np(NP2). % vp1 = vp. Used to avoid left-recursion vp1(IV, Attr, nil) --> iv(IV, Attr). vp1(app(NP, TV), [N,G,D], Referrer) --> tv(TV, [N,_,_]), np(NP, [_N,G,D], Referrer). vp1(app(NP1, app(DTV, NP2)), _, _) --> dtv(DTV,_), np(NP1,_,_), np(NP2,_,_). % vp[+t] vpt(app(NPt, TV),Var,[N,_,_]) --> tv(TV,[N,_,_]),npt(NPt,Var). %NP % np = np1 plus recursion. Used to avoid left-recursion np(NP, Attr, Referrer) --> np1(NP, Attr, Referrer). %attributes of conjunctive NPs need to be combined in some way: %two definite NPs make for a definite conjunction, indefinite otherwise: np(app(app(CON, NP1), NP2), [plural,_G,D1], Referrer) --> np1(NP1, [_,_,D1], Referrer), con(CON), np(NP2, [_,_,D2], _), { D1 == D2 }. np(app(app(CON, NP1), NP2), [plural,_G,indefinite], Referrer) --> np1(NP1, [_,_,D1], Referrer), con(CON), np(NP2, [_,_,D2], _), { D1 \= D2 }. np1(PN,Attr,nil) --> pn(PN,Attr). np1(app(Det, Noun), [N,G,D], nil) --> det(Det,[_N,_G,D]), noun(Noun,[N,G,_D]). np1(PRON, Attr, Referrer) --> pron(PRON, Attr, Referrer). %which/who np whnp(WHO) --> whodet(WHO). whnp(app(WHICH,N)) --> whichdet(WHICH), noun(N,_). %np[+t] (empty np) npt(lam(P,app(P,Var)),Var) --> []. %Lexicon %Verbs iv(lam(X, walk(X)),[singular,_,_]) --> [walks]. iv(lam(X, walk(X)),[plural,_,_]) --> [walk]. iv(lam(X, talk(X)),[singular,_,_]) --> [talks]. iv(lam(X, talk(X)),[plural,_,_]) --> [talk]. iv(lam(X, run(X)),[singular,_,_]) --> [runs]. iv(lam(X, run(X)),[plural,_,_]) --> [run]. tv(lam(Y, lam(X, like(X,Y))), [singular,_,_]) --> [likes]. tv(lam(Y, lam(X, like(X,Y))), [plural,_,_]) --> [like]. tv(lam(Y, lam(X, killed(X,Y))),[_N,_,_]) --> [killed]. tv(lam(Y, lam(X, chase(X,Y))),[singular,_,_]) --> [chases]. tv(lam(Y, lam(X, chase(X,Y))),[plural,_,_]) --> [chase]. tv(lam(Y, lam(X, dance_with(X,Y))),[singular,_,_]) --> [dances,with]. tv(lam(Y, lam(X, dance_with(X,Y))),[plural,_,_]) --> [dance,with]. tv(lam(Y, lam(X, gather_in(X,Y))),[plural,_,_]) --> [gather,in]. dtv(lam(Z, lam(Y, lam(X, gives(X, Y, Z)))),[singular,_,_]) --> [gives]. dtv(lam(Z, lam(Y, lam(X, gives(X, Y, Z)))),[plural,_,_]) --> [give]. %Nouns noun(lam(X, footmassage(X)),[singular,_G,_D]) --> [foot, massage]. noun(lam(X, woman(X)),[singular,female,_D]) --> [woman]. noun(lam(X, man(X)),[singular,male,_D]) --> [man]. noun(lam(X, girl(X)),[singular,female,_D]) --> [girl]. noun(lam(X, boy(X)),[singular,male,_D]) --> [boy]. noun(lam(X, cat(X)),[singular,_G,_D]) --> [cat]. noun(lam(X, dog(X)),[singular,_G,_D]) --> [dog]. noun(lam(X, yard(X)),[singular,_G,_D]) --> [yard]. %Plural nouns, these are to be wrapped by collective entities (ce): noun(woman,[plural,female,_D]) --> [women]. noun(man,[plural,male,_D]) --> [men]. noun(girl,[plural,female,_D]) --> [girls]. noun(boy,[plural,male,_D]) --> [boys]. noun(cat,[plural,_G,_D]) --> [cats]. noun(dog,[plural,_G,_D]) --> [dogs]. pn(lam(X, app(X, vincent)),[singular,male,definite]) --> [vincent]. pn(lam(X, app(X, john)),[singular,male,definite]) --> [john]. pn(lam(X, app(X, mia)),[singular,female,definite]) --> [mia]. pn(lam(X, app(X, mary)),[singular,female,definite]) --> [mary]. pn(lam(X, app(X, sue)),[singular,female,definite]) --> [sue]. pn(lam(X, app(X, lee)),[singular,male,definite]) --> [lee]. %Singular noun with 'the' is treated as a proper noun: pn(lam(X, app(X, Z)),[singular,G,definite]) --> [the, Z], { Y =..[Z,X], noun(lam(X,Y),[singular,G,_D],[Z],[]) }. pron(lam(X, app(X, _He)), [singular, _Gender, indefinite], X) --> (['I'] ; [me]). pron(lam(X, app(X, _He)), [singular, _Gender, indefinite], X) --> [you] ; [you]. pron(lam(X, app(X, he)), [singular, male, indefinite], he) --> [he]. pron(lam(X, app(X, him)), [singular, male, indefinite], him) --> [him]. pron(lam(X, app(X, she)), [singular, female, indefinite], she) --> [she]. pron(lam(X, app(X, her)), [singular, female, indefinite], her) --> [her]. pron(lam(X, app(X, _He)), [singular, neuter, indefinite], X) --> [it] ; [it]. pron(lam(X, app(X, _He)), plural, _Gender, indefinite, X) --> [we] ; [us]. pron(lam(X, app(X, _He)), plural, _Gender, indefinite, X) --> [you] ; [you]. pron(lam(X, app(X, _He)), plural, _Gender, indefinite, X) --> [they] ; [them]. %Det %Quantifiers: det(lam(U, lam(V, 'A' (X, app(U, X) => app(V, X)))), [_,_,indefinite]) --> [every] ; [all]. det(lam(U, lam(V, 'E' (X, app(U, X) ^ app(V, X)))), [_,_,indefinite]) --> [a] ; [some]. %Quantifiers for second NP: det(lam(U, lam(V, lam(W, 'A' (X, app(U, X) => app(app(V, X),W))))), [_,_,indefindte]) --> [every] ; [all]. det(lam(U, lam(V, lam(W, 'E' (X, app(U, X) ^ app(app(V, X),W))))), [_,_,indefinite]) --> [a] ; [some]. %Det for plural nouns det(lam(U, lam(V, app(V, ce(U)))), [_,_,definite]) --> [the]. %Det for questions yndet --> [does];[do]. whodet(lam(P,lam(X,app(P,X)))) --> [who]. whichdet(lam(S,lam(P,lam(X,(app(S,X)^app(P,X)))))) --> [which]. %connectives for NP and VP con(lam(U, lam(V, lam(X, (app(U, X) ^ app(V,X)))))) --> [and]. %con(lam(U, lam(V, lam(W, lam(X, (app(app(U, X),W) ^ app(app(V,X),W))))))) --> [and]. con(lam(U, lam(V, lam(X, (app(U, X) v app(V,X)))))) --> [or]. %connectives for sentences cons(lam(U, lam(V, U => V))) --> [implies]. cons(lam(U, lam(V, U ^ V))) --> [and]. cons(lam(U, lam(V, U v V))) --> [or]. %Beta conversion ie., apply arguments to lambda expressions %app(mia, lam(X, walk(X))) --> walk(mia) betaconv(Expr, Result, []) :- var(Expr), (debugstack -> write('Stack: '), writeln([]) ; true), Result = Expr. %push variable on stack betaconv(Expr, Result, Stack) :- nonvar(Expr), Expr = app(Functor, Arg), nonvar(Functor), alphaconv(Functor, [], []-_, Alpha), (debugstack -> write('Stack: '), writeln([Arg|Stack]) ; true), (debugconv -> write(' (app) expr: '), writeln(Alpha) ; true), betaconv(Alpha, Result, [Arg|Stack]). %betaconv(Functor, Result, [Arg|Stack]). %pop from stack betaconv(Expr, Result, [Element|Stack]) :- nonvar(Expr), Expr = lam(Element, Formula), (debugstack -> write('Stack: '), writeln(Stack) ; true), (debugconv -> write(' (lam) expr: '), writeln(Formula) ; true), betaconv(Formula, Result, Stack). %handle connectives and remaining lamda-expressions betaconv(Expr, Result, []) :- nonvar(Expr), \+ (Expr = app(X, _), nonvar(X)), (debugconv -> write(' (comp) expr: '), writeln(Expr) ; true), compose(Expr, Functor, SubExprs), betaconvlist(SubExprs, Results), compose(Result, Functor, Results). %beta convert a list of expressions betaconvlist([], []). betaconvlist([Expr|Tail], [Result|Results]) :- betaconv(Expr, Result, []), betaconvlist(Tail, Results). % foo(bar) -> [foo, bar] compose(Term, Symbol, ArgList):- Term =.. [Symbol | ArgList]. %Alpha conversion, ie. rename variables so as not to conflict with variables %outside their scope. alphaconv(Expr, Sub, Free1-Free2, Result) :- var(Expr), (member(sub(Arg, Result), Sub), Expr==Arg, !, Free2=Free1 ; Result=Expr, Free2=[Expr|Free1]). %first test for lambda/quantifier alphaconv(Expr, Subs, Free1-Free2, lam(Y, F2)) :- nonvar(Expr), Expr = lam(X, F1), alphaconv(F1, [sub(X, Y) | Subs], Free1-Free2, F2). alphaconv(Expr, Subs, Free1-Free2, some(Y, F2)) :- nonvar(Expr), Expr = some(X, F1), alphaconv(F1, [sub(X, Y) | Subs], Free1-Free2, F2). alphaconv(Expr, Subs, Free1-Free2, all(Y, F2)) :- nonvar(Expr), Expr = all(X, F1), alphaconv(F1, [sub(X, Y) | Subs], Free1-Free2, F2). %then try to match binary connectives: alphaconv(Expr1, Subs, Free1-Free2, Expr2) :- nonvar(Expr1), \+ Expr1 = lam(_,_), \+ Expr1 = some(_,_), \+ Expr1 = all(_,_), \+ Expr1 = ce(_,_), compose(Expr1, Symbol, Args1), alphaconvlist(Args1, Subs, Free1-Free2, Args2), compose(Expr2, Symbol, Args2). alphaconv(Result, [], []-_, Result). %process a list of expressions alphaconvlist([], _, Free-Free, []). alphaconvlist([Expr|Tail], Subs, Free1-Free3, [Result|Results]) :- alphaconv(Expr, Subs, Free1-Free2, Result), alphaconvlist(Tail, Subs, Free2-Free3, Results). %%% Plural Noun Phrases and Ambiguity %%% %(Verb)categories of interpretation: %all boys dance with all girls, and vice versa: cat1([dance_with]). %all dogs chase all cats, but not vice versa: cat2([chase, like]). %all cats were killed by some dog, but not all dogs killed a cat: cat3([killed]). %every dog chases some cat, and every cat is chased by some dog: cat4([dance_with, chase, like, killed]). %every boy dances with some girl, and every girl dances with some boy: cat5([dance_with]). %the boys gather in the yard: cat6([gather_in]). %Given a pseudo logic formula, eg. % dance(ce(boy), ce(girl)) % return a possible disambiguation, such as: Ax boy(x) => Ey girl(y) ^ dance(x, y) %nothing to decollectivize: decollectivize(In, In) :- compose(In, _F, Args), \+ member(ce(_), Args),!. %two occurences of ce: decollectivize(In, Out) :- compose(In, F, Args), member(ce(A),Args), member(ce(B),Args), \+B=A, !, PredA =.. [A, X], PredB =.. [B, Y], PredF =.. [F, X, Y], PredG =.. [F, Y, X], ( %cat1: all of the yankees are fighting all of the 49ers, and vice versa: ( cat1(C1), member(F,C1), Out = (('A' (X, PredA => ('A' (Y, PredB => PredF)))) ^ ('A' (Y, PredB => ('A' (X, PredA => PredG))))) ); %all policemen are driving all of the demonstrators away, but not vice versa: ( cat2(C2), member(F,C2),Out = ('A' (X, PredA => ('A' (Y, PredB => PredF)))) ); %all cats were killed by some dog, but not all dogs killed a cat: ( cat3(C3), member(F,C3),Out = ('A' (Y, PredB => ('E' (X, PredA ^ PredF)))) ); %every dog chases some cat, and every cat is chased by some dog: ( cat4(C4), member(F,C4),Out = (('A' (X, PredA => ('E' (Y, PredB ^ PredF)))) ^ ('A' (Y, PredB => ('E' (X, PredA ^ PredF))))) ); %every boy dances with some girl, and vice versa: ( cat5(C5), member(F,C5), Out = (('A' (X, PredA => ('E' (Y, PredB ^ PredF)))) ^ ('A' (Y, PredB => ('E' (X, PredA ^ PredF)))) ^ ('A' (Y, PredB => ('E' (X, PredA ^ PredG)))) ^ ('A' (X, PredA => ('E' (Y, PredB ^ PredG))))) )%etc. %Out = ('A' (X, PredA => ('E' (Y, PredB ^ PredF)))) ). %single occurence of ce(): decollectivize(In, Out) :- compose(In, F, Args), member(ce(A),Args), PredA =.. [A,X], (Args = ce(A), PredF =.. [F, X]; Args = [ce(A),Y], PredF =.. [F, X, Y]; Args = [Y,ce(A)], PredF =.. [F, Y, X]), cat6(C6), (\+ member(F, C6), (Out = ('A' (X, PredA => PredF))); member(F, C6), Out = In). writelist([]). writelist([H|T]) :- writeln(H), writelist(T). %% Assignment4 % Knowledgebase %print the kb: kb :- setof(X, fact(X), L), writeln('Knowledgebase: '), nl, writelist(L). kb(X):- findall(Y, (fact(Y), Y =.. List, member(X,List)), L), write('Knowledgebase for: '),writeln(X), nl, writelist(L). %predicates to assert/remove facts add(Fact):- asserta(fact(Fact)), write('Asserted fact('), write(Fact), writeln(')'). remove(Fact):- retractall(fact(Fact)), write('Removed fact('), write(Fact), writeln(')'). %facts: fact(boy(vincent)). /* fact(man(john)). fact(woman(mary)). fact(walk(john)). fact(talk(john)). fact(talk(mary)). fact(like(john,mary)). fact(girl(mia)). fact(boy(vincent)). fact(girl(sue)). fact(boy(lee)). fact(run(lee)). fact(talk(lee)). fact(like(lee, mia)). fact(like(vincent,mia)). fact(like(mia,lee)). fact(like(sue,lee)). fact(like(mary,john)). fact(chase(ce(dog),ce(cat))). fact(run(ce(dog))). fact(run(ce(cat))). fact(cat(felix)). fact(dog(lassie)). */ %Evaluate queries %Determine if the sentence is a query query([Sentence], Sentence):- Sentence =.. [ynq|_]; Sentence =.. [whq|_]. query(Sentence, Sentence):- Sentence =.. [ynq|_]; Sentence =.. [whq|_]. %determine truth value of yesno-questions %evaluateList for evaluating single or multiple interpretations evaluateList([]). evaluateList([H|T]):- evaluate(H, Ans), write('To be evaluated: '), write(H),nl, write('The answer is '), writeln(Ans),nl, evaluateList(T). %evaluate YN-question evaluate(Query, Answer):- Query =.. [ynq|[Sentence]], (istrue(Sentence), Answer = 'yes',!; Answer = 'no'). %evaluate WHQ-question evaluate(Query, Answer):- Query =.. [whq|[S1^S2]], evaluate(whq(S1), A1), evaluate(whq(S2), A2), tosets(A1,A2,Answer). evaluate(Query, Answer):- Query =.. [whq|[Sentence]], findall(X, (betaconv(app(Sentence,X),Result,[]),istrue(Result)),A), list_to_set(A,Answer). tosets([],_,[]). tosets([H|T], List,Result):- tosets2(H, List, R), tosets(T, List, RR), append(RR,R,Result). tosets2(_,[],[]). tosets2(X, [H|T],[[X,H]|Result]):- tosets2(X, T, Result). %Determine truthvalue of formula istrue(A):-fact(A). istrue(A):-discourse(A). istrue(A ^ B):- istrue(A), istrue(B). istrue(A v B):- istrue(A); istrue(B). istrue(A => B):- \+ istrue(A),!; istrue(A), istrue(B). istrue(A):- discourse('A' (X,Pre => A)), satisfy(X, Pre). istrue(A):- fact('A' (X,Pre => A)), satisfy(X, Pre). istrue('A' (X,Pre => Post)):- findall(X, satisfy(X, Pre), List), findall(X, satisfy(X, Pre=>Post), List2), length(List,L),length(List2,L). % alltrue(Xlist, X, Pre, Post). istrue('E' (_, S)):- istrue(S). satisfy(_, S):- istrue(S). add_discourse(S):- S = S1^S2, add_discourse(S1), add_discourse(S2). add_discourse(S):- (\+ discourse(S), assert(discourse(S)); true). %Given a pseudo-logic formula, return candidates for its pronouns resolve(F, Result) :- referrer(PRON, Referrer, [N,G,D]), referent(Y,[N,G,_D]), Y = lam(Z, app(Z, Referent)), replace(Referrer, Referent, F, NewF), write('First candidate for '), write(Referrer), %write(' in '), write(PRON), write(':'), nl, writeln(Referent), %findall(Y, referent(Y, [N,G,_D]), List), %length(List, L), %(L > 1 -> % write('Candidates for '), write(X), write(' in '), write(PRON), write(':'), nl, % writelist(List), %; true), retract(referrer(PRON, Referrer, [N,G,D])), resolve(NewF, Result). %Until there are none left: resolve(Result, Result). %Replace occurences of a referrer with a referent, in a formula: replace(Referrer, Referent, S, R) :- S = A ^ B, replace(Referrer, Referent, A, A1), replace(Referrer, Referent, B, B1), R = A1 ^ B1. replace(X,_,S,S):- S =.. List, \+ member(X, List),!. replace(X,Referent,S,R):- S =.. List, append(First, [X|Rest], List), append(First, [Referent|Rest], New), N =.. New, replace(X,Referent,N,R).