/*-------------------------------------------------------------*/ /* NL Parsing in NCL */ /* (C) 1993 Lydia Sinapova, Zdravko Markov, II-BAS */ /*-------------------------------------------------------------*/ /* DESCRIPTION: ----------- The program illustrates a distributed parsing scheme based on the NCL spreading activation and default mechanisms. It comprises two parts - a net-clause structured in 4 layers (input layer, syntax layer, semantic layer and default layer) and a Prolog program. The latter comprises the definitions of the node procedures, dictionary, word senses and a top level for user interaction. The linguistic descriptions are embedded in the nodes of the network and their relations are expressed by the links between the nodes. A set of linked nodes can be viewed as a frame-like structure describing a linguistic object. The parsing process is based on the NCL spreading activation algorithm. Within the network the net-variables have a twofold usage - both as channels for data transfer and as slots in frames. The initial language constructions that are to be analyzed are passed to the network through the input nodes (represented as free nodes). They correspond to objects and actions. Each input node can accept a particular constituent type. For each constituent type several input nodes are provided. The order of the constituents in a sentence is implicitly reflected by the subsequent activation of the corresponding input nodes. Input nodes are linked to spreading-activation nodes that analyze the syntactic and semantic relations between the input entities. These nodes comprise the processing layer of the network. Within the processing layer the nodes are organized in two interacting levels - syntactic and semantic. The syntax-semantics interaction is accomplished through appropriate links between the syntactic and semantic nodes. At the syntactic level constituents that form a valid syntactic structure are linked to constraint nodes that test their semantic compatibility. If the semantic constraints are violated the corresponding syntactic links are cut off and the input constituents are forced to find their proper places in the input nodes so as to form syntactically and semantically acceptable structure. This process is based on variable uninstantiation and backtracking in the Net-clause programming environment. At the semantic level there are three types of nodes - basic case-frame nodes, optional case-frame nodes and selection nodes. Basic case-frame nodes invoke filling-in the slots of a particular case frame representing the meaning of the parsed sentence. They are activated when the entire sentence has been entered. Optional case-frame nodes handle optional constituents of the sentence. They are activated only if such constituents are encountered but not before the end of the sentence. Selection nodes are used to choose the appropriate meaning of a word with many senses.The selection nodes for a given ambiguous word comprise its discrimination subnetwork. Selection is performed on the basis of both syntactic and semantic constraints and preferences encoded in the links between the nodes. The discrimination between incompatible meanings of a given word is done by means of inhibitory links between the corresponding nodes. Choosing a particular meaning of a word means activating a subnetwork describing the concept that corresponds to the meaning of the word. The representation of a concept is distributed among several nodes referring to different semantic aspects of the concept. The correspondences between a word and its meanings is accomplished by linking its discrimination network to the nodes describing its separate meanings. The default layer comprises several default nodes organized in a partial hierarchy. The default nodes are activated by the processing nodes on an attempt to process data which have not been obtained yet. The output of the network is activated by the case-frame nodes upon filling the slots with the appropriate fillers. REFERENCE: --------- Sinapova, L. A network parsing scheme. In: Ph. Jorrand & V. Sgurev (eds.), Proceedings of AIMSA'90, Artificial Intelligence IV, North-Holland, 1990, 383-392. */ /*-------------------------------------------------------------*/ /* Net-Clause */ /*-------------------------------------------------------------*/ /*----------------------- Input layer -------------------------*/ o(O1): v(V1,S1): p(P1): o(O2): v(V2,S2): p(P2): from(L1): from(L2): for(For): to(To): threw(Threw): visit(Visit): s_object(S_ob): p_object(P_ob): v_object(V_ob): delimiter(D): c(C): /*----------------------- Syntax layer ------------------------*/ node(O1,V1,P1,2,Clause1 = ok): node(O2,V2,P2,1,Clause2 = ok): node(Clause1,D,~S1,2,case(V1,O1,P1)): node(Clause2,D,~S2,2,case(V2,O2,P2)): node(V1,P1,~S1,2,obj_constr(V1,P1)): node(V2,P2,~S2,2,obj_constr(V2,P2)): node(Clause1,L1,C,~W,3,loc_from1(V1,V2,L1,P1)): node(Clause1,L1,~C,~W,2,loc_from(V1,L1,P1,W)): node(Clause2,D,L2,3,loc_from(V2,L2,P2,W1)): node(Clause2,D,L1,~W,3,loc_from(V2,L1,P2,W)): /*---------------------- Semantic Layer -----------------------*/ node(Threw,To,2,Threw = Propel): node(Threw,P_ob,2,Threw = Propel): node(Threw,~Spons,D,2,Threw = Propel): node(Threw,P1,2,soc_obj(P1,S_ob)): node(Threw,For,2,Threw = Spons): node(Threw,S_ob,2,Threw = Spons): node(Threw,~C,1,FT=ft): node(Threw,D,~FT,2,ST=st): node(Propel,1,Action = propel): node(Propel,FT,2,propel_constr(P1,P_ob)): node(Propel,ST,2,propel_constr(P2,P_ob)): node(Propel,~P_ob,~P2,D,2,find_pr(P1,P_ob)): node(Propel,Action,P_ob,FT,4,propel_case(Action,O1,Propel,P_ob,To)): node(Propel,Action,P_ob,ST,4,propel_case(Action,O2,Propel,P_ob,To)): node(Spons,1,Action = sponsor): node(Spons,P1,FT,3,spons_constr(P1,S_ob)): node(Spons,P2,ST,3,spons_constr(P2,S_ob)): node(Spons,Action,S_ob,FT,4,spons_case(Action,O1,Spons,S_ob,For)): node(Spons,Action,S_ob,ST,4,spons_case(Action,O2,Spons,S_ob,For)): node(Visit,~C,1,FV=ft): node(Visit,D,~FV,2,SV=sv): node(Visit,P1,FV,3,visit_constr(P1,V_ob)): node(Visit,P2,SV,3,visit_constr(P2,V_ob)): node(Visit,~V_ob,D,2,find(P2,V_ob)): node(Visit,V_ob,D,FV,4,visit_case(visit,O1,Visit,V_ob)): node(Visit,V_ob,D,SV,4,visit_case(visit,O2,Visit,V_ob)): /*---------------------- Default Layer ------------------------*/ default(O1,somebody): default(O2,O1): default(V2,V1): default(P2,DP2,pro(P1,V2,DP2)): default(DP2,DP3,pro(L1,V2,DP3)): default(DP3,something): default(P1,DP1,pro(P2,V1,DP1)): default(DP1,something). /*-------------------------------------------------------------*/ /* Prolog procedures */ /*-------------------------------------------------------------*/ /*--------- Default node procedures and constraints -----------*/ pro(P,V,DP):- nonvar(P),propg(P,V,DP),!. propg(P,V,P):- var(V),!. propg(P,V,P):- obj_constr(V,P),!. find(P,X):-nonvar(X),!. find(P,P). find_pr(P1,Y):- object(P1),Y = P1. find_pr(P1,Y):- sense(P1,X),object(X),Y = X. find_pr(_,_). soc_obj(P1,S_ob):- s_event(P1),S_ob = P1. soc_obj(_,_). loc_from(V,L,P,ok):- loc_constr(V,L),source_slot(V,L,P). loc_from(V,L,P,_). loc_from1(V,V,L,P):- loc_constr(V,L),source_slot(V,L,P). loc_from1(_,_,_,_). /*------------------ Case-role constraints --------------------*/ propel_constr(P1,Y):- object(P1),Y = P1. propel_constr(P1,Y):- sense(P1,X),object(X),Y = X. propel_constr(_,_). spons_constr(P1,Y):- s_event(P1), Y = P1. spons_constr(P1,Y):- sense(P1,X),s_event(X),Y = X. spons_constr(_,_). visit_constr(P,Y):- s_event(P),Y = P,!. visit_constr(P,Y):- sense(P,X), s_event(X),Y = X,!. visit_constr(_,_). obj_constr(eats,P):- food(P). obj_constr(drinks,P):- drink(P). obj_constr(likes,P):- object(P). obj_constr(takes,P):- object(P). obj_constr(picks,P):- object(P). obj_constr(washes,P):-object(P),washable(P). obj_constr(propel,P):- sense(P,X),object(X). obj_constr(propel,P):-object(P). obj_constr(visited,P):- s_event(P),v_object(P),!. obj_constr(visited,P):- sense(P,X),s_event(X),s_object(X),v_object(X). loc_constr(takes,L):- human(L);location(L). loc_constr(picks,L):- location(L). /*----------------------- Top Level ---------------------------*/ parse([X]):-callw(X),delimiter(.),!. parse([X|Y]):-callw(X),!,parse(Y). /*----------------- Output of the network ---------------------*/ propel_case(Action,O1,Propel,P_ob,To):- nl,write('verb = '),write(Propel), nl,write('action = '),write(Action), nl,write('agent_of('),write(Action), write(') = '),write(O1), nl,write('object_of('),write(Action),write(') = '),write(P_ob), nl,cprop_case(To). cprop_case(To):- nonvar(To),nl,write('direction = '),write(To). cprop_case(_). spons_case(Action,O1,Spons,S_ob,For):- nl,write('verb = '),write(Spons), nl,write('action = '),write(Action), nl,write('agent_of('),write(Action), write(') = '),write(O1), nl,write('object_of('),write(Action),write(') = '),write(S_ob), nl,sprop_case(For). sprop_case(For):- nonvar(For),nl,write('recepient = '),write(For). sprop_case(_). visit_case(Action,O1,Visit,V_ob):- nl,write('verb = '),write(Visit), nl,write('action = '),write(Action), nl,write('agent_of('),write(Action), write(') = '),write(O1), nl,write('object_of('),write(Action),write(') = '),write(V_ob),nl. case(X,Y,Z):-ppwrite(X,Y,Z). source_slot(V,L,P):-pswrite(L,P). ppwrite(X,Y,Z):- nl,write('verb_action = '),act(X,X1),write(X1), nl,write('subject_of('),write(X1),write(') = '), write(Y),nl, write('d_object_of('),write(X1),write(') = '),write(Z),nl. pswrite(L,P):- nl,write('pre_location_of('),write(P), write(') = '),write(L),nl. /*----------------------- Dictionary --------------------------*/ callw(tom):-o(tom). callw(bob):-o(bob). callw(threw):-v(threw,threw),threw(threw). callw(visited):-v(visited,ok),visit(visited). callw(eats):-v(eats,_). callw(drinks):-v(drinks,_). callw(likes):-v(likes,_). callw(takes):-v(takes,_). callw(took):-v(takes,_). callw(picks):-v(picks,_). callw(washes):-v(washes,_). callw(eat):-v(eats,_). callw(drink):-v(drinks,_). callw(like):-v(likes,_). callw(take):-v(takes,_). callw(pick):-v(picks,_). callw(wash):-v(washes,_). callw(ball):-p(ball). callw(concert):-p(concert). callw(cake):-p(cake). callw(apple):-p(apple). callw(wine):-p(wine). callw(tea):-p(tea). callw(table):-from(table). callw(desk):-from(desk). callw(charity):-for(charity). callw(dog):-to(dog). callw(and):-c(and). callw(_):-!. /*------------------------ Word Sense -------------------------*/ act(eats,eating). act(drinks,drinking). act(likes,liking). act(takes,taking). act(picks,picking). act(threw,propel). act(threw,gave). act(washes,washing). human(tom). human(bob). food(something). food(cake). food(apple). drink(something). drink(wine). drink(tea). object(table). location(table). location(desk). washable(table). washable(apple). object(sphere). s_event(dance). s_event(concert). sense(ball,sphere). sense(ball,dance). object(X):- food(X). object(X):- drink(X). object(X):- sense(X,Y),object(Y). animate(X):- human(X). /*-------------------------------------------------------------*/ /* EXAMPLES: */ /*-------------------------------------------------------------*/ /*--------------------- Demo sentences ------------------------*/ sent([tom,eats,cake]). sent([tom,eats,cake,and,an,apple]). sent([tom,eats,cake,and,drinks,wine]). sent([tom,eats,cake,and,drinks]). sent([tom,eats]). sent([tom,and,bob,drink,wine]). sent([tom,likes,cake,and,eats,it]). sent([tom,takes,the,cake,from,the,table]). sent([tom,takes,the,apple,and,the,cake,from,the,table]). sent([tom,takes,the,cake,from,the,table,and,eats,it]). sent([tom,takes,the,cake,from,the,table,and,washes,it]). sent([tom,takes,the,apple,from,the,table,and,washes,it]). sent([tom,threw,a,ball]). sent([tom,threw,a,ball,for,charity]). sent([tom,threw,a,ball,to,the,dog]). sent([tom,took,the,apple,from,the,table,and,threw,it]). sent([tom,threw,a,ball,and,bob,took,it]). sent([tom,threw,a,ball,and,bob,visited,it]). /* Parsing Demo Sentences */ /* ?- sent(S),parse(S). verb_action = eating subject_of(eating) = tom d_object_of(eating) = cake S=[tom,eats,cake]; verb_action = eating subject_of(eating) = tom d_object_of(eating) = apple verb_action = eating subject_of(eating) = tom d_object_of(eating) = cake S=[tom,eats,cake,and,an,apple]; verb_action = drinking subject_of(drinking) = tom d_object_of(drinking) = wine verb_action = eating subject_of(eating) = tom d_object_of(eating) = cake S=[tom,eats,cake,and,drinks,wine]; verb_action = drinking subject_of(drinking) = tom d_object_of(drinking) = something verb_action = eating subject_of(eating) = tom d_object_of(eating) = cake S=[tom,eats,cake,and,drinks]; ... */