2
8
10
11:-public hi/0, hi/1, quote/1. 12
13:- mode control(+),
14 doing(+,+),
15 uses(+,?),
16 process(+),
17 simplify(+,?),
18 simplify(+,?,?),
19 simplify_not(+,?),
20 revand(+,+,?),
21 report(?,+,+,+),
22 report_item(+,?). 23
24
30
31eg( [ does, america, contain, new_york, ? ] ).
32eg( [ does, mexico, border, the, united_states, ? ] ).
33eg( [ is, the, population, of, china, greater, than, nb(200), million, ? ] ).
34eg( [ does, the, population, of, china, exceed, nb(1000), million, ? ] ).
35eg( [ is, the, population, of, china, nb(840), million, ? ] ).
36eg( [ does, the, population, of, china, exceed, the, population, of,
37 india, ? ] ).
38eg( [ is, spain, bordered, by, the, pacific, ? ] ).
39eg( [ does, the, atlantic, border, spain, ? ] ).
40eg( [ is, the, rhine, in, switzerland, ? ] ).
41eg( [ is, the, united_kingdom, in, europe, ? ] ).
42
43
50
51ed( 1, [ what, rivers, are, there, ? ],
52
53 [amazon, amu_darya, amur, brahmaputra, colorado,
54 congo_river, cubango, danube, don, elbe, euphrates, ganges,
55 hwang_ho, indus, irrawaddy, lena, limpopo, mackenzie,
56 mekong, mississippi, murray, niger_river, nile, ob, oder,
57 orange, orinoco, parana, rhine, rhone, rio_grande, salween,
58 senegal_river, tagus, vistula, volga, volta, yangtze,
59 yenisei, yukon, zambesi] ).
60
61ed( 2, [ does, afghanistan, border, china, ? ],
62
63 [true] ).
64
65ed( 3, [ what, is, the, capital, of, upper_volta, ? ],
66
67 [ouagadougou] ).
68
69ed( 4, [ where, is, the, largest, country, ? ],
70
71 [asia, northern_asia] ).
72
73ed( 5, [ which, countries, are, european, ? ],
74
75 [albania, andorra, austria, belgium, bulgaria, cyprus,
76 czechoslovakia, denmark, east_germany, eire, finland,
77 france, greece, hungary, iceland, italy, liechtenstein,
78 luxembourg, malta, monaco, netherlands, norway, poland,
79 portugal, romania, san_marino, spain, sweden, switzerland,
80 united_kingdom, west_germany, yugoslavia] ).
81
82ed( 6, [ which, country, '''', s, capital, is, london, ? ],
83
84 [united_kingdom] ).
85
86ed( 7, [ which, is, the, largest, african, country, ? ],
87
88 [sudan] ).
89
90ed( 8, [ how, large, is, the, smallest, american, country, ? ],
91
92 [0--ksqmiles] ).
93
94ed( 9, [ what, is, the, ocean, that, borders, african, countries,
95 and, that, borders, asian, countries, ? ],
96
97 [indian_ocean] ).
98
99ed( 10, [ what, are, the, capitals, of, the, countries, bordering, the,
100 baltic, ? ],
101
102 [[[denmark]:[copenhagen], [east_germany]:[east_berlin],
103 [finland]:[helsinki], [poland]:[warsaw],
104 [soviet_union]:[moscow], [sweden]:[stockholm],
105 [west_germany]:[bonn]]] ).
106
107ed( 11, [ which, countries, are, bordered, by, two, seas, ? ],
108
109 [egypt, iran, israel, saudi_arabia, turkey] ).
110
111ed( 12, [ how, many, countries, does, the, danube, flow, through, ? ],
112
113 [6] ).
114
115ed( 13, [ what, is, the, total, area, of, countries, south, of, the, equator,
116 and, not, in, australasia, ? ],
117
118 [10228--ksqmiles] ).
119
120ed( 14, [ what, is, the, average, area, of, the, countries, in, each,
121 continent, ? ],
122
123 [[africa,233--ksqmiles], [america,496--ksqmiles],
124 [asia,485--ksqmiles], [australasia,543--ksqmiles],
125 [europe,58--ksqmiles]] ).
126
127ed( 15, [ is, there, more, than, one, country, in, each, continent, ? ],
128
129 [false] ).
130
131ed( 16, [ is, there, some, ocean, that, does, not, border, any, country, ? ],
132
133 [true] ).
134
135ed( 17, [ what, are, the, countries, from, which, a, river, flows, into,
136 the, black_sea, ? ],
137
138 [[romania,soviet_union]] ).
139
140ed( 18, [ what, are, the, continents, no, country, in, which, contains, more,
141 than, two, cities, whose, population, exceeds, nb(1), million, ? ],
142
143 [[africa,antarctica,australasia]] ).
144
145ed( 19, [ which, country, bordering, the, mediterranean, borders, a, country,
146 that, is, bordered, by, a, country, whose, population, exceeds,
147 the, population, of, india, ? ],
148
149 [turkey] ).
150
151ed( 20, [ which, countries, have, a, population, exceeding, nb(10),
152 million, ? ],
153
154 [afghanistan, algeria, argentina, australia, bangladesh,
155 brazil, burma, canada, china, colombia, czechoslovakia,
156 east_germany, egypt, ethiopia, france, india, indonesia,
157 iran, italy, japan, kenya, mexico, morocco, nepal,
158 netherlands, nigeria, north_korea, pakistan, peru,
159 philippines, poland, south_africa, south_korea,
160 soviet_union, spain, sri_lanka, sudan, taiwan, tanzania,
161 thailand, turkey, united_kingdom, united_states, venezuela,
162 vietnam, west_germany, yugoslavia, zaire] ).
163
164ed( 21, [ which, countries, with, a, population, exceeding, nb(10), million,
165 border, the, atlantic, ? ],
166
167 [argentina, brazil, canada, colombia, france, mexico,
168 morocco, netherlands, nigeria, south_africa, spain,
169 united_kingdom, united_states, venezuela, west_germany,
170 zaire] ).
171
172ed( 22, [ what, percentage, of, countries, border, each, ocean, ? ],
173
174 [[arctic_ocean,2], [atlantic,35], [indian_ocean,14],
175 [pacific,20]] ).
176
177ed( 23, [ what, countries, are, there, in, europe, ? ],
178
179 [albania, andorra, austria, belgium, bulgaria, cyprus,
180 czechoslovakia, denmark, east_germany, eire, finland,
181 france, greece, hungary, iceland, italy, liechtenstein,
182 luxembourg, malta, monaco, netherlands, norway, poland,
183 portugal, romania, san_marino, spain, sweden, switzerland,
184 united_kingdom, west_germany, yugoslavia] ).
185
186
190
191demo(Type) :- demo(Type,L), inform(L), check_words(L,S), process(S).
192
193demo(mini,List) :- eg(List).
194demo(main,List) :- ed(_,List,_).
195
196inform(L) :- nl, write('Question: '), inform1(L), nl, !.
197
198inform1([]).
199inform1([H|T]) :- write(H), put(32), inform1(T).
200
201
205
206test_chat :- test_chat(_).
207
208test_chat(N) :-
209 show_title,
210 ed(N,Sentence,CorrectAnswer),
211 process(Sentence,CorrectAnswer,Status,Times),
212 show_results(N,Status,Times),
213 fail.
214test_chat(_).
215
216test :-
217 time(rtest_chats(20)).
218
219 220rtest_chats(0) :- !.
221rtest_chats(N) :-
222 rtest_chat(1),
223 NN is N - 1,
224 rtest_chats(NN).
225
226rtest_chat(N) :-
227 ed(N,Sentence,CorrectAnswer), !,
228 process(Sentence,CorrectAnswer,Status,_Times),
229 ( Status == true
230 -> true
231 ; format(user_error, 'Test ~w failed!~n', [N])
232 ),
233 NN is N + 1,
234 rtest_chat(NN).
235rtest_chat(_).
236
237show_title :-
238 format('Chat Natural Language Question Anwering Test~n~n',[]),
239 show_format(F),
240 format(F, ['Test','Parse','Semantics','Planning','Reply','TOTAL']),
241 nl.
242
243show_results(N,Status,Times) :-
244 show_format(F),
245 format(F, [N|Times]),
246 ( Status = true ->
247 nl
248 ; otherwise ->
249 tab(2), write(Status), nl
250 ).
251
252show_format( '~t~w~10+ |~t~w~12+~t~w~10+~t~w~10+~t~w~10+~t~w~10+' ).
253
254
255process(Sentence,CorrectAnswer,Status,Times) :-
256 process(Sentence,Answer,Times),
257 !,
258 check_answer(Answer,CorrectAnswer,Status).
259process(_,_,failed,[0,0,0,0,0]).
260
261
262process(Sentence,Answer,[Time1,Time2,Time3,Time4,TotalTime]) :-
263 statistics(runtime, [T0, _]),
264
265 sentence(E,Sentence,[],[],[]),
266
267 statistics(runtime, [T1, _]),
268 Time1 is T1 - T0,
269 statistics(runtime, [T2, _]),
270
271 i_sentence(E,QT),
272 clausify(QT,UE),
273 simplify(UE,S),
274
275 statistics(runtime, [T3, _]),
276 Time2 is T3 - T2,
277 statistics(runtime, [T4, _]),
278
279 qplan(S,S1), !,
280
281 statistics(runtime, [T5, _]),
282 Time3 is T5 - T4,
283 statistics(runtime, [T6, _]),
284
285 answer(S1,Answer), !,
286
287 statistics(runtime, [T7, _]),
288 Time4 is T7 - T6,
289 TotalTime is Time1 + Time2 + Time3 + Time4.
290
291
292 293answer((answer([]):-E),[B]) :- !, holds(E,B).
294answer((answer([X]):-E),S) :- !, seto(X,E,S).
295answer((answer(X):-E),S) :- seto(X,E,S).
296
297check_answer(A,A,true) :- !.
298check_answer(_,_,'wrong answer').
299
300
304
305runtime_entry(start) :-
306 version,
307 format(user,'~nChat Demonstration Program~n~n',[]),
308 hi.
309
310hi :-
311 hi(user).
312
313hi(File) :-
314 repeat,
315 ask(File,P),
316 control(P), !,
317 end(File).
318
319ask(user,P) :- !,
320 write('Question: '),
321 ttyflush,
322 read_in(P).
323ask(File,P) :-
324 seeing(Old),
325 see(File),
326 read_in(P),
327 nl,
328 doing(P,0),
329 nl,
330 see(Old).
331
332doing([],_) :- !.
333doing([X|L],N0) :-
334 out(X),
335 advance(X,N0,N),
336 doing(L,N).
337
338out(nb(X)) :- !,
339 write(X).
340out(A) :-
341 write(A).
342
343advance(X,N0,N) :-
344 uses(X,K),
345 M is N0+K,
346 ( M>72, !,
347 nl,
348 N is 0;
349 N is M+1,
350 put(" ")).
351
352uses(nb(X),N) :- !,
353 chars(X,N).
354uses(X,N) :-
355 chars(X,N).
356
357chars(X,N) :- atomic(X), !,
358 name(X,L),
359 length(L,N).
360chars(_,2).
361
362end(user) :- !.
363end(F) :-
364 close(F).
365
366control([W,'.']) :-
367 (W==bye; W==quit; W==exit; W==done; W==thanks),
368 !,
369 display('Cheerio.'),
370 nl.
371control([trace,'.']) :- !,
372 tracing ~= on,
373 display('Tracing from now on!'), nl, fail.
374control([do,not,trace,'.']) :- !,
375 tracing ~= off,
376 display('No longer tracing.'), nl, fail.
377control([do,mini,demo,'.']) :- !,
378 display('Executing mini demo...'), nl,
379 demo(mini), fail.
380control([do,main,demo,'.']) :- !,
381 display('Executing main demo...'), nl,
382 demo(main), fail.
383control([test,chat,'.']) :- !,
384 test_chat, fail.
385control(U0) :-
386 check_words(U0,U),
387 process(U),
388 fail.
389
390process(U) :-
391 statistics(runtime, [_, _]),
392 sentence(E,U,[],[],[]),
393 statistics(runtime, [_, Et0]),
394 report(E,'Parse',Et0,tree),
395 statistics(runtime, [_, _]),
396 logic(E,S),
397 statistics(runtime, [_, Et1]),
398 report(S,'Semantics',Et1,expr),
399 statistics(runtime, [_, _]),
400 qplan(S,S1), !,
401 statistics(runtime, [_, Et2]),
402 report(S1,'Planning',Et2,expr),
403 statistics(runtime, [_, _]),
404 answer(S1), !, nl,
405 statistics(runtime, [_, Et3]),
406 report(_,'Reply',Et3,none).
407process(_) :-
408 failure.
409
410failure :-
411 display('I don''t understand!'), nl.
412
413report(Item,Label,Time,Mode) :-
414 tracing =: on, !,
415 nl, write(Label), write(': '), write(Time), write('msec.'), nl,
416 report_item(Mode,Item).
417report(_,_,_,_).
418
419report_item(none,_).
420report_item(expr,Item) :-
421 write_tree(Item), nl.
422report_item(tree,Item) :-
423 print_tree(Item), nl.
424%report_item(quant,Item) :-
425% pp_quant(Item,2), nl.
426
427quote(A&R) :-
428 atom(A), !,
429 quote_amp(R).
430quote(_-_).
431quote(_--_).
432quote(_+_).
433quote(verb(_,_,_,_,_)).
434quote(wh(_)).
435quote(name(_)).
436quote(prep(_)).
437quote(det(_)).
438quote(quant(_,_)).
439quote(int_det(_)).
440
441quote_amp('$VAR'(_)) :- !.
442quote_amp(R) :-
443 quote(R).
444
445logic(S0,S) :-
446 i_sentence(S0,S1),
447 clausify(S1,S2),
448 simplify(S2,S).
449
450simplify(C,(P:-R)) :- !,
451 unequalise(C,(P:-Q)),
452 simplify(Q,R,true).
453
454simplify(setof(X,P0,S),R,R0) :- !,
455 simplify(P0,P,true),
456 revand(R0,setof(X,P,S),R).
457simplify((P,Q),R,R0) :-
458 simplify(Q,R1,R0),
459 simplify(P,R,R1).
460simplify(true,R,R) :- !.
461simplify(X^P0,R,R0) :- !,
462 simplify(P0,P,true),
463 revand(R0,X^P,R).
464simplify(numberof(X,P0,Y),R,R0) :- !,
465 simplify(P0,P,true),
466 revand(R0,numberof(X,P,Y),R).
467simplify(\+P0,R,R0) :- !,
468 simplify(P0,P1,true),
469 simplify_not(P1,P),
470 revand(R0,P,R).
471simplify(P,R,R0) :-
472 revand(R0,P,R).
473
474simplify_not(\+P,P) :- !.
475simplify_not(P,\+P).
476
477revand(true,P,P) :- !.
478revand(P,true,P) :- !.
479revand(P,Q,(Q,P)).
480
481unequalise(C0,C) :-
482 numbervars(C0,1,N),
483 functor(V,v,N),
484 functor(M,v,N),
485 inv_map(C0,V,M,C).
486
487inv_map('$VAR'(I),V,_,X) :- !,
488 arg(I,V,X).
489inv_map(A=B,V,M,T) :- !,
490 drop_eq(A,B,V,M,T).
491inv_map(X^P0,V,M,P) :- !,
492 inv_map(P0,V,M,P1),
493 exquant(X,V,M,P1,P).
494inv_map(A,_,_,A) :- atomic(A), !.
495inv_map(T,V,M,R) :-
496 functor(T,F,K),
497 functor(R,F,K),
498 inv_map_list(K,T,V,M,R).
499
500inv_map_list(0,_,_,_,_) :- !.
501inv_map_list(K0,T,V,M,R) :-
502 arg(K0,T,A),
503 arg(K0,R,B),
504 inv_map(A,V,M,B),
505 K is K0-1,
506 inv_map_list(K,T,V,M,R).
507
508drop_eq('$VAR'(I),'$VAR'(J),V,M,true) :- !,
509 ( I=\=J, !,
510 irev(I,J,K,L),
511 arg(K,M,L),
512 arg(K,V,X),
513 arg(L,V,X);
514 true).
515drop_eq('$VAR'(I),T,V,M,true) :- !,
516 deref(I,M,J),
517 arg(J,V,T),
518 arg(J,M,0).
519drop_eq(T,'$VAR'(I),V,M,true) :- !,
520 deref(I,M,J),
521 arg(J,V,T),
522 arg(J,M,0).
523drop_eq(X,Y,_,_,X=Y).
524
525deref(I,M,J) :-
526 arg(I,M,X),
527 (var(X), !, I=J;
528 deref(X,M,J)).
529
530exquant('$VAR'(I),V,M,P0,P) :-
531 arg(I,M,U),
532 ( var(U), !,
533 arg(I,V,X),
534 P=(X^P0);
535 P=P0).
536
537irev(I,J,I,J) :- I>J, !.
538irev(I,J,J,I).
539
540:- mode check_words(+,-). 541
542check_words([],[]).
543check_words([Word|Words],[RevWord|RevWords]) :-
544 check_word(Word,RevWord),
545 check_words(Words,RevWords).
546
547:- mode check_word(+,-). 548
549check_word(Word,Word) :- word(Word), !.
550check_word(Word,NewWord) :-
551 display('? '), display(Word), display(' -> (!. to abort) '), ttyflush,
552 read(NewWord0),
553 NewWord0 \== !,
554 check_word(NewWord0,NewWord).
555
556:- mode ~=(+,+), =+(+,-), =:(+,?). 557
558Var ~= Val :-
559 ( recorded(Var,val(_),P), erase(P)
560 ; true), !,
561 recordz(Var,val(Val),_).
562
563Var =+ Val :-
564 ( recorded(Var,val(Val0),P), erase(P)
565 ; Val0 is 0), !,
566 Val is Val0+1,
567 recordz(Var,val(Val),_).
568
569Var