2:- module(tuples,[tuples/4,write_tuples/2]).    3
    4:- use_module(semlib(drs2tacitus),[label/4]).    5:- use_module(semlib(errors),[warning/2]).    6:- use_module(semlib(options),[option/2]).    7:- use_module(knowledge(punctuation),[punctuation/2]).    8:- use_module(library(lists),[member/2,append/3,last/2,select/3]).    9
   10
   11/* =======================================================================
   12   Dynamic predicates
   13======================================================================= */
   14
   15:- dynamic cond_ctr/1. cond_ctr(0).
   16
   17
   18/* =======================================================================
   19   Main: tuples (DRG)
   20======================================================================= */
   21
   22tuples(Tags,DRS,N1,Sorted):- 
   23   label(N1,k,K0,N2),
   24   initcondcounter,
   25   tuples(DRS,K0,[]-_,Tags,[]-Tuples,N2-_,[]-_),
   26   inverse(Tuples,Tuples1),
   27   main_label(Tuples1,Tuples2),
   28   surface(Tags,Tuples2,Extended),
   29%  writet(Extended),
   30   order(Extended,Extended,Ordered),
   31%  writet(Ordered),
   32   sort(Ordered,Sorted),
   33   unboxer(Sorted,Tags).
   34
   35
   36/* =======================================================================
   37   Print tuples (just for testing purposes)
   38======================================================================= */
   39
   40writet([X|L]):- write(X), nl, writet(L). 
   41writet([]):- nl.
   42
   43
   44/* =======================================================================
   45   Invert Tuples if needed (e.g. for relative clauses and gerunds)
   46======================================================================= */
   47
   48inverse(Tuples0,Tuples5):-
   49   member(tuple(_, _:equality, ext, X,          _),Tuples0),
   50   select(tuple(L1, C:Role:1,   ext, X,         I1),Tuples0,Tuples1),    T1=tuple(L1,C:Role:-1,int, X,        I1),
   51   select(tuple(L2, C:Role:1,   int, Y,         I2),Tuples1,Tuples2),    T2=tuple(L2,C:Role:-1,ext, Y,        I2),
   52   select(tuple(L3, K,          role, C:Role:1, I3),Tuples2,Tuples3), !, T3=tuple(L3,K,        role,C:Role:-1,I3),
   53   Tuples4=[T1,T2,T3|Tuples3],
   54%  warning('inverted role tuple for ~p',[X]),
   55   inverse(Tuples4,Tuples5).
   56
   57inverse(Tuples,Tuples).
   58
   59
   60/* =======================================================================
   61   Promote Main Tuples out of embedded structures
   62======================================================================= */
   63
   64% Remove main labels that have inverted roles
   65%
   66main_label(T1,T3):-
   67   select(tuple(_,K:E,main,K,_),T1,T2),
   68   member(tuple(_,K,role,C:R:-1,_),T2),
   69   member(tuple(_,C:R:-1,ext,K:E,_),T2), !,
   70   main_label(T2,T3).
   71
   72main_label(T1,T3):-
   73   select(tuple(J,K:R,main,K1,Word),T1,T2),
   74   member(tuple(_,CC:B,_,K1,_),T2),
   75   member(tuple(_,K2,binary,CC:B,_),T2), !,
   76   main_label([tuple(J,K:R,main,K2,Word)|T2],T3).
   77
   78main_label(T1,T3):-
   79   select(tuple(J,K:R,main,K1,Word),T1,T2),
   80   member(tuple(_,CC:B,_,K1,_),T2),
   81   member(tuple(_,K2,unary,CC:B,_),T2), !,
   82   main_label([tuple(J,K:R,main,K2,Word)|T2],T3).
   83
   84main_label(T,T).
   85
   86
   87/* =======================================================================
   88   Order edges for each discourse referent
   89======================================================================= */
   90
   91order([],_,[]).
   92
   93order([T|L1],Refs,Ordered):-
   94   T = tuple(_,_,_,X,_),
   95   split(L1,X,WithX,WithoutX),       %%% split tuple wrt X
   96   position([T|WithX],Refs,Pos),     %%% get positions for X
   97%  write(X:Pos),nl,
   98   sort(Pos,Sorted),
   99   localOrder(Sorted,1,L2,Ordered),  %%% normalise order starting with 1
  100   order(WithoutX,Refs,L2).
  101
  102
  103/* =======================================================================
  104   Determine local position (of relations)
  105======================================================================= */
  106
  107position([],_,[]).
  108
  109position([tuple([],N1,int,N2,W)|L1],Tuples,[tuple([P],N1,int,N2,W)|L2]):-
  110   member(tuple(_,N1,ext,X,_),Tuples),
  111   member(tuple([P|_],_,_,X,_),Tuples), !,
  112   position(L1,Tuples,L2).
  113
  114position([tuple([],N1,int,N2,W)|L1],Tuples,[tuple([P],N1,int,N2,W)|L2]):-
  115   member(tuple(_,N1,ext,B,_),Tuples),
  116   member(tuple(_,B,referent,X,_),Tuples), 
  117   member(tuple([P|_],_,_,X,_),Tuples), !,
  118   position(L1,Tuples,L2).
  119
  120position([tuple([],N1,int,N2,W)|L1],Tuples,[tuple([P],N1,int,N2,W)|L2]):-
  121   member(tuple(_,N1,ext,B,_),Tuples),
  122   member(tuple(_,B,dominates,C,_),Tuples),
  123   member(tuple(_,C,referent,X,_),Tuples), 
  124   member(tuple([P|_],_,_,X,_),Tuples), !,
  125   position(L1,Tuples,L2).
  126
  127position([tuple([],R1,int,N2,W)|L1],Tuples,[tuple([P],R1,int,N2,W)|L2]):-
  128   member(tuple(_,R1,ext,Y,_),Tuples),
  129   member(tuple(_,R2,int,Y,_),Tuples),
  130   member(tuple(_,R2,ext,Z,_),Tuples),
  131   member(tuple([P|_],_,_,Z,_),Tuples), !,
  132   position(L1,Tuples,L2).
  133
  134position([T|L1],Tuples,[T|L2]):-
  135   position(L1,Tuples,L2).
  136
  137
  138/* =======================================================================
  139   Determine local order
  140======================================================================= */
  141
  142localOrder([],_,L,L).
  143
  144localOrder([tuple(A,B,C,D,E)|L],N,L1,[tuple(A,0,B,C,D,E)|L2]):- 
  145   A = [], !,
  146   localOrder(L,N,L1,L2).
  147
  148localOrder([tuple(A,B,C,D,E)|L],N,L1,[tuple(A,N,B,C,D,E)|L2]):-
  149   M is N + 1,
  150   localOrder(L,M,L1,L2).
  151
  152
  153/* =======================================================================
  154   Split tuples into two sets based on third argument
  155======================================================================= */
  156
  157split([],_,[],[]).
  158
  159split([T|L1],X,[T|L2],L3):-
  160   T = tuple(_,_,_,X,_), !,
  161   split(L1,X,L2,L3).
  162
  163split([T|L1],X,[T|L2],L3):-
  164   T = tuple(_,_,_,_,X,_), !,
  165   split(L1,X,L2,L3).
  166
  167split([T|L1],X,L2,[T|L3]):-
  168   split(L1,X,L2,L3).
  169
  170
  171/* =======================================================================
  172   Add surface tuples (ideally should be eliminated)
  173======================================================================= */
  174
  175surface([],T,T).
  176
  177surface([Index:_|W],T1,T2):-                % if token is
  178   member(tuple(I,_,_,_,_),T1),             % already part of a tuple
  179   member(Index,I), !,                      % then 
  180   surface(W,T1,T2).                        % take next token
  181
  182surface([Index1:[tok:Word|Tags]|W],T1,[T|T2]):- 
  183   member(pos:POS,Tags),
  184   punctuation(POS,left),
  185   member(tuple([Index2|_],_,_,X,_),T1),
  186   Index1 is Index2 - 1,
  187   member(tuple(_,K,referent,X,_),T1), !,
  188   T = tuple([Index1],K,punctuation,X,[Word]),
  189   surface(W,T1,T2).
  190
  191surface([Index1:[tok:Word|Tags]|W],T1,[T|T2]):- 
  192   member(pos:POS,Tags),
  193   punctuation(POS,right),
  194   member(tuple(Indices,_,_,X,_),T1),
  195   last(Indices,Index2),
  196   Index1 is Index2 + 1,
  197   member(tuple(_,K,referent,X,_),T1), !,
  198   T = tuple([Index1],K,punctuation,X,[Word]),
  199   surface(W,T1,T2).
  200
  201surface([Index:[tok:Word|_]|W],T1,[T|T2]):- 
  202   I is div(Index,1000),
  203   event(T1,Index,I,K,E,Distance), 
  204   \+ (event(T1,Index,I,_,_,Smaller), Smaller < Distance), !,
  205   T = tuple([Index],K,surface,E,[Word]),
  206%  warning('surface tuple: ~p (~p)',[Word,Index]),
  207   surface(W,T1,T2).
  208
  209surface([Index:[tok:Word|_]|W],T1,[T|T2]):- 
  210   T = tuple([Index],k,error,x,[Word]),
  211   warning('word not part of tuples: ~p',[Word]),
  212   surface(W,T1,T2).
  213
  214
  215/* =======================================================================
  216   Find an event tuple with distance to Index1 (slow!)
  217======================================================================= */
  218
  219event(Tuples,Index1,I,K,E,Distance):-
  220   member(tuple(_,K,event,Event,_),Tuples),
  221   member(tuple([Index2|_],Event,instance,E,_),Tuples),
  222   I is div(Index2,1000),
  223   Distance is abs(Index1-Index2).
  224
  225event(Tuples,Index1,I,K,E,Distance):-
  226   member(tuple(_,K,attribute,Event,_),Tuples),
  227   member(tuple([Index2|_],Event,arg,E,_),Tuples),
  228   I is div(Index2,1000),
  229   Distance is abs(Index1-Index2).
  230
  231%event(Tuples,Index1,K,E,Distance):-
  232%   member(tuple(_,K,event,Event,_),Tuples),
  233%   member(tuple([Index2|_],Event,instance,E,_),Tuples),
  234%   Distance is abs(Index1-Index2),
  235%   Distance < 1000.
  236
  237
  238/* =======================================================================
  239   Counter for DRS-conditions
  240======================================================================= */
  241
  242condcounter(CC):-
  243   retract(cond_ctr(X)),
  244   label(X,c,CC,N),
  245   assert(cond_ctr(N)).
  246
  247initcondcounter:-
  248   retract(cond_ctr(_)),
  249   assert(cond_ctr(0)).
  250
  251
  252/* =======================================================================
  253   Converting DRSs into graph tuples
  254
  255   tuples(+DRS,+CurrentDRSid,+Refs,+Words,?Tuples,?Counter,?Indices)
  256   
  257   where: tuple(Index,Node1,Edge,Node2,Words)
  258
  259======================================================================= */
  260
  261tuples(sdrs(D,R),K,R1-R3,W,T1-T3,N1-N3,I1-I3):- !, tuples(D,K,R1-R2,W,T1-T2,N1-N2,I1-I2), tuples(R,K,R2-R3,W,T2-T3,N2-N3,I2-I3).
  262tuples(merge(B1,B2),K,R1-R3,W,T1-T3,N1-N3,I1-I3):- !, tuples(B1,K,R1-R2,W,T1-T2,N1-N2,I1-I2), tuples(B2,K,R2-R3,W,T2-T3,N2-N3,I2-I3).
  263tuples(alfa(_,B1,B2),K,R1-R3,W,T1-T3,N1-N3,I1-I3):- !, tuples(B1,K,R1-R2,W,T1-T2,N1-N2,I1-I2), tuples(B2,K,R2-R3,W,T2-T3,N2-N3,I2-I3).
  264
  265%tuples(lab(K0,sdrs([sub(lab(L,B),Sub)|D],R)),K,R1-R3,W,T1-[T|T3],N1-N3,I1-I3):- !, 
  266%   T = tuple([],K0,dominates,L,[]),
  267%   tuples(sub(lab(L,B),Sub),K,R1-R2,W,T1-T2,N1-N2,I1-I2), 
  268%   tuples(lab(K0,sdrs(D,R)),K,R2-R3,W,T2-T3,N2-N3,I2-I3).
  269
  270%tuples(lab(K0,sdrs([lab(L,B)|D],R)),K,R1-R3,W,T1-[T|T3],N1-N3,I1-I3):- !, 
  271%   T = tuple([],K0,dominates,L,[]),
  272%   tuples(lab(L,B),K,R1-R2,W,T1-T2,N1-N2,I1-I2), 
  273%   tuples(lab(K0,sdrs(D,R)),K,R2-R3,W,T2-T3,N2-N3,I2-I3).
  274
  275tuples(lab(L,B),K,R1-R2,W,T1-[T|T2],N1-N2,I1-I2):- !, 
  276   T = tuple([],K,dominates,L,[]),
  277   tuples(B,L,R1-R2,W,T1-T2,N1-N2,I1-I2).
  278
  279tuples(sub(lab(L1,B1),B2),K,R1-R3,W,T1-[T|T3],N1-N3,I1-I3):- !, 
  280   T = tuple([],K,dominates,L1,[]),
  281   tuples(B1,L1,R1-R2,W,T1-T2,N1-N2,I1-I2), 
  282   tuples(B2,L1,R2-R3,W,T2-T3,N2-N3,I2-I3).
  283
  284tuples(_:drs([],C),K,R1-R2,W,T1-T2,N1-N2,I1-I2):- !, tuples(C,K,R1-R2,W,T1-T2,N1-N2,I1-I2).
  285
  286% This clause adds a 'main' label for events and states
  287%
  288tuples(B:drs([_:I:R|L],C),K,R1-R2,W,T1-[Tu1,Tu2|T2],N1-N2,I1-I2):- 
  289    member(_:_:role(R,_,_,1),C), 
  290    \+ member(_:_:role(_,R,_,-1),C),   % don't add main lables for inversed roles!
  291    member(POS,[v,a]),
  292    member(_:J:pred(R,_,POS,_),C), !,
  293    word(I,I1,W,Word),
  294    Tu1 = tuple(I,K,referent,K:R,Word),
  295    Tu2 = tuple(J,K:R,main,K,Word),
  296    tuples(B:drs(L,C),K,[K:R|R1]-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  297
  298tuples(B:drs([_:I:R|L],C),K,R1-R2,W,T1-[T|T2],N1-N2,I1-I2):- !,
  299    word(I,I1,W,Word),
  300    T = tuple(I,K,referent,K:R,Word),
  301    tuples(B:drs(L,C),K,[K:R|R1]-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  302
  303tuples([lab(A,B)|L],K,R1-R3,W,T1-T3,N1-N3,I1-I3):- !, tuples(lab(A,B),K,R1-R2,W,T1-T2,N1-N2,I1-I2),tuples(L,K,R2-R3,W,T2-T3,N2-N3,I2-I3).
  304
  305tuples([sub(A,B)|L],K,R1-R3,W,T1-T3,N1-N3,I1-I3):- !, tuples(sub(A,B),K,R1-R2,W,T1-T2,N1-N2,I1-I2),tuples(L,K,R2-R3,W,T2-T3,N2-N3,I2-I3).
  306
  307tuples([_:I:pred(X,Sym,n,Sense)|L],K,R1-R2,W,T1-[E1,E2|T2],N1-N2,I1-I2):-
  308    word(I,I1,W,Word), nonvar(X), member(Dom:X,R1), !,
  309    condcounter(CC),
  310    E1 = tuple([],K,          concept,  CC:Sym:Sense,[]),
  311    E2 = tuple(I,CC:Sym:Sense,instance, Dom:X,Word),
  312    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  313
  314tuples([_:I:pred(X,Sym,v,Sense)|L],K,R1-R2,W,T1-[E1,E2|T2],N1-N2,I1-I2):- 
  315    word(I,I1,W,Word), nonvar(X), member(Dom:X,R1), !,
  316    condcounter(CC),
  317    E1 = tuple([],K,          event,CC:Sym:Sense,[]),
  318    E2 = tuple(I,CC:Sym:Sense,instance,    Dom:X,Word),
  319    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  320
  321tuples([_:I:pred(X,_,s,1)|L],K,R1-R2,W,T1-[E|T2],N1-N2,I1-I2):- 
  322    word(I,I1,W,Word), nonvar(X), member(Dom:X,R1), !,
  323    E = tuple(I,K,function,       Dom:X,Word),
  324    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  325
  326tuples([_:I:pred(X,Sym,a,Sense)|L],K,R1-R2,W,T1-[E1,E2|T2],N1-N2,I1-I2):- 
  327    word(I,I1,W,Word), nonvar(X), member(Dom:X,R1), !,
  328    condcounter(CC),
  329    E1 = tuple([],K,          attribute,CC:Sym:Sense,[]),
  330    E2 = tuple(I,CC:Sym:Sense,arg,       Dom:X,Word),
  331    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  332
  333tuples([_:I:pred(X,Sym,r,Sense)|L],K,R1-R2,W,T1-[E1,E2|T2],N1-N2,I1-I2):- 
  334    word(I,I1,W,Word), nonvar(X), member(Dom:X,R1), !,
  335    condcounter(CC),
  336    E1 = tuple([],K,          attribute,CC:Sym:Sense,[]),
  337    E2 = tuple(I,CC:Sym:Sense,arg,       Dom:X,Word),
  338    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  339
  340tuples([_:I:named(X,Sym,Type,_)|L],K,R1-R2,W,T1-[E1,E2|T2],N1-N2,I1-I2):- 
  341    word(I,I1,W,Word), nonvar(X), member(Dom:X,R1), !,
  342    condcounter(CC),
  343    E1 = tuple([],K,         named,CC:Sym:Type,[]),
  344    E2 = tuple(I,CC:Sym:Type,instance,  Dom:X,Word),
  345    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  346
  347tuples([B:_:timex(X,date(_,I2:Y,I3:M,I4:D))|L],K,R1-R2,W,T,N,I):- !,
  348    tuples([B:I2:timex(X,year,Y),B:I3:timex(X,month,M),B:I4:timex(X,day,D)|L],K,R1-R2,W,T,N,I).
  349
  350tuples([_:I:timex(X,Type,Sym)|L],K,R1-R2,W,T1-[E1,E2|T2],N1-N2,I1-I2):- 
  351    word(I,I1,W,Word), nonvar(X), member(Dom:X,R1), !,
  352    condcounter(CC),
  353    E1 = tuple([],K,         Type,CC:Sym:Type,[]),
  354    E2 = tuple(I,CC:Sym:Type,arg,  Dom:X,Word),
  355    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  356
  357tuples([_:I:eq(X,Y)|L],K,R1-R2,W,T1-[E1,E2,E3|T2],N1-N2,I1-I2):- 
  358    word(I,I1,W,Word), nonvar(X), nonvar(Y), member(D1:X,R1), member(D2:Y,R1), !,
  359    condcounter(CC),
  360    E1 = tuple(I, K,    relation,CC:equality,Word),
  361    E2 = tuple([],CC:equality,int,D1:X,[]),
  362    E3 = tuple([],CC:equality,ext,D2:Y,[]),
  363%    E1 = tuple([], K,    relation,CC:equality,Word),
  364%    E2 = tuple([],CC:equality,int,D1:X,[]),
  365%    E3 = tuple( I,CC:equality,ext,D2:Y,[]),
  366    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  367
  368tuples([B:I:rel(X,Y,subset_of,Sense)|L],K,R,W,T,N,Is):-
  369   tuples([B:I:rel(Y,X,superset_of,Sense)|L],K,R,W,T,N,Is).
  370
  371tuples([_:I:rel(X,Y,Sym,Sense)|L],K,R1-R2,W,T1-[E1,E2,E3|T2],N1-N2,I1-I2):-
  372    word(I,I1,W,Word), nonvar(X), nonvar(Y), member(D1:X,R1), member(D2:Y,R1), !,
  373    condcounter(CC),
  374    E1 = tuple([],K,relation,CC:Sym:Sense,[]),
  375    E2 = tuple([],CC:Sym:Sense,int,D1:X,[]),
  376    E3 = tuple( I,CC:Sym:Sense,ext,D2:Y,Word),
  377    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  378
  379tuples([_:I:role(X,Y,Sym,Dir)|L],K,R1-R2,W,T1-[E1,E2,E3|T2],N1-N2,I1-I2):-
  380    word(I,I1,W,Word), nonvar(X), nonvar(Y), member(D1:X,R1), member(D2:Y,R1), !,
  381    condcounter(CC),
  382    E1 = tuple([],K,role,CC:Sym:Dir,[]),
  383    E2 = tuple([],CC:Sym:Dir,int,D1:X,[]),
  384    E3 = tuple( I,CC:Sym:Dir,ext,D2:Y,Word),
  385    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  386
  387tuples([I:rel(X,Y,Sym)|L],K,R1-R2,W,T1-[E|T2],N1-N2,I1-I2):-
  388%    word(I,I1,W,Word), !, 
  389%    E = tuple(I,X,Sym,Y,Word),
  390    word(_,I1,W,Word), !, 
  391    E = tuple([],X,Sym,Y,Word),
  392    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  393
  394tuples([_:I:card(X,Y,Type)|L],K,R1-R2,W,T1-[E1,E2|T2],N1-N2,I1-I2):-
  395    word(I,I1,W,Word), nonvar(X), member(Dom:X,R1), !,
  396    condcounter(CC),
  397    E1 = tuple([],K,       cardinality,CC:Y:Type,[]),
  398    E2 = tuple(I,CC:Y:Type,arg,         Dom:X,Word),
  399    tuples(L,K,R1-R2,W,T1-T2,N1-N2,[I|I1]-I2).
  400
  401tuples([_:_:prop(X,B)|L],K,R1-R1,W,T1-T3,N1-N3,I1-I3):-
  402    nonvar(X), member(Dom:X,R1), !,
  403    tuples(B,Dom:X,R1-_,W,T1-T2,N1-N2,I1-I2),
  404    tuples(L,K,R1-_,W,T2-T3,N2-N3,I2-I3).
  405
  406tuples([_:_:prop(X,B)|L],K,R1-R1,W,T1-[T|T3],N1-N3,I1-I3):-
  407    nonvar(X), member(Dom:X,R1), !,
  408    T = tuple([],K,subordinates:prop,Dom:X,[]),
  409    tuples(B,Dom:X,R1-_,W,T1-T2,N1-N2,I1-I2),
  410    tuples(L,K,R1-_,W,T2-T3,N2-N3,I2-I3).
  411
  412tuples([_:_:not(B)|L],K1,R1-R1,W,T1-[E1,E2|T3],N1-N4,I1-I3):- !,
  413    condcounter(CC),
  414    E1 = tuple([],K1,unary,CC:not,[]),
  415    E2 = tuple([],CC:not,scope,K2,[]),
  416    label(N1,k,K2,N2),
  417    tuples(B,K2,R1-_,W,T1-T2,N2-N3,I1-I2),
  418    tuples(L,K1,R1-_,W,T2-T3,N3-N4,I2-I3).
  419
  420tuples([_:_:pos(B)|L],K1,R1-R1,W,T1-[E1,E2|T3],N1-N4,I1-I3):- !,
  421    condcounter(CC),
  422    E1 = tuple([],K1,unary,CC:pos,[]),
  423    E2 = tuple([],CC:pos,scope,K2,[]),
  424    label(N1,k,K2,N2),
  425    tuples(B,K2,R1-_,W,T1-T2,N2-N3,I1-I2),
  426    tuples(L,K1,R1-_,W,T2-T3,N3-N4,I2-I3).
  427
  428tuples([_:_:nec(B)|L],K1,R1-R1,W,T1-[E1,E2|T3],N1-N4,I1-I3):- !,
  429    condcounter(CC),
  430    E1 = tuple([],K1,unary,CC:nec,[]),
  431    E2 = tuple([],CC:nec,scope,K2,[]),
  432    label(N1,k,K2,N2),
  433    tuples(B,K2,R1-_,W,T1-T2,N2-N3,I1-I2),
  434    tuples(L,K1,R1-_,W,T2-T3,N3-N4,I2-I3).
  435
  436tuples([_:_:imp(B1,B2)|L],K1,R1-R1,W,T1-[E1,E2,E3|T4],N1-N6,I1-I4):- !,
  437    condcounter(CC),
  438    E1 = tuple([],K1,binary,CC:imp,[]),
  439    E2 = tuple([],CC:imp,antecedent,K2,[]),
  440    E3 = tuple([],CC:imp,consequent,K3,[]),
  441    label(N1,k,K2,N2),
  442    tuples(B1,K2,R1-R2,W,T1-T2,N2-N3,I1-I2),
  443    label(N3,k,K3,N4),
  444    tuples(B2,K3,R2-_,W,T2-T3,N4-N5,I2-I3),
  445    tuples(L,K1,R1-_,W,T3-T4,N5-N6,I3-I4).
  446
  447tuples([_:_:or(B1,B2)|L],K1,R1-R1,W,T1-[E1,E2,E3|T4],N1-N6,I1-I4):- !,
  448    condcounter(CC),
  449    E1 = tuple([],K1,binary,CC:or,[]),
  450    E2 = tuple([],CC:or,antecedent,K2,[]),
  451    E3 = tuple([],CC:or,consequent,K3,[]),
  452    label(N1,k,K2,N2),
  453    tuples(B1,K2,R1-R2,W,T1-T2,N2-N3,I1-I2),
  454    label(N3,k,K3,N4),
  455    tuples(B2,K3,R2-_,W,T2-T3,N4-N5,I2-I3),
  456    tuples(L,K1,R1-_,W,T3-T4,N5-N6,I3-I4).
  457
  458tuples([_:_:duplex(Type,B1,_,B2)|L],K1,R1-R1,W,T1-[E1,E2,E3|T4],N1-N6,I1-I4):- !,
  459    condcounter(CC),
  460    E1 = tuple([],K1,duplex,CC:Type,[]),
  461    E2 = tuple([],CC:Type,antecedent,K2,[]),
  462    E3 = tuple([],CC:Type,consequent,K3,[]),
  463    label(N1,k,K2,N2),
  464    tuples(B1,K2,R1-R2,W,T1-T2,N2-N3,I1-I2),
  465    label(N3,k,K3,N4),
  466    tuples(B2,K3,R2-_,W,T2-T3,N4-N5,I2-I3),
  467    tuples(L,K1,R1-_,W,T3-T4,N5-N6,I3-I4).
  468
  469tuples([Err|L],K,R,W,T,N,I):- !, 
  470     warning('unknown tuple: ~p',[Err]),
  471     tuples(L,K,R,W,T,N,I).
  472
  473tuples([],_,R-R,_,T-T,N-N,I-I).
  474
  475
  476/* =======================================================================
  477   Convert words in tuple format
  478======================================================================= */
  479
  480word([],_,_,[]):- !.
  481word([Index|Is],Old,W,Ws):- member(Js,Old), member(Index,Js), !, word(Is,Old,W,Ws).
  482word([Index|Is],Old,W,[Tok|Ws]):- member(Index:[tok:Tok|_],W), !, word(Is,Old,W,Ws).
  483word([_|Is],Old,W,Ws):- word(Is,Old,W,Ws).
  484
  485
  486/* =======================================================================
  487   Output tuples to stream
  488======================================================================= */
  489
  490write_tuples([],_).
  491
  492write_tuples([tuple(_Index,Order,Node1,Edge,Node2,Words)|L],Stream):- !,
  493   write_node(Node1,Stream),
  494   format(Stream,' ~w ',[Edge]),
  495   write_node(Node2,Stream),
  496   format(Stream,' ~w [ ',[Order]),
  497   write_tokens(Words,Stream),
  498   write_tuples(L,Stream).
  499
  500write_tuples([T|L],Stream):-
  501   warning('unable to output tuple ~p',[T]),
  502   write_tuples(L,Stream).
  503
  504
  505/* =======================================================================
  506   Output tokens to stream
  507======================================================================= */
  508
  509write_tokens([],Stream):- !, write(Stream,']'), nl(Stream).
  510write_tokens([X|L],Stream):- format(Stream,'~w ',[X]), write_tokens(L,Stream).
  511
  512
  513/* =======================================================================
  514   Output nodes to stream
  515======================================================================= */
  516
  517write_node(A:B,Stream):- !, format(Stream,'~w:',[A]), write_node(B,Stream).
  518write_node(A,Stream):- format(Stream,'~w',[A]).
  519
  520
  521/* =======================================================================
  522   Generate from DRG (wrapper)
  523======================================================================= */
  524
  525unboxer(_,_):- !.         % still in development!
  526
  527unboxer(Tuples,Tags):-
  528   findall(T,(T=tuple(_,_,_,ext,_,_),member(T,Tuples)),Ext),
  529   gen(Tuples,Ext,[],S),
  530   warning('unboxer says: ~p',[S]),
  531   compare(S,Tags), !.
  532
  533unboxer(_,_):-
  534   warning('unboxer failed',[]).
  535
  536
  537/* =======================================================================
  538   Comparing with gold standard
  539======================================================================= */
  540
  541compare([],[]):- !.
  542
  543compare([Tok|L1],[_:[tok:Tok|_]|L2]):- !,
  544   compare(L1,L2).
  545
  546compare([Tok1|_],[_:[tok:Tok2|_]|_]):- !,
  547   warning('unboxer generated different surface token "~p" instead of "~p"',[Tok1,Tok2]).
  548
  549compare([Tok1|_],[]):- !,
  550   warning('unboxer generated exta surface token "~p"',[Tok1]).
  551
  552compare([],[_:[tok:Tok2|_]|_]):- !,
  553   warning('unboxer missed surface token "~p"',[Tok2]).
  554
  555
  556/* =======================================================================
  557   Generate from DRG
  558======================================================================= */
  559
  560gen([],_,G,T):- 
  561   compose(G,C),
  562   member(_:[S],C), 
  563%  write(S),nl,
  564   text(S,[],T), !.
  565
  566gen(L1,Ext,G,S):-
  567   select(tuple(_,_,K1,dominates,K2,[]), L1,L2),  % redundant, remove
  568   member(tuple(_,_,K1,_,K2,_),L2), !,
  569   gen(L2,Ext,G,S).
  570
  571gen(L1,Ext,G1,S):-                                %         K1
  572   select(tuple(_,_,K1,Rel,K2,T1), L1,L2),        %         |
  573   member(Rel,[dominates,because]),               % ... --> K2 --> Old
  574   member(tuple(_,_,_,continuation,K2,T2),L1),    % 
  575   select(K1:C,G1,G2), !,                         % 
  576   concatenate([T1,T2,v(K2)|C],Reduced),          %
  577   gen(L2,Ext,[K1:Reduced|G2],S).                 % Generate: K1 = K2 + Old(K1)
  578
  579gen(L1,Ext,G1,S):-                                %   K1
  580   select(tuple(_,_,K1,Rel,K2,T), L1,L2),         %   |
  581   member(Rel,[dominates,because]),               %   K2 --> Old
  582   select(K1:C,G1,G2), !,                         % 
  583   concatenate([T,v(K2)|C],Reduced),              %
  584   gen(L2,Ext,[K1:Reduced|G2],S).                 % Generate: K1 = K2 + Old(K1)
  585
  586gen(L1,Ext,G,S):-                                 %         K1
  587   select(tuple(_,_,K1,Rel,K2,T1), L1,L2),        %         |
  588   member(Rel,[dominates,because]),               % ... --> K2
  589   member(tuple(_,_,_,continuation,K2,T2),L1), !, % 
  590   concatenate([T1,T2,v(K2)],Reduced),            % NOT GUARENTEED TO BE THE LAST!
  591   gen(L2,Ext,[K1:Reduced|G],S).                  % Generate: K1 = K2
  592
  593gen(L1,Ext,G,S):-                                 %   K1
  594   select(tuple(_,_,K1,Rel,K2,T), L1,L2),         %   |
  595   member(Rel,[dominates,because]), !,            %   K2
  596   concatenate([T,v(K2)],Reduced),                %
  597   gen(L2,Ext,[K1:Reduced|G],S).                  % Generate: K1 = K2
  598
  599gen([T|L],Ext,G1,S):-
  600   T = tuple(_I,_O,_N,_E,X,_T),
  601   select(X:C,G1,G2), !,                          % X is already generated
  602   split(L,X,WithX,WithoutX), 
  603   partial(1,[T|WithX],Ext,Partial),
  604   append(Partial,C,Appended),
  605   concatenate(Appended,Reduced),
  606   gen(WithoutX,Ext,[X:Reduced|G2],S).
  607
  608gen([T|L],Ext,G,S):-
  609   T = tuple(_I,_O,_N,_E,X,_T),
  610   split(L,X,WithX,WithoutX), 
  611   partial(1,[T|WithX],Ext,Partial),
  612   concatenate(Partial,Reduced),
  613%  write(E:X:Reduced),nl,
  614   gen(WithoutX,Ext,[X:Reduced|G],S).
  615
  616
  617/* =======================================================================
  618   Generate a partial (incomplete) surface string
  619======================================================================= */
  620
  621partial(I,L1,Ext,[v(V)|S2]):-
  622   select(tuple(_,I,N,int,_,_),L1,L2), 
  623   member(tuple(_,_,N,ext,V,_),Ext), !,
  624   J is I + 1,
  625   partial(J,L2,Ext,S2).
  626
  627partial(I,L1,Ext,[v(V)|S2]):-
  628   select(tuple(_,I,V,main,_,[]),L1,L2), !,
  629   J is I + 1,
  630   partial(J,L2,Ext,S2).
  631
  632partial(I,L1,Ext,[S1|S2]):-
  633   select(tuple(_,I,_,_,_,S1),L1,L2), !,
  634   J is I + 1,
  635   partial(J,L2,Ext,S2).
  636
  637partial(_,_,_,[]).
  638
  639
  640/* =======================================================================
  641   Concatenate a surface string, v(V) denotes a variable V 
  642======================================================================= */
  643
  644concatenate([],[]):- !.
  645concatenate([[]|L1],L2):- !, concatenate(L1,L2).
  646concatenate([X],[X]):- !.
  647concatenate([v(V)|L1],[v(V)|L2]):- !, concatenate(L1,L2).
  648concatenate([L,v(V)|L1],[L,v(V)|L2]):- !, concatenate(L1,L2).
  649concatenate([La,Lb|L1],L2):- !, append(La,Lb,L), concatenate([L|L1],L2).
  650
  651
  652/* =======================================================================
  653   Compose surface string
  654======================================================================= */
  655
  656% compose(L,_):-  write(l:L),nl, fail.
  657
  658compose(L1,L7):-
  659   select(V1:[S],L1,L2),          % complete strings, three variables
  660   secondOccur(S,S2),
  661   select(V2:Sa1,L2,L3),          % V1 part of V2 and
  662   subst(Sa1,V1:[S2],Sa2),         
  663   select(V3:Sb1,L3,L4),          % V1 part of V3 
  664   subst(Sb1,V1:[S2],Sb2), 
  665   select(V4:Sc1,L4,L5),          % V1 part of V4 
  666   subst(Sc1,V1:[S2],Sc2), 
  667   select(V5:Sd1,L5,L6),          % V1 part of V5
  668   subst(Sd1,V1:[S2],Sd2), !,
  669   concatenate(Sa2,Sa3),
  670   concatenate(Sb2,Sb3),
  671   concatenate(Sc2,Sc3),
  672   concatenate(Sd2,Sd3),
  673   compose([V2:Sa3,V3:Sb3,V4:Sc3,V5:Sd3|L6],L7).
  674
  675compose(L1,L6):-
  676   select(V1:[S],L1,L2),          % complete strings, three variables
  677   secondOccur(S,S2),
  678   select(V2:Sa1,L2,L3),          % V1 part of V2 and
  679   subst(Sa1,V1:[S2],Sa2),         
  680   select(V3:Sb1,L3,L4),          % V1 part of V3 
  681   subst(Sb1,V1:[S2],Sb2), 
  682   select(V4:Sc1,L4,L5),          % V1 part of V4 
  683   subst(Sc1,V1:[S2],Sc2), !,
  684   concatenate(Sa2,Sa3),
  685   concatenate(Sb2,Sb3),
  686   concatenate(Sc2,Sc3),
  687   compose([V2:Sa3,V3:Sb3,V4:Sc3|L5],L6).
  688
  689compose(L1,L5):-
  690   select(V1:[S],L1,L2),          % complete strings, two variables
  691   secondOccur(S,S2),
  692   select(V2:Sa1,L2,L3),          % V1 part of V2 and
  693   subst(Sa1,V1:[S2],Sa2),         
  694   select(V3:Sb1,L3,L4),          % V1 part of V3 
  695   subst(Sb1,V1:[S2],Sb2), !,
  696   concatenate(Sa2,Sa3),
  697   concatenate(Sb2,Sb3),
  698   compose([V2:Sa3,V3:Sb3|L4],L5).
  699
  700compose(L1,L4):-
  701   select(V1:[S1],L1,L2),          % complete strings, one variable
  702   select(V2:S2,L2,L3),            % V1 part of V2
  703   subst(S2,V1:[S1],S3), !,
  704   concatenate(S3,S4),
  705   compose([V2:S4|L3],L4).
  706
  707compose(L1,L4):-
  708   select(V1:[],L1,L2),            % empty strings
  709   select(V2:S2,L2,L3),
  710   subst(S2,V1:[],S3), !,
  711   concatenate(S3,S4),
  712   compose([V2:S4|L3],L4).
  713
  714compose(L1,L3):-
  715  select(_:[],L1,L2), !,
  716  compose(L2,L3).
  717
  718compose(L,L).
  719
  720
  721/* =======================================================================
  722   Substitute variable for string
  723======================================================================= */
  724
  725subst([v(X)|L],X:[],L):- !.
  726subst([v(X)|L],X:[V],[V|L]):- !.
  727subst([X|L1],Y:V,[X|L2]):- subst(L1,Y:V,L2).
  728
  729
  730/* =======================================================================
  731   Second Occurrence
  732======================================================================= */
  733
  734secondOccur([],[]).
  735secondOccur([X|L1],[m(X)|L2]):- secondOccur(L1,L2).
  736
  737
  738/* =======================================================================
  739   Map Multiple Occurrence to Text
  740======================================================================= */
  741
  742text([],_,[]).
  743text([m(m(X))|L1],A,L2):- !, text([m(X)|L1],A,L2).
  744text([m(X)|L1],A,L2):- member(X,A), !, text(L1,A,L2).  % already generated
  745text([m(X)|L1],A,[X|L2]):- !, text(L1,[X|A],L2).
  746text([X|L1],A,[X|L2]):- text(L1,A,L2)