1% This file is part of the Attempto Parsing Engine (APE).
    2% Copyright 2008-2013, Attempto Group, University of Zurich (see http://attempto.ifi.uzh.ch).
    3%
    4% The Attempto Parsing Engine (APE) is free software: you can redistribute it and/or modify it
    5% under the terms of the GNU Lesser General Public License as published by the Free Software
    6% Foundation, either version 3 of the License, or (at your option) any later version.
    7%
    8% The Attempto Parsing Engine (APE) is distributed in the hope that it will be useful, but WITHOUT
    9% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
   10% PURPOSE. See the GNU Lesser General Public License for more details.
   11%
   12% You should have received a copy of the GNU Lesser General Public License along with the Attempto
   13% Parsing Engine (APE). If not, see http://www.gnu.org/licenses/.
   14
   15
   16%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
   17%
   18%  Resolution of anaphors in discourse representation structures
   19%
   20%  N. E. Fuchs, IFI University of Zurich
   21%
   22%  May 31, 2005
   23%
   24%  Version 110724
   25%
   26%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
   27%
   28%  Resolution of Anaphors
   29%
   30%    Resolution is governed by accessibility, closest textual precedence, specificity, and reflexivity.
   31%
   32%    Accessibility rules: a discourse referent is accessible from a DRS D if the discourse referent is in D, in a DRS enclosing D, in the antecedent of an 
   33%    ifthen-DRS with D as consequent, or in a disjunct that precedes D in an or-DRS. 
   34%
   35%    If the anaphor is a non-reflexive personal pronoun or a non-reflexive possessive pronoun the resolution algorithm picks the closest preceding accessible 
   36%    noun phrase that agrees in genus, numerus and person with the anaphor, and that is not the subject of the sentence. If resolution fails, an error situation 
   37%    arises.
   38%
   39%    Reflexive personal and possessive pronouns are resolved by APE that picks the subject of the sentence in which the pronoun occurs if the subject agrees in 
   40%    genus, numerus and person with the anaphor. If resolution fails, APE generates an error message.
   41%
   42%    If the anaphor is a definite noun phrase the resolution algorithm picks the closest preceding accessible noun phrase with matching genus and person and matching 
   43%    numerus - where a singular anaphor matches a singular countable or a mass antecedent, and a plual anaphor matches a plural countable antecedent. Either all 
   44%    anaphor conditions are a subset of the antecedent conditions, or a part of the anaphor conditions including the condition of the main noun is a subset of 
   45%    the  antecedent conditions, while the remaining anaphor conditions match conditions found in the DRS. Complex conditions of the anaphor that lead to sub-DRSs 
   46%    have to exactly unify with respective sub-DRSs in the antecedent. If resolution fails, the anaphor is treated as a new indefinite noun phrase, and a warning 
   47%    is generated.
   48%
   49%    If the anaphor is a variable the resolution algorithm picks the closest preceding accessible identical bare variable, or the closest preceding accessible 
   50%    noun phrase that has the variable as opposition. If variables are redefined in the same accsibility range, or if resolution fails, an error situation arises.
   51%
   52%    Proper nouns are unique and accessible from everywhere.
   53%
   54%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
   55
   56%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
   57%
   58%  Representation of Antecedents and Anaphors
   59%
   60%    A proper name is represented in the DRS by the single condition
   61%
   62%    anaphor(Anaphortype, AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, SentenceID, TokenID, Tokens, SentenceSubject)
   63%
   64%    where
   65%
   66%    - Anaphortype is proper_name
   67%    - AnaphorID is the number of the noun phrase
   68%    - AnaphorReferent is named(proper name)
   69%    - AnaphorConditions is []
   70%    - AnaphorGenus is one of masc, fem, human, neutr, encoded in a way that supports the gender hierarchy
   71%    - AnaphorNumerus is one of sg, pl, mass, encoded in a way that supports the number hierarchy
   72%    - AnaphorPerson is one of second, third
   73%    - SentenceID is the number of the sentence in which the anaphor occurs
   74%    - TokenID is the number of the first token of the anaphor
   75%    - Tokens is the proper name without a possibly occurring definite determiner
   76%    - SentenceSubject is ''
   77%
   78%
   79%    An indefinite noun phrase is represented in the DRS by its DRS conditions plus one additional condition
   80%
   81%    antecedent(AntecedentID, AntecedentReferent, AntecedentConditions, AntecedentGenus, AntecedentNumerus, AntecedentPerson, AntecedentSID, AntecedentTID, AntecedentTokens)
   82%
   83%    if the indefinite noun phase has an attached variable then follows a further condition 
   84%
   85%    antecedent(AntecedentIDV, AntecedentReferent, AntecedentConditionsV, AntecedentGenus, AntecedentNumerus, AntecedentPerson, AntecedentSID, AntecedentTID, AntecedentTokensV]
   86%
   87%    where
   88%
   89%    - AntecedentID is the number of the noun phrase
   90%    - AntecedentIDV is AntecedentID + 1
   91%    - AntecedentReferent is the main discourse referent of the noun phrase
   92%    - AntecedentConditions is the list of the conditions that the noun phrase contributes to the DRS; minus any conditions that 
   93%      refer to anaphors (e.g. as in 'a man who sees himself' where 'himself' is represented by a separate anaphor/10 condition)
   94%    - AntecedentConditionsV contains just the condition for the variable
   95%    - AntecedentGenus is one of masc, fem, human, neutr, encoded in a way that supports the gender hierarchy
   96%    - AntecedentNumerus is one of sg, pl, mass, encoded in a way that supports the number hierarchy
   97%    - AntecedentPerson is one of second, third
   98%    - AntecedentSID is the number of the sentence in which the antecedent occurs
   99%    - AntecedentTID is the number of the first token of the antecedent
  100%    - AntecedentTokens is the noun of the main condition of the antecedent 
  101%    - AntecedentTokensV is the name of the variable
  102%
  103%
  104%    Indefinite pronouns - 'someone', 'somebody', 'something' and their negated and universal forms - are treated like an indefinite noun phrase.
  105%
  106%
  107%    A definite noun phrase is represented in the DRS by the single condition
  108%
  109%    anaphor(Anaphortype, AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens, SentenceSubject)
  110%
  111%    if the indefinite noun phase has an attached variable then follows a further condition 
  112%
  113%    antecedent(AntecedentIDV, AntecedentReferent, AntecedentConditionsV, AntecedentGenus, AntecedentNumerus, AntecedentPerson, AntecedentSID, AntecedentTID, AntecedentTokens]
  114%
  115%    where
  116%
  117%    - Anaphortype is definite_noun_phrase
  118%    - AnaphorID is the number of the noun phrase
  119%    - AntecedentIDV is AnaphorID + 1
  120%    - AnaphorReferent is the main discourse referent of the noun phrase
  121%    - AnaphorConditions is the list of the conditions that the noun phrase contributes to the DRS; minus any conditions that 
  122%      refer to other anaphors (e.g. as in 'a man who sees himself/the dog' where 'himself/the dog' is represented by a separate anaphor/10
  123%      condition)
  124%    - AntecedentConditionsV contains just the condition for the variable
  125%    - AnaphorGenus is one of masc, fem, human, neutr, encoded in a way that supports the gender hierarchy
  126%    - AnaphorNumerus is one of sg, pl, mass, encoded in a way that supports the number hierarchy
  127%    - AnaphorPerson is one of second, third
  128%    - AnaphorSID is the number of the sentence in which the anaphor occurs
  129%    - AnaphorTID is the number of the first token of the anaphor
  130%    - AnaphorTokens is the noun of the main condition of the anaphor 
  131%    - AntecedentTokensV is the name of the variable
  132%    - SentenceSubject is ''
  133%
  134%
  135%    A nonreflexive personal or possessive pronoun is represented in the DRS by the single condition
  136%
  137%    anaphor(Anaphortype, AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens, SentenceSubject)
  138%
  139%    where
  140%
  141%    - Anaphortype is nonreflexive_pronoun
  142%    - AnaphorID is the number of the noun phrase
  143%    - AnaphorReferent is the main discourse referent of the noun phrase
  144%    - AnaphorConditions is the list of the conditions that the noun phrase would contribute to the DRS; for pronouns AnaphorConditions is empty; for
  145%      variables there is the single condition variable/2
  146%    - AnaphorGenus is one of masc, fem, human, neutr, encoded in a way that supports the gender hierarchy
  147%    - AnaphorNumerus is one of sg, pl, mass, encoded in a way that supports the number hierarchy
  148%    - AnaphorPerson is one of second, third
  149%    - AnaphorSID is the number of the sentence in which the anaphor occurs
  150%    - AnaphorTID is the number of the first token of the anaphor
  151%    - AnaphorTokens is the text token of the anaphor 
  152%    - SentenceSubject is "subj(discourse referent of the subject of the sentence)", or "nosubj" if there is no subject
  153%
  154%
  155%    A bare variable is represented in the DRS by the single condition
  156%
  157%    anaphor(Anaphortype, AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens, SentenceSubject)
  158%
  159%    where
  160%
  161%    - Anaphortype is one of nonreflexive_pronoun, reflexive_pronoun, variable
  162%    - AnaphorID is the number of the noun phrase
  163%    - AnaphorReferent is the main discourse referent of the noun phrase
  164%    - AnaphorConditions is the list of the conditions that the noun phrase would contribute to the DRS; for pronouns AnaphorConditions is empty; for
  165%      variables there is the single condition variable/2
  166%    - AnaphorGenus is one of masc, fem, human, neutr, encoded in a way that supports the gender hierarchy
  167%    - AnaphorNumerus is one of sg, pl, mass, encoded in a way that supports the number hierarchy
  168%    - AnaphorPerson is one of second, third
  169%    - AnaphorSID is the number of the sentence in which the anaphor occurs
  170%    - AnaphorTID is the number of the first token of the anaphor
  171%    - AnaphorTokens is the text token of the anaphor 
  172%    - SentenceSubject is ''
  173%
  174%
  175%    Essential assumptions
  176%
  177%    - noun phrases are numbered by AntecedentID and AnaphorID in textual order
  178%    - textual order of antecedents and anaphors is preserved in DRS processed by refres
  179%
  180%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  181
  182%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  183%
  184%  declarations
  185%
  186%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  187
  188:- module(refres, [resolve_anaphors/2]).  189
  190%%%:- check.
  191
  192:- dynamic(variable_defined/3).  193
  194:- dynamic(nesting_level/1).  195
  196:- op( 400,  xfx, :).           % label
  197:- op( 400,  fy, -).            % negation
  198:- op( 400,  fy, ~).            % negation as failure
  199:- op( 600, xfy, v).            % disjunction
  200:- op( 650, xfy, =>).           % implication 
  201
  202:- use_module('../logger/error_logger', [add_error_message_once/4, add_warning_message_once/4]).  203:- use_module('../lexicon/lexicon_interface', [noun_pl/3]).  204
  205%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  206%
  207%  resolve_anaphors(+DRSIn, -DRSOut)
  208%
  209%    - resolve_anaphors/3 resolves all anaphors of DRSIn against antecedents within DRSIn
  210%
  211%    - DRSIn contains additional conditions for antecedents (antecedent/8) and for anaphors (anaphor/10)
  212%    - DRSOut is DRSIn 
  213%			without the conditions antecedent/8 and anaphor/10,
  214%			without the conditions variable/2,
  215%      		with resolved anaphors
  216%	 - if refres generates error messages then DRSOut should be discarded since it is possibly corrupted
  217%
  218%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  219
  220resolve_anaphors(drs(ReferentsIn, ConditionsIn), DRSOut) :-
  221  catch(call(resolve_anaphors1(drs(ReferentsIn, ConditionsIn), DRSOut)), CatchType, add_error_message_once(anaphor, '', CatchType, 'Send screenshot to APE developers.')).
  222
  223resolve_anaphors1(drs(ReferentsIn, ConditionsIn), drs(ReferentsOut, ConditionsOut)) :-
  224  initialise_DRS_nesting_level,
  225  % enforce ordering of this DRS nesting level
  226  enforce_order(ConditionsIn, ConditionsInUpdated, [], ConditionsAllOut, [], AntecedentsIn),
  227  % match anaphors to antecedents, and collect all proper names
  228  resolve_all_anaphors(drs(ReferentsIn, ConditionsInUpdated), ConditionsAllOut, AntecedentsIn, _AntecedentsOut, [], _ProperNamesOut, drs(ReferentsOut, ConditionsIntermediate)),
  229  % remove duplicate conditions that are artefacts of anaphors like in "There is a man. The cat of the man sleeps." 
  230  % where "the cat of the man" cannot be resolved, and thus leaves two conditions for "man"
  231  filter_conditions(ConditionsIntermediate, ConditionsOut),
  232  % clean up for next run
  233  cleanup.
  234
  235  
  236%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  237%
  238%  resolve_all_anaphors(+DRSIn, ConditionsAll, +AntecedentsIn, -AntecedentsOut, +ProperNamesIn, -ProperNamesOut, -DRSOut)
  239%
  240%    - resolve_all_anaphors/7 processes all conditions of DRSIn in depth-first order, and identifies them as antecedents, anaphors, complex conditions, or simple 
  241%      conditions. Antecedents are collected in AntecedentsIn, anaphors are resolved in textual order calling resolve_one_anaphor/9, complex conditions lead to  
  242%      recursive calls of resolve_all_anaphors/7 taking into account the nesting of DRSs (respectively the accessibility of referents), while simple conditions ?   
  243%      with the exception  of variable/2 ? are just copied to DRSOut.
  244%
  245%    - DRSIn contains additional conditions for antecedents (antecedent/8) and for anaphors (anaphor/10)
  246%    - DRSOut is DRSIn without the additional conditions and without the conditions variable/2
  247%    - ConditionsAll contains all conditions of the current DRS nesting level; used in resolve_one_anaphor/9 to resolve pronouns
  248%    - AntecedentsIn/AntecedentsOut is a threaded pair of lists of antecedents
  249%    - ProperNamesIn/ProperNamesOut is a threaded pair of lists of proper names
  250%
  251%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  252
  253resolve_all_anaphors(drs(Referents, []), _ConditionsAllIn, AntecedentsIn, AntecedentsOut, ProperNames, ProperNames, drs(Referents, [])) :-
  254  !,
  255  (
  256    var(AntecedentsOut)
  257    ->
  258    AntecedentsOut = AntecedentsIn
  259  ;
  260    true
  261  ).
  262
  263resolve_all_anaphors(drs(ReferentsIn, [Condition|Conditions]), ConditionsAllIn, AntecedentsIn, AntecedentsOut, ProperNamesIn, ProperNamesOut, DRSOut) :-
  264  (
  265    % simple conditions _-_  with the exception of variable(_, _)-_ are just copied
  266    Condition = _-_
  267    ->
  268    (
  269      Condition = variable(_, _)-_
  270      ->
  271      % variables are checked for redefinition
  272      define_new_variable(Condition, apposition), 
  273      DRSOut = drs(ReferentsOut, ConditionsOut)
  274    ;
  275      DRSOut = drs(ReferentsOut, [Condition|ConditionsOut])
  276    ),
  277    resolve_all_anaphors(drs(ReferentsIn, Conditions), ConditionsAllIn, AntecedentsIn, AntecedentsOut, ProperNamesIn, ProperNamesOut, drs(ReferentsOut, ConditionsOut))
  278  ;
  279    % antecedent
  280    Condition = antecedent(_, _, _, _, _, _, _, _, _)
  281    ->
  282    % add antecedent in correct order
  283    insert_antecedent(Condition, AntecedentsIn, AntecedentsIM),
  284    % continue loop
  285    resolve_all_anaphors(drs(ReferentsIn, Conditions), ConditionsAllIn, AntecedentsIM, AntecedentsOut, ProperNamesIn, ProperNamesOut, DRSOut)
  286  ;
  287    % anaphoric reference
  288    Condition = anaphor(_, AnaphorID1, _, _, _, _, _, _, _, _, _)
  289    ->
  290    (
  291      % Conditions contains an anaphor with smaller ID
  292      append(Front, [anaphor(Anaphortype2, AnaphorID2, AnaphorReferent2, AnaphorConditions2, AnaphorGenus2, AnaphorNumerus2, AnaphorPerson2, SentenceID2, TokenID2, Tokens2, Subject2)|Rest], Conditions),
  293      AnaphorID2 < AnaphorID1
  294      ->
  295      % permute anaphors
  296      append(Front,[anaphor(Anaphortype2, AnaphorID2, AnaphorReferent2, AnaphorConditions2, AnaphorGenus2, AnaphorNumerus2, AnaphorPerson2, SentenceID2, TokenID2, Tokens2, Subject2), Condition|Rest], PermutedConditions),
  297      resolve_all_anaphors(drs(ReferentsIn, PermutedConditions), ConditionsAllIn, AntecedentsIn, AntecedentsOut, ProperNamesIn, ProperNamesOut, DRSOut)
  298    ;
  299      % anaphor is in textual order
  300      resolve_one_anaphor(drs(ReferentsIn, Conditions), ConditionsAllIn, ConditionsAllOut, Condition, AntecedentsIn, AntecedentsIntermediate, ProperNamesIn, ProperNamesIM, drs(ReferentsIM, ConditionsIM)),     
  301      % continue loop
  302      resolve_all_anaphors(drs(ReferentsIM, ConditionsIM), ConditionsAllOut, AntecedentsIntermediate, AntecedentsOut, ProperNamesIM, ProperNamesOut, DRSOut)
  303    )
  304  ;
  305    % nested list
  306    is_list(Condition)
  307    ->
  308    DRSOut = drs(ReferentsOut, [ConditionListOut|ConditionsOut]),
  309    resolve_all_anaphors(drs(ReferentsIn, Condition), ConditionsAllIn, AntecedentsIn, AntecedentsTemp, ProperNamesIn, ProperNamesTemp, drs(ReferentsTemp, ConditionListOut)),
  310    resolve_all_anaphors(drs(ReferentsTemp, Conditions), ConditionsAllIn, AntecedentsTemp, AntecedentsOut, ProperNamesTemp, ProperNamesOut, drs(ReferentsOut, ConditionsOut))
  311  ;
  312    % embedded DRSs 
  313    (
  314      % negation
  315      Condition = - drs(ReferentsNIn, ConditionsNIn)
  316    ;
  317      % negation as failure
  318      Condition = ~ drs(ReferentsNIn, ConditionsNIn)
  319    ;
  320      % possibility
  321      Condition = can(drs(ReferentsNIn, ConditionsNIn))
  322    ;
  323      % necessity
  324      Condition = must(drs(ReferentsNIn, ConditionsNIn))
  325    ;
  326      % recommendation
  327      Condition = should(drs(ReferentsNIn, ConditionsNIn))
  328    ;
  329      % admissibility
  330      Condition = may(drs(ReferentsNIn, ConditionsNIn))
  331    ;
  332      % single question
  333      Condition = question(drs(ReferentsNIn, ConditionsNIn))
  334    ;
  335      % single command
  336      Condition = command(drs(ReferentsNIn, ConditionsNIn))
  337    ;
  338      % sentence subordination
  339      Condition = _ : drs(ReferentsNIn, ConditionsNIn)
  340    )
  341    ->
  342    functor(Condition, Operator, _),
  343    arg(1, Condition, Label),
  344    increase_DRS_nesting_level,
  345    % enforce ordering of this DRS nesting level
  346    enforce_order(ConditionsNIn, ConditionsNInUpdated, ConditionsAllIn, ConditionsAllOut, AntecedentsIn, AntecedentsInUpdated),
  347    % resolve anaphors on the current DRS nesting level; do not export any antecedents
  348    resolve_all_anaphors(drs(ReferentsNIn, ConditionsNInUpdated), ConditionsAllOut, AntecedentsInUpdated, AntecedentsInUpdated, ProperNamesIn, ProperNamesIM, drs(ReferentsIntermediate, ConditionsIntermediate1)),
  349    % continue on the previous DRS nesting level with ConditionsAllIn and with AntecedentsIn extended by antecedents for proper names found on this level
  350    decrease_DRS_nesting_level,
  351    add_proper_name_antecedents(ProperNamesIn, ProperNamesIM, AntecedentsIn, AntecedentsInPlusProperNames),
  352    resolve_all_anaphors(drs(ReferentsIn, Conditions), ConditionsAllIn, AntecedentsInPlusProperNames, AntecedentsOut, ProperNamesIM, ProperNamesOut, drs(ReferentsOut, ConditionsOut)),
  353    % remove duplicate conditions that are artefacts of anaphors like "the cat of the man" that could not be resolved
  354    % and thus could leave two conditions for "man"
  355    filter_conditions(ConditionsIntermediate1, ConditionsIntermediate2),
  356    % build DRSOut
  357    build_drs(Operator, Label, drs(ReferentsIntermediate, ConditionsIntermediate2), NewDRS),
  358    DRSOut = drs(ReferentsOut, [NewDRS|ConditionsOut])
  359  ;
  360    % embedded DRSs: implication
  361    Condition = drs(Referents1In, Conditions1In) => drs(Referents2In, Conditions2In)
  362    ->
  363    increase_DRS_nesting_level,
  364    % enforce ordering and resolve anaphors on the current DRS nesting level
  365    enforce_order(Conditions1In, Conditions1InUpdated, ConditionsAllIn, ConditionsAllIM1, AntecedentsIn, AntecedentsIM1),
  366    % to resolve the anaphora in the precondition the conditions of the consequence may be needed (example: A clerk enters every card of himself. )
  367    append(ConditionsAllIM1, Conditions2In, ConditionsAllPlusConsequence),
  368    resolve_all_anaphors(drs(Referents1In, Conditions1InUpdated), ConditionsAllPlusConsequence, AntecedentsIM1, AntecedentsIM2, ProperNamesIn, ProperNamesIM1, drs(Referents1Out, Conditions1Intermediate)), 
  369    enforce_order(Conditions2In, Conditions2InUpdated, ConditionsAllIM1, ConditionsAllIM2, AntecedentsIM2, AntecedentsIM3),
  370    resolve_all_anaphors(drs(Referents2In, Conditions2InUpdated), ConditionsAllIM2, AntecedentsIM3, _AntecedentsOut, ProperNamesIM1, ProperNamesIM2, drs(Referents2Out, Conditions2Intermediate1)),
  371    % continue on the previous DRS nesting level with ConditionsAllIn and with AntecedentsIn extended by antecedents for proper names found on this level
  372    decrease_DRS_nesting_level,
  373    add_proper_name_antecedents(ProperNamesIn, ProperNamesIM2, AntecedentsIn, AntecedentsInPlusProperNames),
  374    resolve_all_anaphors(drs(ReferentsIn, Conditions), ConditionsAllIn, AntecedentsInPlusProperNames, AntecedentsOut, ProperNamesIM2, ProperNamesOut, drs(ReferentsOut, ConditionsOut)),
  375    % remove duplicate conditions that are artefacts of anaphors like "the cat of the man" that could not be resolved
  376    % and thus could leave two conditions for "man"
  377    filter_conditions(Conditions1Intermediate, Conditions1Out),
  378    filter_conditions(Conditions2Intermediate1, Conditions2Intermediate2),
  379    % remove from the consequence of the implication any conditions that already occur in the precondition - with the exception of formulas
  380    subtract_conditions(Conditions2Intermediate2, Conditions1Out, Conditions2Out),
  381    % build DRSOut
  382    DRSOut = drs(ReferentsOut, [drs(Referents1Out, Conditions1Out) => drs(Referents2Out, Conditions2Out)|ConditionsOut])    
  383  ;
  384    % embedded DRSs: disjunction
  385    % 'v' is interpreted as a right-associative binary operator
  386    % for instance, a disjunction of three disjuncts is represented as D1 v drs([], [D2 v D3]) where each disjunct D is a DRS
  387    Condition = drs(Referents1In, Conditions1In) v DisjunctRestIn
  388    ->
  389    increase_DRS_nesting_level,
  390    % enforce ordering for first disjunct
  391    enforce_order(Conditions1In, Conditions1InUpdated, ConditionsAllIn, ConditionsAllIM, AntecedentsIn, AntecedentsInUpdated),
  392    % resolve anaphors of first disjunct
  393    resolve_all_anaphors(drs(Referents1In, Conditions1InUpdated), ConditionsAllIM, AntecedentsInUpdated, AntecedentsIM, ProperNamesIn, ProperNamesIM1, drs(Referents1Out, Conditions1Intermediate)),
  394    % process rest of disjuncts
  395    DisjunctRestIn = drs(_ReferentsDisjunctRestIn, ConditionsDisjunctRestIn),
  396    enforce_order(ConditionsDisjunctRestIn, _ConditionsDisjunctRestInUpdated, ConditionsAllIM, ConditionsAllOut, AntecedentsIM, AntecedentsIMUpdated),
  397    resolve_all_anaphors(DisjunctRestIn, ConditionsAllOut, AntecedentsIMUpdated, _AntecedentsOut, ProperNamesIM1, ProperNamesIM2, drs(ReferentsRestOut, ConditionsRestIntermediate)),
  398    % continue on the previous DRS nesting level with ConditionsAllIn and with AntecedentsIn extended by antecedents for proper names found on this level
  399    decrease_DRS_nesting_level,
  400    add_proper_name_antecedents(ProperNamesIn, ProperNamesIM2, AntecedentsIn, AntecedentsInPlusProperNames),
  401    resolve_all_anaphors(drs(ReferentsIn, Conditions), ConditionsAllIn, AntecedentsInPlusProperNames, AntecedentsOut, ProperNamesIM2, ProperNamesOut, drs(ReferentsOut, ConditionsOut)),
  402    % remove duplicate conditions that are artefacts of anaphors like "the cat of the man" that could not be resolved
  403    % and thus could leave two conditions for "man"
  404    filter_conditions(Conditions1Intermediate, Conditions1Out),
  405    filter_conditions(ConditionsRestIntermediate, ConditionsRestOut),
  406    % build DRSOut
  407    DRSOut = drs(ReferentsOut, [drs(Referents1Out, Conditions1Out) v drs(ReferentsRestOut, ConditionsRestOut)|ConditionsOut])
  408  ).
  409
  410
  411%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  412%
  413%  resolve_one_anaphor(+drs(ReferentsIn, ConditionsIn), ConditionsAllIn, ConditionsAllOut, +Anaphor, +AntecedentsIn, -AntecedentsOut, +ProperNamesIn, -ProperNamesOut, -drs(ReferentsOut, ConditionsOut))
  414%
  415%    - resolve_one_anaphor/9 matches an Anaphor against the Antecedents, and then adapts the ReferentsIn and ConditionsIn of the DRS containing Anaphor generating 
  416%      ReferentsOut and ConditionsOut; furthermore it collects the proper names in the threaded pair of lists ProperNamesIn/ProperNamesOut
  417%
  418%    - ConditionsAllIn/ConditionsAllOut is a threaded pair of all conditions of the current DRS level
  419%    - Anaphor is the anaphor being processed
  420%    - AntecedentsIn/AntecedentsOut  is a threaded pair of lists of antecedents
  421%    - ProperNamesIn/ProperNamesOut is a threaded pair of lists of proper names
  422%
  423%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  424
  425resolve_one_anaphor(drs(ReferentsIn, ConditionsIn), ConditionsAllIn, ConditionsAllOut, Anaphor, AntecedentsIn, AntecedentsOut, ProperNamesIn, ProperNamesOut, drs(ReferentsOut, ConditionsOut)) :-
  426  (
  427    % non-reflexive personal pronoun or non-reflexive possessive pronoun
  428    Anaphor = anaphor(nonreflexive_pronoun, AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens, SentenceSubject)
  429    ->
  430    (
  431      % non-reflexive personal pronoun or non-reflexive possessive pronoun can be resolved 
  432      % constraints: AnaphorID > AntecedentID, AnaphorGenus = AntecedentGenus, AnaphorNumerus = AntecedentNumerus, AnaphorPerson = AntecedentPerson; a non-reflexive pronoun can occur as subject, 
  433      % as object or in a prepositional phrase, but it must not refer to the subject of the sentence in which it occurs
  434      member(antecedent(AntecedentID,  AntecedentReferent, _AntecedentConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AntecedentSID, AntecedentTID, AntecedentTokens), AntecedentsIn),
  435      AnaphorID > AntecedentID,
  436      SentenceSubject \== subj(AntecedentReferent)
  437      ->
  438      delete_all_occurrences_of_one_discourse_referent(ReferentsIn, AnaphorReferent, ReferentsOut),
  439      (
  440        % add anaphors "he", "she", "he/she", "it", "they" to antecedents to handle cases like 'He sees himself.' ...
  441        (AnaphorTokens = 'he' ; AnaphorTokens = 'she' ; AnaphorTokens = 'he/she' ; AnaphorTokens = 'it' ; AnaphorTokens = 'they')
  442        ->
  443        ConditionsOut = [antecedent(AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens)|ConditionsIn]
  444      ;
  445        % ... but not the anaphors "him", "her", "him/her", "them", "his", "her", "his/her", "its", "their"
  446        ConditionsOut = ConditionsIn
  447      ),
  448      ConditionsAllOut = ConditionsAllIn,
  449      AnaphorReferent = AntecedentReferent,
  450      AntecedentsOut = AntecedentsIn,
  451      ProperNamesOut = ProperNamesIn
  452    ;
  453      % non-reflexive personal pronoun or non-reflexive possessive pronoun could not be resolved
  454      % create error message and continue resolution
  455      ReferentsOut = ReferentsIn,
  456      ConditionsOut = ConditionsIn,
  457      ConditionsAllOut = ConditionsAllIn,
  458      ProperNamesOut = ProperNamesIn,
  459      AntecedentsOut = AntecedentsIn,
  460      atom_concat('Unresolved anaphor: ', AnaphorTokens, ErrorText),
  461	  add_error_message_once(anaphor, AnaphorSID-AnaphorTID, ErrorText, 'Identify correct accessible antecedent.')
  462    )
  463  ;
  464    % definite noun phrase
  465    Anaphor = anaphor(definite_noun_phrase, AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens, SentenceSubject)
  466    ->
  467    % if AnaphorConditions contains a condition for a variable then check for variable redefinition
  468    (
  469      member(variable(VariableReferent, VariableName)-AnaphorSID/_, AnaphorConditions),
  470      VariableReferent == AnaphorReferent
  471      ->
  472      (
  473        % variable is redefined on the same or a higher nesting level
  474        variable_defined(VariableName, DRSNestingLevel, bare),
  475        nesting_level(CurrentNestingLevel),
  476        CurrentNestingLevel >= DRSNestingLevel
  477        ->
  478        atom_concat('Redefined variable: ', VariableName, ErrorText),
  479        add_error_message_once(anaphor, AnaphorSID - AnaphorTID, ErrorText, 'Assign unique variables.')
  480      ;
  481        true
  482      )
  483    ;
  484      true
  485    ),
  486    (
  487      % definite noun phrase can be completely resolved against one antecedent
  488      % examples: "a red man who owns a dog" -> "the red man who owns a dog", "a who man does not work patiently" -> "the man who does not work patiently"
  489      % constraints: AnaphorID > AntecedentID, AnaphorGenus = AntecedentGenus, AnaphorPerson = AntecedentPerson, and ...   
  490      member(antecedent(AntecedentID, AntecedentReferent, AntecedentConditions, AnaphorGenus, _AntecedentNumerus, AnaphorPerson, AntecedentSID, AntecedentTID, AntecedentTokens), AntecedentsIn),
  491      AnaphorID > AntecedentID,
  492      % ... main noun of anaphor matches main noun of antecedent and ...
  493      AnaphorTokens = AntecedentTokens,
  494      % ... anaphor is not part of antecedent - as in "a card of the card X1" - and ...
  495      \+ (member(relation(ReferentX, of, ReferentY)-AntecedentSID/_, AntecedentConditions), ReferentX == AntecedentReferent, ReferentY == AnaphorReferent), 
  496      % ... does not wrongly refer to a variable - as the last "the card X1" in "If a card X1 is a card of the card X1 then a man enters the card X1." - and ...
  497      (
  498        member(variable(ReferentZ, _X1)-AntecedentSID/_, AntecedentConditions)
  499        ->
  500        ReferentZ == AntecedentReferent
  501      ;
  502        true
  503      ),
  504      % ... AnaphorConditions are a subset of the AntecedentConditions
  505      \+ \+ (
  506              % decouple variables of antecedent and anaphor and ...
  507              Antecedent = antecedent(AntecedentID, AntecedentReferent, AntecedentConditions, AnaphorGenus, AntecedentNumerus, AnaphorPerson, AntecedentSID, AntecedentTID, AntecedentTokens),
  508              copy_term(Antecedent, CopiedAntecedent),
  509              % ... ground variables of CopiedAntecedent to preserve their correct syntactic relations and ...
  510              numbervars(CopiedAntecedent, 1, _),
  511			  % ... unify AnaphorReferent with ground CopiedAntecedentReferent and ...
  512              CopiedAntecedent = antecedent(_, CopiedAntecedentReferent, CopiedAntecedentConditions, _, _, _, _, _, _),
  513			  AnaphorReferent = CopiedAntecedentReferent, 
  514			  % ... match all AnaphorConditions with CopiedAntecedentConditions
  515              match_elements(AnaphorConditions, CopiedAntecedentConditions)
  516            )
  517      ->
  518      % Before eliminating the referents of AnaphorConditions from the domain make sure that there is not the case "the card of who" that leads
  519      % to the anaphor conditions [relation(E, of, B)-1, object(E, card, countable, na, eq, 1)-1]. Removing all referents of AnaphorConditions would
  520      % also incorrectly remove the referent B that is defined elsewhere.
  521      (
  522        \+ \+ member(relation(AnaphorReferent, of, Owner1)-AnaphorSID/_, AnaphorConditions),
  523        \+ (member(object(Owner2, _, _, _, _, _)-AnaphorSID/_, AnaphorConditions), Owner1 == Owner2)
  524        ->
  525        select(relation(_SomeObject, of, _Owner)-AnaphorSID/_, AnaphorConditions, RestAnaphorConditions)
  526      ;
  527        RestAnaphorConditions = AnaphorConditions
  528      ), 
  529      % eliminate referents of RestAnaphorConditions
  530      term_variables(RestAnaphorConditions, AnaphorReferents),
  531      delete_all_occurrences_of_all_discourse_referents(ReferentsIn, AnaphorReferents, ReferentsOut),
  532      % eliminate from AntecedentsIn all antecedents following Anaphor whose conditions are a subset of AnaphorConditions
  533      eliminate_spurious_antecedents(AntecedentsIn, AnaphorID, AnaphorConditions, AntecedentsOut),
  534      ConditionsOut = ConditionsIn,
  535      ConditionsAllOut = ConditionsAllIn,
  536      AnaphorReferent = AntecedentReferent,
  537      ProperNamesOut = ProperNamesIn
  538    ;
  539	  % definite noun phrase can be resolved  partially against an antecedent and partially against other DRS conditions
  540      % examples: "a red man owns a dog" -> "the red man who owns a dog", "a man does not work patiently" -> "the man who does not work patiently"
  541      % constraints: AnaphorID > AntecedentID, AnaphorGenus = AntecedentGenus, AnaphorPerson = AntecedentPerson, and ...   
  542      member(antecedent(AntecedentID, AntecedentReferent, AntecedentConditions, AnaphorGenus, _AntecedentNumerus, AnaphorPerson, AntecedentSID, AntecedentTID, AntecedentTokens), AntecedentsIn),
  543      AnaphorID > AntecedentID,
  544      % ... main noun of anaphor matches main noun of antecedent and ...
  545      AnaphorTokens = AntecedentTokens,
  546      % ... AnaphorConditions are a subset of the AntecedentConditions and ConditionsAllIn
  547      \+ \+ (
  548              % decouple variables of Antecedent and ConditionsAllIn from those of Anaphor and ...
  549              Antecedent = antecedent(AntecedentID, AntecedentReferent, AntecedentConditions, AnaphorGenus, AntecedentNumerus, AnaphorPerson, AntecedentSID, AntecedentTID, AntecedentTokens),
  550              copy_term((Antecedent, ConditionsAllIn), (CopiedAntecedent, CopiedConditionsAllIn)),
  551              % ... ground variables of CopiedAntecedent and CopiedConditionsAllIn to preserve their correct syntactic relations and ...
  552              numbervars((CopiedAntecedent, CopiedConditionsAllIn), 1, _),
  553			  % ... unify AnaphorReferent with ground CopiedAntecedentReferent and ...
  554              CopiedAntecedent = antecedent(_, CopiedAntecedentReferent, CopiedAntecedentConditions, _, _, _, _, _, _),
  555			  AnaphorReferent = CopiedAntecedentReferent, 
  556              % ... identify main noun of anaphor conditions and ...
  557              once(append(Front, [object(AnaphorReferent, AnaphorTokens, Quant, Unit, Op, Count)-AnaphorSID/TID|Tail], AnaphorConditions)), 
  558              once(append(Front, Tail, RemainingAnaphorConditions)),
  559              MainAnaphorCondition = object(AnaphorReferent, AnaphorTokens, Quant, Unit, Op, Count)-AnaphorSID/TID,
  560              % ... match MainAnaphorCondition with AntecedentConditions and ...
  561              match_elements([MainAnaphorCondition], AntecedentConditions),
  562			  % ... match RemainingAnaphorConditions with concatenation of CopiedAntecedentConditions and CopiedConditionsAllIn
  563              append(CopiedAntecedentConditions, CopiedConditionsAllIn, CopiedAntecedentConditionsAndCopiedConditionsAllIn),
  564              match_elements(RemainingAnaphorConditions, CopiedAntecedentConditionsAndCopiedConditionsAllIn)
  565            )
  566      ->
  567      term_variables(AnaphorConditions, AnaphorReferents),
  568      delete_all_occurrences_of_all_discourse_referents(ReferentsIn, AnaphorReferents, ReferentsOut),
  569      % eliminate from AntecedentsIn all antecedents following Anaphor whose conditions are a subset of AnaphorConditions
  570      eliminate_spurious_antecedents(AntecedentsIn, AnaphorID, AnaphorConditions, AntecedentsOut),
  571      ConditionsOut = ConditionsIn,
  572      ConditionsAllOut = ConditionsAllIn,
  573      AnaphorReferent = AntecedentReferent,
  574      ProperNamesOut = ProperNamesIn
  575   ;
  576      % definite noun phrase could not be resolved
  577      % treat it as indefinite noun phrase
  578      ReferentsOut = ReferentsIn,
  579      ProperNamesOut = ProperNamesIn,
  580      AntecedentsOut = AntecedentsIn,
  581      % add its conditions without variable conditions to the DRS
  582      delete_all_occurrences_of_all_elements(AnaphorConditions, [variable(_, _)-_], AnaphorConditionsWithoutVariables),
  583      append(AnaphorConditionsWithoutVariables, ConditionsIn, ConditionsIM),
  584      % add anaphor condition as antecedent condition to ConditionsOut so that it will be added to antecedents in the next round
  585      % necessary to handle cases like "The man sees himself."
  586      ConditionsOut = [antecedent(AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens)|ConditionsIM],
  587      % add  the anaphor conditions to ConditionsAll
  588      append(AnaphorConditions, ConditionsAllIn, ConditionsAllOut),
  589      % create a warning message 
  590      (
  591        % countable anaphor: distinguish between singular or plural
  592        \+ \+ member(object(AnaphorReferent, AnaphorTokens, countable, na, _Op, AnaphorCount)-AnaphorSID/_, AnaphorConditions)
  593        ->
  594        (
  595          % singular anaphor
  596          AnaphorCount = 1
  597          ->
  598          AnaphorNoun = AnaphorTokens
  599        ;
  600          % plural anaphor
  601          % AnaphorCount > 1
  602          lexicon_interface:noun_pl(AnaphorNoun, AnaphorTokens, _Gender)
  603          ->
  604          true
  605        ;
  606          % anaphor not in any lexicon
  607          AnaphorNoun = AnaphorTokens
  608        ),
  609        concat_atom(['The definite noun phrase ''the ', AnaphorNoun, ''' does not have an antecedent and thus is not interpreted as anaphoric reference, but as a new indefinite noun phrase.'], ErrorText1),
  610        concat_atom(['If the definite noun phrase ''the ', AnaphorNoun, ''' should be an anaphoric reference then you must introduce an appropriate antecedent.'], ErrorText2),
  611        add_warning_message_once(anaphor, AnaphorSID-AnaphorTID, ErrorText1, ErrorText2)
  612      ;
  613        % mass anaphor
  614        member(object(AnaphorReferent, AnaphorTokens, mass, na, na, na)-AnaphorSID/_, AnaphorConditions)
  615        ->
  616        concat_atom(['The definite noun phrase ''the ', AnaphorTokens, ''' does not have an antecedent and thus is not interpreted as anaphoric reference, but as a new indefinite noun phrase.'], ErrorText1),
  617        concat_atom(['If the definite noun phrase ''the ', AnaphorTokens, ''' should be an anaphoric reference then you must introduce an appropriate antecedent.'], ErrorText2),
  618        add_warning_message_once(anaphor, AnaphorSID-AnaphorTID, ErrorText1, ErrorText2)
  619      )
  620    )
  621  ;
  622    % variable
  623    Anaphor = anaphor(variable, AnaphorID, AnaphorReferent, AnaphorConditions, _AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens, SentenceSubject)
  624    ->
  625    (
  626      % variable can be resolved
  627      % constraints: AnaphorID > AntecedentID, AnaphorNumerus = AntecedentNumerus, AnaphorPerson = AntecedentPerson, and AnaphorConditions are identical to the AntecedentConditions
  628      member(antecedent(AntecedentID, AntecedentReferent, AntecedentConditions, _AntecedentGenus, AnaphorNumerus, AnaphorPerson, AntecedentSID, AntecedentTID, AntecedentTokens), AntecedentsIn),
  629      AnaphorID > AntecedentID,
  630      % AnaphorGenus = AntecedentGenus, % variables are assigned a numerus but not a genus
  631      AntecedentConditions = [variable(AntecedentReferent, AntecedentVariable)-_AntecedentIndex],
  632      AnaphorConditions = [variable(AnaphorReferent, AnaphorVariable)-_AnaphorIndex],
  633      AntecedentVariable == AnaphorVariable
  634      ->
  635      delete_all_occurrences_of_one_discourse_referent(ReferentsIn, AnaphorReferent, ReferentsOut),
  636      ConditionsOut = ConditionsIn,
  637      ConditionsAllOut = ConditionsAllIn,
  638      AntecedentsOut = AntecedentsIn,
  639      AnaphorReferent = AntecedentReferent,
  640      ProperNamesOut = ProperNamesIn      
  641    ;
  642      % variable could not be resolved
  643      % treat variable as new bare variable
  644      % store variable for later check of possible redefinition (as in "X sees a man X")
  645      AnaphorConditions = [Variable],
  646	  define_new_variable(Variable, bare),
  647      % insert "something" and an antecedent to allow anaphoric references to this new bare variable
  648      ConditionsOut = [antecedent(AnaphorID, AnaphorReferent, AnaphorConditions, _AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens), 
  649                       object(AnaphorReferent,something,dom,na,na,na)-AnaphorSID/AnaphorTID|ConditionsIn],
  650      ReferentsOut = ReferentsIn,
  651      ConditionsAllOut = ConditionsAllIn,
  652      AntecedentsOut = AntecedentsIn,
  653      ProperNamesOut = ProperNamesIn      
  654    )
  655  ;
  656    % proper name
  657    Anaphor = anaphor(proper_name, AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens, SentenceSubject)
  658    ->
  659    (
  660      % proper name occurred previously
  661      % constraints: ProperNamesIn contains an entry matching AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson and AnaphorTokens
  662      member(proper_name(_ID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, _SID, _TID, AnaphorTokens), ProperNamesIn) 
  663      -> 
  664      ReferentsOut = ReferentsIn,
  665      ConditionsOut = ConditionsIn,
  666      ConditionsAllOut = ConditionsAllIn,
  667      AntecedentsOut = AntecedentsIn,
  668      ProperNamesOut = ProperNamesIn
  669    ;
  670      % new proper name
  671      ReferentsOut = ReferentsIn,
  672      % an appropriate antecedent condition is added to allow references to the new proper name by pronouns 
  673      ConditionsOut = [antecedent(AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens)|ConditionsIn],
  674      ConditionsAllOut = ConditionsAllIn,
  675      AntecedentsOut = AntecedentsIn,
  676      % store proper name
  677      ProperNamesOut = [proper_name(AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens)|ProperNamesIn]
  678    )
  679 ;
  680    % unrecognised anaphor
  681    Anaphor = anaphor(_UnrecognizedAnaphorType, AnaphorID, AnaphorReferent, AnaphorConditions, AnaphorGenus, AnaphorNumerus, AnaphorPerson, AnaphorSID, AnaphorTID, AnaphorTokens, SentenceSubject) 
  682    ->
  683    % create error message and continue resolution
  684    ReferentsOut = ReferentsIn,
  685    ConditionsOut = [unresolved(Anaphor)|ConditionsIn],
  686    ConditionsAllOut = ConditionsAllIn,
  687    AntecedentsOut = AntecedentsIn,
  688    ProperNamesOut = ProperNamesIn,
  689    add_error_message_once(anaphor, AnaphorSID-AnaphorTID, 'Unrecognised anaphor.', 'Send screenshot to APE developers.')
  690  ).
  691
  692
  693%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  694%
  695%  Groups of Supporting Predicates in Approximately Alphabetical Order
  696%
  697%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  698%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  699%
  700%  add_proper_name_antecedents(+ProperNamesThisLevel, +ProperNamesNestedLevel, +AntecedentsThisLevelIn, -AntecedentsThisLevelOut) 
  701%
  702%    - a nested level can introduce proper name anaphors, i.e. ProperNamesNestedLevel contains new elements compared to ProperNamesThisLevel
  703%    - these proper name anaphors are inserted as antecedents into AntecedentsThisLevelIn resulting in AntecedentsThisLevelOut
  704%
  705%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  706
  707add_proper_name_antecedents(ProperNamesThisLevel, ProperNamesNestedLevel, AntecedentsThisLevelIn, AntecedentsThisLevelOut) :-
  708  % new proper names encountered on nested level?
  709  delete_all_occurrences_of_all_elements(ProperNamesNestedLevel, ProperNamesThisLevel, NewProperNames),
  710  (
  711    % no
  712    NewProperNames = []
  713    ->
  714    AntecedentsThisLevelOut = AntecedentsThisLevelIn
  715  ;
  716    % yes
  717    prepend_proper_name_antecedents(NewProperNames, AntecedentsThisLevelIn, AntecedentsThisLevelIntermediate1),
  718    sort(AntecedentsThisLevelIntermediate1, AntecedentsThisLevelIntermediate2),
  719    reverse(AntecedentsThisLevelIntermediate2, AntecedentsThisLevelOut)
  720  ).
  721  
  722prepend_proper_name_antecedents([], Antecedents, Antecedents).
  723
  724prepend_proper_name_antecedents([proper_name(ID, Referent, Conditions, Genus, Numerus, Person, SID, TID, Tokens)|MoreProperNames], Antecedents, NewAntecedents) :-
  725  prepend_proper_name_antecedents(MoreProperNames, [antecedent(ID, Referent, Conditions, Genus, Numerus, Person, SID, TID, Tokens)|Antecedents], NewAntecedents).
  726  
  727  
  728%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  729%
  730%  build_drs(Operator, Label, DRS, NewDRS)
  731%
  732%    - for negation, negation as failure, possibility, necessity: NewDRS = Operator(DRS)
  733%    - for sentence subordination: NewDRS = Label : DRS
  734%
  735%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  736
  737build_drs(Operator, Label, DRS, NewDRS) :-
  738  (
  739    var(Label)
  740	->
  741	NewDRS =.. [Operator, Label, DRS]
  742  ;
  743    % nonvar(Label)
  744	NewDRS =.. [Operator, DRS]
  745  ).
  746
  747
  748%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  749%
  750%  check_for_redefined_variables(+Antecedents)
  751%
  752%    - checks whether the list of Antecedents contains redefined variables
  753%    - redefined variables can occur in antecedents that stand for indefinte noun phrases, or in antecedents that stand just for variables
  754%
  755%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  756
  757check_for_redefined_variables([]).
  758
  759check_for_redefined_variables([_Antecedent]).
  760
  761% skip divider between DRS nesting levels
  762check_for_redefined_variables([divider_between_DRS_nesting_levels|Antecedents]) :-
  763  check_for_redefined_variables(Antecedents).
  764
  765check_for_redefined_variables([Antecedent|Antecedents]) :-
  766  Antecedent = antecedent(AntecedentID1, AntecedentReferent1, AntecedentConditions1, _AnaphorGenus1, _AntecedentNumerus1, _AntecedentPerson1, AntecedentSID1, AntecedentTID1, _AntecedentTokens1), 
  767  (
  768    % variable is already defined in previous indefinite NP antecedent
  769    select(variable(Referent1, VariableName)-AntecedentSID1/_, AntecedentConditions1, [_|_]),
  770    Referent1 == AntecedentReferent1,
  771    member(antecedent(AntecedentID2, AntecedentReferent2, AntecedentConditions2, _AnaphorGenus2, _AntecedentNumerus2, _AntecedentPerson2, AntecedentSID2, _AntecedentTID2, _AntecedentTokens2), Antecedents),
  772    AntecedentID2 < AntecedentID1,
  773    select(variable(Referent2, VariableName)-AntecedentSID2/_, AntecedentConditions2, [_|_]),
  774    Referent2 == AntecedentReferent2
  775    ->
  776    atom_concat('Redefined variable: ', VariableName, ErrorText),
  777    add_error_message_once(anaphor, AntecedentSID1 - AntecedentTID1, ErrorText, 'Assign unique variables.')
  778  ;
  779    % variable is not redefined
  780    true
  781  ),
  782  % check remaining antecedents for redefinition
  783  check_for_redefined_variables(Antecedents).
  784
  785
  786%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  787%
  788%  cleanup/0
  789%
  790%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  791    
  792cleanup :-
  793  retractall(variable_defined(_, _, _)).
  794
  795
  796%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  797%
  798%  define_new_variable(+VariableCondition, +VariableType)
  799%
  800%    - each newly defined variable is asserted as variable_defined(VariableName, DRSNestingLevel, VariableType)
  801%    - VariableType is "bare" or "apposition"
  802%    - create an error message if a variable is redefined within its range of accessibility
  803%    - when the DRS nesting level is decreased all facts variable_defined/3 asserted for that level are retracted (cf. decrease_DRS_nesting_level)
  804%
  805%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  806
  807define_new_variable(variable(_Referent, VariableName)-SentenceIndex/TokenIndex, VariableType) :-
  808  nesting_level(CurrentNestingLevel),
  809  (
  810    % variable is redefined on the same or a higher nesting level
  811    variable_defined(VariableName, DRSNestingLevel, _VariableType),
  812    CurrentNestingLevel >= DRSNestingLevel
  813    ->
  814    atom_concat('Redefined variable: ', VariableName, ErrorText),
  815    add_error_message_once(anaphor, SentenceIndex-TokenIndex, ErrorText, 'Assign unique variables.')
  816  ;
  817    true
  818  ),
  819  assert(variable_defined(VariableName, CurrentNestingLevel, VariableType)).
  820
  821
  822%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  823%
  824%  delete_all_occurrences_of_all_elements(+ListIn, +ElementsToDelete, -ListOut)
  825%
  826%    - ListOut is ListIn without all occurrences of all the members of ElementsToDelete
  827%
  828%
  829%  delete_all(+ListIn, +ElementToDelete, -ListOut)
  830%
  831%    - ListOut is ListIn without all elements that unify with ElementsToDelete; i.e. ElementsToDelete works as a pattern against which the elements are matched
  832%    - notice that delete_all/3 differs from SWI Prologs built-in delete/3 that deletes all elements of ListIn that *simultaneously* unify with ElementToDelete
  833%
  834%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  835		
  836delete_all_occurrences_of_all_elements(ListIn, [], ListIn) :-
  837  !.
  838
  839delete_all_occurrences_of_all_elements(ListIn, [ElementToDelete|ElementsToDelete], ListOut) :-
  840  delete_all(ListIn, ElementToDelete, ListIM),
  841  !,
  842  delete_all_occurrences_of_all_elements(ListIM, ElementsToDelete, ListOut).
  843  
  844
  845delete_all([X|Xs],Z,Ys) :-
  846  \+ \+ (X = Z), 
  847  delete_all(Xs,Z,Ys).
  848
  849delete_all([X|Xs],Z,[X|Ys]) :- 
  850  \+ \+ (X \= Z), 
  851  delete_all(Xs,Z,Ys).
  852
  853delete_all([],_X,[]).
  854  
  855%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  856%
  857%  delete_all_occurrences_of_all_discourse_referents(+ReferentsIn, +ReferentsToDelete, -ReferentsOut)
  858%
  859%    - ReferentsOut is the list ReferentsIn without all occurrences of the elements of the list ReferentsToDelete
  860%
  861%
  862%  delete_all_occurrences_of_one_discourse_referent(+ReferentsIn, +ReferentToDelete, -ReferentsOut)
  863%
  864%    - ReferentsOut is the list ReferentsIn without all occurrences of ReferentToDelete
  865%
  866%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  867
  868delete_all_occurrences_of_all_discourse_referents(Referents, [], Referents) :-
  869  !.
  870
  871delete_all_occurrences_of_all_discourse_referents(ReferentsIn, [ReferentToDelete|ReferentsToDelete], ReferentsOut) :-
  872  delete_all_occurrences_of_one_discourse_referent(ReferentsIn, ReferentToDelete, ReferentsIM),
  873  delete_all_occurrences_of_all_discourse_referents(ReferentsIM, ReferentsToDelete, ReferentsOut).
  874
  875
  876delete_all_occurrences_of_one_discourse_referent([], _ReferentToDelete, []).
  877
  878delete_all_occurrences_of_one_discourse_referent([Referent|Referents], ReferentToDelete, ReferentsOut) :-
  879  (
  880    Referent == ReferentToDelete
  881    -> 
  882    delete_all_occurrences_of_one_discourse_referent(Referents, ReferentToDelete, ReferentsOut)
  883  ;
  884    delete_all_occurrences_of_one_discourse_referent(Referents, ReferentToDelete, ReferentsRest),
  885    ReferentsOut = [Referent|ReferentsRest]
  886  ).
  887
  888%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  889%
  890%  eliminate_spurious_antecedents(+AntecedentsIn, +AnaphorID, +AnaphorConditions, -AntecedentsOut)
  891%
  892%    - AntecedentsOut is AntecedentsIn without spurious antecedents
  893%    - if a noun phrase like "the price of a resource" generates the anaphor "the price of a resource" and the antecedent "a resource", and the anaphor 
  894%      can be resolved then the antecedent is spurious
  895%    - spurious antecedents have an ID that is larger than AnaphorID and non-empty conditions that are a subset of AnaphorConditions 
  896%
  897%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  898
  899eliminate_spurious_antecedents(AntecedentsIn, AnaphorID, AnaphorConditions, AntecedentsOut) :-
  900  (
  901    member(antecedent(AntecedentID, AntecedentReferent, AntecedentConditions, AntecedentGenus, AntecedentNumerus, AntecedentPerson, AntecedentSID, AntecedentTID, AntecedentTokens), AntecedentsIn),
  902    AnaphorID < AntecedentID, 
  903    \+ AntecedentConditions = [],
  904    \+ \+ (numbervars((AnaphorConditions, AntecedentConditions), 1, _), forall(member(Condition, AntecedentConditions), member(Condition, AnaphorConditions)))
  905    ->
  906    delete(AntecedentsIn, antecedent(AntecedentID, AntecedentReferent, AntecedentConditions, AntecedentGenus, AntecedentNumerus, AntecedentPerson, AntecedentSID, AntecedentTID, AntecedentTokens), AntecedentsIntermediate),
  907    eliminate_spurious_antecedents(AntecedentsIntermediate, AnaphorID, AnaphorConditions, AntecedentsOut)
  908  ;
  909    AntecedentsOut = AntecedentsIn
  910  ).
  911
  912%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  913%
  914%  DRS nesting level: initialise_DRS_nesting_level/0, increase_DRS_nesting_level/0, decrease_DRS_nesting_level/0
  915%
  916%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  917
  918initialise_DRS_nesting_level :-
  919  retractall(nesting_level(_)),
  920  assert(nesting_level(1)).
  921  
  922
  923increase_DRS_nesting_level :-
  924  retract(nesting_level(CurrentNestingLevel)),
  925  NewNestingLevel is CurrentNestingLevel + 1,
  926  assert(nesting_level(NewNestingLevel)).
  927  
  928
  929decrease_DRS_nesting_level :-
  930  retract(nesting_level(CurrentNestingLevel)),
  931  NewNestingLevel is CurrentNestingLevel - 1,
  932  assert(nesting_level(NewNestingLevel)),
  933  retractall(variable_defined(_VariableName, CurrentNestingLevel, _VariableType)).
  934
  935
  936%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  937%
  938%  enforce_order(+ConditionsIn, -ConditionsOut, +ConditionsAllIn, -ConditionsAllOut, +AntecedentsIn, -AntecedentsOut)
  939%
  940%    - enforce_order/6 
  941%        removes all antecedent/8 conditions from ConditionsIn giving ConditionsOut, and
  942%        prepends them in reverse textual order to AntecedentsIn resulting in AntecedentsOut (this guarantees the selection of the closest preceding antecedent)  
  943%        collects all simple conditions of ConditionsIn and adds them to the front of ConditionsAllIn resulting in ConditionsAllOut
  944%
  945%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
  946
  947enforce_order(ConditionsIn, ConditionsOut, ConditionsAllIn, ConditionsAllOut, AntecedentsIn, AntecedentsOut) :-
  948  % remove all antecedents from ConditionsIn and ...
  949  remove_and_collect_antecedents(ConditionsIn, [], AllAntecedents, [], ConditionsRest),
  950  % ... prepend them in inverse order to AntecedentsIn to get AntecedentsOut
  951  sort(AllAntecedents, AllAntecedentsSorted),
  952  reverse(AllAntecedentsSorted, AllAntecedentsSortedReversed),
  953  (
  954    AntecedentsIn = []
  955    ->
  956    AntecedentsOut = AllAntecedentsSortedReversed
  957  ;
  958    % for non-empty AntecedentsIn add divider between DRS nesting levels
  959    append(AllAntecedentsSortedReversed, [divider_between_DRS_nesting_levels|AntecedentsIn], AntecedentsOut)
  960  ),
  961  check_for_redefined_variables(AntecedentsOut),
  962  % reverse remaining conditions
  963  reverse(ConditionsRest, ConditionsOut),
  964  % prepend the remaining DRS conditions in reverse order to ConditionsAllIn to get ConditionsAllOut
  965  append(ConditionsOut, ConditionsAllIn, ConditionsAllOut).
  966  
  967
  968remove_and_collect_antecedents([], Antecedents, Antecedents, ConditionsOut, ConditionsOut).
  969
  970remove_and_collect_antecedents([ConditionIn|ConditionsIn], AntecedentsSofar, Antecedents, ConditionsOutSofor, ConditionsOut) :-
  971  (
  972    ConditionIn = antecedent(_ID, _Referent, _Conditions, _Genus, _Numerus, _Person, _SentenceID, _TokenID, _Tokens)
  973    -> 
  974    transform_allquantified_nouns(ConditionIn, TransformedConditionIn),
  975    remove_and_collect_antecedents(ConditionsIn, [TransformedConditionIn|AntecedentsSofar], Antecedents, ConditionsOutSofor, ConditionsOut)
  976  ;
  977    % generalised quantors 'exactly', 'less than' and 'at most' have additional bracketing that must be ...
  978    is_list(ConditionIn)
  979    -> 
  980    % ... processed recursively
  981    remove_and_collect_antecedents(ConditionIn, [], NewAntecedents, [], NewConditions),
  982    append(NewAntecedents, AntecedentsSofar, NewAntecedentsSofar),
  983    remove_and_collect_antecedents(ConditionsIn, NewAntecedentsSofar, Antecedents, [NewConditions|ConditionsOutSofor], ConditionsOut)
  984  ;
  985    remove_and_collect_antecedents(ConditionsIn, AntecedentsSofar, Antecedents, [ConditionIn|ConditionsOutSofor], ConditionsOut)
  986  ).
  987  
  988
  989transform_allquantified_nouns(Condition, TransformedCondition) :-
  990  % phrases like "all men" generate an "antecedent(1, A, [object(A, man, countable, na, eq, 1)-1], $gen(B, $human(C)), $num(D, $pl), 1,'' , man)" that
  991  % on the one side is plural and on the other side has the count "eq 1"
  992  % to allow anaphoric reference by "the men" and "they" the count is replaced by "geq 2"
  993  (
  994    Condition = antecedent(AntecedentID, AntecedentReferent, AntecedentConditions, AntecedentGenus, '$num'(SP, '$pl'), AntecedentPerson, AntecedentSID, AntecedentTID, AntecedentTokens),
  995    select(object(Referent, Lemma, countable, na, eq, 1)-AntecedentSID/_, AntecedentConditions, RestAntecedentConditions),
  996    Referent == AntecedentReferent
  997    ->
  998    NewAntecedentConditions = [object(Referent, Lemma, countable, na, geq, 2)-AntecedentSID/_|RestAntecedentConditions],
  999    TransformedCondition = antecedent(AntecedentID, AntecedentReferent, NewAntecedentConditions, AntecedentGenus, '$num'(SP, '$pl'), AntecedentPerson, AntecedentSID, AntecedentTID, AntecedentTokens)
 1000  ;
 1001    TransformedCondition = Condition
 1002  ).
 1003
 1004
 1005%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
 1006%
 1007%  filter_conditions(+(ConditionsIn, -ConditionsOut)
 1008%
 1009%    - ConditionsOut is ConditionsIn without duplicate conditions
 1010%    - create an error message if there are inconsistent noun phrase conjunctions, i.e. if they contain fewer elements than the plural object states
 1011%
 1012%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
 1013
 1014filter_conditions(ConditionsIn, ConditionsOut) :-
 1015  % remove duplicate conditions
 1016  remove_duplicate_conditions(ConditionsIn, ConditionsWithoutDuplicates),
 1017  % check for noun phrase conjunctions that refer anaphorically to themselves
 1018  noun_phrase_conjunction_refers_to_itself(ConditionsWithoutDuplicates),
 1019  % establish original order of conditions
 1020  reverse(ConditionsWithoutDuplicates, ConditionsOut).
 1021
 1022
 1023remove_duplicate_conditions(Conditions, ConditionsWithoutDuplicates) :-
 1024  remove_duplicate_conditions(Conditions, [], ConditionsWithoutDuplicates).
 1025
 1026remove_duplicate_conditions([], ConditionsWithoutDuplicates, ConditionsWithoutDuplicates).
 1027
 1028remove_duplicate_conditions([Condition|RestConditions], Singles, ConditionsWithoutDuplicates) :-
 1029  (
 1030    % simple Condition occurs identically – but possibly with different sentence index and different token index – in RestConditions
 1031    Condition = ConditionProper - _/_,
 1032    member(DuplicateSimpleCondition, RestConditions),
 1033    DuplicateSimpleCondition = DuplicateSimpleConditionProper - _/_,
 1034    ConditionProper == DuplicateSimpleConditionProper
 1035    ->
 1036    remove_duplicate_conditions(RestConditions, Singles, ConditionsWithoutDuplicates)
 1037  ;
 1038    % complex Condition occurs identically in RestConditions
 1039    member(DuplicateComplexCondition, RestConditions),
 1040    Condition == DuplicateComplexCondition
 1041    ->
 1042    remove_duplicate_conditions(RestConditions, Singles, ConditionsWithoutDuplicates)
 1043  ;
 1044    % Condition does not occur in RestConditions
 1045    remove_duplicate_conditions(RestConditions, [Condition|Singles], ConditionsWithoutDuplicates)
 1046  ).
 1047
 1048   
 1049noun_phrase_conjunction_refers_to_itself(Conditions) :-
 1050  (
 1051    % get head of noun phrase conjunction
 1052    select(object(Whole,na,countable,na,eq,N)-Sentence/'', Conditions, RestConditions)
 1053    ->
 1054    % count the has_part/2 branches of the noun phrase conjunction 
 1055    % use subterm/2 instead of member/2 since RestConditions can contain a list derived from a generalised quantifier
 1056    findall(1, (subterm(has_part(Whole1,_Part)-Sentence/'', RestConditions), Whole1 == Whole), Branches),
 1057    (
 1058      % all N has_part/2 branches exist
 1059      length(Branches, N)
 1060      ->
 1061      true
 1062    ;
 1063      % there are less than N has_part/2 branches meaning that there are anaphoric references within the noun phrase conjunction
 1064      add_error_message_once(anaphor, Sentence - '', 'Noun phrase conjunction refers anaphorically to itself.', 'Remove anaphoric references from noun phrase conjunction.')
 1065    ),
 1066    noun_phrase_conjunction_refers_to_itself(RestConditions)
 1067  ;
 1068   % there are no (further) noun phrase conjunctions
 1069   true
 1070  ).
 1071
 1072
 1073%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
 1074%
 1075%  insert_antecedent(+Antecedent, +AntecedentsIn, -AntecedentsOut)
 1076%
 1077%    - insert_antecedent/3 inserts Antecedent into the list AntecedentsIn generating AntecedentOut while the orderedness of the antecedents is preserved
 1078%
 1079%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
 1080
 1081insert_antecedent(Antecedent, AntecedentsIn, AntecedentsOut) :-
 1082  (
 1083    % insert Antecedent before divider between DRS nesting levels
 1084    member(divider_between_DRS_nesting_levels, AntecedentsIn) 
 1085    ->
 1086    append(Front, [divider_between_DRS_nesting_levels|Tail], AntecedentsIn),
 1087    insert_antecedent1(Antecedent, Front, FrontOut),
 1088    append(FrontOut, [divider_between_DRS_nesting_levels|Tail], AntecedentsOut)
 1089  ;
 1090    % no divider
 1091    insert_antecedent1(Antecedent, AntecedentsIn, AntecedentsOut)
 1092  ),
 1093  check_for_redefined_variables(AntecedentsOut).
 1094
 1095  
 1096insert_antecedent1(Antecedent, [], [Antecedent]) :-
 1097  !.			
 1098
 1099insert_antecedent1(antecedent(ID1, R1, C1, G1, N1, P1, SID1, TID1, T1), [antecedent(ID2, R2, C2, G2, N2, P2, SID2, TID2, T2)|Antecedents], [antecedent(ID2, R2, C2, G2, N2, P2, SID2, TID2, T2)|AntecedentsIM]) :-	
 1100  ID1 < ID2,
 1101  !,
 1102  insert_antecedent1(antecedent(ID1, R1, C1, G1, N1, P1, SID1, TID1, T1), Antecedents, AntecedentsIM).		
 1103
 1104insert_antecedent1(antecedent(ID1, R1, C1, G1, N1, P1, SID1, TID1, T1),[antecedent(ID2, R2, C2, G2, N2, P2, SID2, TID2, T2)|Antecedents], [antecedent(ID1, R1, C1, G1, N1, P1, SID1, TID1, T1), antecedent(ID2, R2, C2, G2, N2, P2, SID2, TID2, T2)|Antecedents]) :-	
 1105  ID1 >= ID2.				
 1106
 1107
 1108%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
 1109%
 1110%  match_elements(+Subset, +Set)
 1111%
 1112%    - match_elements(Subset, Set) succeeds if all elements of Subset  - with the exception of antecedents and anaphors - occur in Set that is ground
 1113%    - complex elements - represented by sub-DRSs - must occur identically in both sets
 1114%
 1115%  match_element_against_disjunction(+Element, +Disjunction)
 1116%
 1117%    - match_element_against_disjunction(Element, Disjunction) succeeds if Element matches one of the disjuncts of Disjunction
 1118%
 1119%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
 1120
 1121match_elements([], _Set).
 1122
 1123match_elements([Element|Elements], Set) :-
 1124  (
 1125    % singular noun anaphor 'the object' refers to ...
 1126    Element = object(R1, Noun, countable, na, eq, 1) - _Index1
 1127    ->
 1128    (
 1129      % ... singular countable noun antecedent 'an/1 object', 'at least/more than/exactly 1 object', or to ...
 1130      member(object(R2, Noun, countable, na, _Op, 1) - _Index2, Set),  
 1131      R1 = R2
 1132    ;
 1133      % ... mass noun antecedent occurring by itself (e.g. some water) or with measurement noun (e.g. 2 kg of water)
 1134      member(object(R2, Noun, mass, _Unit, _Op, _Count) - _Index2, Set), 
 1135      R1 = R2
 1136    )
 1137  ;
 1138	% plural noun anaphor 'the objects' represented as 'at least 2 objects' refers to ...
 1139    Element = object(R1, Noun, countable, na, geq, 2) - _Index1
 1140    ->
 1141    (
 1142      % ... plural countable noun antecedent antecedent 'N2 objects', 'at least/more than/exactly N2 objects', where N2>=2, or to ...
 1143      member(object(R2, Noun, countable, na, _Op, N2) - _Index2, Set), 
 1144      N2 >= 2, 
 1145      R1 = R2
 1146    ;
 1147      % ... antecedent 'measurement noun of objects'
 1148      member(object(R2, Noun, countable, Unit, _Op, _Count) - _Index2, Set),	
 1149      \+ Unit = na, 
 1150      R1 = R2
 1151    )
 1152  ;
 1153    % modifier/4
 1154    Element = modifier_pp(Arg11, Arg12, Arg13) - _Index1
 1155    ->
 1156    member(modifier_pp(Arg21, Arg22, Arg23) - _Index2, Set),
 1157    % must allow for backtracking in member/2 since groups of modifier/4 conditions must be matched in any order
 1158    Arg11 = Arg21,
 1159    Arg12 = Arg22,
 1160    Arg13 = Arg23
 1161  ;
 1162    % has_part/2
 1163    Element = has_part(Whole1, Part1) - _Index1
 1164    ->
 1165    member(has_part(Whole2, Part2) - _Index2, Set),
 1166    % must allow for backtracking in member/2 since groups of has_part/2 conditions must be matched in any order
 1167    Whole1 = Whole2,
 1168    Part1 = Part2
 1169  ;
 1170    % other simple conditions
 1171    Element = Condition1 - _Index1
 1172    -> 
 1173    member(Condition2 - _Index2, Set),
 1174    Condition1 = Condition2
 1175  ;
 1176    % antecedents
 1177    Element = antecedent(_, _, _ ,_, _, _, _, _)
 1178    ->
 1179    true
 1180  ;
 1181    % anaphors
 1182    Element = anaphor(_, _, _ ,_, _, _, _, _, _, _)
 1183    ->
 1184    true
 1185  ;
 1186    % nested list
 1187    is_list(Element)
 1188    ->
 1189    member(List, Set),
 1190    is_list(List),
 1191    match_elements(Element, List),
 1192    match_elements(List, Element)
 1193  ;
 1194    % complex condition: drs
 1195    Element = drs(_Referents1, Conditions1)
 1196    ->
 1197    member(drs(_Referents2, Conditions2), Set),
 1198    match_elements(Conditions1, Conditions2),
 1199    match_elements(Conditions2, Conditions1)
 1200  ;
 1201    % complex condition: negation
 1202    Element = - drs(_Referents1, Conditions1)
 1203    ->
 1204    member(- drs(_Referents2, Conditions2), Set),
 1205    match_elements(Conditions1, Conditions2),
 1206    match_elements(Conditions2, Conditions1)
 1207  ;
 1208    % complex condition: negation as failure
 1209    Element = ~ drs(_Referents1, Conditions1)
 1210    ->
 1211    member(~ drs(_Referents2, Conditions2), Set),
 1212    match_elements(Conditions1, Conditions2),
 1213    match_elements(Conditions2, Conditions1)
 1214  ;
 1215    % complex condition: possibility
 1216    Element = can(drs(_Referents1, Conditions1))
 1217    ->
 1218    member(can(drs(_Referents2, Conditions2)), Set),
 1219    match_elements(Conditions1, Conditions2),
 1220    match_elements(Conditions2, Conditions1)
 1221  ;
 1222    % complex condition: necessity
 1223    Element = must(drs(_Referents1, Conditions1))
 1224    ->
 1225    member(must(drs(_Referents2, Conditions2)), Set),
 1226    match_elements(Conditions1, Conditions2),
 1227    match_elements(Conditions2, Conditions1)
 1228  ;
 1229    % complex condition: recommendation
 1230    Element = should(drs(_Referents1, Conditions1))
 1231    ->
 1232    member(should(drs(_Referents2, Conditions2)), Set),
 1233    match_elements(Conditions1, Conditions2),
 1234    match_elements(Conditions2, Conditions1)
 1235  ;
 1236    % complex condition: admissibility
 1237    Element = may(drs(_Referents1, Conditions1))
 1238    ->
 1239    member(may(drs(_Referents2, Conditions2)), Set),
 1240    match_elements(Conditions1, Conditions2),
 1241    match_elements(Conditions2, Conditions1)
 1242  ;
 1243    Element = question(drs(_Referents1, Conditions1))
 1244    ->
 1245    member(question(drs(_Referents2, Conditions2)), Set),
 1246    match_elements(Conditions1, Conditions2),
 1247    match_elements(Conditions2, Conditions1)
 1248  ;
 1249    Element = command(drs(_Referents1, Conditions1))
 1250    ->
 1251    member(command(drs(_Referents2, Conditions2)), Set),
 1252    match_elements(Conditions1, Conditions2),
 1253    match_elements(Conditions2, Conditions1)
 1254  ;
 1255    % complex condition: sentence subordination
 1256    Element = _ : drs(_Referents1, Conditions1)
 1257    ->
 1258    member( _ :(drs(_Referents2, Conditions2)), Set),
 1259    match_elements(Conditions1, Conditions2),
 1260    match_elements(Conditions2, Conditions1)
 1261  ;
 1262    % complex condition: implication
 1263    Element = drs(_ReferentsP1, ConditionsP1) => drs(_ReferentsC1, ConditionsC1)
 1264    ->
 1265    member(drs(_ReferentsP2, ConditionsP2) => drs(_ReferentsC2, ConditionsC2), Set),
 1266 	match_elements(ConditionsP1, ConditionsP2),
 1267    match_elements(ConditionsP2, ConditionsP1),
 1268 	match_elements(ConditionsC1, ConditionsC2),
 1269    match_elements(ConditionsC2, ConditionsC1)
 1270  ;
 1271    % complex condition: disjunction
 1272    % identity of Element and its counterpart in Set is established here
 1273    Element = drs(_ReferentsD1, ConditionsD1) v DisjunctsRest1
 1274    ->
 1275    member(drs(_ReferentsD2, ConditionsD2) v DisjunctsRest2, Set),
 1276    % first disjunct drs(_ReferentsD1, ConditionsD1) of Element can match any of the disjuncts of drs(_ReferentsD2, ConditionsD2) v DisjunctsRest2
 1277    match_element_against_disjunction(drs(_ReferentsD1, ConditionsD1), drs(_ReferentsD2, ConditionsD2) v DisjunctsRest2),
 1278    % match remaining disjuncts DisjunctsRest1 of Element against drs(_ReferentsD2, ConditionsD2) v DisjunctsRest2
 1279    (
 1280      % DisjunctsRest1 consists of exctly one disjunct
 1281      \+ DisjunctsRest1 = drs([], [_ v _])
 1282      ->
 1283      match_element_against_disjunction(DisjunctsRest1, drs(_ReferentsD2, ConditionsD2) v DisjunctsRest2)
 1284    ;
 1285      % DisjunctsRest1 consists of more than one disjunct
 1286      DisjunctsRest1 = drs([], [DisjunctsRest11 v DisjunctsRest12])
 1287      ->
 1288      match_elements([DisjunctsRest11 v DisjunctsRest12], [drs(_ReferentsD2, ConditionsD2) v DisjunctsRest2])
 1289    )
 1290  ),
 1291  match_elements(Elements, Set).
 1292
 1293
 1294match_element_against_disjunction(drs(_ReferentsD1, ConditionsD1), drs(_ReferentsD2, ConditionsD2) v DisjunctsRest2) :-
 1295  % Element drs(_ReferentsD1, ConditionsD1) matches one of the disjuncts of the Disjunction drs(_ReferentsD2, ConditionsD2) v DisjunctsRest2
 1296  (
 1297    % Element matches first disjunct of Disjunction
 1298    match_elements(ConditionsD1, ConditionsD2)
 1299    ->
 1300    true
 1301  ;
 1302    % Element does not match first disjunct of Disjunction
 1303    % there is exactly one further disjunct; try it
 1304    \+ DisjunctsRest2 = drs([], [_ v _])
 1305    ->
 1306    match_elements([drs(_ReferentsD1, ConditionsD1)], [DisjunctsRest2]) 
 1307  ;
 1308    % Element does not match first disjunct of Disjunction
 1309    % there are at least two further disjuncts; try them in order
 1310    DisjunctsRest2 = drs([], [DisjunctsRest21 v DisjunctsRest22])
 1311    ->
 1312    match_element_against_disjunction(drs(_ReferentsD1, ConditionsD1), DisjunctsRest21 v DisjunctsRest22) 
 1313  ).
 1314
 1315
 1316%---------------------------------------------------------------------------------------------------------
 1317%
 1318%  subterm(+Sub,+Term) 
 1319%
 1320%  	Sub is a subterm of Term
 1321%
 1322%---------------------------------------------------------------------------------------------------------
 1323
 1324subterm(Term, Term) :-
 1325  nonvar(Term).
 1326
 1327subterm(Sub,Term):-
 1328  nonvar(Term),
 1329  functor(Term,_F,N),
 1330  N > 0,
 1331  subterm(N,Sub,Term).
 1332
 1333
 1334subterm(N,Sub,Term):-
 1335  arg(N,Term,Arg),       
 1336  subterm(Sub,Arg).
 1337
 1338subterm(N,Sub,Term):-
 1339  N>1,
 1340  N1 is N-1,
 1341  subterm(N1,Sub,Term).
 1342   
 1343%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
 1344%
 1345%  subtract_conditions(+Conditions1, +Conditions2, -Difference)
 1346%
 1347%    - Difference contains all the conditions of Conditions1 that are not contained in Conditions2 - with the exception of formulas that are not affected
 1348%    - indices of conditions are ignored
 1349%    - no unification of conditions takes place
 1350%
 1351%-----------------------------------------------------------------------------------------------------------------------------------------------------------------
 1352
 1353subtract_conditions(Difference, [], Difference).
 1354
 1355subtract_conditions(Conditions1, [Condition2|Conditions2], Difference) :-
 1356  (
 1357    Condition2 = Condition2C - _,
 1358    Condition2C \= formula(_, _, _),
 1359    select(Condition - _, Conditions1, RestConditions1),
 1360    Condition == Condition2C
 1361    ->
 1362    subtract_conditions(RestConditions1, Conditions2, Difference)
 1363  ;
 1364    subtract_conditions(Conditions1, Conditions2, Difference)
 1365  ).
 1366  
 1367  
 1368%-----------------------------------------------------------------------------------------------------------------------------------------------------------------