2:- module(vpe,[resolveVPE/2]).    3
    4/* =============================================================
    5   Importing predicates
    6============================================================= */
    7
    8:- use_module(library(lists),[member/2,append/3,select/3]).    9:- use_module(boxer(betaConversionDRT),[betaConvert/2]).   10:- use_module(semlib(options),[option/2]).   11:- use_module(semlib(errors),[warning/2]).   12
   13
   14/* =============================================================
   15   Main
   16============================================================= */
   17
   18resolveVPE(B,B):- option('--vpe',false), !.
   19
   20resolveVPE(B,B):- option('--vpe',true), !,
   21   warning('VPE resolution not activated',[]).
   22
   23resolveVPE(In,Out):- detectVPE(In,Out,[]-_Stack), !.
   24
   25resolveVPE(B,B).
   26
   27
   28/* =============================================================
   29   VPE detection
   30============================================================= */
   31
   32detectVPE(merge(B1,B2),merge(U1,U2),St1-St3):- !, 
   33   detectVPE(B1,U1,St1-St2), 
   34   window(St2,St4),
   35   detectVPE(B2,U2,St4-St3).
   36
   37detectVPE(alfa(T,B1,B2),alfa(T,U1,U2),St1-St3):- !, 
   38   detectVPE(B1,U1,St1-St2), 
   39   detectVPE(B2,U2,St2-St3).
   40
   41detectVPE(B:drs(Dom,Conds1),Drs,St1-St2):-
   42   select(_:Ind:pred(E,Sym,v,98),Conds1,Conds2),
   43   constraints(Conds2,Sym,E),   
   44   %%% VPE detected, !,
   45   resolveVPE(B:drs(Dom,Conds2),Ind,Sym,E,St1,ResolvedDrs),
   46   detectVPE(ResolvedDrs,Drs,St1-St2).
   47
   48detectVPE(B:drs(Dom,Con1),B:drs(Dom,Con2),St1-St2):-
   49   detectVPEc(Con1,Con2,[B:drs(Dom,Con1)|St1]-St2).
   50
   51
   52/* =============================================================
   53   VPE detection (DRS-conditions)
   54============================================================= */
   55
   56detectVPEc([B:I:not(B)|L1],[B:I:not(U)|L2],St1-St3):- !, 
   57   detectVPE(B,U,St1-St2),
   58   detectVPEc(L1,L2,St2-St3).
   59
   60detectVPEc([B:I:pos(B)|L1],[B:I:pos(U)|L2],St1-St3):- !, 
   61   detectVPE(B,U,St1-St2),
   62   detectVPEc(L1,L2,St2-St3).
   63
   64detectVPEc([B:I:nec(B)|L1],[B:I:nec(U)|L2],St1-St3):- !, 
   65   detectVPE(B,U,St1-St2),
   66   detectVPEc(L1,L2,St2-St3).
   67
   68detectVPEc([B:I:prop(X,B)|L1],[B:I:prop(X,U)|L2],St1-St3):- !, 
   69   detectVPE(B,U,St1-St2),
   70   detectVPEc(L1,L2,St2-St3).
   71
   72detectVPEc([B:I:imp(B1,B2)|L1],[B:I:imp(U1,U2)|L2],St1-St4):- !, 
   73   detectVPE(B1,U1,St1-St2), 
   74   detectVPE(B2,U2,St2-St3), 
   75   detectVPEc(L1,L2,St3-St4).
   76
   77detectVPEc([B:I:or(B1,B2)|L1],[B:I:or(U1,U2)|L2],St1-St4):- !, 
   78   detectVPE(B1,U1,St1-St2), 
   79   detectVPE(B2,U2,St2-St3), 
   80   detectVPEc(L1,L2,St3-St4).
   81
   82detectVPEc([B:I:duplex(T,B1,V,B2)|L1],[B:I:duplex(T,U1,V,U2)|L2],St1-St4):- !, 
   83   detectVPE(B1,U1,St1-St2), 
   84   detectVPE(B2,U2,St2-St3), 
   85   detectVPEc(L1,L2,St3-St4).
   86
   87detectVPEc([C|L1],[C|L2],St1-St2):- !,
   88   detectVPEc(L1,L2,St1-St2).
   89
   90detectVPEc([],[],S-S).
   91
   92
   93/* =============================================================
   94   Constraints
   95============================================================= */
   96
   97constraints(Conds,Sym,E):-
   98   constraint1(Conds,Sym,E),
   99   constraint2(Conds,Sym,E), 
  100   constraint3(Conds,Sym,E), 
  101   constraint4(Conds,Sym,E),
  102   constraint5(Conds,Sym,E),
  103   constraint6(Conds,Sym,E).
  104
  105
  106/* =============================================================
  107   Constraint 1: Not part of How-question
  108============================================================= */
  109
  110constraint1(Conds,_,E):-
  111   member(_:_:rel(U,_,manner_rel,_),Conds), E==U, 
  112   !, fail.
  113
  114constraint1(_,_,_).
  115
  116
  117/* =============================================================
  118   Constraint 2: do + ADJ
  119============================================================= */
  120
  121constraint2(Conds,do,E):-
  122    member(_:_:pred(U,Sym,a,_),Conds), E==U, 
  123    member(Sym,[good,well,great,ok,poorly,terrific,right,wrong,
  124                badly,better,bad,best,worse,worst]), 
  125    !, fail.
  126
  127constraint2(_,_,_).
  128
  129
  130/* =============================================================
  131   Constraint 3: do + NP
  132============================================================= */
  133
  134constraint3(Conds,do,E):-
  135   member(_:_:pred(U,Sym,a,_),Conds), E==U, 
  136   member(Sym,[anything,everything,something,nothing,that,what]), 
  137   !, fail.
  138
  139constraint3(_,_,_).
  140
  141
  142/* =============================================================
  143   Constraint 4: do + more/enough/...
  144============================================================= */
  145
  146constraint4(Conds,do,E):-
  147   member(_:_:pred(U,Sym,a,_),Conds), E==U, 
  148   member(Sym,[enough,more,less,little,much]),
  149   !, fail.
  150
  151constraint4(_,_,_).
  152
  153
  154/* =============================================================
  155   Constraint 5: do away with ...
  156============================================================= */
  157
  158constraint5(Conds,do,E):-   
  159   member(_:_:pred(U,Sym,a,_),Conds), E==U, 
  160   member(Sym,[away]),
  161   !, fail.
  162
  163constraint5(_,_,_).
  164
  165/* =============================================================
  166   Constraint 6: where SUBJ BE
  167============================================================= */
  168
  169constraint6(Conds,be,E):-   
  170   member(_:_:rel(U,_,loc_rel,0),Conds), E==U, 
  171   !, fail.
  172
  173constraint6(_,_,_).
  174
  175
  176/* =============================================================
  177   Antecedent Index (only beginning and end)
  178============================================================= */
  179
  180antBegEnd(AntInd,Beg,End):-
  181   member(Beg,AntInd),
  182   \+ (member(I,AntInd), I < Beg),
  183   member(End,AntInd),
  184   \+ (member(I,AntInd), I > End), !.
  185
  186
  187/* =============================================================
  188   Parallel Elements (target clause)
  189============================================================= */
  190
  191parallelElements([],_,[],Par-Par,A-A):- 
  192   member(Sub,[agent,patient,theme]), 
  193   member(Sub,Par).
  194
  195parallelElements([_:_:rel(U,X,Rel,_)|L1],E,L2,Par1-Par2,A1-A2):-
  196   U==E,
  197   parallelElements(L1,E,L2,[Rel|Par1]-Par2,app(A1,X)-A2). 
  198
  199parallelElements([C|L1],E,[C|L2],Par1-Par2,A1-A2):-
  200   parallelElements(L1,E,L2,Par1-Par2,A1-A2). 
  201   
  202
  203/* =============================================================
  204   VPE resolution (real)
  205============================================================= */
  206
  207resolveVPE(B:drs(Dom,Conds1),Ind,_Sym,E,Stack,ResolvedDrs):-
  208   option('--x',false),
  209   tempStack(B:drs(Dom,Conds1),Stack,TempStack),
  210   parallelElements(Conds1,E,Conds2,[]-Par,app(Q,E)-App),
  211   NewDrs = app(VP,lam(Q,merge(B:drs(Dom,Conds2),App))),
  212   member(AntDrs,TempStack), 
  213   sortDRS(AntDrs,SortedAntDrs),
  214   abstractDRS(SortedAntDrs,Ind,Par,VP,_), 
  215   betaConvert(NewDrs,ResolvedDrs), !.
  216
  217resolveVPE(B:drs(Dom,Conds),Ind,Sym,E,_Stack,Drs):-
  218   option('--x',false),
  219   Drs = B:drs(Dom,[B:Ind:pred(E,Sym,v,0)|Conds]).
  220
  221
  222/* =============================================================
  223   VPE resolution (experimental)
  224============================================================= */
  225
  226resolveVPE(B:drs(Dom,Conds1),Ind,Sym,E,Stack,Drs):-
  227   option('--x',true),
  228   tempStack(B:drs(Dom,Conds1),Stack,TempStack),
  229%   write('Stack:'),nl,writeStack(TempStack,1),
  230   findall(Par,parallelElements(Conds1,E,_,[]-Par,_),Pars),
  231   nSolutions(Pars,TempStack,E,Sym,Ind,0,Conds1,Conds3), !,
  232   Drs = B:drs(Dom,Conds3).
  233
  234resolveVPE(B:drs(Dom,Conds),Ind,Sym,E,_Stack,Drs):-
  235   option('--x',true),
  236   Drs = B:drs(Dom,[B:Ind:pred(E,Sym,v,97)|Conds]).
  237
  238
  239/* =============================================================
  240   N solutions
  241============================================================= */
  242
  243nSolutions([],_,_,_,_,N,C,C):- !, N > 0.
  244
  245nSolutions([P|Ps],Stack,E,Sym,Ind,N1,C1,C3):-
  246   nSol(Stack,E,Sym,Ind,P,N1,N2,C1,C2),
  247   nSolutions(Ps,Stack,E,Sym,Ind,N2,C2,C3).
  248
  249nSol([],_,_,_,_,N,N,Conds,Conds):- !.
  250
  251nSol([AntDrs|Stack],E,Sym,[Ind],Par,N1,N3,Conds1,Conds2):-
  252   sortDRS(AntDrs,SortedAntDrs),
  253   abstractDRS(SortedAntDrs,[Ind],Par,_,AntInd), 
  254   antBegEnd(AntInd,Beg,End),
  255   NewInd = [Ind,Beg,End],
  256   \+ member(NewInd:_,Conds1), !,  % new solution!
  257   N2 is N1 + 1,
  258   New = NewInd:pred(E,Sym,vpe,N2),
  259   parConds(Par,NewInd,E,N2,[New|Conds1],Conds3),
  260   nSol([AntDrs|Stack],E,Sym,[Ind],Par,N2,N3,Conds3,Conds2).
  261
  262nSol([_|Stack],E,Sym,[Ind],Par,N1,N2,Conds1,Conds2):-
  263   nSol(Stack,E,Sym,[Ind],Par,N1,N2,Conds1,Conds2).
  264
  265
  266/* =============================================================
  267   Sort DRS
  268============================================================= */
  269
  270sortDRS(B:drs(Dom,Conds),B:drs(Dom,SortedConds)):-
  271   sort(Conds,SortedConds).
  272
  273
  274/* =============================================================
  275   Parallel Conditions (experiment only)
  276============================================================= */
  277
  278parConds([],_,_,_,C,C).
  279
  280parConds([Par|L],Index,E,N,C1,[Index:pred(E,Par,par,N)|C2]):-
  281   parConds(L,Index,E,N,C1,C2).
  282    
  283
  284/* =============================================================
  285   Abstraction (DRSs)
  286============================================================= */
  287
  288abstractDRS(B:drs(Dom,Conds),Ind,Par,Abs,AntInd):-
  289   member(AI:pred(E,_Sym,v,_),Conds),
  290   before(AI,Ind),             %%% excludes VP cataphora!
  291   minimalDistance(AI,Ind,2),  %%% excludes Bill doesnt [want] to []
  292   checkParallelElements(Par,E,Conds,ParRef,Drs-Lam), !,
  293   conceptAbstraction(Conds,[],Ind,AI,Dom,E,ParRef,[]-AbsDom,[]-AbsCond,[]-AntInd),
  294   Drs = B:drs(AbsDom,AbsCond),
  295   Abs = lam(F,app(F,lam(E,Lam))).
  296
  297
  298/* =============================================================
  299   Concept Abstraction
  300============================================================= */
  301
  302conceptAbstraction([],_,_,_,_,_,_,D-D,C-C,J-J).
  303
  304conceptAbstraction([I:_|L],NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J2):- 
  305   before(I,AI), !,                     %%% skip material before antecedent head
  306   conceptAbstraction(L,NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J2).
  307
  308conceptAbstraction([_:Cond|_],_NotCopied,_Ind,_AI,_Dom,_E,_Par,AD-AD,AC-AC,J-J):- 
  309   Cond = pred(_,Pred,a,_), 
  310   member(Pred,[more,less,as,than]), !.       %%% comparative/equative --> block
  311
  312%conceptAbstraction([_:Cond|_],_NotCopied,_Ind,_AI,_Dom,E,_Par,AD-AD,AC-AC,J-J):- 
  313%   Cond = pred(X,Pred,a,_), 
  314%   member(Pred,[more,less,as,than]),                 %%% comparative/equative --> block
  315%   X==E, !.
  316
  317conceptAbstraction([I1:Cond|L],NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J3):- 
  318   Cond = pred(X,_,_,_), X==E, !,       %%% Copy all 1-place predicates
  319   newIndex(I1,I2,J1,J2),
  320   conceptAbstraction(L,NC,Ind,AI,Dom,E,Par,AD1-AD2,[I2:Cond|AC1]-AC2,J2-J3).
  321
  322conceptAbstraction([I1:Cond|L],NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J3):- 
  323   Cond = named(X,_,_,_), X==E, !,      %%% Copy all 1-place predicates
  324   newIndex(I1,I2,J1,J2),
  325   conceptAbstraction(L,NC,Ind,AI,Dom,E,Par,AD1-AD2,[I2:Cond|AC1]-AC2,J2-J3).
  326
  327conceptAbstraction([I1:Cond|L],NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J3):- 
  328   Cond = timex(X,_), X==E, !,          %%% Copy all 1-place predicates
  329   newIndex(I1,I2,J1,J2),
  330   conceptAbstraction(L,NC,Ind,AI,Dom,E,Par,AD1-AD2,[I2:Cond|AC1]-AC2,J2-J3).
  331
  332conceptAbstraction([I1:Cond|L],NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J3):- 
  333   Cond = card(X,_,_), X==E, !,          %%% Copy all 1-place predicates
  334   newIndex(I1,I2,J1,J2),
  335   conceptAbstraction(L,NC,Ind,AI,Dom,E,Par,AD1-AD2,[I2:Cond|AC1]-AC2,J2-J3).
  336
  337conceptAbstraction([_:Cond|L],NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J2):- 
  338   option('--x',true),                  %%% Skip already parallel-marked elements
  339   Cond = rel(_,_,parallel,1), !,
  340   conceptAbstraction(L,NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J2).
  341
  342conceptAbstraction([I1:Cond|L],NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J3):- 
  343   option('--x',true),
  344   Cond = rel(X,Y,_,_), X==E, 
  345   member(Z,Par), Z==Y, !,              %%% Parallel Element --> copy
  346   newIndex(I1,I2,J1,J2),
  347   conceptAbstraction(L,NC,Ind,AI,Dom,E,Par,AD1-AD2,[I2:Cond,[]:rel(X,Y,parallel,1)|AC1]-AC2,J2-J3).
  348
  349conceptAbstraction([I1:Cond|L],NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J3):- 
  350   option('--x',false),
  351   Cond = rel(X,Y,_,_), X==E, 
  352   member(Z,Par), Z==Y, !,              %%% Parallel Element --> copy
  353   newIndex(I1,I2,J1,J2),
  354   conceptAbstraction(L,NC,Ind,AI,Dom,E,Par,AD1-AD2,[I2:Cond|AC1]-AC2,J2-J3).
  355
  356conceptAbstraction([_:Cond|_],_NotCopied,_Ind,_AI,_Dom,_E,_Par,AD-AD,AC-AC,J-J):- 
  357   Cond = rel(_,_,Rel,_), 
  358   member(Rel,[than,as,like,more,less]), !.   %%% comparative/equative --> block
  359
  360%conceptAbstraction([_:Cond|_],_NotCopied,_Ind,_AI,_Dom,E,_Par,AD-AD,AC-AC,J-J):- 
  361%   Cond = rel(X,_,Rel,_), 
  362%   member(Rel,[than,as,like,more,less]),          %%% comparative/equative --> block
  363%   X==E, !.
  364
  365conceptAbstraction([I1:Cond|L],NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J3):- 
  366   Cond = rel(X,Y,_,_), X==E, 
  367   before(I1,Ind), 
  368   \+ ( member(_:U,Dom), Y==U ), 
  369   \+ ( member(I3:rel(X,_,Rel,_),L), X==E,    
  370        member(Rel,[than,as,like]),
  371        before(I3,I1) ),   
  372   !, %%% Copy relations to definites
  373   newIndex(I1,I2,J1,J2),
  374   conceptAbstraction(L,NC,Ind,AI,Dom,E,Par,AD1-AD2,[I2:Cond|AC1]-AC2,J2-J3).
  375
  376conceptAbstraction([I1:Cond|L],NotCopied,Ind,AI,Dom,E,Par,AD1-AD3,AC1-AC3,J1-J4):- 
  377   Cond = rel(X,Y,_Rel,_), X==E,
  378   before(I1,Ind), 
  379   member(_:U,Dom), Y==U, 
  380%   \+ ( member(I3:rel(X,_,Rel,_),L), X==E,    
  381%        member(Rel,[than,as,like]),
  382%        before(I3,I1) ),   
  383   \+ ( member(_:pred(V,_,_,98),L), 
  384        V==Y ),
  385   \+ ( member(_:pred(V,_,_,98),NotCopied), 
  386        V==Y ),
  387   !, %%% Copy relations to indefinites
  388   newIndex(I1,I2,J1,J2),
  389   append(L,NotCopied,Conds), sort(Conds,SortedConds),
  390   conceptAbstraction(SortedConds,[],Ind,AI,Dom,Y,Par,AD1-AD2,AC1-AC2,J2-J3),
  391   conceptAbstraction(L,NotCopied,Ind,AI,Dom,E,Par,[[]:Y|AD2]-AD3,[I2:Cond|AC2]-AC3,J3-J4).
  392
  393conceptAbstraction([I1:Cond|L],NC,Ind,AI,Dom,E,Par,AD1-AD2,AC1-AC2,J1-J3):- 
  394   Cond = prop(X,PDrs), X==E, 
  395   PDrs = _:drs(_,PConds),
  396   \+ member(Ind:_,PConds), !,
  397   newIndex(I1,I2,J1,J2),
  398   conceptAbstraction(L,NC,Ind,AI,Dom,E,Par,AD1-AD2,[I2:Cond|AC1]-AC2,J2-J3).
  399
  400conceptAbstraction([C|L],NotCopied,Ind,AI,Dom,E,Par,AD,AC,J):- 
  401   conceptAbstraction(L,[C|NotCopied],Ind,AI,Dom,E,Par,AD,AC,J).
  402
  403
  404/* =============================================================
  405   New Index (add -11 for evaluation purposes)
  406============================================================= */
  407
  408newIndex(I,I,J,J):-
  409   option('--x',false), !.
  410
  411newIndex(I1,I2,J1,J2):-
  412   option('--x',true), !,
  413   I2 = [-11|I1],
  414   append(I1,J1,J2).
  415
  416
  417/* =============================================================
  418   Check Parallel Elements (should all be present)
  419============================================================= */
  420
  421checkParallelElements([],_,_,[],Lam-Lam).
  422
  423checkParallelElements([Sym|L],E,Conds,[X|Par],Lam1-Lam2):-
  424   member(_:rel(U,X,Sym,_),Conds), E==U, !,
  425   checkParallelElements(L,E,Conds,Par,lam(X,Lam1)-Lam2).
  426
  427
  428/* =============================================================
  429   Word order
  430============================================================= */
  431
  432before(L1,L2):-
  433   member(I1,L1),
  434   member(I2,L2), I1 < I2, !.
  435
  436/* =============================================================
  437   Minimal distance
  438============================================================= */
  439
  440minimalDistance([I1],[I2],Min):- !,
  441   Difference is abs(I1-I2),
  442   Difference >= Min.
  443
  444minimalDistance(_,_,_).
  445
  446
  447/* =============================================================
  448   Window (number of DRSs kept on stack)
  449============================================================= */
  450
  451window([A,B,C,D,E,F,G,H,I,J|_],[A,B,C,D,E,F,G,H,I,J]):- !.
  452
  453window(W,W).
  454
  455
  456/* =============================================================
  457   Print Stack of antecedents (for debugging purposes)
  458============================================================= */
  459
  460writeStack([],_):- nl.
  461writeStack([X|L],N):- 
  462   write(stack:N),nl, 
  463   output:print(user_output,X),nl, 
  464   M is N + 1, writeStack(L,M).
  465
  466
  467/* =============================================================
  468   Stack (only top N)
  469============================================================= */
  470
  471tempStack(DRS,[A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T|_],[DRS,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T]):- !.
  472tempStack(DRS,Stack,[DRS|Stack])