1/* @(#)chattop.pl	26.1 5/13/88 */
    2
    3/*
    4	Copyright 1986, Fernando C.N. Pereira and David H.D. Warren,
    5
    6			   All Rights Reserved
    7*/
    8
    9% CHATTOP.PL
   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
   25/* ----------------------------------------------------------------------
   26	Simple questions
   27	These question do not require setof/3 and are useful for early
   28	testing of a system.
   29   ---------------------------------------------------------------------- */
   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
   44/* ----------------------------------------------------------------------
   45	Standard question set
   46	This is the standard chat question set, originally put together
   47	by David and Fernando and use in their papers. Quintus uses this
   48	set as a standard for performance comparisons.
   49   ---------------------------------------------------------------------- */
   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
  187/* ----------------------------------------------------------------------
  188	Simple Access to demonstrations
  189   ---------------------------------------------------------------------- */
  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(0' ), inform1(T).
  200
  201
  202/* ----------------------------------------------------------------------
  203	Top level processing for verification and performance analysis
  204   ---------------------------------------------------------------------- */
  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					% added JW
  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	% Version of answer/1 from TALKR which returns answer
  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
  301/* ----------------------------------------------------------------------
  302	Top level for runtime version, and interactive demonstrations
  303   ---------------------------------------------------------------------- */
  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([bye,'.']) :- !,
  367   display('Cheerio.'),
  368   nl.
  369control([trace,'.']) :- !,
  370   tracing ~= on,
  371   display('Tracing from now on!'), nl, fail.
  372control([do,not,trace,'.']) :- !,
  373   tracing ~= off,
  374   display('No longer tracing.'), nl, fail.
  375control([do,mini,demo,'.']) :- !,
  376   display('Executing mini demo...'), nl,
  377   demo(mini), fail.
  378control([do,main,demo,'.']) :- !,
  379   display('Executing main demo...'), nl,
  380   demo(main), fail.
  381control([test,chat,'.']) :- !,
  382   test_chat, fail.
  383control(U0) :-
  384   check_words(U0,U),
  385   process(U),
  386   fail.
  387
  388process(U) :-
  389   statistics(runtime, [_, _]),
  390   sentence(E,U,[],[],[]),
  391   statistics(runtime, [_, Et0]),
  392   report(E,'Parse',Et0,tree),
  393   statistics(runtime, [_, _]),
  394   i_sentence(E,QT),
  395   clausify(QT,UE),
  396   simplify(UE,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%JW: pp_quant/2 is not defined
  425%report_item(quant,Item) :-
  426%   pp_quant(Item,2), nl.
  427
  428quote(A&R) :-
  429   atom(A), !,
  430   quote_amp(R).
  431quote(_-_).
  432quote(_--_).
  433quote(_+_).
  434quote(verb(_,_,_,_,_)).
  435quote(wh(_)).
  436quote(name(_)).
  437quote(prep(_)).
  438quote(det(_)).
  439quote(quant(_,_)).
  440quote(int_det(_)).
  441
  442quote_amp('$VAR'(_)) :- !.
  443quote_amp(R) :-
  444   quote(R).
  445
  446
  447simplify(C,(P:-R)) :- !,
  448   unequalise(C,(P:-Q)),
  449   simplify(Q,R,true).
  450
  451simplify(setof(X,P0,S),R,R0) :- !,
  452   simplify(P0,P,true),
  453   revand(R0,setof(X,P,S),R).
  454simplify((P,Q),R,R0) :-
  455   simplify(Q,R1,R0),
  456   simplify(P,R,R1).
  457simplify(true,R,R) :- !.
  458simplify(X^P0,R,R0) :- !,
  459   simplify(P0,P,true),
  460   revand(R0,X^P,R).
  461simplify(numberof(X,P0,Y),R,R0) :- !,
  462   simplify(P0,P,true),
  463   revand(R0,numberof(X,P,Y),R).
  464simplify(\+P0,R,R0) :- !,
  465   simplify(P0,P1,true),
  466   simplify_not(P1,P),
  467   revand(R0,P,R).
  468simplify(P,R,R0) :-
  469   revand(R0,P,R).
  470
  471simplify_not(\+P,P) :- !.
  472simplify_not(P,\+P).
  473
  474revand(true,P,P) :- !.
  475revand(P,true,P) :- !.
  476revand(P,Q,(Q,P)).
  477
  478unequalise(C0,C) :-
  479   numbervars(C0,1,N),
  480   functor(V,v,N),
  481   functor(M,v,N),
  482   inv_map(C0,V,M,C).
  483
  484inv_map('$VAR'(I),V,_,X) :- !,
  485   arg(I,V,X).
  486inv_map(A=B,V,M,T) :- !,
  487   drop_eq(A,B,V,M,T).
  488inv_map(X^P0,V,M,P) :- !,
  489   inv_map(P0,V,M,P1),
  490   exquant(X,V,M,P1,P).
  491inv_map(A,_,_,A) :- atomic(A), !.
  492inv_map(T,V,M,R) :-
  493   functor(T,F,K),
  494   functor(R,F,K),
  495   inv_map_list(K,T,V,M,R).
  496
  497inv_map_list(0,_,_,_,_) :- !.
  498inv_map_list(K0,T,V,M,R) :-
  499   arg(K0,T,A),
  500   arg(K0,R,B),
  501   inv_map(A,V,M,B),
  502   K is K0-1,
  503   inv_map_list(K,T,V,M,R).
  504
  505drop_eq('$VAR'(I),'$VAR'(J),V,M,true) :- !,
  506 ( I=\=J, !,
  507      irev(I,J,K,L),
  508      arg(K,M,L),
  509      arg(K,V,X),
  510      arg(L,V,X);
  511   true).
  512drop_eq('$VAR'(I),T,V,M,true) :- !,
  513   deref(I,M,J),
  514   arg(J,V,T),
  515   arg(J,M,0).
  516drop_eq(T,'$VAR'(I),V,M,true) :- !,
  517   deref(I,M,J),
  518   arg(J,V,T),
  519   arg(J,M,0).
  520drop_eq(X,Y,_,_,X=Y).
  521
  522deref(I,M,J) :-
  523   arg(I,M,X),
  524  (var(X), !, I=J;
  525   deref(X,M,J)).
  526
  527exquant('$VAR'(I),V,M,P0,P) :-
  528   arg(I,M,U),
  529 ( var(U), !,
  530      arg(I,V,X),
  531       P=(X^P0);
  532   P=P0).
  533
  534irev(I,J,I,J) :- I>J, !.
  535irev(I,J,J,I).
  536
  537:- mode check_words(+,-).  538
  539check_words([],[]).
  540check_words([Word|Words],[RevWord|RevWords]) :-
  541   check_word(Word,RevWord),
  542   check_words(Words,RevWords).
  543
  544:- mode check_word(+,-).  545
  546check_word(Word,Word) :- word(Word), !.
  547check_word(Word,NewWord) :-
  548   display('? '), display(Word), display(' -> (!. to abort) '), ttyflush,
  549   read(NewWord0),
  550   NewWord0 \== !,
  551   check_word(NewWord0,NewWord).
  552
  553:- mode ~=(+,+), =+(+,-), =:(+,?).  554
  555Var ~= Val :-
  556 ( recorded(Var,val(_),P), erase(P)
  557 ; true), !,
  558 recordz(Var,val(Val),_).
  559
  560Var =+ Val :-
  561 ( recorded(Var,val(Val0),P), erase(P)
  562 ; Val0 is 0), !,
  563   Val is Val0+1,
  564   recordz(Var,val(Val),_).
  565
  566Var