%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% TAGLET.PL %% Matthew Stone %% March, 2002 %% Finger-exercises for xtag+spud-lite. %% %% File Structure. %% 1. Definitions for specific prolog implementations. %% 2. Knowledge base predicates. %% 3. Tree structure definitions and conversions. %% 4. Tree operations. %% 5. Parsing. %% 6. Generation. %% 7. Verification & validation. %% 8. Lexicon %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 1. Definitions for specific prolog implementations. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Some extra list-manipulation and term-manipulation. %% exact_delete(L, E, L2) is true if %% L contains an element identical (==) to E %% (including identity of variables at this point %% in the prolog state). L2 is the list just like %% L but with E omitted. exact_delete([E|R], M, R) :- E == M. exact_delete([H|T], E, [H|R]) :- exact_delete(T, E, R). %% zap(Removable, Removefrom, Result) is true if %% Result is a list containing all elements from %% the list Removefrom except elements of list %% Removable. zap_aux([], _, []). zap_aux([E|T], E, R) :- zap_aux(T, E, R). zap_aux([H|T], E, [H|R]) :- zap_aux(T, E, R), \+(E=H). zap([], R, R). zap([H|T], L, R) :- zap_aux(L, H, M), zap(T, M, R). %% exact_subvar(T1, V) %% true if variable V is identical (==) %% to a subterm of T1. exact_subvar(T1, T2) :- var(T1), T1 == T2. exact_subvar(Term, Subterm) :- \+ var(Term), Term =.. [ _ | Args], member(Next, Args), exact_subvar(Next, Subterm). %% flex_subvar(T1, V) %% unifies variable V with a variable subterm of T1. flex_subvar(T1, T1) :- var(T1). flex_subvar(Term, Subterm) :- \+ var(Term), Term =.. [ _ | Args], member(Next, Args), flex_subvar(Next, Subterm). %% overlap(T1,T2) %% true if T1 and T2 contain the same variable %% as a subterm. overlap(T1, T2) :- flex_subvar(T1, S), exact_subvar(T2, S). %% counter for instantiating variables. :- dynamic(variable_count/1). variable_count(0). %% Sicstus (v 3.7), use the definitions below: %% member(E, L) is true if L contains E. member(E, [E|_]). member(E, [_|R]) :- member(E,R). %% append(F, S, L) is true if L contains F followed by S. append([], L, L). append([H|T], S, [H|L]) :- append(T, S, L). %% reverse(L, R) is true if R is the reverse of L. reverse(L, R) :- raux(L, [], R). raux([], L, L). raux([H|T], L, R) :- raux(T, [H|L], R). %% nv(X, Y, L) instantiates the free variables in X nv(X) :- retract(variable_count(Y)), numbervars(X, Y, Z), assert(variable_count(Z)). %% Print complete details of terms :- prolog_flag(toplevel_print_options, _, [quoted(true), numbervars(true), portrayed(true), max_depth(0)]). :- prolog_flag(debugger_print_options, _, [quoted(true), numbervars(true), portrayed(true), max_depth(0)]). %% For SWI-Prolog, use the definitions below: %% %% nv(X, Y, L) instantiates the free variables in X %% nv(X) :- %% retract(variable_count(Y)), %% numbervars(X, dr, Y, Z), %% assert(variable_count(Z)). %% %% Print complete details of terms %% :- set_prolog_flag(toplevel_print_options, %% [quoted(true), %% portray(true), %% max_depth(0)]). %% :- set_prolog_flag(debugger_print_options, %% [quoted(true), %% portray(true), %% max_depth(0)]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 2. Knowledge base predicates %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% shared(F) should be true %% if F is part of the common ground of the conversation. :- dynamic(shared/1). %% private(F) should be true %% if F is part of the system's private information. :- dynamic(private/1). %% all_shared(L) %% true if all facts in L are part of the common ground. all_shared([]). all_shared([F|R]) :- shared(F), all_shared(R). %% all_private(L) %% true if all facts in L are part of system's private info. all_private([]). all_private([F|R]) :- private(F), all_private(R). %% make_all_shared(L) %% always true %% as a side-effect, add facts in L to the common ground. make_all_shared([]). make_all_shared([F|R]) :- assert(shared(F)), make_all_shared(R). %% make_all_private(L) %% always true %% as a side-effect, add facts in L to system's private info. make_all_private([]). make_all_private([F|R]) :- assert(private(F)), make_all_private(R). %% clear %% always true %% as a side-effect, resets the knowledge base. clear :- retractall(shared(_)), retractall(private(_)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 3. Tree structure definitions and operations. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% Structures %% TAGLET is a tree-rewriting formalism with two operations: %% - substitution: replacing a leaf by a new subtree %% corresponding to obligatory syntactic complementation. %% - sister-adjunction: adding a subtree as a new child %% corresponding to optional syntactic modification %% %% The program represents TAGLET trees with four alternative %% structures: %% n/t-structures: for elementary trees in the lexicon. %% n/t-structures are completely unsaturated. %% na/ta-structures: for derived trees in analysis. %% na/ta-structures are saturated across a single %% uninterrupted span of text, otherwise unsatureted. %% ng/tg-structures: for derived trees in generation. %% ng/tg-structures are freely saturated %% (though complements at each node %% are provided in order) and freely unsaturated. %% nx-structures: for completed derivations %% nx-structures are completely saturated. %% All structures share substructure: %% category terms for syntactic categories. %% w(word) structures for overt lexical material. %% comp/premod(category?)/postmod(category?) %% specifying a TAGLET operation. %% children are labeled c- or m- or h-, giving - structures %% %% N/T STRUCTURES. %% %% n(cat: category, %% head: n-structure, %% unsat_left: category list (R to L order), %% unsat_right: category list (L to R order)) %% %% t(node: n-structure, %% op: TAGLET operation) %% %% NA/TA STRUCTURES. %% %% na(category: cat, %% head: node, %% unsat_left: cat list (R to L order), %% sat_left: -na-structure list (L to R order), %% left_comp_below: yes or no, %% unsat_right: cat list (L to R order), %% sat_right: -na-structure list (R to L order), %% right_comp_below: yes or no) %% %% ta(node: na-structure, %% root: category, %% unfinished_left: yes or no, %% unfinished_right: yes or no, %% right_op_done: yes or no, %% op: TAGLET operation) %% %% NG/TG STRUCTURES. %% %% ng(cat: category, %% head: ng-structure, %% unsat_left: category list (R to L order), %% sat_left: -ng-structure list (L to R order), %% unsat_right: category list (L to R order), %% sat_right: -ng-structure list (R to L order)) %% %% tg(node: ng-structure, %% root: category, %% op: TAGLET operation) %% %% NX STRUCTURES %% %% nx(cat: category, %% children: -nx-structure list (L to R order)) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% nx_root(nx(C, _), C). nx_root(w(_), word). nx_leaves(w(W), [W|R], R). nx_leaves(nx(_, L), S, E) :- nx_leaves_list(L, S, E). nx_leaves_list([], R, R). nx_leaves_list([ _K-H | T], S, E) :- nx_leaves(H, S, M), nx_leaves_list(T, M, E). nx_leaves(T, S) :- nx_leaves(T, S, []). n_info(w(W), W, P, P, A, A). n_info(n(C, H, UL, UR), W, P, _HP, ArgListIn, ArgListOut) :- n_info_list(UL, ArgListIn, ArgListN1), n_info_list(UR, ArgListN1, ArgListN2), arg(1, C, E), ((nonvar(E); exact_subvar(ArgListN2, E)) -> n_info(H, W, P, C, ArgListN2, ArgListOut) ; n_info(H, W, P, C, [E | ArgListN2], ArgListOut) ). n_info_list([], L, L). n_info_list([C|R], L, F) :- arg(1, C, E), ((nonvar(E); exact_subvar(L, E)) -> n_info_list(R, L, F); n_info_list(R, [E|L], F) ). t_info(t(N, _), W, P, A) :- n_info(N, W, P, w, [], A). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % TRANSFORMATIONS BETWEEN STRUCTURES % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%--------------------------------- %% %% n/t to na/ta n_to_na_structure(w(Word), w(Word), no, no, word). n_to_na_structure( n(C, H, UL, UR), na(C, H2, UL, [], LB, UR, [], RB), LBN, RBN, C ) :- n_to_na_structure(H, H2, LB, RB, _), (UL = [] -> LBN = LB ; LBN = yes), (UR = [] -> RBN = RB ; RBN = yes). t_to_ta_structure( t(Node, comp), ta(Exp, Root, LB, RB, no, comp) ) :- n_to_na_structure(Node, Exp, LB, RB, Root). t_to_ta_structure( t(Node, premod(Root)), ta(Exp, Root, LB, RB, no, premod) ) :- n_to_na_structure(Node, Exp, LB, RB, _). t_to_ta_structure( t(Node, postmod(Root)), ta(Exp, Root, LB, RB, no, postmod) ) :- n_to_na_structure(Node, Exp, LB, RB, _). %%--------------------------------- %% %% na/ta to nx na_to_nx_structure(w(Word), w(Word)). na_to_nx_structure( na(C, H, _, LS, _, _, RS, _), nx(C, L) ) :- reverse(RS, X), na_to_nx_list(X, [], CX), na_to_nx_structure(H, H2), na_to_nx_list(LS, [ h-H2 | CX], L). na_to_nx_list([], L, L). na_to_nx_list([ K-H | T], L, [ K-HC | R]) :- na_to_nx_structure(H, HC), na_to_nx_list(T, L, R). ta_to_nx_structure(ta(Node, _, _, _, _, _), NX) :- na_to_nx_structure(Node, NX). %%--------------------------------- %% %% n/t to ng/tg n_to_ng_structure(w(Word), w(Word), word). n_to_ng_structure( n(C, H, UL, UR), ng(C, H2, UL, [], UR, []), C ) :- n_to_ng_structure(H, H2, _). t_to_tg_structure( t(Node, comp), tg(Exp, Root, comp) ) :- n_to_ng_structure(Node, Exp, Root). t_to_tg_structure( t(Node, premod(Root)), tg(Exp, Root, premod) ) :- n_to_ng_structure(Node, Exp, _). t_to_tg_structure( t(Node, postmod(Root)), tg(Exp, Root, postmod) ) :- n_to_ng_structure(Node, Exp, _). t_for_tg_template( tg(_, N, comp), t(n(N,_,_,_), comp) ). t_for_tg_template( tg(_, N, postmod), t(_, postmod(N)) ). t_for_tg_template( tg(_, N, premod), t(_, premod(N)) ). %%--------------------------------- %% %% ng/tg to nx ng_to_nx_structure(w(Word), w(Word)). ng_to_nx_structure( ng(C, H, _, LS, _, RS), nx(C, L) ) :- reverse(RS, X), ng_to_nx_list(X, [], CX), ng_to_nx_structure(H, H2), ng_to_nx_list(LS, [ h-H2 | CX], L). ng_to_nx_list([], L, L). ng_to_nx_list([ K-H | T], L, [ K-HC | R]) :- ng_to_nx_structure(H, HC), ng_to_nx_list(T, L, R). tg_to_nx_structure(tg(Node, _, _), NX) :- ng_to_nx_structure(Node, NX). %%------------------------------------ %% %% nx to n/t nx_elements( w(Word), w(Word), SubElements, SubElements ). nx_elements( nx(C, Kids), n(C, Head, UnsatLeft, UnsatRight), SubElementsStart, SubElementsEnd ) :- nx_elements_left(C, Kids, Head, [], UnsatLeft, UnsatRight, SubElementsStart, SubElementsEnd). nx_elements_left( C, [ h-H | R ], Head, Left, Left, Right, SubElementsStart, SubElementsEnd ) :- nx_elements(H, Head, SubElementsStart, SubElementsNext), nx_elements_right(C, R, [], Right, SubElementsNext, SubElementsEnd). nx_elements_left( C, [ m-M | T ], Head, Sofar, Left, Right, SubElementsStart, SubElementsEnd ) :- nx_t_elements(premod(C), M, SubElementsStart, SubElementsNext), nx_elements_left(C, T, Head, Sofar, Left, Right, SubElementsNext, SubElementsEnd). nx_elements_left( C, [ c-M | T ], Head, Sofar, Left, Right, SubElementsStart, SubElementsEnd ) :- nx_t_elements(comp, M, SubElementsStart, SubElementsNext), nx_root(M, MC), nx_elements_left(C, T, Head, [MC | Sofar], Left, Right, SubElementsNext, SubElementsEnd). nx_elements_right( _C, [], Sofar, Right, SubElements, SubElements ) :- reverse(Sofar, Right). nx_elements_right( C, [ m-M | T], Sofar, Right, SubElementsStart, SubElementsEnd ) :- nx_t_elements(postmod(C), M, SubElementsStart, SubElementsNext), nx_elements_right(C, T, Sofar, Right, SubElementsNext, SubElementsEnd). nx_elements_right( C, [ c-M | T], Sofar, Right, SubElementsStart, SubElementsEnd ) :- nx_t_elements(comp, M, SubElementsStart, SubElementsNext), nx_root(M, MC), nx_elements_right(C, T, [ MC | Sofar ], Right, SubElementsNext, SubElementsEnd). nx_t_elements( Op, NX, [ t(N, Op) | SubElementsStart ], SubElementsEnd ) :- nx_elements(NX, N, SubElementsStart, SubElementsEnd). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 4. Tree Operations %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 4a. Combinatory operations for parsing: %% - substitute completed tree on spine & right frontier %% - postmodify by completed tree on spine & right frontier %% - substitute completed tree on spine & left frontier %% - premodify by completed tree on spine & left frontier %% Keeping track of what the constituent needs where %% in order to be fully saturatied. na_compute_unfinished( na(_,_,UL,_,LB,UR,_,RB), AB ) :- ((UL = [], UR = []) -> compute_unfinished(LB, RB, AB); AB = yes ). combine_parse( ta(Major, Root, no, yes, _, Op), ta(Minor, R, no, no, X, comp), ta(Result, Root, no, U, yes, Op) ) :- subst_on_right_frontier(Major, ta(Minor, R, no, no, X, comp), Result, U). combine_parse( ta(Major, Root, no, RB, _, Op), ta(Minor, R, no, no, X, postmod), ta(Result, Root, no, RB, yes, Op) ) :- postmod_on_right_frontier(Major, ta(Minor, R, no, no, X, postmod), Result). combine_parse( ta(Minor, R, no, no, X, comp), ta(Major, Root, yes, RB, no, Op), ta(Result, Root, U, RB, no, Op) ) :- subst_on_left_frontier(Major, ta(Minor, R, no, no, X, comp), Result, U). combine_parse( ta(Minor, R, no, no, X, premod), ta(Major, Root, LB, RB, no, Op), ta(Result, Root, LB, RB, no, Op) ) :- premod_on_left_frontier(Major, ta(Minor, R, no, no, X, premod), Result). %%--------------------------------- %% %% subst_on_right_frontier(SubstInto, Subst, Result) subst_on_right_frontier( na(C, H, UL, SL, LCB, [R|URs], SR, no), ta(N, R, no, no, _, comp), na(C, H, UL, SL, LCB, URs, [ c-N | SR], no), B ) :- (URs = [] -> B = no ; B = yes). subst_on_right_frontier( na(C, H, UL, SL, LCB, URs, SR, yes), ta(N, R, no, no, X, comp), na(C, H2, UL, SL, LCB, URs, SR, B), B2 ) :- subst_on_right_frontier(H, ta(N, R, no, no, X, comp), H2, B), (URs = [] -> B2 = B ; B2 = yes). %%--------------------------------- %% %% postmod_on_right_frontier(Into, Mod, Result) postmod_on_right_frontier( na(C, H, UL, SL, LCB, UR, SR, no), ta(N, C, no, no, _, postmod), na(C, H, UL, SL, LCB, UR, [ m-N | SR], no) ). postmod_on_right_frontier( na(C, H, UL, SL, LCB, UR, SR, yes), ta(N, R, no, no, X, postmod), na(C, H2, UL, SL, LCB, UR, SR, yes) ) :- postmod_on_right_frontier(H, ta(N, R, no, no, X, postmod), H2). postmod_on_right_frontier( na(C, H, UL, SL, LCB, UR, [], no), ta(N, R, no, no, X, postmod), na(C, H2, UL, SL, LCB, UR, [], no) ) :- postmod_on_right_frontier(H, ta(N, R, no, no, X, postmod), H2). %%--------------------------------- %% %% subst_on_left_frontier(Into, Mod, Result) subst_on_left_frontier( na(C, H, [L|UL], SL, no, URs, SR, RCB), ta(N, L, no, no, _, comp), na(C, H, UL, [ c-N |SL], no, URs, SR, RCB), B ) :- (UL = [] -> B = no ; B = yes). subst_on_left_frontier( na(C, H, UL, SL, yes, UR, SR, RCB), ta(N, R, no, no, X, comp), na(C, H2, UL, SL, B, UR, SR, RCB), B2 ) :- subst_on_left_frontier(H, ta(N, R, no, no, X, comp), H2, B), (UL = [] -> B2 = B ; B2 = yes). %%--------------------------------- %% %% premod_on_left_frontier(Into, Mod, Result) premod_on_left_frontier( na(C, H, UL, SL, no, UR, SR, RCB), ta(N, C, no, no, _, premod), na(C, H, UL, [ m-N | SL], no, UR, SR, RCB) ). premod_on_left_frontier( na(C, H, UL, SL, yes, UR, SR, RCB), ta(N, R, no, no, X, premod), na(C, H2, UL, SL, yes, UR, SR, RCB) ) :- premod_on_left_frontier(H, ta(N, R, no, no, X, premod), H2). premod_on_left_frontier( na(C, H, UL, [], no, UR, SR, RCB), ta(N, R, no, no, X, premod), na(C, H2, UL, [], no, UR, SR, RCB) ) :- premod_on_left_frontier(H, ta(N, R, no, no, X, premod), H2). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 4b. Combinatory operations for generation: %% - substitute, premodify or postmodify anywhere %% Keep track of the tree address of the operation, %% to distinguish combinatory operations. combine_gen( tg(N, C, Op), T, tg(N2, C, Op), Addr ) :- gen_op_tree(N, T, N2, Addr). gen_op_list([ K-N | R ], T, Inc, [ K-N2 | R ], [ Index | Addr]) :- length(R, Ct), Index is Inc * Ct, gen_op_tree(N, T, N2, Addr). gen_op_list([ N | R ], T, Inc, [ N | R2 ], Addr) :- gen_op_list(R, T, Inc, R2, Addr). gen_op_tree( ng(C, H, UL, SL, UR, SR), T, ng(C, H2, UL, SL, UR, SR), [ 0 | Addr ] ) :- gen_op_tree(H, T, H2, Addr). gen_op_tree( ng(C, H, UL, SL, UR, SR), T, ng(C, H, UL, SL2, UR, SR), Addr ) :- gen_op_list(SL, T, -1, SL2, Addr). gen_op_tree( ng(C, H, UL, SL, UR, SR), T, ng(C, H, UL, SL, UR, SR2), Addr ) :- gen_op_list(SR, T, 1, SR2, Addr). gen_op_tree( ng(C, H, [L|UL], SL, UR, SR), tg(N, L, comp), ng(C, H, UL, [ c-N | SL], UR, SR), [Ct] ) :- length(SL, CtP), Ct is - CtP. gen_op_tree( ng(C, H, UL, SL, UR, SR), tg(N, C, premod), ng(C, H, UL, [ m-N | SL], UR, SR), [Ct] ) :- length(SL, CtP), Ct is - CtP. gen_op_tree( ng(C, H, UL, SL, [R|UR], SR), tg(N, R, comp), ng(C, H, UL, SL, UR, [ c-N | SR]), [Ct] ) :- length(SR, Ct). gen_op_tree( ng(C, H, UL, SL, UR, SR), tg(N, C, postmod), ng(C, H, UL, SL, UR, [ m-N | SR]), [Ct] ) :- length(SR, Ct). generalize_addr([], []). generalize_addr([_], [_]) :- !. generalize_addr([A|T], [A|R]) :- generalize_addr(T, R). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 5. Parsing. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 5a. CKY Parser with semantics. %% %% Edges are stored in the form of chart entries: %% %% s_chart(start: index of first word in constituent, %% end: index of first word after constituent, %% tree: syntax of constituent, %% comp-presup: presuppositions of complements, %% mod-presup: presuppositions of modifiers, %% comp-assert: assertion of complements, %% mod-assert: assertion of modifiers). :- dynamic(s_chart/6). %% add_s_edges(Start, End) %% determine all possible constituents that %% could start at index Start and continue %% to span the words before End, based on %% the current state of the chart. add_s_edges(Start, End) :- s_chart(Start, Middle, Tree1, P1c, P1m, A1c, A1m), s_chart(Middle, End, Tree2, P2c, P2m, A2c, A2m), combine_parse(Tree1, Tree2, Tree3), append(A1c, A2c, A3c), append(A1m, A2m, A3m), append(P1c, P2c, P3c), append(P1m, P2m, P3m), assert(s_chart(Start, End, Tree3, P3c, P3m, A3c, A3m)), fail. add_s_edges(_, _). %% extend_s_chart(Start, End) %% determine all possible constituents %% that could start at index Start and %% continue to span the words before End, %% but first add all shorter constituents %% with the same endpoint to the chart. extend_s_chart(EndLessOne, End) :- EndLessOne is End - 1, !. extend_s_chart(Start, End) :- Next is Start + 1, Next < End, extend_s_chart(Next, End), add_s_edges(Start, End). %% build_s_chart(Start, End) %% determine all possible constituents %% starting at Start or later and ending %% up to End or earlier, by combining %% the words in the chart already into %% a bottom-up table. build_s_chart(X, Y) :- Y is X + 1, !. build_s_chart(Start, End) :- Prev is End - 1, Prev > Start, build_s_chart(Start, Prev), extend_s_chart(Start, End). %% word_s_edges(Item, Start, End) %% access the lexicon to insert all possible %% structures for the given item which is %% assumed to start at Start, with End the %% start of the first item afterwards. word_s_edges(Word, Start, Next) :- initial_tree(Word, Ltree, Presup, Assert), t_to_ta_structure(Ltree, Tree), (Ltree = t(_,comp) -> (Pc = Presup, Pm = [], Ac = Assert, Am = []); (Pc = [], Pm = Presup, Ac = [], Am = Assert)), assert(s_chart(Start, Next, Tree, Pc, Pm, Ac, Am)), fail. word_s_edges(_, _, _). %% setup_s_chart(Items, Start, End) %% Given the list Items of all words in the %% input remaining at index Start, add edges %% for these words to the chart, and return %% in End the index of the end of the sentence. setup_s_chart([], N, N). setup_s_chart([Word | More], Start, End) :- Next is Start + 1, word_s_edges(Word, Start, Next), setup_s_chart(More, Next, End). %% cky_s_parse(Words, Tree, Pc, Pm, Assert) %% Uses CKY chart parsing to find %% a parse tree Tree that provides an %% analysis of Words, under which %% Pc is the presupposition of complements, %% Pm is the presupposition of modifiers, and %% Assert is the assertion of the items. cky_s_parse(Words, Tree, Pc, Pm, Ac, Am) :- retractall(s_chart(_,_,_,_,_,_,_)), setup_s_chart(Words, 0, End), build_s_chart(0, End), s_chart(0, End, BigTree, Pc, Pm, Ac, Am), ta_to_nx_structure(BigTree, Tree). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 5b. CKY Parser with semantics and interpretation. %% %% Edges are stored in the form of chart entries: %% %% i_chart(start: index of first word in constituent, %% end: index of first word after constituent, %% tree: syntax of constituent, %% all-presup: presuppositions of consituent, %% assert: assertion of constituent, %% interps: matches for interpretations in context). %% %% Control flow and predicate semantics isomorphic to %% the semantic interpreter. :- dynamic(i_chart/6). add_i_edges(Start, End) :- i_chart(Start, Middle, Tree1, P1, A1, I1), i_chart(Middle, End, Tree2, P2, A2, I2), combine_parse(Tree1, Tree2, Tree3), append(A1, A2, A3), append(P1, P2, P3), findall(P3, (member(P1, I1), member(P2, I2)), I3), \+ (I3 = []), assert(i_chart(Start, End, Tree3, P3, A3, I3)), fail. add_i_edges(_, _). extend_i_chart(EndLessOne, End) :- EndLessOne is End - 1, !. extend_i_chart(Start, End) :- Next is Start + 1, Next < End, extend_i_chart(Next, End), add_i_edges(Start, End). build_i_chart(X, Y) :- Y is X + 1, !. build_i_chart(Start, End) :- Prev is End - 1, Prev > Start, build_i_chart(Start, Prev), extend_i_chart(Start, End). word_i_edges(Word, Start, Next) :- initial_tree(Word, Ltree, Presup, Assert), t_to_ta_structure(Ltree, Tree), findall(Presup, all_shared(Presup), Interp), \+ (Interp = []), assert(i_chart(Start, Next, Tree, Presup, Assert, Interp)), fail. word_i_edges(_, _, _). setup_i_chart([], N, N). setup_i_chart([Word | More], Start, End) :- Next is Start + 1, word_i_edges(Word, Start, Next), setup_i_chart(More, Next, End). cky_i_parse(Words, Tree, Presup, Assert, Interp) :- retractall(i_chart(_,_,_,_,_,_)), setup_i_chart(Words, 0, End), build_i_chart(0, End), i_chart(0, End, BigTree, Presup, Assert, Interp), ta_to_nx_structure(BigTree, Tree). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 6. Generation. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% Generation is driven by SPUD-style greedy search. %% The data structure for an abstract point in the %% search space is a STATE: %% %% state(tree_gen: tg derived structure %% with free vars & coreference constraints (WFV&CC) %% tree_inst: tg derived structure %% instantiated to intended referents (IIR), %% presup_gen: presupposition of structure (WFV&CC) %% presup_inst: presupposition of structure (IIR), %% assert_gen: assertion of structure (WFV&CC) %% assert_inst: assertion of structure (IIR), %% interp: matches for presup_gen in shared knowledge, %% left2express: communicative goals, %% last_op: last operation performed, %% antimatch: operations to avoid because searched elsewhere) %%--------------------------------- %% %% STATE OPERATIONS %% state_final(State) %% True if the utterance is finished -- %% - there are no unfilled substitution sites. %% - the presupposition identifies its referent uniquely %% - the assertion establishes all the needed facts. state_final( state(_T, Ti, _P, Pi, _A, _Ai, [Pi], [], _Op, _Nm) ) :- \+ combine_gen(Ti, tg(_, _, comp), _, _). %% state_cost(State, C) %% C is the score or cost of the state %% approximating the amount of work that remains, %% in terms of the number of holes in the tree, %% the number of missing facts, and the ambiguity %% of the presupposition. state_cost(state(_,Ti,_,_,_,_,I,CG,_,_), C) :- length(I, C1), length(CG, C2), findall(T2, combine_gen(Ti, tg(_, _, comp), T2, _), L), length(L, C3), C is C1 + C2 + C3. %% state_tree(State, Tree) %% accessor relation for the tree T. state_tree(state(_,T,_,_,_,_,_,_,_,_), T). %% state_history(State, History) %% accessor relation for the state search info. state_history(state(_,_,_,_,_,_,_,_,_,H), H). %% state_dont_repeat_search(State, Alts, NewState %% go through a list of alternatives Alts you've already %% considered, and update State to NewState so that %% you won't try those alternatives again in aux_state_dont_repeat_search( [ state(_, _, _, _, _, _, _, _, Op, _) | L ], [ Op | Rest ], Tail ) :- aux_state_dont_repeat_search(L, Rest, Tail). aux_state_dont_repeat_search([], Nm, Nm). state_dont_repeat_search( state(T, Ti, P, Pi, A, Ai, I, CG, Op, Nm), Done, state(T, Ti, P, Pi, A, Ai, I, CG, Op, Nm2) ) :- aux_state_dont_repeat_search(Done, Nm2, Nm). %%--------------------------------- %% %% SEARCH %% extend_by_one(State, NewState) %% Add a word to State to get NewState, %% updating trees, semantics, interpretation, %% and making sure that the word hasn't %% already been tried. spud_options( S1, L ) :- findall(S2, extend_by_one(S1, S2), L). extend_by_one( state(T, Ti, P, Pi, A, Ai, I, CG, _Op, Nm), state(T2, T2i, P2, P2i, A2, A2i, I2, CG2, step(Item,Addr,LPi,LAi), [step(Item,GenAddr,LPi,LAi) | Nm ]) ) :- combine_gen(T, LTG, T2, Addr), generalize_addr(Addr, GenAddr), t_for_tg_template(LTG, LT), initial_tree(Item, LT, LP, LA), t_to_tg_structure(LT, LTG), append(LP, P, P2), append(LA, A, A2), findall((T2, LP, P2, LA, A2), (T=Ti, P=Pi, A=Ai), [(T2i, LPi, P2i, LAi, A2i)]), all_shared(LPi), all_private(LAi), \+ member(step(Item,Addr,LPi,LAi), Nm), zap(LAi, CG, CG2), findall(P2, (member(P, I), all_shared(LP)), I2). extend_by_one( initial_state(N, Ni, CG), state(T, Ti, P, Pi, A, Ai, I, CG2, step(Item,[],Pi,Ai), [step(Item,[],Pi, Ai)] ) ) :- t_for_tg_template(tg(_, N, comp), LT), initial_tree(Item, LT, P, A), t_to_tg_structure(LT, T), findall((T, N, P, A), (N = Ni), [(Ti, Ni, Pi, Ai)]), all_shared(Pi), all_private(Ai), zap(Ai, CG, CG2), findall(P, all_shared(P), I). %% best_state(List, Top) %% true if Top is equivalent to a state with minimum cost %% in List, and if Top is so constituted %% to avoid any search generated by previous %% matches to best_state. best_state( [ State | States ], Best ) :- state_cost(State, C), find_best(State, C, States, [State], Best). find_best(State, _, [], _Tried, State). find_best(State, C, [ Next | States], Tried, Best) :- state_cost(Next, C2), (C < C2 -> find_best(State, C, States, Tried, Best); (C2 < C -> find_best(Next, C2, States, [Next], Best); (find_best(State, C, States, [Next | Tried], Best) ; (is_best(Next, C2, States), state_dont_repeat_search(Next, Tried, Best))))). is_best(_, _, []). is_best(State, C, [ Next | States]) :- state_cost(Next, C2), C =< C2, is_best(State, C, States). %% spud_search(start, end) %% true if end is a final state that %% can be obtained by greedy search from end. spud_search(Start, Start) :- state_final(Start), !. spud_search(Start, End) :- spud_options(Start, Choices), best_state(Choices, Next), spud_search(Next, End). %% spud_ref(Object, Tree) %% shortcut to use spud search to construct Tree %% as a referring expression for Object. spud_ref(Object, Tree) :- spud_search(initial_state(n3(_,sing), n3(Object,sing), []), End), state_tree(End, TG), tg_to_nx_structure(TG, Tree). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 7. Verification and validation. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% cluster(Facts, Sofar, Result) %% A CLUSTER of facts describes an overlapping %% situation (you can move from any fact to any %% other fact in the cluster by repeatedly linking %% facts with shared variables). %% Sofar is a set of clusters, %% Result is the set of clusters that results by %% adding Facts to Sofar. cluster_one(_Term, New, Not, [], [New | Not]). cluster_one(Term, New, Not, [C | R], Result) :- overlap(Term, C), !, append(C, New, Next), cluster_one(Term, Next, Not, R, Result). cluster_one(Term, New, Not, [C | R], Result) :- cluster_one(Term, New, [C | Not], R, Result). cluster([], Clusters, Clusters). cluster([Term | Rest], Sofar, Result) :- cluster_one(Term, [Term], [], Sofar, Next), cluster(Rest, Next, Result). %% justify_modifiers(Modifier Semantics, %% Sentence info, %% DbIn, CtIn, %% DbOut, CtOut) %% Create a database DbOut that extends DbIn with %% distractors to explain all the modifying meaning %% listed in Modifiier Semantics. %% CtIn and CtOut allow you to create new numbered %% constants with the descriptions. %% Sentence info tells you what information about %% the distractors is necessary. justify_modifiers([], _, Db, Db). justify_modifiers([M|R], Clusters, DbIn, DbOut) :- member(F, Clusters), exact_delete(F, M, X), findall(X, nv(X), [NX]), append(NX, DbIn, DbMid), justify_modifiers(R, Clusters, DbMid, DbOut). %% pc(Words, TreeG, TreeI, Shared, Private) %% Parse words as TreeG, %% Create intended reference TreeI, %% And database %% which will convince SPUD search to %% generate TreeI/Words back. pc(Words, TreeG, TreeI, Shared, PAc, PAm, Private) :- cky_s_parse(Words, TreeG, Pc, Pm, Ac, Am), append(Pc, Pm, Presup), append(Ac, Am, Assert), findall((Presup, TreeG, Ac, Am, Assert), nv(Presup), [(SDB1, TreeI, PAc, PAm, Private)]), cluster(Presup, [], Clusters), justify_modifiers(Pm, Clusters, SDB1, Shared), nv(Private). %% roundtrip(Input, State, Tree, Output) %% Parse sentence INPUT and create SPUD input %% that would result in INPUT, including %% Spud initial state State. %% Then call spud, and report the Tree and Sentence %% spud gives. roundtrip(Words, initial_state(OpG, OpI, PrivateM), Tree, Subtrees, W2) :- pc(Words, TreeG, TreeI, Shared, _PrivateC, PrivateM, Private), make_all_shared(Shared), make_all_private(Private), nx_root(TreeG, OpG), nx_root(TreeI, OpI), spud_search(initial_state(OpG, OpI, PrivateM), End), state_tree(End, TG), tg_to_nx_structure(TG, Tree), nx_leaves(Tree, W2), nx_t_elements(comp, Tree, Subtrees, []). doublecheck(Words, Tree, Assert) :- cky_i_parse(Words, Tree, Presup, Assert, [Presup]), nv(Assert). make_assertion_and_presupposition(_, _, [], [], []) :- !. make_assertion_and_presupposition([97, 95 | PL], Word, Args, [], [A]) :- !, name(Pred, PL), A =.. [Pred, Word | Args]. make_assertion_and_presupposition([112, 95 | PL], Word, Args, [P], []) :- !, name(Pred, PL), P =.. [Pred, Word | Args]. make_assertion_and_presupposition(PL, Word, Args, [P], [A]) :- name(P_Pred, [112, 95 | PL]), P =.. [P_Pred, Word | Args], name(A_Pred, [97, 95 | PL]), A =.. [A_Pred, Word | Args]. make_entry(Tree) :- t_info(Tree, Word, Preterminal, Args), functor(Preterminal, Pred, _), name(Pred, PL), make_assertion_and_presupposition(PL, Word, Args, P, A), assert(initial_tree(Word, Tree, P, A)). make_entry_list([]). make_entry_list([T|R]) :- make_entry(T), make_entry_list(R). test(T, W, S, W2) :- sample_sentence(T), nx_t_elements(comp, T, Subtrees, []), make_entry_list(Subtrees), nx_leaves(T, W), clear, roundtrip(W, S, _, _, W2). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% 8. Lexicon. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% For language learning experiments. :- dynamic(initial_tree/4). clear_grammar :- retractall(initial_tree(_,_,_,_)). %% Presupposed definite singular NPs. initial_tree( NounSing, t(n(n3(I,sing), n(n2size(I,def), n(n2color(I,def), n(n2quality(I,def), n(n2origin(I,def), n(n1(I), w(NounSing), [], Comps), [], []), [], []), [], []), [], []), [det(I,sing,def)], []), comp), Content, [] ) :- member((NounSing, Comps, Content), [(dog, [], [type(I,dog)]), (cat, [], [type(I,cat)])]). %% Asserted indefinite singular NPs. initial_tree( NounSing, t(n(n3(I,sing), n(n2size(I,indef), n(n2color(I,indef), n(n2quality(I,indef), n(n2origin(I,indef), n(n1(I), w(NounSing), [], Comps), [], []), [], []), [], []), [], []), [det(I,sing,indef)], []), comp), [], Content ) :- member((NounSing, Comps, Content), [(dog, [], [type(I,dog)]), (cat, [], [type(I,cat)])]). %% Presupposed color adjectives in definite NPs. initial_tree( ColorAdj, t(n(a3(S,I,def), n(a2(S,I,def), n(a1(S,I,def), w(ColorAdj), [], []), [], []), [], []), premod(n2color(I,def))), [color(S,I,ColorAdj)], [] ) :- member(ColorAdj, [white, black, red, green, blue, yellow, orange, purple, brown, gray, tan]). %% Asserted color adjectives in indefinite NPs. initial_tree( ColorAdj, t(n(a3(S,I,indef), n(a2(S,I,indef), n(a1(S,I,indef), w(ColorAdj), [], []), [], []), [], []), premod(n2color(I,indef))), [], [color(S,I,ColorAdj)] ) :- member(ColorAdj, [white, black, red, green, blue, yellow, orange, purple, brown, gray, tan]). %% Presupposed size adjectives in definite NPs. initial_tree( SizeAdj, t(n(a3(S,I,def), n(a2(S,I,def), n(a1(S,I,def), w(SizeAdj), [], []), [], []), [], []), premod(n2size(I,def))), [size(S,I,SizeAdj)], [] ) :- member(SizeAdj, [huge, big, little, enormous, large, small, tiny]). %% Asserted size adjectives in indefinite NPs. initial_tree( SizeAdj, t(n(a3(S,I,indef), n(a2(S,I,indef), n(a1(S,I,indef), w(SizeAdj), [], []), [], []), [], []), premod(n2size(I,indef))), [], [size(S,I,SizeAdj)] ) :- member(SizeAdj, [huge, big, little, enormous, large, small, tiny]). %% Presupposed general descriptive adjectives in definite NPs. initial_tree( QualAdj, t(n(a3(S,I,def), n(a2(S,I,def), n(a1(S,I,def), w(QualAdj), [], []), [], []), [], []), premod(n2quality(I,def))), [prop(S,I,QualAdj)], [] ) :- member(QualAdj, [fuzzy, furry, hairy, friendly, mean, shaggy]). %% Asserted general descriptive adjectives in indefinite NPs. initial_tree( QualAdj, t(n(a3(S,I,indef), n(a2(S,I,indef), n(a1(S,I,indef), w(QualAdj), [], []), [], []), [], []), premod(n2quality(I,indef))), [], [prop(S,I,QualAdj)] ) :- member(QualAdj, [fuzzy, furry, hairy, friendly, mean, shaggy]). %% Adverbs that modify presupposed adjectives. initial_tree( AdjAdv, t(n(adv, w(AdjAdv), [], []), premod(a3(S,_,def))), [degree(S,AdjAdv)], [] ) :- member(AdjAdv, [very, rather, quite, somewhat, slightly]). %% Adverbs that modify asserted adjectives. initial_tree( AdjAdv, t(n(adv, w(AdjAdv), [], []), premod(a3(S,_,indef))), [], [degree(S,AdjAdv)] ) :- member(AdjAdv, [very, rather, quite, somewhat, slightly]). %% Singular definite determiners. initial_tree( DetSing, t(n(det(I,sing,def), w(DetSing), [], []), comp), [ status(I,DetSing) ], [] ) :- member(DetSing, [the, this, that]). %% Singular indefinite determiners. initial_tree( DetSing, t(n(det(I,sing,indef), w(DetSing), [], []), comp), [ status(I,DetSing) ], [] ) :- member(DetSing, [a, some]). %% Main verbs, asserted. initial_tree( VerbSing, t(n(s(E), n(v2epistemic(E), n(v2discourse(E), n(v2time(E), n(v2manner(E), n(v1(E), w(VerbSing), [], Comps), [], []), [], []), [], []), [], []), [n3(A,sing)], []), comp), Presup, Assert ) :- member((VerbSing, Comps, Presup, Assert), [(sleeps, [], [], [sleeping(E), sleeper(E,A)]), (likes, [n3(B,_)], [], [liking(E), liker(E,A), liked(E,B)])]). %% Epistemic premodifiers of main verbs, asserted. initial_tree( Emod, t(n(adv3(E), n(adv(E), w(Emod), [], []), [],[]), premod(v2epistemic(E))), [], [status(E,Emod)] ) :- member(Emod, [probably, certainly, definitely, possibly]). %% Discourse premodifiers of main verbs, asserted. initial_tree( Dmod, t(n(adv3(E), n(adv(E), w(Dmod), [], []), [],[]), premod(v2discourse(E))), Presup, Assert ) :- member((Dmod, Presup, Assert), [(even, [unlikely_a(E)] , []), (also, [parallel(E,A)], []), (only, [alts(E,A)], [unreal(A)]), (just, [alts_on_scale(E,A)], [unreal(A)])]). %% Temporal premodifiers of main verbs, asserted. initial_tree( Tmod, t(n(adv3(E), n(adv(E), w(Tmod), [], []), [],[]), premod(v2time(E))), [], [time(E, Tmod)] ) :- member(Tmod, [already, eventually]). %% Manner premodifiers of main verbs, asserted. initial_tree( Tmod, t(n(adv3(E), n(adv(E), w(Tmod), [], []), [],[]), premod(v2manner(E))), [], [manner(E, Tmod)] ) :- member(Tmod, [deeply, madly]).