USISbar.gifcogslogo.jpglogobackneutral.gif22USISbar.gif
previous up next
Left: Lectures Up: General Information Right: Exercise Class


Example of a POP-11 Program

THE AUTOMATED TOURIST GUIDE - from "Computers & Thought" THE AUTOMATED TOURIST GUIDE - from "Computers & Thought"

/*
THE AUTOMATED TOURIST GUIDE - from "Computers & Thought"
http://www.informatics.sussex.ac.uk/local/books/computers-and-thought/index.html

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();
*/

lib prodsys;
lib semnet;

/*****************************************************

   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;

---------------------------------------------------------

Benedict du Boulay, AI Programming II web pages updated on Wednesday 8 January 2003