..head01rCS680 ..foot59ci A Prolog Augmented Transition Network Parser Table of Contents 1. General 1 2. ATN Form 1 Figure 1. ATN Network 1 Figure 2. Phrase Network 2 3. Approach 2  Phase I 2 Phase II 2 Phase III 2 4. Phase I 2 5. Phase II 3 6. Phase III 5   ATNBLD 6 ATNNEW 8 7. Conclusions 9 Attachements:  1. ATN.PRO  Program Listing 1-1 Phase I - Example I 1-5 Phase I - Example II 1-6 2. ATNREV.PRO  Program Listing 2-1 Phase II - Example I 2-4 Phase II - Example II 2-4 3. ATNBLD.PRO  Program Listing 3-1 Example ATN Definition 3-3 4. ATNNEW1.PRO  Program Listing 4-1 Phase III - Example I 4-4 Phase III - Example II (Subject Predicate Agreement) 4-5 ..head01rCS680 ..foot59c## A PROLOG AUGMENTED TRANSITION NETWORK PARSER  submitted by Ludwig J. Schumacher November 26, 1985 1. General. This report documents the development of an Augmented Transition Network (ATN) sentence parser in the PROLOG language and is submitted in partial fulfillment of the requirements for CS 680, Natural Language Processing, George Mason University, Fall 1985. It is assumed that the reader is familiar with natural language processing and PROLOG so associated terms will be used without explanation. The author had no prior experience with logic programming and does not presume to evaluate the PROLOG language, only that small subset of commands he was able to master in attempting to apply the language to this specific project. The examples contained herein are executed under A.D.A. PROLOG, ver 1.6c, (c) Automata Design Associates 1985. 2. ATN Form. The form of the ATN which is used in this paper is shown in Figure 1. This form has been chosen not as comprehensive coverage of English sentence structure but to provide a simple form which does incorporate the major features of ATNs. Figure 2 is the noun and prepositional phrase network.  - Transition from node to node based upon specified conditions. - Optional conditions, such as the determiner and adjective in the noun phrase.  - Augmentation with sub-networks such as the noun and prepositional phrases. - Recursiveness such as the adjective in the noun phrase and the noun phrase at node 2. np pp * * * * verb \/ * pp \/ *  np **** > q1 ************** > q2/ ********** > q3/ * * /\ q0 * * aux * verb * * * aux **** > q4 ************* > q5 np  Figure 1. ATN Network adj det * * ****** \/ * noun prep qnp * * > qnp1 ********** > qnp2/ qpp ****** > qnp ****** jump Figure 2. Phrase Network 3. Approach. The project was conducted in three phases. a. Phase I. Phase I was experimentation with PROLOG to develop some working application. An ATN parser was programmed but only by forcing PROLOG into a procedural mold. This phase culminated in a briefing presented in class on 24 October. b. Phase II. Phase II was the translation of the procedures developed in Phase I into facts and rules appropriate for a logic program, which would more fully exploit the capabilities of PROLOG. c. Phase III. Phase III was additional experimentation to make the programs more dynamic and to exploit the power of an ATN to pass differing information depending upon the particular transition. These experiments included procedures to automatically update the vocabulary, allow for user defined networks, refinement of the database search procedures, and incorporation of subject and predicate agreement verification. 4. Phase I a. The program developed during Phase I (Attachment 1) is not a logic program, but a set of procedures executed with the PROLOG language. Procedures are defined as a set of 'q' rules which are passed the current node number and the unparsed and parsed parts of the sentence. Each set of procedures defined the actions to be taken at that node. For example, q(0,_) are the procedures for node 0, q(1,_,_) are the procedures for node 1, etc. b. There are a number of limitations to this approach. - The addition of a node requires a new set of procedures and modification of the code for each node from which a transition can be made. - It would be difficult to modify the code dynamically, since procedures must be executed in sequence, and changes would have to be inserted at specific points.  - Elimination of a node requires not only the elimination of the procedure for that node, but the removal of all calls to that node from other procedures. ..page 5. Phase II. Phase II was the development of a logic program to accomplish the same functions as that developed during Phase I. The approach was to translate the statement, "There is a transition from node X to node Y on condition Z", to the PROLOG equivalent "arc(X,Y,Z)". The complete program is at Attachment 2 and appropriate sections are reproduced below.  a. The first step was to redefine the facts. The transitions are in the form of arc(from node,to node,condition). arc(q0,q1,np). arc(q1,q2,verb). arc(q2,q2,np). arc(q2,q3,pp). arc(q0,q4,aux). arc(q4,q5,np). arc(q1,q5,aux). arc(q5,q2,verb). b. The terminal nodes are identified by term(at node,empty list), where the remainder of the sentence is the second variable. term(q2,[]). term(q3,[]). c. Since phrase transitions are based upon a series of words rather than a single condition, they are treated as separate networks. The empty list as the transition condition is used to effect a jump. arc(qnp,qnp1,det). arc(qnp,qnp1,[]). arc(qnp1,qnp1,adj). arc(qnp1,qnp2,noun). arc(qpp,qnp,prep). d. With these 'facts' established, one can now use the recursive and backtracking nature of PROLOG to find a path from the initial point to a terminal node. 1) A sentence is input as a PROLOG list enclosed in brackets and with each word separated by a comma. There is no punctuation at the end of the sentence. All words must be in lower case. 2) Once the sentence, S, has been input, control is passed to the rule trans (transition). The variables are: current node, next node, parsed sentence, sentence remaining to be parsed, and sentence remaining to be parsed after transition. trans(q0,Nq,Parse,S,S1)  ..page 3) If the current node (Lq) is a terminal node and the remainder of the sentence (S1) is null, then the sentence has been parsed. trans(Lq,_,Parse,S1,_) :- term(Lq,S1),nl, print('Completed ',Lq), nl,print(Parse). 4) If the next word (S0) is the type (Type) to effect a transition, then trans is called recursively. (Note: Nbr is a variable designed to provide information on the singularity or plurality of the word. It is not used in this example.) trans(Lq,Nq,Parse,[S0|S1],S1) :- word(S0,Type,Nbr), arc(Lq,Nq,Type), nl, print('Transition ',Lq,' ',Nq,' ',S0, ' ',Type), append(Parse,[[Type],S0],P1), !, trans(Nq,Z,P1,S1,S2). 5) If the next word in the sentence does not establish the criteria for a transition, check to determine if a phrase does. If so, the rest of the sentence is checked for the proper phrase, either np or pp. This requires the separate network check, ptrans, which allows parsing as the network is transitioned, but will return unchanged if it fails.  trans(Lq,Nq,Parse,S0,S1) :- arc(Lq,Nq,np), ptrans(qnp,Nq,Lq,S0,[np],Parse). trans(Lq,Nq,Parse,S0,S1) :- arc(Lq,Nq,pp), ptrans(qpp,Nq,Lq,S0,[pp],Parse). 6) If no word or phrase has been found to effect a transition, the sentence will not parse. trans(Lq,Nq,Parse,S0,S1) :- !,nl, print('The sentence failed at ',Lq), nl,print('Parsed ',Parse), nl,print('Left ',S0). 7) The phrase transition network code is almost identical to the primary code, except that it continues to call itself until such time as it reaches qnp2, which is the terminal node, or fails at a node other than qnp2. In the first case it will effect a transition to the next node (Nq) and call trans with the new data. In the second case, ptrans will fail and conditions remain unchanged. ptrans(Bq,Nq,Lq,[S0|S1],Pr,Parse) :- word(S0,Type,Nbr), arc(Bq,Zq,Type), append(Pr,[[Type],S0],P1), !, ptrans(Zq,Nq,Lq,S1,P1,Parse). ptrans(qnp2,Nq,Lq,S0,Pr,Parse) :- nl, print('Transition ',Lq,' ',Nq), nl, print(Pr), append(Parse,Pr,P1), !, trans(Nq,Rq,P1,S0,S1). 6. Phase III  a. These programs demonstrate that PROLOG can be used to develop an ATN parser but still do not exploit the power of PROLOG to operate in a dynamic environment. Specific capabilities which should be included are: 1) The ATN should be able to provide additional information beyond whether or not the sentence parsed. 2) The program should assist the user in construction of the ATN definition. 3) The program should verify the words are in the vocabulary set before attempting to parse, and if not, allow them to be added. 4) The database search should be efficient. Especially in the case of a large vocabulary set, the initial form of word(Name,[type]) is unacceptable in that PROLOG must conduct a linear search of the entire set of words to identify success or failure. (a) Dr. Berghel, University of Nebraska, suggested in his presentation at George Mason that the vocabulary be stored as individual letters and the search space would be reduced to words of a particular length. For example, the word 'the' would be in the database as "word(t,h,e)". In order to identify if "the" is in the vocabulary set, it is partitioned into the individual letters and only those words with arity 3 would need to be searched. (b) An alternative to the use of arity would be to construct each word as a separate fact. Thus "the" would be represented as "the(word)". It is assumed that PROLOG is more efficient searching a database of unique facts rather than one of fewer facts differentiated by arity. There may, however, be some impact on memory requirements. It must also be noted that this would not serve the spelling correction procedure outlined by Dr. Berghel. (c) A concept which could be integrated with either of the two approaches outlined above would be to allow the facts which are used more often to migrate to the front of the list. Specifically, exploit PROLOG's capability to alter the program by deleting facts when used and adding them to the front of the list. b. The two programs at Attachments 3 and 4 incorporate some of these concepts. Attachment 3 is a listing and example use of the program 'ATNBLD' which can be used to build the primary transition network. Attachment 4, 'ATNNEW', uses the network developed by ATNBLD, stores each word as a separate, unique fact, and identifies sentences in which the subject and predicate are not in number agreement. 1) ATNBLD ATNBLD requests the names of the nodes and the conditions for transition and establishes a separate database for the network defined by the user. The initial node must be entered and all terminal nodes identified. Then the user defines paths to each terminal node. (a) BUILD. Build is the entry point into the program. It requests the start node (Q0), the terminal nodes, termnode, then transfers to flow. The predicate 'ret', defined in a standard routine, is used to retract predicates. It is used here to retract any predicates which would interfere with the construction of the network. The predicates generated within the program are:  - term: defines that a node is a terminal node - qend: identifies nodes that have a path to a terminal node - arc: identifies the transitions from node to node build :- batch,ret(qend),nl,ret(arc),nl,ret(term),asserta(term([],[])), consult(node),nl,print('Enter the start node: '),read(Q0), asserta(qend(Q0)),termnode,flow(Q0). termnode :- print('Enter the next terminal node or the word done: '), read(QT), not(QT=done), termck(QT), assertfa(node,term(QT,[])), asserta(qend(QT)), termnode. termnode :- !,true. termck(Qt) :- not(term(Qt,[])); nl,print('Terminal node ',Qt,' already entered'),nl. ..page (b) FLOW. Flow is the primary control structure. It requests the next node and the condition for transition. It verifies that the condition is valid, that the arc has not been previously defined, and adds it to the database. The predicate 'qendck' verifies a path has been completed. flow(Q0) :- nl,print('Transition from ',Q0,' to ? '),read(Qnext), print(' on condition ? '),read(Con), con(Q0,Con),arcck(Q0,Qnext,Con), assertfz(node,arc(Q0,Qnext,Con)), qendck(Q0,Qnext). con(Q0,Con) :- condition(Con). con(Q0,Con) :- nl,print(Con,' is an invalid condition. '), flow(Q0). condition(verb). condition(noun). condition(aux). condition(prep). condition(aux). condition(pp). condition(np). arcck(Q0,Qn,Z) :- not(arc(Q0,Qn,Z)); nl,print('Arc from ',Q0,' to ',Qn,' on ',Z,' exits.'). (c) The predicate 'qendck' verifies that there is a path from the end node of the arc just entered to a terminal node. If not, control is passed to 'flow', otherwise 'nextnode' allows a new path to be initiated or the program terminated. Pthck is used to verify that there is a path to each of the terminal nodes before the program is terminated. Checkstart prevents isolated nodes from being inserted into the network. qendck(Q0,Qnext) :- qend(Qnext),(qend(Q0);asserta(qend(Q0))),nextnode. qendck(Q0,Qnext) :- (qend(Q0);asserta(qend(Q0))),flow(Qnext). nextnode :- nl,print('Enter next start node or the word done ? '), read(Ns), not(Ns=done), ((checkstart(Ns), flow(Ns));nextnode). ..page nextnode :- pthck, !,retract(term([],[])), nl,print('Network completed'), listing(arc),listing(term), nl,print('Enter name of new ATN file '),read(S), update(node,S),forget(node). nextnode :- nextnode. pthck :- term(Q,[]),not(Q=[]),not(arc(_,Q,_)), nl,print('No path to terminal node ',Q), !,fail. pthck :- term([],[]). checkstart(Ns) :- qend(Ns); nl,print(Ns,' is an invalid node '),fail. 2) ATNNEW One of the features of an ATN vis-a-vis other parsers is that the path of transversal can be used to provide information. ATNNEW is an example which demonstrates that this can be accomplished in PROLOG. This program, which is limited to the ATN in Figure 1, identifies the subject of the sentence as the noun (or nouns) in the noun phrase used to transition between nodes q0 and q1, or q4 and q5. It also uses the 'p' or 's' associated with each noun or verb and checks the subject and predicate for agreement in number. The code for the predicate ptrans, below, is annotated along the right-hand column with numbers to correspond to the notes below. ptrans(Bq,Nq,Lq,[S0|S1],Pr,Parse) :- S0(Type,Nbr), -1 arc(Bq,Zq,Type), ( ( not(Type=noun); subj(_) ); asserta(subj(Nbr)) ), -2 append(Pr,[[Type],S0],P1), ptrans(Zq,Nq,Lq,S1,P1,Parse). ptrans(Bq,Nq,Lq,S,Pr,Parse) :- arc(Bq,Zq,[]), ptrans(Zq,Nq,Lq,S,Pr,Parse). ptrans(qnp2,Nq,Lq,[S0|S1],Pr,Parse) :- S0=and,(Lq=q4;Lq=q0), -3 ( ( subj(_),retract(subj(_)) ); not(subj(_)) ), -4 asserta(subj(p)), -5 append(Pr,[and],P1), ptrans(qnp,Nq,Lq,S1,P1,Parse). ptrans(qnp2,Nq,Lq,[S0|S1],Pr,Parse) :- S0=and, -6 append(Pr,[and],P1), ptrans(qnp,Nq,Lq,S1,P1,Parse). ptrans(qnp2,Nq,Lq,S0,Pr,Parse) :- nl, print('Transition ',Lq,' ',Nq), nl, print(Pr), append(Parse,Pr,P1), trans(Nq,Rq,P1,S0,S1). -1. S0 is the next word in the sentence. Each word is defined as a unique fact with a type and number (p or s or x).  -2. This line establishes the number of the subject as that of the noun unless one has already been established. The subject for all sentences covered by the ATN in Figure 1 will be located in noun phrases parsed before reaching node q2, hence nouns in noun phrases at node q2 or q3 will be ignored. -3. This predicate is a special provision for the use of 'and' if the next word is 'and', and we are attempting to transition from node q4 or q0. -4. Retract the predicate subj which contains the number for the subject. The not(subj(_)) is actually not required, since the subj has had to been asserted if the program gets to this point but is included for balance. -5. This part of the clause establishes the number associated with the subject as plural based on the use of and. -6. This clause accounts for the case of an and in a noun phrase not at node q0 or q4. 6. Conclusions. The programs developed for this project demonstrate that PROLOG is a powerful language that offers unique capabilities and interesting potential but little user interface. It is surprising that the power of the language has not been exploited to enhance the utility. a. Any useful application will require some form of procedure. Construction of these procedures, such as in the Phase III example, is awkward in the current language. b. Although all variables are local to a predicate, the dynamic nature of PROLOG enables the programmer to establish global variables through program modification. It is this feature which appears to offer great potential. c. There are some alternative search techniques, beyond the scope of this paper, which should be evaluated. d. Given that these examples only employ the most rudimentary PROLOG commands, the language appears to offer a rich environment, limited primarily by the lack of user interface. ..pgno1 ..foot59c1-## /* Augmented Transition Network Program ATN.PRO 10/22/85 */ /* Standard routines for append & membership checking */ append([],L,L). append([Z|L1],L2,[Z|L3]) :- append(L1,L2,L3). printstring([]). printstring([H|T]) :- put(H), printstring(T). member(X,[X|_]). member(X,[_|Y]) :- member(X,Y). /* The start module accepts a set of words, enclosed in brackets and separated by commas. It calls wordck to verify that each of the words is in the vocabulary set. */ start :- batch,nl,print('INPUT'),nl,print('-----'),nl, nl,print('Input sentence: '),read(S),nl, print('The working set is ',S),wordck(S),!, nl,nl,print('TRANSFERS'),nl,nl,print('---------'),nl,nl,q(0,S). /* Wordck checks for the end of the set, [], then if the word is in the vocabulary. If not, it asks for the category, and adds it to the file WORD.TEM which is joined with the program after it has run.*/ wordck([]) :- !,true. wordck([H|T]) :- word(H,Y),wordck(T). wordck([H|T]) :- nl,print(H,' is not a recognized word '), nl,print(' enter verb,aux, .. '),read(Z), wordnew(H,Z),wordck(T). wordnew(W,Z) :- assertz(word(W,Z)),open('word.tem',ar), nlf('word.tem'), printf('word.tem', 'word(', W, ',', Z, ').'), close('word.tem'). /* Trans checks the category of the current word (H) versus the category required to make a transition (Z). */ trans(H,Z) :- word(H,X), member(X,[Z]). qfail(Nq,S,E) :- !, nl,nl,print('The sentence failed at ',Nq),nl, print('The sentence form to this node is ',E),nl, print('The rest of the sentence is ',S),qend1. qend(Z,E) :- nl,nl,print('OUTPUT'),nl,print('------'),nl,nl, print('The sentence is:'),nl,nl,print(E),nl,nl, print('The sentence is completed at node ',Z),qend1. qend1 :- open('word.tem',ar),nlf('word.tem'), close('word.tem'),exec('ren atn.pro atn.sav'), exec('copy atn.sav+word.tem atn.pro'), exec('erase atn.sav'),exec('erase word.tem'). /* Print transfer from node to node */ qout(A,B,C,D,E,F) :- append(E,[C,'(',A,')'],F), nl, print('Transfer from node ',B,' to node ',D, ' by word ',A,' evaluated as a ',C). /* Main program to check the conditions for transfer from node to node. The first number is the number of the node, i.e. q(0.. is node 0. The module either checks for a word type and transfers control directly, or passes to np / pp the next node. */ /* Node 0 - aux to 4 / np to 1 / or fail */ q(0,[H|T]) :- trans(H,[aux]),!,qout(H,0,[aux],4,E,F), q(4,T,F). q(0,[H|T]) :- np(H,T,1,[],0,[np]). q(0,S) :- qfail(0,S,[]). /* Node 1 - verb to 2 / aux to 5 / or fail */ q(1,[H|T],E) :- trans(H,[verb]),!,qout(H,1,[verb],2,E,F), q(2,T,F). q(1,[H|T],E) :- trans(H,[aux]),!, qout(H,1,[aux],5,E,F), q(5,T,F). q(1,S,E) :- qfail(1,S,E). /* Node 2 - null to end / np to 2 / pp to 3 / or fail */ q(2,H,E) :- member(H,[[]]), !, qend(2,E). q(2,[H|T],E) :- np(H,T,2,E,2,[np]). q(2,[H|T],E) :- pp(H,T,3,E,2,[pp]). q(2,S,E) :- qfail(2,S,E). /* Node 3 - null to end / or fail */ q(3,H,E) :- trans(H,[]), !, qend(3,E). q(3,S,E) :- qfail(3,S,E). /* Node 4 - np to 5 / or fail */ q(4,[H|T],E) :- np(H,T,5,E,4,[np]). q(4,S,E) :- qfail(4,S,E). /* Node 5 - verb to 2 / or fail */ q(5,[H|T],E) :- trans(H,[verb]),!, qout(H,5,[verb],2,E,F), q(2,T,F). q(5,S,E) :- qfail(5,S,E). /* Noun phrase - (det) (adj) (adj) .. noun */ /* The np1 clause is required to allow recursive calls for adj */ np(H,[S|T],Nq,E,Lq,G) :- trans(H,[det]), !, append(G,['det(',H,')'],G1), np1([S|T],Nq,E,Lq,G1). np(H,Z,Nq,E,Lq,G) :- np1([H|Z],Nq,E,Lq,G). np1([H|T],Nq,E,Lq,G) :- trans(H,[adj]), append(G,['adj(',H,')'],G1), np1(T,Nq,E,Lq,G1). np1([H|T],Nq,E,Lq,G) :- trans(H,[noun]),!,nl, append(G,['noun(',H,')'],G1), append(E,G1,F), print('Transfer from node ',Lq,' to ',Nq), print(' by ',G1),q(Nq,T,F). /* Prep phrase requires a prep followed by a np */ pp(H,[S|T],Nq,E,Lq,G) :- trans(H,[prep]), append(['prep(',H,')'],G,G1), np(S,T,Nq,E,Lq,G1). /* Word defines the vocabulary set */ word(the,[det]). word(boy,[noun]). word(runs,[verb]). word(happy,[adj]). word(john,[noun]). word(can,[aux]). word(run,[verb]). word(a,[det]). word(big,[adj]). word(small,[adj]). word(girl,[noun]). word(dog,[noun]). word(on,[prep]). word(pretty,[adj]). word(fast,[adj]). word(barks,[verb]). word(to,[prep]). word([],[]). word(giant, [noun]). word(is, [verb]). word(giant, [noun]). word(is, [verb]). word(sleeps, [verb]). word(mary, [noun]). word(likes, [verb]). ..pgno1 ..foot59c2-## /* Augmented Transition Network Program ATNREV.PRO 11/24/85 */ /* Standard routines for append & membership checking */ append([],L,L). append([Z|L1],L2,[Z|L3]) :- append(L1,L2,L3). printstring([]). printstring([H|T]) :- put(H), printstring(T). member(X,[X|_]). member(X,[_|Y]) :- member(X,Y). /* The start module accepts a set of words, enclosed in brackets and separated by commas. It calls wordck to verify that each of the words is in the vocabulary set. */ start :- batch,nl,print('INPUT'),nl,print('-----'),nl, nl,print('Input sentence: '),read(S),nl, print('The working set is ',S),wordck(S),!, nl,nl,print('TRANSFERS'),nl,nl,print('---------'),nl,nl, Parse=[], trans(q0,Nq,Parse,S,S1). /* Wordck checks for the end of the set, [], then if the word is in the vocabulary. If not, it asks for the category, and adds it to the file WORD.TEM which is joined with the program after it has run.*/ wordck([]) :- !,true. wordck([H|T]) :- word(H,_,_),wordck(T). wordck([H|T]) :- nl,print(H,' is not a recognized word '), nl,print(' enter verb,aux, .. '),read(Z), wordnew(H,Z),wordck(T). wordnew(W,Z) :- assertz(word(W,Z,s)),open('word.tem',ar), nlf('word.tem'), printf('word.tem', 'word(', W, ',', Z, ').'), /* The arcs are defined in terms of from node, to node, condition. Terminal nodes are identified with the empty list. Words are defined by type word name, type, and a character to be used in later examples with the number (plural or singular). */ arc(q0,q1,np). arc(q1,q2,verb). arc(q2,q2,np). arc(q2,q3,pp). arc(q0,q4,aux). arc(q4,q5,np). arc(q1,q5,aux). arc(q5,q2,verb). term(q2,[]). term(q3,[]). word(boy,noun,s). word(boys,noun,pl). word(run,verb,pl). word(runs,verb,s). word(the,det,s). arc(qnp,qnp1,det). arc(qnp,qnp1,_). arc(qnp1,qnp1,adj). arc(qnp1,qnp2,noun). arc(qpp,qnp,prep). /* Trans recursively checks the conditions for transition from the last node (Lq) to the next node (Nq). Phrases are specifically treated as pp or np in order to allow the type of phrase to be identified in the parsed sentence. */ trans(Lq,_,Parse,S1,_) :- term(Lq,S1),nl, print('Completed ',Lq), nl,print(Parse). trans(Lq,Nq,Parse,[S0|S1],S1) :- word(S0,Type,Nbr), arc(Lq,Nq,Type), nl, print('Transition ',Lq,' ',Nq,' ',S0, ' ',Type), append(Parse,[[Type],S0],P1), !, trans(Nq,Z,P1,S1,S2). trans(Lq,Nq,Parse,S0,S1) :- arc(Lq,Nq,np), ptrans(qnp,Nq,Lq,S0,[np],Parse). trans(Lq,Nq,Parse,S0,S1) :- arc(Lq,Nq,pp), ptrans(qpp,Nq,Lq,S0,[pp],Parse). trans(Lq,Nq,Parse,S0,S1) :- !,nl, print('The sentence failed at ',Lq), nl,print('Parsed ',Parse), nl,print('Left ',S0). /* Ptrans checks the transition of the phrase network. The first clause calls itself recursively until node qnp2 has been reached, which concludes the transition. Success results in trans being called with the new node. Failure returns the trans with conditions unchanged. */ ptrans(Bq,Nq,Lq,[S0|S1],Pr,Parse) :- word(S0,Type,Nbr), arc(Bq,Zq,Type), append(Pr,[[Type],S0],P1), !, ptrans(Zq,Nq,Lq,S1,P1,Parse). ptrans(qnp2,Nq,Lq,S0,Pr,Parse) :- nl, print('Transition ',Lq,' ',Nq), nl, print(Pr), append(Parse,Pr,P1), !, trans(Nq,Rq,P1,S0,S1). ..page ..pgno1 ..foot59c3-## /* PROGRAM TO BUILD PRIMARY AUGMENTED TRANSITION NETWORK ATNBLD.PRO 11/24/85 */ /* Build is the entry point into the program. It requires that the program with standard routines and the program node, which is empty, have already been consulted. */ /* The program requests the start and terminal nodes, the paths and transition conditions, then establishes a node program with a name specified by the user. */ /* Ret removes any data from memory which might interfere with network construction. Term([],[]) is required to prevent failure when checkint terminal conditions. Qend identifies all nodes for which there is a path to a terminal node. The start node is identified initially since the program will require this path be completed before any other can be constructed. Termnode accepts the terminal nodes. Flow accepts the transition arcs and conditions. */ build :- batch,ret(qend),nl,ret(arc),nl,ret(term),asserta(term([],[])), nl,print('Enter the start node: '),read(Q0), asserta(qend(Q0)),termnode,flow(Q0). termnode :- print('Enter the next terminal node or the word done: '), read(QT), not(QT=done), termck(QT), assertfa(node,term(QT,[])), asserta(qend(QT)), termnode. termnode :- !,true. /* Flow requests transitions from node to node and adds each arc and new node to the database. Qendck will continue to call flow until such time as a terminal node has been reached then allow a new path to be initiated. */ flow(Q0) :- nl,print('Transition from ',Q0,' to ? '),read(Qnext), print(' on condition ? '),read(Con), con(Q0,Con),arcck(Q0,Qnext,Con), assertfz(node,arc(Q0,Qnext,Con)), qendck(Q0,Qnext). con(Q0,Con) :- condition(Con). con(Q0,Con) :- nl,print(Con,' is an invalid condition. '), flow(Q0). termck(Qt) :- not(term(Qt,[])); nl,print('Terminal node ',Qt,' already entered'),nl. arcck(Q0,Qn,Z) :- not(arc(Q0,Qn,Z)); nl,print('Arc from ',Q0,' to ',Qn,' on ',Z,' exits.'). qendck(Q0,Qnext) :- qend(Qnext),(qend(Q0);asserta(qend(Q0))),nextnode. qendck(Q0,Qnext) :- (qend(Q0);asserta(qend(Q0))),flow(Qnext). /* Nextnode allows a new path to be initiated or the program to be terminated. Before termination it calls pthck to insure there is a path to each terminal node. Checkstart prevents an isolated node from being entered. */ nextnode :- nl,print('Enter next start node or the word done ? '), read(Ns), not(Ns=done), ((checkstart(Ns), flow(Ns));nextnode). nextnode :- pthck, !,retract(term([],[])), nl,print('Network completed'), listing(arc),listing(term), nl,print('Enter name of new ATN file '),read(S), update(node,S). nextnode :- nextnode. pthck :- term(Q,[]),not(Q=[]),not(arc(_,Q,_)), nl,print('No path to terminal node ',Q), !,fail. pthck :- term([],[]). checkstart(Ns) :- qend(Ns); nl,print(Ns,' is an invalid node '),fail. /* Condition lists the acceptable conditions for a transition. */ condition(verb). condition(noun). condition(aux). condition(prep). condition(aux). condition(pp). condition(np). ..pgno1 ..foot59c4-## /* FINAL AUGMENTED TRANSITION NETWORK PROGRAM ATNNEW1.PRO 11/24/85 */ /* Start is the entry into the program. It requires that a set of standard routines has already been consulted (append in particular). It allows the user to specify the network program, which can be build using ATNBLD. Words is a file with the vocabulary set. The sentences is a list of words separated by commas and enclosed in brackets. Wordck verifies that the words are in the vocabulary set, and if not requests required data. Parse is the sentence as it is parsed. Trans controls the flow from node to node. */ start :- nl,print('ATN network file? '),read(Fn), consult(Fn),nl, asserta(file(Fn)), consult(words),nl, batch,nl,print('INPUT'),nl,print('-----'),nl, nl,print('Input sentence: '),read(S),nl, print('The working set is ',S),wordck(S), nl,nl,print('TRANSFERS'),nl,nl,print('---------'),nl,nl, Parse=[], trans(q0,Nq,Parse,S,S1). wordck([]) :- true. wordck([H|T]) :- H(_,_),wordck(T). wordck([H|T]) :- nl,print(H,' is not a recognized word '), nl,print(' enter verb,aux, .. '),read(Z), nl,print(' enter p or s or x '),read(Z1), wordnew(H,Z,Z1),wordck(T). wordnew(W,Z,Z1) :- assertfz(words,W(Z,Z1)). /* Since the phrase transition network includes more specific procedures than the primary network, it is included in this program rather than in the network file consulted by start. It could be more dynamic, but that was considered beyond the scope of this project. */ arc(qnp,qnp1,det). arc(qnp,qnp1,[]). arc(qnp1,qnp1,adj). arc(qnp1,qnp2,noun). arc(qpp,qnp,prep). /* Trans controls the flow along the network. If a terminal node has been reached and the entire sentence has been parsed, the agreement in number (plural or singular) between the subject and predicate is checked. If they do not agree, this fact is displayed. Update words creates a file WORDS.$$$ which contains the new vocabulary. If a conditions for termination has not been met, trans checks for a transition word or a transition phrase. If none of these conditions are met, the sentence will not parse. When a verb is encountered the number (singular or plural) is 'filed'. This procedure is unique for a specific network in which only one verb can be encountered. */ trans(Lq,_,Parse,S1,_) :- term(Lq,S1),nl, print('Completed ',Lq), nl,print(Parse), ( ( subj(Nbr),pred(Nbr) ); (nl,print('The subject and predicate do not agree.') ) ), update(words), exec('erase words.pro'), exec('ren words.$$$ words.pro'), forget(words), file(Fn), forget(Fn), endclr. endclr :- (not(file(_));ret(file)),(not(subj(_));ret(subj)), (not(pred(_));ret(pred)). trans(Lq,Nq,Parse,[S0|S1],S1) :- S0(Type,Nbr), arc(Lq,Nq,Type), ((Type=verb,asserta(pred(Nbr))); not(type=verb)), nl, print('Transition ',Lq,' ',Nq,' ',S0, ' ',Type), append(Parse,[[Type],S0],P1), trans(Nq,Z,P1,S1,S2). trans(Lq,Nq,Parse,S0,S1) :- arc(Lq,Nq,np), ptrans(qnp,Nq,Lq,S0,[' '+np],Parse). trans(Lq,Nq,Parse,S0,S1) :- arc(Lq,Nq,pp), ptrans(qpp,Nq,Lq,S0,[' '+pp],Parse). trans(Lq,Nq,Parse,S0,S1) :- nl, print('The sentence failed at ',Lq), nl,print('Parsed ',Parse), nl,print('Left ',S0), endclr. /* Ptrans checks the transition of the phrase network. It calls itself recursively until node qnp2 is reached. Provisions are included to establish the number (plural or singular) of the subject, which is designed for a specific network in which the noun phrase in which the subject is located will be encountered before any other noun phrase. The upon reaching qnp2 a check is made for the word 'and'. If encountered, the number of the subject is changed to plural and a check for another noun phrase is initiated. The spacing of the parenthesis is to facilitate reading of the code. */ ptrans(Bq,Nq,Lq,[S0|S1],Pr,Parse) :- S0(Type,Nbr), arc(Bq,Zq,Type), ( ( not(Type=noun); subj(_) ); asserta(subj(Nbr)) ), append(Pr,[[Type],S0],P1), ptrans(Zq,Nq,Lq,S1,P1,Parse). ptrans(Bq,Nq,Lq,S,Pr,Parse) :- arc(Bq,Zq,[]), ptrans(Zq,Nq,Lq,S,Pr,Parse). ptrans(qnp2,Nq,Lq,[S0|S1],Pr,Parse) :- S0=and,(Lq=q4;Lq=q0), ( ( subj(_),retract(subj(_)) ); not(subj(_)) ), asserta(subj(p)), append(Pr,[and],P1), ptrans(qnp,Nq,Lq,S1,P1,Parse). ptrans(qnp2,Nq,Lq,[S0|S1],Pr,Parse) :- S0=and, append(Pr,[and],P1), ptrans(qnp,Nq,Lq,S1,P1,Parse). ptrans(qnp2,Nq,Lq,S0,Pr,Parse) :- nl, print('Transition ',Lq,' ',Nq), nl, print(Pr), append(Parse,Pr,P1), trans(Nq,Rq,P1,S0,S1).