/* Transformational Grammar Programme */ /* """""""""""""""""""""""""""""""""" */ /* ..........James Scobbie.......... */ /* ~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~ */ /* artificial intelligence department */ /* """""""""""""""""""""""""""""""""" */ :-op(500,yfx,[#]). go:-banner,choose(Namelist),!,s(Deep,_,_),show(Deep), do(Deep,Namelist,Surface). banner:-line(0),nl, printstring("Do you want to test the ordering of the current"),nl, printstring("package (option 1) or to change some aspects of"),nl, printstring("the rule set for testing? (option 2).Choose the"),nl, printstring("option you require by typing 1 or 2 followed by"),nl, printstring("full-stop,return."),nl, read_in(X),reply(X). reply([1,.]):-!,nl. reply(X):-printstring("I'm sorry, this facility isn't available yet."),nl. show(Deep):-nl, printstring("Deep Structure:"),nl, print(Deep),nl. choose(Namelist):- printstring("Do you require the current order?"),nl, read_in(X), chekchooz(X,Namelist). chekchooz(X,Namelist):- member(yes,X), current(Namelist). chekchooz(X,Namelist):- bchooz(Namelist). bchooz(Namelist):- nl,printstring("Please type in the order of whichever"), nl,printstring("transformations you choose like this:"), nl,printstring("[trans1 trans2 trans3]. or [tran]."),nl, shownames, read_in(X), append(Namelist,[.],X),!. shownames:- name(X), X=..[Name|_], print(Name),nl, fail. shownames:-!. do(Tree,[],Tree). do(Deep,[Trans1|Restrans],Surface):- transform(Trans1,Deep,Worstr), nl,printstring("Result of "), print(Trans1),nl, print(Worstr), do(Worstr,Restrans,Surface). transform(Name,Structure,Result):- details(Name,Sa,Sc1,Sc2), treefit(Sa,Nodelist,Structure), assert(done(0)), tree_prepare(Nodelist,Structure,Pre_change), tree_change(Sc1,Sc2,Pre_change,Result),!. treefit([Firstsa|Restsa],[Firstnode|Restnodes],Tree):- calibrate(Firstsa,Firstnode,Tree), match(Restnodes,Restsa,Firstnode,Tree),!. calibrate(Salist,Firstnode,Tree):- nonvar(Salist), is_list(Salist), member(Sa,Salist), Sa\==[], calibrate(Sa,Firstnode,Tree). calibrate(Firstsa,Firstnode,Tree):- simple_sa(Firstsa), functor(Tree,_,Arity), between(1,Arity,Num), arg(Num,Tree,Firstnode), functor(Firstnode,Firstsa,_). calibrate(Firstsa,Firstnode,Tree):- simple_sa(Firstsa), Tree=..[F|Subtrees], try_all_trees(Firstsa,Firstnode,Subtrees,calibrate). match([],[],_,_). match(Nodes,[Salist|Restsa],Thisnode,Tree):- nonvar(Salist), is_list(Salist), member(Sa,Salist), Sa\==[], match(Nodes,Sa,Thisnode,Tree). match(Nodes,[Savar|Restsa],Thisnode,Tree):- var(Savar), match(Nodes,Restsa,Thisnode,Tree). match([Nextnode|Restnodes],[Savar|Restsa],Thisnode,Tree):- var(Savar), rightnex(Savar,Nextnode,Thisnode,Tree), match(Restnodes,Restsa,Nextnode,Tree). match([Nextnode|Restnodes],[Sa|Restsa],Thisnode,Tree):- simple_sa(Sa), rightnex(Sa,Nextnode,Thisnode,Tree), match(Restnodes,Restsa,Nextnode,Tree). rightnex(Sa,Nextnode,Thisnode,Tree):- sisters(Right,Left,Tree), rightdecendent(Thisnode,Left), leftdecendent(Nextnode,Right), functor(Nextnode,Sa,_). sisters(Right,Left,Tree):- functor(Tree,_,Arity), between(1,Arity,Num), arg(Num,Tree,Left), Newnum is Num+1, arg(Newnum,Tree,Right). sisters(Right,Left,Tree):- Tree=..[_|Subtrees], try_all_trees(Right,Left,Subtrees,sisters). leftdecendent(X,X). leftdecendent(Lonode,Hinode):- arg(1,Hinode,Left_daughter), leftdecendent(Lonode,Left_daughter). rightdecendent(X,X). rightdecendent(Lonode,Hinode):- functor(Hinode,_,Arity), arg(Arity,Hinode,Right_daughter), rightdecendent(Lonode,Right_daughter). tree_prepare([],Tree,Tree):-retractall(done,1),!. tree_prepare([Node1|Restnodes],Oldtree,Newtree):- update(nodenum,Node1,Wortree,Oldtree), tree_prepare(Restnodes,Wortree,Newtree). tree_change(Before,After,Pre_change,Post_change):- assert(done(0)), instantiate(Before,Pre_change), clean(After,Clean_after), change(Before,Clean_after,Pre_change,Post_change). instantiate([],Tree):- retractall(done,1),!. instantiate([Firstnode|Restnodes],Tree):- retract(done(X)), Y is X+1, find(Y,Firstnode,Tree), assert(done(Y)), instantiate(Restnodes,Tree). clean([],[]):-!. clean([0|T],[0|Newt]):- clean(T,Newt),!. clean([Node|Rest],[Newnode|Newrest]):- un_num(Node,Newnode), clean(Rest,Newrest). change([],[],Tree,Tree). change([Bef|Restbef],[Af|Restaf],Oldtree,Newtree):- update(Af,Bef,Worstr,Oldtree), change(Restbef,Restaf,Worstr,Newtree). update(_,_,X,X):- atomic(X). update(XTRA_info,Node,Newtree,Oldtree):- Oldtree=..[F|Subtrees], not(member(Node,Subtrees)), try_all_lists(Node,Newsubtrees,Subtrees,XTRA_info), Newtree=..[F|Newsubtrees]. update(XTRA_info,Node,Newtree,Oldtree):- Oldtree=..[F|Oldlist], member(Node,Oldlist), switch(XTRA_info,Node,Oldlist,Newlist), Newtree=..[F|Newlist]. switch(_,_,[],[]). switch(XTRA_info,Node,[H|T],[H|Newt]):- Node\==H, switch(XTRA_info,Node,T,Newt). switch(nodenum,Node,[Node|T],[Newnode|Newt]):- nodenum(Node,Newnode), switch(XTRA_info,Node,T,Newt). switch(0,Node,[Node|T],New):- switch(0,Node,T,New). switch(XTRA_info,Node,[Node|T],[Newnode,Sis|Newt]):- XTRA_info=..[-,Newnode,Sis], switch(XTRA_info,Node,T,Newt). switch(XTRA_info,Node,[Node|T],[Newnode|Newt]):- XTRA_info=..[>,Mum,Daut], Mum=..[F|List], append(List,[Daut],Newlist), Newnode=..[F|Newlist], switch(XTRA_info,Node,T,Newt). switch(XTRA_info,Node,[Node|T],[Newnode|Newt]):- XTRA_info=..[<,Daut,Mum], Mum=..[F|List], append([Daut],List,Newlist), Newnode=..[F|Newlist], switch(XTRA_info,Node,T,Newt). switch(XTRA_info,Node,[Node|T],[Newnode|Newt]):- XTRA_info=..[+,A,B], functor(A,F,_), Newnode=..[F,A,B], switch(XTRA_info,Node,T,Newt). switch(Newnode,Node,[Node|T],[Newnode|Newt]):- Newnode\==nodenum, Newnode\==0, Newnode=..[F|_], not(member(F,[-,+,>,<])), switch(Newnode,Node,T,Newt). nodenum(X,Y):- X=..[F|List], retract(done(D)), E is D+1, E=<20, assert(done(E)), F\==[], name(F,One), name(E,Num), append(One,Num,Two), Two\==[], name(Newf,Two), Y=..[Newf|List]. un_num(Node,Newnode):- Node=..[F|List], F\==[], name(F,Chars), append(Newchars,Code,Chars), Code\==[], name(Num,Code), integer(Num), Newchars\==[], name(Newf,Newchars), Newnode=..[Newf|List], Newnode\==Node,!. un_num(Node,Newnode):- Node=..[F|List], un_num_lists(List,Newlist), Newnode=..[F|Newlist]. un_num(Node,Node):- atomic(Node), name(Node,Chars), lastelement(Chars,X), name(Nonint,X), not(integer(Nonint)). find(Num,Node,Tree):- functor(Tree,_,Arity), between(1,Arity,X), arg(X,Tree,Node), checkout(Num,Node). find(Num,Node,Tree):- Tree=..[F|Subtrees], try_all_trees(Num,Node,Subtrees,find). checkout(Num,Node):- functor(Node,F,_), name(F,List), name(Num,[Weelist]), member(Weelist,List). try_all_trees(B,A,[H|_],Pred):- Call=..[Pred,B,A,H], call(Call). try_all_trees(B,A,[_|T],Pred):- try_all_trees(B,A,T,Pred). try_all_lists(Node,[],[],_). try_all_lists(Node,[H|T],[New_h|Newt],XTRA_info):- update(XTRA_info,Node,H,New_h), try_all_lists(Node,T,Newt,XTRA_info). un_num_lists([],[]):-!. un_num_lists([H|T],[New_h|Newt]):- un_num(H,New_h), un_num_lists(T,Newt). name(passive([np,t,pass,verb,np], [X1,X2,X3,X4,X5], [X5,X2,X3,X4,pp(prep(by),X1)])). name(reflexive([np,aux,verb,np], [X1,X2,X3,X4], [X1,X2,X3,np#refl(X4)])). name(daughter([verb,np], [X1,X2], [X1>X2,0])). name(chomsky([verb,np], [X1,X2], [X1+particle(down),X2])). name(sister([verb], [X1], [X1-particle(down)])). current([passive]).