This appendix gives a listing in POP-11 of a complete Tourist Guide based on
one programmed by a student. It makes use of the `prodsys' and `semnet'
POP-11 libraries. The program can be called by the command
converse();
/*****************************************************
Rule-Based System for Advising on Entertainment
- see Chapter 7
******************************************************/
;;; following rules deal with entertainment in London
[] -> rulebase;
false -> chatty;
false -> repeating;
rule find_type [entertainment medium unknown];
vars enttype;
[what type of entertainment would you like:
cinema or theatre?] =>>
readline() -> enttype;
remove([entertainment medium unknown]);
add([entertainment medium ^^enttype]);
endrule;
rule find_style [entertainment style unknown];
vars styletype;
[would you like western, drama or horror]=>>
readline() -> styletype;
remove([entertainment style unknown]);
add([entertainment style ^^styletype]);
endrule;
rule cinema_western [entertainment style western]
[entertainment medium cinema];
[soldier blue is on this week at the eros.] =>>
endrule;
rule cinema_horror [entertainment style horror]
[entertainment medium cinema];
[[the amazing doctor vulture is on this week
at the classic and abc1.]
[i was an american vulture in london is on
this week at abc2.]] =>>
endrule;
rule cinema_drama [entertainment style drama]
[entertainment medium cinema];
[[twenty tiny ants is on this week at the carlton.]
[dog on a shed roof is on until thursday at the rialto.]
[sharp shooter the prequel
is on for two weeks at dominion.]]=>>
endrule;
rule theatre_western [entertainment style western]
[entertainment medium theatre];
[home on the range is on at the criterion.]=>>
endrule;
rule theatre_horror [entertainment style horror]
[entertainment medium theatre];
[[cant slay wont slay is on at the adelphi.]
[sweaters is on at the piccadilly.]]=>>
endrule;
rule theatre_drama [entertainment style drama]
[entertainment medium theatre];
[[world go away is on at the phoenix.]
[slaving over a hot keyboard is on at the lyric.]]=>>
endrule;
/*****************************************************
Syntactic and Semantic Analysis of Noun-Phrases
- see Chapter 5
******************************************************/
define DET(word) -> found;
member(word, [a the]) -> found;
enddefine;
define PREP(word) -> found;
if member(word, [near by]) then
"near" -> found;
elseif member(word, [in containing]) then
word -> found;
else
false -> found;
endif;
enddefine;
define NOUN(list) -> found;
if member(list, [[avenue] [street] [road]]) then
[road] -> found;
elseif member(list, [[gallery] [square] [museum]
[theatre] [cinema] [monument]
[lake] [park]] ) then
list -> found;
else
false -> found;
endif
enddefine;
define PROPN(list) -> found;
member(list,
[[the abc1] [the abc2] [the carlton]
[the odeon] [the rialto] [the dominion]
[the classic] [the eros] [the haymarket]
[the criterion] [the phoenix] [the adelphi]
[the savoy] [the piccadilly] [the lyric]
[the royal albert hall]
[the royal opara house]
[the british museum]
[the natural history museum]
[the victoria and albert museum]
[the science museum] [the tower of london]
[hms belfast] [the houses of parliament]
[st pauls cathedral] [westminster abbey]
[london zoo] [the serpentine]
[st katherines dock] [the national gallery]
[nelsons column] [hyde park] [the serpentine]
[the tate gallery] [shaftesbury avenue]
[leicester square] [haymarket]
[piccadilly circus] [coventry street]
[tottenham court road] [trafalgar square]
[jermyn street] [the strand] [denman street]
[kensington gore] [floral street]
[great russel street] [cromwell road]
[exhibition road] [millbank] [tower hill]
[st catherines way]
] ) -> found;
enddefine;
define NP(list) -> meaning;
vars pn, d, n, p, np, sym1, sym2;
if list matches [??pn:PROPN] then
pn -> meaning
elseif list matches [?d:DET ??n:NOUN] then
gensym("v") -> sym1;
[ [ ? ^sym1 isa ^n] ] -> meaning
elseif list matches [?d:DET ??n:NOUN ?p:PREP ??np:NP]
then
gensym("v") -> sym1;
if np matches [[= ?sym2 isa =] ==] then
;;; meaning of noun phrase is
;;; a list of patterns
[ [? ^sym1 isa ^n] [? ^sym1 ^p ? ^sym2] ^^np]
-> meaning
else
;;; meaning of noun phrase is proper name
[ [? ^sym1 isa ^n] [? ^sym1 ^p ^np] ]
-> meaning
endif;
else
;;; unknown noun phrase form
false -> meaning
endif;
enddefine;
define referent(meaning) -> thing;
;;;
;;; find the thing referred by meaning structure
;;;
vars sym, vals, x;
if meaning matches [[= ?sym isa =] ==] then
;;; meaning is a list of patterns
which(sym, meaning) -> vals;
if vals matches [?x ==] then
;;; at least one thing referred to
x -> thing
else
;;; nothing referred to
false -> thing
endif;
else
;;; meaning is a proper name
meaning -> thing;
endif
enddefine;
/*********************************************
Finding a Route on the Underground
- see Chapter 4
**********************************************/
vars verychatty;
false -> verychatty;
/* first set travel and change times */
vars travtime, changetime;
2 -> travtime;
3 -> changetime;
define addonefuture(newplace,newtime,comefrom);
;;; This records in the database a single pending
;;; arrival at a place (where place means
;;; a line-station combination as in the database),
;;; unless there has already been an
;;; arrival at that place.
;;; Also protects against inserting the same future event
;;; twice, as could happen when looking at
;;; line changes due to the fact that the
;;; information that a station is on a given line can
;;; appear twice in the database.
;;; Can also say what it's doing.
vars futureevent;
[will arrive ^newplace at ^newtime mins from ^comefrom]
-> futureevent;
if not(present([arrived ^newplace at = mins from =]))
and not(present(futureevent))
then
add(futureevent);
if verychatty then
[ . . will arrive ^newplace at ^newtime mins] =>>
endif;
endif;
enddefine;
define addfuture(event);
;;; Given an event, adds the pending events that
;;; follow it into the database
vars place, newplace, time, station, line, newln;
;;; Get breakdown of event
;;; Note that the matcher arrow --> could be
;;; replaced by MATCHES except that it
;;; does not return a TRUE/FALSE value.
;;; We know that the event passed to
;;; ADDFUTURE will have the right format.
event --> [arrived ?place at ?time mins from =];
place --> [?line ??station];
;;; First get all the connections on the same line
foreach [^place connects ?newplace] do
addonefuture(newplace,time+travtime,place);
endforeach;
;;; This repeats the last bit for patterns
;;; the other way round
foreach [?newplace connects ^place] do
addonefuture(newplace,time+travtime,place);
endforeach;
;;; Then all the changes to other lines
foreach [[?newln ^^station] connects =] do
addonefuture([^newln ^^station], time+changetime,place);
endforeach;
;;; And again for patterns the other way round
foreach [= connects [?newln ^^station]] do
addonefuture([^newln ^^station], time+changetime,place);
endforeach;
enddefine;
define next();
;;; This looks at all the future events in the database
;;; and finds the one that will happen next - that is,
;;; the one with the smallest value of time, and returns
;;; a list giving the corresponding actual event.
vars leasttime, place, time, lastplace, event;
;;; leasttime has to start bigger than any likely time
100000 -> leasttime;
foreach [will arrive ?place at ?time mins
from ?lastplace] do
if time < leasttime then
[arrived ^place at ^time mins from ^lastplace]
-> event;
time -> leasttime;
endif;
endforeach;
return(event);
enddefine;
define insertnext(event);
;;; Takes an event returned by NEXT and inserts it
;;; into the database, then removes all pending events
;;; which would cause later arrivals at the same station.
;;; Can also print out the event.
vars place;
;;; addition
add(event);
;;; removal
event --> [arrived ?place at = mins from =];
foreach ([will arrive ^place at = mins from =]) do
remove(it);
endforeach;
if chatty or verychatty then
event =>>
endif;
enddefine;
define start(station);
;;; This sets up the database ready to start by inserting
;;; pending arrivals at the starting station
vars line;
foreach [[?line ^^station] connects =] do
addonefuture([^line ^^station],0,[start]);
endforeach;
;;; This is the same as the first half but
;;; for the other sort of patterns
foreach [= connects [?line ^^station]] do
addonefuture([^line ^^station],0,[start]);
endforeach;
enddefine;
define search(startstat,deststat);
;;; Inserts information into the database till the "tree"
;;; as far as the destination station has grown
vars nextevent, destline;
start(startstat);
repeat
next() -> nextevent;
insertnext(nextevent);
quitif (nextevent matches
[arrived [?destline ^^deststat]
at = mins from =]);
addfuture(nextevent);
endrepeat;
add([finished at [^destline ^^deststat]]);
enddefine;
define traceroute();
;;; Assuming the tree has been grown in the database,
;;; and event is the arrival at the destination station,
;;; return a list of the stations through which the
;;; quickest route passes
vars place, lastplace, time, ok, routelist;
;;; ok will always be true
present([finished at ?place]) -> ok;
present([arrived ^place at ?time mins from ?lastplace])
-> ok;
[[^place at ^time mins]] -> routelist;
until lastplace = [start] do
lastplace -> place;
;;; the next line is there for its side effects.
;;; ok will always be true
present([arrived ^place at ?time mins from
?lastplace]) -> ok;
[[^place at ^time mins] ^^routelist] -> routelist;
enduntil;
return(routelist);
enddefine;
define checkstat(station);
;;; simply checks that a station is present
;;; in the database
return(present([[= ^^station] connects =])
or present([= connects [= ^^station]]));
enddefine;
define tidyup();
;;; this removes any previous route-finding information
;;;from the database, in order to clear the way
;;; for a new route
foreach [will arrive = at = mins from =] do
remove(it);
endforeach;
foreach [arrived = at = mins from =] do
remove(it);
endforeach;
foreach [finished at =] do
remove(it);
endforeach;
enddefine;
define route(startstat,deststat);
;;; this is the overall calling program for route finding
;;; this sets up the database for the other routines.
;;; checking
if not(checkstat(startstat)) then
[start station ^^startstat not found] =>>
return(false);
endif;
if not(checkstat(deststat)) then
[destination station ^^deststat not found] =>>
return(false);
endif;
;;; tidy the database in preparation
tidyup();
;;; do the search
search(startstat,deststat);
;;; return the result. Note that the database is left
;;; with all the search stuff still in it
return(traceroute());
enddefine;
define reply(list) -> response;
;;;
;;; Convert a route list into
;;; an English description of the form:
;;;
;;; travelling by underground, take the ... line to ...
;;; then change and take the ... line to ...
;;; then change and take the ... line to ...
;;; ...
vars line, station, line1, response;
list --> [[[?line ??station] ==] ??list];
[travelling by underground, take the
^line line to] -> response;
while list matches [[[?line1 ??station] ==] ??list] do
if line1 /= line then
[^^response ^^station then change and
take the ^line1 line to] -> response;
line1 -> line;
endif;
endwhile;
[^^response ^^station] -> response;
enddefine;
/***************************************************
Top-Level Procedures of the
Automated Tourist Guide
****************************************************/
define setup();
;;;
;;; Setup the database of facts about London
;;;
[
;;; cinemas
[[the abc1] in [shaftesbury avenue]]
[[the abc1] underground [leicester square]]
[[the abc1] isa [cinema]]
[[the abc2] in [shaftesbury avenue]]
[[the abc2] underground [leicester square]]
[[the abc2] isa [cinema]]
[[the carlton] in [haymarket]]
[[the carlton] underground [piccadilly circus]]
[[the carlton] isa [cinema]]
[[the odeon] in [haymarket]]
[[the odeon] underground [piccadilly circus]]
[[the odeon] isa [cinema]]
[[the rialto] in [coventry street]]
[[the rialto] underground [piccadilly circus]]
[[the rialto] isa [cinema]]
[[the dominion] in [tottenham court road]]
[[the dominion] underground [piccadilly circus]]
[[the dominion] isa [cinema]]
[[the classic] in [piccadilly circus]]
[[the classic] underground [piccadilly circus]]
[[the classic] isa [cinema]]
[[the eros] in [piccadilly circus ]]
[[the eros] underground [piccadilly circus]]
[[the eros] isa [cinema]]
;;; theatres
[[the haymarket] in [haymarket]]
[[the haymarket] underground [piccadilly circus]]
[[the haymarket] isa [theatre]]
[[the criterion] in [jermyn street]]
[[the criterion] underground [piccadilly circus]]
[[the criterion] isa [theatre]]
[[the phoenix] in [charing cross road]]
[[the phoenix] underground [tottenham court road]]
[[the phoenix] isa [theatre]]
[[the adelphi] in [the strand]]
[[the adelphi] underground [charing cross]]
[[the adelphi] isa [theatre]]
[[the savoy] in [the strand]]
[[the savoy] underground [charing cross]]
[[the savoy] isa [theatre]]
[[the piccadilly] in [denman street]]
[[the piccadilly] underground [piccadilly circus]]
[[the picadilly] isa [theatre]]
[[the lyric] in [shaftesbury avenue]]
[[the lyric] underground [piccadilly circus]]
[[the lyric] isa [theatre]]
[[the royal albert hall] in [kensington gore]]
[[the royal albert hall] underground
[south kensington]]
[[the royal albert hall] isa [theatre]]
[[the royal opera house] in [floral street]]
[[the royal opera house] underground [covent garden]]
[[the royal opera house] isa [theatre]]
;;; museums
[[the british museum] in [great russel street]]
[[the british museum] underground
[tottenham court road]]
[[the british museum] isa [museum]]
[[the natural history museum] in [cromwell road]]
[[the natural history museum] underground
[south kensington]]
[[the natural history museum] isa [museum]]
[[the victoria and albert museum] in [cromwell road]]
[[the victoria and albert museum] underground
[south kensington]]
[[the victoria and albert museum] isa [museum]]
[[the science museum] in [exhibition road]]
[[the science museum] underground [south kensington]]
[[the science museum] isa [museum]]
;;; galleries
[[the national gallery] in [trafalgar square]]
[[the national gallery] underground [charing cross]]
[[the national gallery] isa [gallery]]
[[the tate gallery] in [millbank]]
[[the tate gallery] underground [pimlico]]
[[the tate gallery] isa [gallery]]
;;; places of interest
[[the tower of london] near [tower hill]]
[[the tower of london] underground [tower hill]]
[[the tower of london] isa [place of interest]]
[[hms belfast] near [the tower of london]]
[[hms belfast] underground [london bridge]]
[[hms belfast] isa [place of interest]]
[[the houses of parliament] near [parliament square]]
[[the houses of parliament] underground [westminster]]
[[the houses of parliament] isa [place of interest]]
[[st pauls cathedral] in [newgate street]]
[[st pauls cathedral] underground [st pauls]]
[[the houses of parliament] isa [place of interest]]
[[westminster abbey] in [millbank]]
[[westminster abbey] underground [westminster]]
[[westminster abbey] isa [place of interest]]
[[st katharines dock] near [st katharines way]]
[[st katharines dock] underground [tower hill]]
[[st katharines dock] isa [place of interest]]
[[nelsons column] in [trafalgar square]]
[[nelsons column] underground [charing cross]]
[[nelsons column] isa [place of interest]]
[[nelsons column] isa [monument]]
[[london zoo] in [regents park]]
[[london zoo] underground [camden town]]
[[london zoo] isa [place of interest]]
[[the serpentine] in [hyde park]]
[[the serpentine] underground [hyde park corner]]
[[the serpentine] isa [lake]]
;;; roads
[[shaftesbury avenue] isa [road]]
[[haymarket] isa [road]]
[[coventry street] isa [road]]
[[tottenham court road] isa [road]]
[[jermyn street] isa [road]]
[[the strand] isa [road]]
[[denman street] isa [road]]
[[kensington gore] isa [road]]
[[floral street] isa [road]]
[[great russell street] isa [road]]
[[cromwell road] isa [road]]
[[exhibition road] isa [road]]
[[millbank] isa [road]]
[[tower hill] isa [road]]
[[st catherines way] isa [road]]
;;; squares
[[leicester square] isa [square]]
[[piccadilly circus] isa [square]]
[[parliament square] isa [square]]
[[trafalgar square] isa [square]]
;;; parks
[[hyde park] isa [park]]
[[regents park] isa [park]]
;;; underground topology for route finder
[[JUBILEE charing cross] connects [JUBILEE green park]]
[[JUBILEE green park] connects [JUBILEE bond street]]
[[JUBILEE bond street] connects [JUBILEE baker street]]
[[BAKERLOO embankment] connects [BAKERLOO charing cross]]
[[BAKERLOO charing cross] connects
[BAKERLOO piccadilly circus]]
[[BAKERLOO piccadilly circus] connects
[BAKERLOO oxford circus]]
[[CIRCLE embankment] connects [CIRCLE westminster]]
[[CIRCLE westminster] connects [CIRCLE st jamess park]]
[[CIRCLE st jamess park] connects [CIRCLE victoria]]
[[CIRCLE victoria] connects [CIRCLE sloane square]]
[[CIRCLE sloane square] connects
[CIRCLE south kensington]]
[[PICCADILLY south kensington] connects
[PICCADILLY knightsbridge]]
[[PICCADILLY knightsbridge] connects
[PICCADILLY hyde park corner]]
[[PICCADILLY hyde park corner] connects
[PICCADILLY green park]]
[[PICCADILLY green park] connects
[PICCADILLY piccadilly circus]]
[[CENTRAL lancaster gate] connects [CENTRAL marble arch]]
[[CENTRAL marble arch] connects [CENTRAL bond street]]
[[CENTRAL bond street] connects [CENTRAL oxford circus]]
[[CENTRAL oxford circus] connects
[CENTRAL tottenham court road]]
[[VICTORIA warren street] connects
[VICTORIA oxford circus]]
[[VICTORIA oxford circus] connects [VICTORIA green park]]
[[VICTORIA green park] connects [VICTORIA victoria]]
[[VICTORIA victoria] connects [VICTORIA pimlico]]
[[VICTORIA pimlico] connects [VICTORIA vauxhall]]
[[NORTHERN charing cross] connects
[NORTHERN leicester square]]
[[NORTHERN leicester square] connects
[NORTHERN convent garden]]
;;; fare and zones for fare finder
[[zone1 station] fare [40 pence]]
[[zone2 station] fare [60 pence]]
[[green park] isa [zone1 station]]
[[picadilly circus] isa [zone1 station]]
[[shepherds bush] isa [zone2 station]]
[[goodge street] isa [zone2 station]]
[[brixton] isa [zone2 station]]
] -> database;
enddefine;
define introduction();
;;;
;;; output welcome and instructions to user
;;;
[Hello, this is the automated London tourist guide]=>>
[I can offer information on the following]=>>
[cinema]=>>
[theatre]=>>
[museums]=>>
[galleries]=>>
[places of interest]=>>
[routes and fares on the underground]=>>
[Please ask about any of the above
and I will try to help you]=>>
[Type in your question using lowercase letters only]=>>
[and then press RETURN]=>>
[If you want to exit please type "bye"
and press RETURN]=>>
enddefine;
define answer(query) -> response;
;;;
;;; produce a response to query
;;;
vars list, museums, response, x, y, place, routelist;
if query matches [== places of interest ==] then
;;; this is a query about places of interest
[] -> list;
foreach [?place isa [place of interest]] do
[^^list , ^place] -> list;
endforeach;
;;; strip off leading comma from reply
list --> [, ??list];
[I know about the following places of interest:
^^list] -> response;
elseif query matches [== where is ??np:NP] or
query matches [== where ??np:NP is] then
;;; a query about where somewhere is
;;; find the place referred to by noun-phrase
referent(np) -> place;
if place and present([^place in ?y]) then
[^^place is in ^^y] -> response;
elseif place and present([^place near ?y]) then
[^^place is near ^^y] -> response;
elseif place and present([^place underground ?y])
then
[^^place is near ^^y underground station]
-> response;
else
[I do not know where that place is]
-> response;
endif;
elseif query matches [== get to ??np:NP] then
;;; route finding query
;;; find place referred to by noun-phrase
referent(np) -> place;
if place and present([^place underground ?y]) then
route([victoria], y) -> routelist;
if not(routelist) then
[route not found] -> response
else
reply(routelist) -> response
endif
else
[I do not know where that place is]
-> response;
endif
elseif query matches [== fare to ??x] then
;;; query about fare to a given underground station
if spresent([^x fare ?y]) then
[The fare to ^^x is ^^y] -> response
else
[I do not know about the underground station ^^x]
-> response
endif
elseif query matches [== entertainment ==] or
query matches [== cinema==] or
query matches [== theatre==] or
query matches [== theatres ==] or
query matches [== cinemas ==] then
;;; answer query about entertainment in London
;;; using LIB PRODSYS
;;; add initial entertainment facts to database
add([entertainment medium unknown]);
add([entertainment style unknown]);
;;; run production system
run();
;;; remove database entries created by
;;; production system
flush([entertainment ==]);
[I hope you enjoy the show] -> response;
elseif query matches [] then
;;; blank line input
[please type in your question and press RETURN]
-> response
elseif query matches [bye] then
;;; produce response to terminate session
[bye] -> response
else
;;; cannot handle this query
[Sorry I do not understand. Try rewording
your question] -> response
endif;
enddefine;
define converse();
;;;
;;; main calling procedure
;;;
vars query, response;
;;; setup the database of facts about London
setup();
;;; output welcome and instructions to tourist user
introduction();
;;; read and answer queries until done
repeat
;;; read in query from keyboard
readline() -> query;
;;; produce an answer to query
answer(query) -> response;
;;; output answer to user
response =>>
;;; quit if answer indicates end of session
quitif(response = [bye]);
endrepeat;
enddefine;