2:- module(resolveDRT,[resolveDRS/2,goldAntecedent/2]).    3
    4:- use_module(boxer(bindingViolation),[noBindingViolationDrs/1]).    5:- use_module(boxer(freeVarCheck),[boundVarCheckContext/2,
    6                                   drsCondition/2]).    7:- use_module(library(lists),[member/2,append/3,select/3]).    8:- use_module(semlib(options),[option/2]).    9:- use_module(semlib(errors),[warning/2,gold/2]).   10:- use_module(boxer(categories),[att/3]).   11:- use_module(knowledge(antecedent),[extractFeaturesAna/2,
   12                                     extractFeaturesAnt/2,
   13                                     ana_ant_sort/3,
   14                                     ana_ant_symb/3,
   15                                     pos_ant/2,
   16                                     sentence_position_ant/2,
   17                                     same_sentence/4]).   18
   19
   20/* ========================================================================
   21   Dynamic Predicate
   22======================================================================== */
   23
   24:- dynamic antecedent/2.   25
   26
   27/* ========================================================================
   28   Managing Gold Standard Antecedents
   29======================================================================== */
   30
   31goldAntecedent(Indices,Att):-
   32   att(Att,antecedent,AntecedentIndex), 
   33   number(AntecedentIndex), !,
   34%  write(antecedent(Indices,AntecedentIndex)),nl,
   35   assert(antecedent(Indices,AntecedentIndex)).
   36
   37goldAntecedent(_,_).
   38
   39
   40/* ========================================================================
   41   resolveDRS(+PDRS,     % Projective Discourse Representation Structure
   42              +T1-T2).   % Tags (token information)
   43======================================================================== */
   44
   45resolveDRS(B,Tags):- 
   46   option('--resolve',true), !, 
   47   copy_term(Tags,L-[]), 
   48   setof(X:P,T^(member(X:T,L),member(pos:P,T)),IDs),
   49   resolvePDRS(B,[]-_,[]-_,IDs).
   50
   51resolveDRS(_,_).
   52
   53
   54/* ========================================================================
   55   resolvePDRS(+PDRS,
   56               +C1-C2, % Context is a difference list of pointed DRSs
   57               +P1-P2, % Presuppositions
   58               +T1-T2) % Tags
   59======================================================================== */
   60
   61resolvePDRS(sdrs([],_),C-C,P-P,_):- !.
   62
   63resolvePDRS(sdrs([lab(_,B)|L],C),C1-C3,P1-P3,IDs):- !,
   64   resolvePDRS(B,C1-C2,P1-P2,IDs),
   65   resolvePDRS(sdrs(L,C),C2-C3,P2-P3,IDs).
   66
   67resolvePDRS(sdrs([sub(B1,B2)|L],C),C1-C3,P1-P4,IDs):- !,
   68   resolvePDRS(B1,C1-C2,P1-P2,IDs),
   69   resolvePDRS(B2,C2-_,P2-P3,IDs),
   70   resolvePDRS(sdrs(L,C),C2-C3,P3-P4,IDs).
   71
   72resolvePDRS(merge(B1,B2),C1-C3,P1-P3,IDs):- !,
   73   resolvePDRS(B1,C1-C2,P1-P2,IDs),
   74   resolvePDRS(B2,C2-C3,P2-P3,IDs).
   75
   76resolvePDRS(lab(_,B),Context,P,IDs):- !,
   77   resolvePDRS(B,Context,P,IDs).
   78
   79resolvePDRS(K:drs(D,C),C1-[K:drs(D,C)|C1],P1-P3,IDs):- !,
   80   getAnaphora(K:drs(D,C),C1,P1,[]-As),
   81   projectAnaphora(As,[K:drs(D,C)|C1],P1-P2,IDs),
   82   resolveConds(C,[K:drs(D,C)|C1],P2-P3,IDs).
   83
   84resolvePDRS(U,C-C,P-P,_):- 
   85   warning('unknown DRS in resolvePDRS/4: ~p',[U]).
   86
   87
   88/* ========================================================================
   89   Project an ordered list of anaphoric DRSs
   90======================================================================== */
   91
   92projectAnaphora([],_,P-P,_).
   93
   94projectAnaphora([_I:K:B:Dep|As],C,P1-P3,IDs):-
   95    project(P1,C,K:B,P1-P2,C,Dep,[],IDs), !,
   96    projectAnaphora(As,C,P2-P3,IDs).
   97
   98projectAnaphora([I2:K2:B2:Dep|As1],C,P1-P2,IDs):-
   99    select(I1:K1:B1:[],As1,As2), !,
  100    projectAnaphora([I1:K1:B1:[],I2:K2:B2:Dep|As2],C,P1-P2,IDs).
  101
  102projectAnaphora([_:_:_:Dep|As],C,P1-P2,IDs):-
  103    warning('dependent variable in project/6 not found: ~p',[Dep]),
  104    projectAnaphora(As,C,P1-P2,IDs).
  105
  106
  107/* ========================================================================
  108   Resolve Conditions
  109======================================================================== */
  110
  111resolveConds([],_,P-P,_):- !.
  112
  113resolveConds([_:C|L],Context,P,IDs):- !, 
  114   resolveConds([C|L],Context,P,IDs).
  115
  116resolveConds([not(B)|C],Context,P1-P3,IDs):- !,
  117   resolvePDRS(B,Context-_,P1-P2,IDs),
  118   resolveConds(C,Context,P2-P3,IDs).
  119
  120resolveConds([nec(B)|C],Context,P,IDs):- !,
  121   resolveConds([not(B)|C],Context,P,IDs).
  122
  123resolveConds([pos(B)|C],Context,P,IDs):- !,
  124   resolveConds([not(B)|C],Context,P,IDs).
  125
  126resolveConds([prop(_,B)|C],Context,P,IDs):- !,
  127   resolveConds([not(B)|C],Context,P,IDs).
  128
  129resolveConds([imp(B1,B2)|C],C1,P1-P4,IDs):- !,
  130   resolvePDRS(B1,C1-C2,P1-P2,IDs),
  131   resolvePDRS(B2,C2-_,P2-P3,IDs),
  132   resolveConds(C,C1,P3-P4,IDs).
  133
  134resolveConds([duplex(_,B1,_,B2)|C],Context,P,IDs):- !,
  135   resolveConds([imp(B1,B2)|C],Context,P,IDs).
  136
  137resolveConds([or(B1,B2)|C],C1,P1-P4,IDs):- !,
  138   resolvePDRS(B1,C1-_,P1-P2,IDs),
  139   resolvePDRS(B2,C1-_,P2-P3,IDs),
  140   resolveConds(C,C1,P3-P4,IDs).
  141
  142resolveConds([_|C],Context,P,IDs):- !,
  143   resolveConds(C,Context,P,IDs).
  144
  145
  146/* ========================================================================
  147   Identify Anaphoric Material (free pointers)
  148======================================================================== */
  149
  150%getAnaphora(_:drs([],_),_,_,A1-A4):-
  151%   member(_:_:_:[_|_],A1),
  152%   member(_:_:_:[],A1), !,
  153%   setof(I:K:B:[],member(I:K:B:[],A1),A2),
  154%   setof(I:K:B:[D|L],member(I:K:B:[D|L],A1),A3),
  155%   append(A2,A3,A4).
  156getAnaphora(_:drs([],_),_,_,A1-A2):- sort(A1,A2).
  157getAnaphora(K:drs([F:_:_|Dom],Con),Context,Presups,As):- K==F, !, getAnaphora(K:drs(Dom,Con),Context,Presups,As).
  158getAnaphora(K:drs([F:_:_|Dom],Con),Context,Presups,As):- member(C:_,Context), C==F, !, getAnaphora(K:drs(Dom,Con),Context,Presups,As).
  159getAnaphora(K:drs([F:_:_|Dom],Con),Context,Presups,As):- member(P:_,Presups), P==F, !, getAnaphora(K:drs(Dom,Con),Context,Presups,As).
  160getAnaphora(K:drs([F:I:R|Dom],Con),Context,Presups,A1-A2):-
  161   anaphoricSet(Dom,F,FDom,I1),
  162   anaphoricSet(Con,F,FCon,I2),
  163   dependencies(FCon,[F:I:R|FDom],[]-Dependencies),
  164   append(I1,I2,Is),
  165   getAnaphora(K:drs(Dom,Con),Context,[F:_|Presups],[Is:F:drs([F:I:R|FDom],FCon):Dependencies|A1]-A2). 
  166
  167
  168/* ========================================================================
  169   Check dependencies
  170======================================================================== */
  171
  172dependencies([],Dom,D1-D2):-
  173   checkDependencies(D1,Dom,D2).
  174
  175dependencies([_:_:rel(X,Y,_,_)|L],Dom,D1-D2):- !,
  176   dependencies(L,Dom,[X,Y|D1]-D2).
  177
  178dependencies([_:_:role(X,Y,_,_)|L],Dom,D1-D2):- !,
  179   dependencies(L,Dom,[X,Y|D1]-D2).
  180
  181dependencies([_:_:eq(X,Y,_,_)|L],Dom,D1-D2):- !,
  182   dependencies(L,Dom,[X,Y|D1]-D2).
  183
  184dependencies([_|L],Dom,D1-D2):-
  185   dependencies(L,Dom,D1-D2).
  186
  187
  188/* ========================================================================
  189   Find all dependencies (free variables bound outside the presupposition)
  190======================================================================== */
  191
  192checkDependencies([],_,[]).
  193
  194checkDependencies([X|L1],Dom,L2):-
  195   member(_:_:Y,Dom), X==Y, !,
  196   checkDependencies(L1,Dom,L2).
  197
  198checkDependencies([X|L1],Dom,[X|L2]):-
  199   checkDependencies(L1,Dom,L2).
  200
  201
  202/* ========================================================================
  203   Check for bound variable
  204======================================================================== */
  205
  206boundVar(X,Context):-
  207   member(P1:drs(Dom,_),Context),
  208   member(P2:_:Y,Dom),
  209   X==Y, P1==P2, !.
  210
  211
  212/* ========================================================================
  213   Compute Anaphoric Material
  214======================================================================== */
  215
  216anaphoricSet([],_,[],[]).
  217anaphoricSet([P:[]:E|L1],F,[P:[]:E|L2],I):- P==F, !, anaphoricSet(L1,F,L2,I).
  218anaphoricSet([P:[I|L]:E|L1],F,[P:[I|L]:E|L2],[I]):- P==F, !, anaphoricSet(L1,F,L2,_).
  219anaphoricSet([_|L1],F,L2,I):- anaphoricSet(L1,F,L2,I).
  220
  221
  222/* ========================================================================
  223   Projection -- try to bind, else accommodate
  224
  225   project(+List of presuppositions seen so far (could act as antecedents),
  226           +List of Context DRSs (Possible antecedents),
  227           +Anaphoric DRS,
  228           +Pair of Ingoing and Output List of Presuppositions
  229           +List of DRSs (local DRS + context DRS, to check for binding violations)
  230           +Dependencies (free variables in presupposition)
  231           -Accumulator of solution/4,
  232           -List of IDs to compute proximity)
  233======================================================================== */
  234
  235% Try to match presupposed DRS as antecedent if there are no dependencies.
  236% 
  237project([K1:drs([K0:_:X|D],C)|P],Cs,K2:B2,P1-P2,Bs,[],Solutions,IDs):-
  238   K1 == K0,                                  % Antecedent DRS from presuppositions
  239   match(K0,C,X,B2,IDs,Bs,Y,Score,Ant), !,    % Match antecedent with anaphoric DRS
  240   project([K1:drs(D,C)|P],Cs,K2:B2,P1-P2,Bs,[],[solution(Score,K1:X,K2:Y,Ant)|Solutions],IDs).
  241
  242% Found dependent variable in domain. Remove it from list.
  243%
  244project([K1:drs([_:_:X|D],C)|P],Cs,K2:B2,P1-P2,Bs,Deps1,Solutions,IDs):-
  245   select(Y,Deps1,Deps2), X == Y, !,
  246   project([K1:drs(D,C)|P],Cs,K2:B2,P1-P2,Bs,Deps2,Solutions,IDs).
  247
  248% All other cases.
  249%
  250project([K1:drs([_|D],C)|P],Cs,K2:B2,P1-P2,Bs,Dep,Solutions,IDs):- !,
  251   project([K1:drs(D,C)|P],Cs,K2:B2,P1-P2,Bs,Dep,Solutions,IDs).
  252
  253% Try next presupposed DRS
  254%
  255project([_|P],Cs,K,P1-P2,Bs,Dep,Solutions,IDs):- !,
  256   project(P,Cs,K,P1-P2,Bs,Dep,Solutions,IDs).
  257
  258% No presupposed DRSs anymore. Add free accommodation to solutions.
  259%
  260project([],Cs,K,Ps,Bs,[],Solutions,IDs):- !,
  261   project(Cs,K,Ps,Bs,[],[solution(8,_:_,_:_,free)|Solutions],IDs).
  262
  263% Continue with context-DRSs.
  264%
  265project([],Cs,K,Ps,Bs,Dep,Solutions,IDs):-
  266   project(Cs,K,Ps,Bs,Dep,Solutions,IDs).
  267
  268
  269% Match antecedent with anaphoric DRS (no dependent variables)
  270% 
  271project([K1:drs([K0:_:X|D],C)|Context],K2:B2,P1-P2,Bs,[],Solutions,IDs):-
  272   (K1==K0 ; member(K3:_,Context), K3==K0),
  273   match(K0,C,X,B2,IDs,Bs,Y,Score,Source), !,
  274   project([K1:drs(D,C)|Context],K2:B2,P1-P2,Bs,[],[solution(Score,K1:X,K2:Y,Source)|Solutions],IDs).
  275
  276% Found dependent variable in domain. Remove it from list.
  277%
  278project([K1:drs([_:_:X|D],C)|Context],K2:B2,P1-P2,Bs,Deps1,Solutions,IDs):-      
  279   select(Y,Deps1,Deps2), X == Y, !,
  280   project([K1:drs(D,C)|Context],K2:B2,P1-P2,Bs,Deps2,Solutions,IDs).
  281
  282% ALl other cases
  283%
  284project([K1:drs([_|D],C)|Context],A,P1-P2,Bs,Dep,Solutions,IDs):- !,
  285   project([K1:drs(D,C)|Context],A,P1-P2,Bs,Dep,Solutions,IDs).
  286
  287% Tried all discourse referents. Add local accommodation to solutions.
  288%
  289project([K1:drs([],_)|Context],K2:B2,P1-P2,Bs,[],Solutions,IDs):- !,
  290%  length(Context,Levels), Prob is 0.01/(Levels + 1), Score is 1-Prob,
  291   length(Context,Levels), Score is 9+Levels,
  292   project(Context,K2:B2,P1-P2,Bs,[],[solution(Score,K1:_,K2:_,local)|Solutions],IDs).
  293
  294% Try next context DRS (all other cases)
  295%
  296project([_|Context],A,P1-P2,Bs,Dep,Sol,IDs):- !,  % first argument can be an SDRS?
  297   project(Context,A,P1-P2,Bs,Dep,Sol,IDs).
  298
  299% All context DRSs (and presupposed DRSs) have been considered.
  300% Pick most likely solution (the one with the best score)
  301%
  302project([],B,P1-P2,Bs,[],Solutions,_):- !,
  303   sort(Solutions,Sorted),  
  304%  write(solutions:Sorted),nl,
  305   best(Sorted,Bs,B,P1-P2), !.                                
  306
  307%project([],B,Ps,Bs,[X|L],Solutions,IDs):-        
  308%   warning('dependent variable in project/6 not found: ~p',[X]), !,
  309%   project([],B,Ps,Bs,L,Solutions,IDs).
  310
  311
  312/* ========================================================================
  313   Best (sorted on score, the lower the better!)
  314======================================================================== */   
  315
  316best([Solution|_],Bs,ADRS,P-[ADRS|P]):-         % DRS with free pointer
  317   Solution = solution(_Score,_,_,free),        % hence add to list of presuppositions
  318   append(Bs,[ADRS|P],Context),
  319   boundVarCheckContext(Context,ADRS), !.
  320
  321best([Solution|_],Bs,ADRS,P-P):- 
  322   Solution = solution(_Score,X,Y,Reason),
  323   member(Reason,[local,global]),
  324   append(Bs,P,Context),
  325   \+ \+ (X=Y, boundVarCheckContext(Context,ADRS)), !, 
  326   X=Y.
  327
  328best([Solution|_],Bs,ADRS,P1-P2):- 
  329   Solution = solution(_Score,X,Y,Reason),
  330   \+ member(Reason,[local,global,free]),
  331   append(Bs,P1,Context),
  332   \+ \+ (X=Y,                                  % if unifying X with Y does not
  333          boundVarCheckContext(Context,ADRS),   % yield any free variables
  334          noBindingViolationDrs(Bs)), !,        % or binding violations
  335   X=Y,                                         % then do so
  336   updatePresups(P1,ADRS,P2).
  337
  338best([_|L],Bs,ADRS,P):- best(L,Bs,ADRS,P).
  339
  340
  341/* ========================================================================
  342   Update Presuppositions
  343======================================================================== */   
  344
  345updatePresups([],_,[]).
  346updatePresups([K:drs(D1,C1)|L],P:drs(D2,C2),[K:drs(D4,C4)|L]):- P==K, !, append(D1,D2,D3), removeDuplicates(D3,D4), append(C1,C2,C3), removeDuplicates(C3,C4).
  347updatePresups([B|L1],P,[B|L2]):- updatePresups(L1,P,L2).
  348
  349removeDuplicates([],[]).
  350removeDuplicates([X|L1],L2):- member(Y,L1), X==Y, !, removeDuplicates(L1,L2).
  351removeDuplicates([X|L1],[X|L2]):- removeDuplicates(L1,L2).
  352
  353
  354/* ========================================================================
  355   Check if there is gold standard data available
  356======================================================================== */   
  357
  358goldAntecedentIndex(Conds,AnaInd,AntInd):- 
  359   antecedent(AnaInd,AntInd),               % there is a gold antecedent
  360   member( _:AnaInd:_,Conds), !.            % for the current anaphoric expression
  361
  362
  363/* ========================================================================
  364   Match antecedent with presupposition
  365
  366   match(+Label of Antecedent DRS,
  367         +Conditions of Antecedent DRS,
  368         +Referent of Antecedent DRS,
  369         +Unlabeled Anaphoric DRS,
  370         +List of Token IDs,
  371         +List of Context DRSs
  372         -Referent of Anaphoric DRS,
  373         -Matching Score,
  374         -Matching Type)
  375
  376======================================================================== */   
  377
  378% There is a gold-standard antecedent available; take this as antecedent
  379%
  380match(K1,C1,X,drs([_:_:Y|_],C2),IDs,Bs,Y,0,bow):-
  381   goldAntecedentIndex(C2,I2,AntInd),           % check whether there is a gold label AntInd for one of the conditions of C1
  382   member(K2:I1:Ant,C1), K1==K2,                % get pointed condition with index I1 that belongs to antecedent DRS K1
  383   member(AntInd,I1),                           % this index I1 must contain the AntInd
  384   drsCondition(Z,Ant), Z==X, !,   
  385   refConditions(X,[K1:drs([],C1)|Bs],[]-XConds), 
  386   refConditions(Y,Bs,[]-YConds), 
  387   proximity(I1,I2,IDs,Prox,Pos),
  388   \+ \+ ( X=Y,numbervars(YConds,0,Co),
  389           numbervars(XConds,Co,_),
  390           gold('ana_ant(~q,~q,~p). % p(antecedent: ~p, anaphor: ~p, pos: ~q).',[YConds,XConds,Prox,I1,I2,Pos]) ).
  391
  392
  393% Old rule-based algorithm
  394%
  395% overall precision: 0.44 (2173/4848)
  396% overall recall: 0.44 (2173/4849)
  397
  398match(K1,C1,X,drs(_,C2),_IDs,_Bs,Y,NewScore,P):-
  399   member( _:_:Ana,C2),
  400   member(K2:_:Ant,C1),          K1==K2, 
  401   matching(Y^Ana,Z^Ant,Score,P), Z==X,
  402   noConflicts(Y,C2,X,C1), !,
  403   NewScore is 1-Score.              % inverse score for sorting purposes
  404
  405
  406% Experimental version of pronoun resolution
  407%
  408newmatch(K1,C1,X1,drs([_:_:Y1|_],C2),IDs,Bs,Y1,Score,ana):-
  409%  option('--x',nottrue),                  % set to 'nottrue' to skip this work-in-progress clause
  410   member( _:I2:Ana,C2), \+ I2=[],         % get anaphor condition 
  411   drsCondition(Y2,Ana), Y1==Y2,           % and proper DRS condition
  412%   member(Pro,[male,female]), Ana=pred(_,Pro,_,_),
  413   member(K2:I1:Ant,C1), K1==K2, \+ I1=[], % get antecedent condition
  414
  415%   sentence_position(I1,Sen1,_),
  416%   sentence_position(I2,Sen2,_),
  417%   SenDif is Sen2 - Sen1,  SenDif < 3,
  418
  419   drsCondition(X2,Ant), X1==X2,           % make sure it really is an antecedent condition
  420   refConditions(X1,Bs,[]-Conds), 
  421   compute_score(I1:Conds,I2:[Ana],IDs,Score),
  422   noConflicts(Y1,C2,X1,C1), !.
  423
  424
  425/* ========================================================================
  426   Get Part-of-Speech given an index
  427======================================================================== */   
  428
  429index2pos([I],L,P):- member(I:P,L), !.
  430index2pos([_,J|R],L,P):- index2pos([J|R],L,P).
  431
  432
  433/* ========================================================================
  434   Compute Score of Antecedent Candidate
  435======================================================================== */   
  436
  437compute_score(I1:Ant,I2:Ana,IDs,Score):-
  438   index2pos(I1,IDs,POS),
  439   sentence_position(I1,Sen1,AntPos),
  440   sentence_position(I2,Sen2,AnaPos),
  441   ( Sen1=Sen2, AntPos < AnaPos; \+ Sen1=Sen2 ),
  442   extractFeaturesAna(Ana,[FAna|_]),
  443   extractFeaturesAnt(Ant,FAnt),
  444   %
  445   % Feature 1: Probability in sentence -N given token position pronoun
  446   %
  447   SenDif is Sen1-Sen2,
  448   same_sentence(FAna,AnaPos,SenDif,Prob1),
  449   %
  450   % Feature 2
  451   %
  452%   sentence_position_ant(AntPos,Prob2),
  453   %
  454   % Feature 3: Probability Part-of-Speech X of antecedent
  455   %
  456   pos_ant(POS,Prob3),
  457   %
  458   % Feature 4
  459   %
  460   material_in_common(Ant,Ana,Prob4),
  461   %
  462   % Feature 5
  463   %
  464   member(sort:Sort,FAnt), ana_ant_sort(FAna,Sort,Prob5),
  465   \+ (member(sort:Sort1,FAnt), ana_ant_sort(FAna,Sort1,Prob51), Prob51 < Prob5),
  466   %
  467   % Feature 6
  468   %
  469   member(symb:Symb,FAnt), 
  470   ana_ant_symb(FAna,Symb,Prob6),
  471   \+ (member(symb:Symb1,FAnt), ana_ant_symb(FAna,Symb1,Prob61), Prob61 < Prob6),
  472%  write(ana_ant_symb(FAna,Symb,Prob6)),nl,
  473   %
  474   % Combine Features
  475   %
  476%    Score is Prob1+Prob4. % 0.38 (1876/4826)
  477%    Score is Prob1+Prob3+Prob4. % 0.46 (2244/4826)
  478%    Score is Prob1+Prob4+Prob5. % 0.58 (2384/4827)
  479    Score is Prob1+Prob3+Prob4+Prob5. % 0.59 (2956/4946)
  480%    Score is Prob1+Prob3+Prob4. % 0.40 (2003/4957)
  481%    Score is Prob1+Prob3+Prob5+Prob6.  % 0.59
  482
  483
  484
  485
  486/* ========================================================================
  487   Check whether anaphor and antecedent have material in common
  488======================================================================== */   
  489
  490material_in_common(_  ,Ana,0):- member(Pro,[female,male,thing]), member(pred(_,Pro,n,_),Ana), !.
  491%material_in_common(Ant,Ana,0):- \+ \+ (member(Same,Ant), member(Same,Ana)), !.
  492material_in_common(Ant,Ana,0):- member(pred(_,Symb,Sort,_),Ant), member(pred(_,Symb,Sort,_),Ana), !.
  493material_in_common(Ant,Ana,1):- member(pred(_,Symb,_,_),Ant), member(pred(_,Symb,_,_),Ana), !.
  494material_in_common(Ant,Ana,0):- member(named(_,Same,Sort,_),Ant), member(named(_,Same,Sort,_),Ana), !.
  495material_in_common(Ant,Ana,1):- member(named(_,Same,_,_),Ant), member(named(_,Same,_,_),Ana), !.
  496material_in_common(_  ,_  ,10).
  497
  498
  499/* ========================================================================
  500   Calculate Proximity
  501======================================================================== */   
  502
  503proximity([_,Y|L1],L2,IDs,P,Pos):- !, proximity([Y|L1],L2,IDs,P,Pos).
  504proximity([X],[_,Z|L],IDs,P,Pos):- !, proximity([X],[Z|L],IDs,P,Pos).
  505proximity([X],[Y],IDs,P,Pos):- number(X), number(Y), X<Y, from(IDs,X,Y,P), member(X:Pos,IDs), !.
  506proximity(_  ,_  ,_  ,0,'UNK').
  507
  508from([],_,_,0).
  509from([X:_|L],X,Y,D):- !, to(L,Y,0,D).
  510from([_|L],X,Y,D):- from(L,X,Y,D).
  511
  512to([X:_|_],X,D1,D2):- !, D2 is D1 + 1.
  513to([_|L],X,D1,D2):- D is D1 + 1, to(L,X,D,D2).
  514
  515sentence_position([X|_],Zin,Pos):-
  516   number(X),
  517   Pos is mod(X,1000),
  518   Zin is (X-Pos)/1000, !.
  519
  520
  521/* ========================================================================
  522   Get conditions for a specific discourse referent
  523======================================================================== */   
  524
  525refConditions(X,[K:drs(D,C1)|L],L1-L2):-
  526   select(_:_:C,C1,C2), 
  527   member(C,[pred(Z,_,_,_),named(Z,_,_,_),role(_,Z,_,1),role(Z,_,_,-1)]), Z==X, !,
  528   refConditions(X,[K:drs(D,C2)|L],[C|L1]-L2).
  529
  530refConditions(X,[K:drs(D,C1)|L],L1-L3):-
  531   select(_:_:eq(Z,Y),C1,C2), Z==X, !,
  532   refConditions(X,[K:drs(D,C2)|L],L1-L2),
  533   refConditions(Y,[K:drs(D,C2)|L],L2-L3).
  534
  535refConditions(X,[_|L],L1-L2):- !, refConditions(X,L,L1-L2).
  536    
  537refConditions(_,[],L-L):- \+ L = [].
  538
  539
  540/* ========================================================================
  541   Check for Conflicts
  542======================================================================== */   
  543
  544noConflicts(X,AnaConds,Y,AntConds):-                    
  545    \+ \+ ( X=Y,                                           % resolving must
  546            \+ ( member(_:_:not(_:drs(_,C0)),AntConds),    % not result in X=X
  547                 member(_:_:eq(A,B),C0),                   % in a negated DRS
  548                 A==X, B==X ),                             % and
  549            \+ ( member(_:_:pred(A,male,_,_),AnaConds),    % not result in
  550                 member(_:_:pred(B,female,_,_),AntConds),  % hermaphrodites
  551                 A==X, B==X ),                             
  552            \+ ( member(_:_:pred(A,female,_,_),AnaConds),
  553                 member(_:_:pred(B,male,_,_),AntConds),
  554                 A==X, B==X ) ).
  555
  556
  557/* ========================================================================
  558   Matching (anaphor, antecedent)
  559======================================================================== */   
  560
  561% amr matching
  562matching(Y^pred(Y,i,n,1),  Z^pred(Z,i,n,1),  1.0,n:i  ):-    option('--semantics',amr).
  563matching(Y^pred(Y,you,n,1),Z^pred(Z,you,n,1),1.0,n:you):-    option('--semantics',amr).
  564matching(Y^pred(Y,he,n,1), Z^pred(Z,he,n,1), 1.0,n:he):-     option('--semantics',amr).
  565matching(Y^pred(Y,she,n,1),Z^pred(Z,she,n,1),1.0,n:she):-    option('--semantics',amr).
  566matching(Y^pred(Y,it,n,1),Z^pred(Z,it,n,1),1.0,n:she):-      option('--semantics',amr).
  567matching(Y^pred(Y,we,n,1),Z^pred(Z,we,n,1),1.0,n:she):-      option('--semantics',amr).
  568matching(Y^pred(Y,they,n,1),Z^pred(Z,they,n,1),1.0,n:she):-  option('--semantics',amr).
  569
  570% time
  571matching(Y^pred(Y,now,a,1),Z^pred(Z,now,a,1),0.99,a:now).
  572
  573% he
  574matching(Y^pred(Y,male,n,2),Z^named(Z,S,per,_),0.9,per:S).
  575matching(Y^pred(Y,male,n,2),Z^named(Z,S,_,_),0.1,per:S).
  576matching(Y^pred(Y,male,n,2),Z^pred(Z,male,n,2),0.99,n:male).
  577matching(Y^pred(Y,male,n,2),Z^pred(Z,S,n,_),0.5,n:S).
  578matching(Y^pred(Y,male,n,2),Z^card(Z,_,_),0.1,card).
  579
  580% she
  581matching(Y^pred(Y,female,n,2),Z^named(Z,S,per,_),0.9,per:S).
  582matching(Y^pred(Y,female,n,2),Z^named(Z,S,_,_),0.1,per:S).
  583matching(Y^pred(Y,female,n,2),Z^pred(Z,female,n,2),0.99,n:female).
  584matching(Y^pred(Y,female,n,2),Z^pred(Z,S,n,_),0.5,n:S).
  585matching(Y^pred(Y,female,n,2),Z^card(Z,_,_),0.1,card).
  586
  587% it
  588matching(Y^pred(Y,neuter,a,_),Z^named(Z,S,per,_),0.1,per:S).
  589matching(Y^pred(Y,neuter,a,_),Z^named(Z,S,_,_),0.8,per:S).
  590matching(Y^pred(Y,neuter,a,_),Z^pred(Z,neuter,a,_),0.99,a:neuter).
  591matching(Y^pred(Y,neuter,a,_),Z^pred(Z,S,n,_),0.5,n:S).
  592
  593% they, them, theirs, this, that, those, these
  594matching(Y^pred(Y,thing,n,12),Z^pred(Z,S,n,_),0.5,n:S):-    \+ option('--semantics',amr).
  595matching(Y^pred(Y,thing,n,12),Z^named(Z,S,_,_),0.1,per:S):- \+ option('--semantics',amr).
  596
  597% I, me, mine, you, yours, we, us, ours, myself, yourself, ourselves
  598matching(Y^pred(Y,person,n,1),Z^pred(Z,S,n,_),0.1,n:S):-      \+ option('--semantics',amr).
  599matching(Y^pred(Y,person,n,1),Z^named(Z,S,per,_),0.8,per:S):- \+ option('--semantics',amr).
  600matching(Y^pred(Y,person,n,1),Z^named(Z,S,_,_),0.5,per:S):-   \+ option('--semantics',amr).
  601
  602% the
  603matching(Y^pred(Y,S,n,_),Z^pred(Z,S,n,_),0.9,n:S):- \+ option('--semantics',amr).
  604
  605% names
  606matching(Y^named(Y,S,T,_),Z^named(Z,S,T,_),0.9,per:S):- \+ option('--semantics',amr).
  607matching(Y^named(Y,S,_,_),Z^named(Z,S,_,_),0.7,per:S):- \+ option('--semantics',amr).
  608
  609% timex
  610matching(Y^timex(Y,date(_:D1,_:D2,_:D3,_:D4)),Z^timex(Z,date(_:D1,_:D2,_:D3,_:D4)),0.9,timex):- \+ option('--semantics',amr)