From ldb@lx.cog.brown.edu Tue May 12 09:52:11 1998 Date: Tue, 12 May 1998 09:52:55 -0400 From: Lubomir Bourdev /****************************************************** Talk Lubomir Bourdev CG170 Final Project The program supports: parsing of: adverbs, PPs, unlimited adjectives (separated with 'and' :) ) 1,2,3 person sg/pl, gender past,continuous,perfective questions on: yes/no, subject, object, PP (where), adverbs (when/how/where), NPs in PPs disambiguation of: pronouns (he, her..) definite NPs (the red book) definite NPs without heads (the green one). properties,heads and name are used in disambiguation user-aided disambiguation supported 'multiple heads' 'unifying individuals' including their attributes with NP+'to be'+NP construction: "she is a professor" maintaining a name of individual besides heads ("that girl is Jenny") maintaining and querying attributes of individuals NP+'to be'+Adjs construction: "they are large and green" It does not support: generation -- this is not easy with the way I parse... many different np-s can refer to the same individual when/how/where questions targeted to PPs are just heuristics based on the type of PP. For example, 'on NP' is defined as 'when' PP -- on the table But it could also refer to time -- on Monday. So, the heuristics is not always correct on/off of features, negation (e.g. "she is not sleeping", or "it is not bad") The failure notices are very general: "cannot dereference" instead of for example "cannot dereference "he"" Plural is not very sophisticated. It works only if the individual is in plural, not for several individuals simultaneously: "he is a student. she is a professor. they were running" -- doesn't work Note: When I use the program I often forget that it treats indefinite NP-s always as new the first time it meets them, and expects them to be definite afetr that. For example: Eugene is writing a program. who is writing a program? -- wrong! should be "...the program" Start the program with the 'start' predicate Examples: >> Jenny was beautiful ok. >> a little girl was playing outside ok. >> the girl had a big book ok. >> it was red and interesting ok. >> that girl was Jenny ok. >> was Jenny playing outside yes. >> who is little Jenny >> where was she playing outside >> _________________________ | ?- start. Hello. Please type to exit. >> a green book has been lying on a red book ok. >> the red one is lying on a table ok. >> it is large and heavy Ambiguous: the green book, the red book, the table which one? the book Ambiguous: the green book, the red book which one? the red one ok. >> what is heavy the red large heavy book >> the table is heavy and beautiful ok. >> what is heavy the red large heavy book, the heavy beautiful table >> you are stupid ok. >> you are stupid and slow ok. >> who is slow the stupid slow computer >> I am good ok. >> am I good yes. >> who is good the good student >> I am Lubo ok. >> who is good Lubo ___________________________________ | ?- start. Hello. Please type to exit. >> Eugene is running fast ok. >> he is running now ok. >> how is he running fast >> when is Eugene running now >> did he run yestarday no. >> he is a professor ok. >> the professor is an important person ok. >> is Eugene the person yes. >> is he important yes. _________________________ | ?- start. Hello. Please type to exit. >> a professor is sitting in a chair ok. >> Jenny is awesome ok. >> she is sleeping Ambiguous: Jenny, the professor which one? Jenny ok. >> Mark is the professor ok. >> is she sleepin cannot parse >> is she sleeping yes. >> what is Mark sitting in the chair ******************************************************/ :- use_module(library(lists)). /*===================================================== Operators =====================================================*/ :- op(500,xfy,&). :- op(510,xfy,=>). :- op(100,fx,`). start :- write('Hello. Please type to exit.'),nl, init_db, add_ind_by_head(agr(1,m,sg), [student], [],_ID1), add_ind_by_head(agr(2,f,sg), [computer], [],_ID2), main_loop. main_loop :- write('>> '), read_sent(Sentence), \+ Sentence=[bye], (parse(Sentence, Parse, Target)-> (dereference(Parse,Fact)-> (reply(Target, Fact)->main_loop;write('cannot reply'),nl) ; write('cannot dereference'),nl) ; write('cannot parse'),nl), main_loop. %% __ __ _ %% | \/ | __ _(_)_ __ %% | |\/| |/ _` | | '_ \ %% | | | | (_| | | | | | %% |_| |_|\__,_|_|_| |_| %% %% Some high-order routines -- analyzing the parse, dereferencing and %% disambiguating, quering and modifying the database and displaying response %% reply(yesno, fact(be_unify, _Auxs, ID, ID, _Mods)) :- !, write('yes.'),nl. reply(yesno, fact(be_attr(Attrs), Auxs, Subject, Object, _Mods)) :- !, (find_fact(be, Auxs, Subject, Object, Attrs) -> write('yes.') ; write('no. ')), nl. reply(yesno, fact(Verb, Auxs, Subject, Object, Mods)) :- !, (find_fact(Verb, Auxs, Subject, Object, Mods) -> write('yes.') ; write('no. ')),nl. reply(gap(X,T), fact(be_attr(Attrs), Auxs, Subject, Object, _Mods)) :- !, reply(gap(X,T), fact(be, Auxs, Subject, Object, Attrs)). reply(gap(X,np), fact(Verb, Auxs, Subject, Object, Mods)) :- !, setof(X, find_fact(Verb, Auxs, Subject, Object, Mods), Inds), print_individuals(Inds), nl ; write('no one / nothing.'),nl. reply(gap(_X,T), fact(Verb, Auxs, Subject, Object, _Mods)) :- !, setof(Mods, fact(Verb, Auxs, Subject, Object, Mods), ModsLst), select_modifiers_l(T, ModsLst, Selected), print_modifiers(Selected),nl. select_modifiers_l(_Type, [], []). select_modifiers_l(Type, [Mods|Rest], Selected) :- select_modifiers(Type,Mods,Sel), select_modifiers_l(Type,Rest,SelRest), append(Sel,SelRest,Selected). select_modifiers(_Type, [], []). select_modifiers(Type, [Mod|Mods], [Mod|Sel]) :- select_modifier(Type,Mod),!, select_modifiers(Type, Mods, Sel). select_modifiers(Type, [_Mod|Mods], Sel) :- select_modifiers(Type, Mods, Sel). select_modifier(Type, adv(X)) :- adverb_(X,Type). select_modifier(Type, prep(PP,_Ind)) :- pp_(PP,Type). print_modifiers([]). print_modifiers([Mod]) :- !, print_modifier(Mod). print_modifiers([Mod|Rest]) :- print_modifier(Mod), write(', '), print_modifiers(Rest). print_modifier(adv(X)) :- write(X). print_modifier(prep(PP,Ind)) :- write(PP), write(' '), serialize_individual(Ind, Lst), print_list(Lst). % reply(gap(X,T), fact(Verb, Auxs, Subject, Object, Mods)) :- !, % (setof(X,fact(Verb,Auxs,Subject, Object, Mods),Inds) -> % print_individuals(Inds), nl ; % write('no one / nothing.'),nl). reply(assertion, fact(Verb, Auxs, Subject, Object, Mods)) :- !, add_fact(Verb, Auxs, Subject, Object, Mods), write('ok.'),nl. add_fact(be_unify, _Auxs, Subject, Object, _Mods) :- !, unify_individuals(Subject, Object). add_fact(be_attr(Attrs), Auxs, Subject, Object, _Mods) :- !, add_attributes(Subject, Attrs), assert(fact(be, Auxs, Subject, Object, Attrs)). add_fact(Verb, Auxs, Subject, Object, Mods) :- !, assert(fact(Verb, Auxs, Subject, Object, Mods)). %% ____ __ %% | _ \ ___ _ __ ___ / _| ___ _ __ ___ _ __ ___ ___ _ __ %% | | | |/ _ \ '__/ _ \ |_ / _ \ '__/ _ \ '_ \ / __/ _ \ '__| %% | |_| | __/ | | __/ _| __/ | | __/ | | | (_| __/ | %% |____/ \___|_| \___|_| \___|_| \___|_| |_|\___\___|_| %% dereference(fact(Verb, Auxs, SubjR, ObjR, ModsR), fact(Verb, Auxs, Subject, Object, Mods)) :- deref_ind(SubjR, Subject), deref_ind(ObjR, Object), deref_mods(ModsR,Mods),!. deref_mods([],[]). deref_mods([ModR|ModsR],[Mod|Mods]) :- deref_mod(ModR,Mod), deref_mods(ModsR,Mods). deref_mod(prep(PP, IndR), prep(PP, Ind)) :- deref_ind(IndR,Ind). deref_mod(adv(A), adv(A)). %% void subject for intransitive verbs deref_ind(void,void). %% don't muck with the target of a question deref_ind(q(X),X). %% Proper name. Add it to database if not there yet deref_ind(name(Agr,Name), Name) :- add_ind_by_name(Agr,Name). %% new individual. Adds it to the database deref_ind(new(Agr,Head,Atts), ID) :- add_ind_by_head(Agr, [Head], Atts, ID). %% existing individual. Looks it up and disambiguates possibilities deref_ind(existing(Agr,Heads,Atts), ID) :- find_individuals(Agr, Heads, Atts, IDs), disambiguate(IDs,ID). disambiguate([ID],ID). disambiguate([ID1,ID2|IDs], ID) :- print_disambiguate([ID1,ID2|IDs]), write('which one? '), read_sent(Words), np(IndH, _, _, nogap, Words,[]), deref_ind(IndH, ID), member(ID, [ID1,ID2|IDs]),!. disambiguate(A,B) :- disambiguate(A,B). print_disambiguate([ID1|IDs]) :- write('Ambiguous: '), print_individuals([ID1|IDs]), nl. print_individuals([ID]) :- !, serialize_individual(ID, Output), print_list(Output). print_individuals([ID|Rest]) :- serialize_individual(ID, Output), print_list(Output), write(', '), print_individuals(Rest). serialize_individual(ID+1, [the | AttsHead]) :- individual(agr(_,_,sg), [Head|_Rest], Atts, ID+1), append(Atts,[Head],AttsHead), !. serialize_individual(ID+1, [the | AttsHead]) :- individual(agr(_,_,pl), [Head|_Rest], Atts, ID+1), n_(Head,Heads,_), append(Atts,[Heads],AttsHead), !. serialize_individual(Name, [Name]). print_list([]). print_list([A|Rest]) :- write(' '), write(A), print_list(Rest). %% ____ %% | _ \ __ _ _ __ ___ ___ _ __ %% | |_) / _` | '__/ __|/ _ \ '__| %% | __/ (_| | | \__ \ __/ | %% |_| \__,_|_| |___/\___|_| %% %% parse(Sentence, Fact, assertion):- s(Fact, nogap, Sentence, []),!. parse(Sentence, Query, Target):- q(Query, Target, Sentence, []),!. q(fact(Verb,Aux,q(X),Obj,Mods), gap(X,np)) --> whpron(gap(X,np,agr(P,_G,N),subjective)), vp(Verb,Aux,Obj,Mods,agr(_Tense,N,P), nogap). q(Fact,gap(X,T)) --> whpron(gap(X,T,Agr,S)), s_inv(Fact, gap(X,T,Agr,S)). q(Fact,yesno) --> s_inv(Fact,nogap). s_inv(fact(Verb,[Tense|Aux],Subj,Obj,Mods), Gap) --> aux(agr(Tense,N,P),Form), np(Subj, agr(P,_G,N), subjective, nogap), vp(Verb,Aux,Obj,Mods,Form,Gap). s(fact(Verb,Auxs,Subj,Obj,Mods), Gap) --> np(Subj, agr(P,_G,N), subjective, nogap), vp(Verb,Auxs,Obj,Mods, agr(_Tense,N,P),Gap). whpron(gap(_,np, agr(_,f,_),subjective)) --> [who],!. whpron(gap(_,np, agr(_,m,_),subjective)) --> [who],!. whpron(gap(_,np, agr(3,_,sg),_ )) --> [what],!. whpron(gap(_,np, agr(_,_,_), objective)) --> [whom],!. whpron(gap(_,how,agr(_,_,_), objective)) --> [how],!. whpron(gap(_,when,agr(_,_,_), objective)) --> [when],!. whpron(gap(_,where,agr(_,_,_), objective)) --> [where],!. %%%%% Verb phrase vp(Verb, Aux, Obj, Mods, Form, Gap) %% Verb is the verb in infinitive (e.g. sleep, jump, give) %% Aux is a list of auxiliaries %% Obj is parameters of an individual (individual handler) %% Mods is a list of modifiers %% a modifier is either a PP or an adverb %% (e.g. prep(with,'Jenny'), prep(slowly)) ). %% Form is the input form (e.g. pres or pastp) %% Gap is gap(X,, , ) or nogap vp(Verb, Aux, void, Mods, Form, Gap) --> v(it, Verb, Form), opt_mods(Mods, Gap), {do_remover(Form,Aux)}. vp(Verb, Aux, Obj, Mods, Form, Gap) --> {distribute(Gap,Gap1,Gap2) }, v(tr, Verb, Form), np(Obj, _Agr, objective, Gap1), opt_mods(Mods, Gap2), {do_remover(Form,Aux)}. % must take into account do insertion in yes-no questions do_remover(inf(do),[]):-!. do_remover(agr(Tense,_,_), [Tense]):-!. do_remover(Form, [Form]). vp(Verb, [Aux|Auxs], Obj, Mods, Form, Gap) --> aux(Form, Form1), vp(Verb, Auxs, Obj, Mods, Form1, Gap), {agr_remover(Form, Aux)}. agr_remover(agr(Tense,_,_), Tense):- !. agr_remover(Aux, Aux). %% Special case: NP (AUX)+be Adjectives (it is long and beautiful). %% return be_attr([beautiful,long]) as verb type to indicate this case... vp(be_attr(Attr), [], void, Mods, presp, Gap) --> opt_adjs(Attr), opt_mods(Mods, Gap). %% Special case: NP (AUX)+be NP (that girl is Jenny) %% return be_unify as verb type to indicate this case. Send NP as object vp(be_unify, [], Obj, Mods, presp, Gap) --> {distribute(Gap,Gap1,Gap2) }, np(Obj, _Agr, objective, Gap1), opt_mods(Mods, Gap2). distribute(nogap,nogap,nogap). distribute(gap(A,B,C,D), nogap, gap(A,B,C,D)). distribute(gap(A,B,C,D), gap(A,B,C,D), nogap). %% up to one -- limit because of left recursion opt_mods([], nogap) --> []. opt_mods(Mod1, Gap) --> modifier(Mod1, Gap). modifier([adv(Adv)],nogap) --> [Adv], {adverb_(Adv,_)}. modifier([],gap(_,how,_Agr,_Case)) --> []. modifier([],gap(_,when,_Agr,_Case)) --> []. modifier([],gap(_,where,_Agr,_Case)) --> []. modifier([prep(PP,NP)], Gap) --> [PP], {pp_(PP,_)}, np(NP,_Agr,subjective, Gap). %%%%% Noun phrase np(Semantics, Agreement, Case, Gap) %% Semantics is an individual handler of type existing/new/name %% Agreement is agr(person,gender,number) %% Case is subjective or objective %% Gap is gap(X,, , ) or nogap np(q(X),Agr,Case, gap(X,np,Agr,Case)) --> []. %% if the individual already exists, doesn't add it again np(name(Agr,PN), Agr, _Case, nogap) --> [PN], {pn_(PN,Agr)}. %% existing individual. Looks it up. np(existing(Agr,[Head],Atts), Agr, _Case, nogap) --> det(existing, Agr), opt_adjs(Atts), n(Head, Agr). %% "the good one" -- no head np(existing(Agr,[],Atts), Agr, _Case, nogap) --> det(existing, Agr), opt_adjs(Atts), one(Agr). %% new individual. Adds it to the database np(new(Agr,Head,Atts), Agr, _Case, nogap) --> det(new, Agr), opt_adjs(Atts), n(Head, Agr). %% pronoun. Must refer to existing individual np(existing(Agr,[],[]), Agr, Case, nogap) --> pronoun(Agr,Case). %% beautiful and lovely and great and awesome... opt_adjs([]) --> []. opt_adjs([Attr]) --> opt_adj(Attr). opt_adjs([Attr|Attrs]) --> opt_adj(Attr), [and], opt_adjs(Attrs). opt_adj(Adj) --> [very], opt_adj(Adj). opt_adj(Adj) --> [Adj], {adj_(Adj)}. aux(agr(pres,sg,1), B) --> [Aux], {aux_(B, w(Aux), _, _, _, _, _, _, _)}. aux(agr(pres,sg,2), B) --> [Aux], {aux_(B, _, w(Aux), _, _, _, _, _, _)}. aux(agr(pres,sg,3), B) --> [Aux], {aux_(B, _, _, w(Aux), _, _, _, _, _)}. aux(agr(pres,pl,_), B) --> [Aux], {aux_(B, _, w(Aux), _, _, _, _, _, _)}. aux(agr(past,sg,1), B) --> [Aux], {aux_(B, _, _, _, w(Aux), _, _, _, _)}. aux(agr(past,sg,2), B) --> [Aux], {aux_(B, _, _, _, _, w(Aux), _, _, _)}. aux(agr(past,sg,3), B) --> [Aux], {aux_(B, _, _, _, w(Aux), _, _, _, _)}. aux(agr(past,pl,_), B) --> [Aux], {aux_(B, _, _, _, _, w(Aux), _, _, _)}. aux(inf(will) , B) --> [Aux], {aux_(B, _, _, _, _, _, w(Aux), _, _)}. aux(pastp , B) --> [Aux], {aux_(B, _, _, _, _, _, _, w(Aux), _)}. aux(presp , B) --> [Aux], {aux_(B, _, _, _, _, _, _, _, w(Aux))}. v(T, LF,agr(pres,sg,1)) --> [V], {v_(T, V, _, _, _, _, _, LF)}. v(T, LF,agr(pres,sg,2)) --> [V], {v_(T, V, _, _, _, _, _, LF)}. v(T, LF,agr(pres,sg,3)) --> [V], {v_(T, _, V, _, _, _, _, LF)}. v(T, LF,agr(pres,pl,_)) --> [V], {v_(T, V, _, _, _, _, _, LF)}. v(T, LF,agr(past,_ ,_)) --> [V], {v_(T, _, _, V, _, _, _, LF)}. v(T, LF,inf(_) ) --> [V], {v_(T, _, _, _, V, _, _, LF)}. v(T, LF,pastp ) --> [V], {v_(T, _, _, _, _, V, _, LF)}. v(T, LF,presp ) --> [V], {v_(T, _, _, _, _, _, V, LF)}. n(N, agr(_,G,sg)) --> [N], {n_(N ,_,G)}. n(LF,agr(_,G,pl)) --> [N], {n_(LF,N,G)}. pronoun(Agr,subjective) --> [P], {pronoun_(P, _, Agr)}. pronoun(Agr,objective ) --> [P], {pronoun_(_, P, Agr)}. det(existing, agr(3,_,_ )) --> [the]. det(existing, agr(3,_,sg)) --> [this]. det(existing, agr(3,_,sg)) --> [that]. det(existing, agr(3,_,pl)) --> [these]. det(existing, agr(3,_,pl)) --> [those]. det(new, agr(3,_,pl)) --> []. det(new, agr(3,_,sg)) --> [a]. det(new, agr(3,_,sg)) --> [an]. det(new, agr(3,_,pl)) --> [some]. one(agr(_,_,sg)) --> [one]. one(agr(_,_,pl)) --> [ones]. %% ____ _ _ _ %% | _ \(_) ___| |_(_) ___ _ __ __ _ _ __ _ _ %% | | | | |/ __| __| |/ _ \| '_ \ / _` | '__| | | | %% | |_| | | (__| |_| | (_) | | | | (_| | | | |_| | %% |____/|_|\___|\__|_|\___/|_| |_|\__,_|_| \__, | %% |___/ %% n_(author, authors, m/f). n_(professor, professors, m/f). n_(programmer,programmers,m/f). n_(computer, computers, n). n_(student, students, m/f). n_(book, books, n). n_(program, programs, n). n_(girl, girls, f). n_(boy, boy, n). n_(guy, guys, m). n_(table, tables, n). n_(house, houses, n). n_(ground, grounds, n). n_(chair, chairs, n). n_(game, games, n). n_(weather, no_pl(w), n). n_(person, people, m/f). pn_('Mark', agr(3,m,sg)). pn_('Eugene',agr(3,m,sg)). pn_('Jenny', agr(3,f,sg)). pn_('Lubo', agr(_,m,sg)). pn_('Benoit',agr(_,m,sg)). pn_('Marcin',agr(_,m,sg)). pn_('Koko', agr(_,_,sg)). adj_(interesting). adj_(important). adj_(large). adj_(beautiful). adj_(lovely). adj_(great). adj_(awesome). adj_(smart). adj_(slow). adj_(red). adj_(green). adj_(stupid). adj_(blue). adj_(little). adj_(big). adj_(good). adj_(bad). adj_(heavy). pronoun_('I', me, agr(1,m,sg)). pronoun_(he, him, agr(3,m,sg)). pronoun_(she, her, agr(3,f,sg)). pronoun_(it, it, agr(3,n,sg)). pronoun_(we, us, agr(1,_,pl)). pronoun_(you, you, agr(2,_,_ )). pronoun_(they,them,agr(3,_,pl)). aux_(future, w(will),w(will),w(will),nil, nil, nil, nil, nil). aux_(pastp, w(have),w(have),w(has), w(had),w(had), w(have),nil, nil). aux_(presp, w(am), w(are), w(is), w(was),w(were),w(be), w(been),nil). aux_(pass, w(am), w(are), w(is), w(was),w(were),w(be), w(been),w(being)). aux_(inf(do),w(do), w(do), w(does),w(did),nil, nil, nil, nil). v_(it, halt, halts, halted, halt, halted, halting, halt). v_(it, sleep, sleeps, slept, sleep, slept, sleeping, sleep). v_(it, run, runs, ran, run, run, running, run). v_(it, play, plays, played, play, played, playing, play). v_(it, sit, sits, sat, sit, sat, sitting, sit). v_(it, lie, lies, lay, lie, lay, lying, lie). v_(tr, read, reads, read, read, read, reading, read). v_(tr, write, writes, wrote, write, written,writing, write). v_(tr, meet, meets, met, meet, met, meeting, meet). v_(tr, have, has, had, have, had, having, have). v_(tr, see, sees, saw, see, seen, seeing, see). pp_(with, how). pp_(in, where). pp_(on, where). pp_(to, how). pp_(from, which). pp_(of, which). adverb_(slowly, how). adverb_(fast, how). adverb_(now, when). adverb_(yestarday, when). adverb_(tomorrow, when). adverb_(outside, where). %% ____ _ _ %% | _ \ __ _| |_ __ _| |__ __ _ ___ ___ %% | | | |/ _` | __/ _` | '_ \ / _` / __|/ _ \ %% | |_| | (_| | || (_| | |_) | (_| \__ \ __/ %% |____/ \__,_|\__\__,_|_.__/ \__,_|___/\___| %% %% Includes routines for adding new individuals, searching %% individuals with certain criteria, unifying individuals, etc. init_db :- (retract(last_id(_)) ->assert(last_id(0)) ; assert(last_id(0))), reset_individuals, reset_facts, assert(individual(void,void,void,void)), assert(fact(void,void,void,void,void)). reset_individuals :- retract(individual(_,_,_,_)), reset_individuals, !. reset_individuals. reset_facts :- retract(fact(_,_,_,_,_)), reset_facts, !. reset_facts. new_id(A) :- retract(last_id(K)), A=K+1, assert(last_id(A)). %% Be sure to have NameID, Heads and Atts bound! add_ind_by_name(Agr, NameID) :- individual(Agr1, _Heads, _Atts, NameID), !, Agr = Agr1. add_ind_by_name(Agr, NameID) :- assert(individual(Agr, [], [], NameID)). add_ind_by_head(Agr, Heads, Atts, ID) :- new_id(ID), assert(individual(Agr, Heads, Atts, ID)), add_attr_fact(ID, Atts). add_attr_fact(_ID, []) :- !. add_attr_fact(ID, Atts) :- add_fact(be, [pres], ID, void, Atts). find_fact(Verb, Auxs, Subj, Obj, Atts) :- fact(Verb, Auxs, Subj, Obj, Atts1), subset(Atts,Atts1). find_individuals(Agr, Heads, Atts, IDs) :- setof(ID,[Agr,Heads,Atts]^find_individual(Agr,Heads,Atts,ID),IDs). % be sure to bind Heads and Atts!!! Use [] if needed find_individual(agr(P,G1,N), Heads, Atts, ID) :- individual(agr(P,G,N),Heads1,Atts1, ID), gender_agree(G,G1,_), subset(Heads,Heads1), subset(Atts, Atts1). add_attributes(ID, []) :- !, individual(_Agr,_Heads,_Atts, ID). add_attributes(ID, NewAtts) :- individual(Agr,Heads,Atts, ID), union(Atts,NewAtts,AllAtts), retract(individual(Agr,Heads,Atts, ID)), assert( individual(Agr,Heads,AllAtts, ID)). unify_individuals(ID1,ID2) :- individual(agr(P,G1,N),Heads1,Atts1, ID1), individual(agr(P,G2,N),Heads2,Atts2, ID2), \+ ID1=ID2, gender_agree(G1,G2,G), select_id(ID1,ID2,GoodID,BadID), union(Heads1,Heads2,Heads), union(Atts1,Atts2,Atts), retract(individual(agr(P,G1,N),Heads1,Atts1, ID1)), retract(individual(agr(P,G2,N),Heads2,Atts2, ID2)), assert( individual(agr(P,G,N),Heads, Atts, GoodID)), %% replace badID with goodID in the facts database replace_ind(BadID, GoodID). gender_agree(G,G,G). gender_agree(m/f,m, m). gender_agree(m/f,f, f). gender_agree(m,m/f, m). gender_agree(f,m/f, f). select_id(A+1, B+1, A+1, B+1) :- !. %% two numbers select_id(A+1, Name, Name, A+1) :- !. select_id(Name, A+1, Name, A+1) :- !. %% %% Replacing individual's ID-s in the fact database after two individuals unify %% replace_ind(OldID, NewID) :- replace_subj_ind(OldID, NewID), replace_obj_ind(OldID, NewID), replace_mod_ind(OldID, NewID). replace_subj_ind(OldID, NewID) :- fact(Verb, Auxs, OldID, Obj, Mods), !, retract(fact(Verb, Auxs, OldID, Obj, Mods)), assert( fact(Verb, Auxs, NewID, Obj, Mods)), replace_subj_ind(OldID, NewID). replace_subj_ind(_OldID, _NewID). replace_obj_ind(OldID, NewID) :- fact(Verb, Auxs, Subj, OldID, Mods), !, retract(fact(Verb, Auxs, Subj, OldID, Mods)), assert( fact(Verb, Auxs, Subj, NewID, Mods)), replace_obj_ind(OldID, NewID). replace_obj_ind(_OldID, _NewID). %% Deal with that later replace_mod_ind(_OldID, _NewID). %% ___ __ ___ %% |_ _| / / / _ \ %% | | / / | | | | %% | | / / | |_| | %% |___| /_/ \___/ %% %%% read_sent(Words) %%% ================ %%% %%% Words ==> set of words read from the %%% standard input %%% %%% Words are delimited by spaces and the %%% line is ended by a newline. Case is not %%% folded; punctuation is not stripped. read_sent(Words) :- get0(Char), % prime the lookahead read_sent(Char, Words). % get the words % Newlines end the input. read_sent(C, []) :- newline(C), !. % Spaces are ignored. read_sent(C, Words) :- space(C), !, get0(Char), read_sent(Char, Words). % Everything else starts a word. read_sent(Char, [Word|Words]) :- read_word(Char, Chars, Next), % get the word name(Word, Chars), % pack the characters % into an atom read_sent(Next, Words). % get some more words %%% read_word(Chars) %%% ================ %%% %%% Chars ==> list of characters read from standard %%% input and delimited by spaces or %%% newlines % Space and newline end a word. read_word(C, [], C) :- space(C), !. read_word(C, [], C) :- newline(C), !. % All other chars are added to the list. read_word(Char, [Char|Chars], Last) :- get0(Next), read_word(Next, Chars, Last). %%% space(Char) %%% =========== %%% %%% Char === the ASCII code for the space %%% character space(32). %%% newline(Char) %%% ============= %%% %%% Char === the ASCII code for the newline %%% character newline(10). %% _ _ _ _ _ _ _ _ %% | | | | |_(_) (_) |_(_) ___ ___ %% | | | | __| | | | __| |/ _ \/ __| %% | |_| | |_| | | | |_| | __/\__ \ %% \___/ \__|_|_|_|\__|_|\___||___/ %% append_uniquely(El, Lst, Lst) :- member(El,Lst),!. append_uniquely(El, In, [El|In]). union([],A,A). union([X|Rest],A,Out) :- append_uniquely(X,A,XA), union(Rest,XA,Out). subset([],_). subset([X|Rest],A) :- member(X,A), subset(Rest,A).