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:- module(drs_to_drslist, [
   16		drs_to_drslist/2
   17	]).   18
   19
   20:- use_module(drs_ops, [
   21		drs_operator/1
   22	]).

DRS to DRS lists converter

This module provides predicates to split a given DRS into a list of DRSs, such that if the elements of the resulting list are merged (by concatenating the domains and the condition lists of its DRSs), then the resulting DRS is structurally equivalent to the original. The DRSs in the resulting list do not share discourse referents.

author
- Kaarel Kaljurand
version
- 2009-06-03

*/

 drs_to_drslist(+Drs:drs, -DrsList:list) is det
Arguments:
Drs- is an Attempto DRS
DrsList- is a list of Attempto DRSs
   45drs_to_drslist(drs(_, CondList), DrsListSorted) :-
   46	termlist_to_termlistlist(CondList, CondListList),
   47	maplist(condlist_to_drs, CondListList, DrsList),
   48	sort_drslist(DrsList, DrsListSorted).
   49
   50
   51condlist_to_drs(CondList, drs(Dom, CondList)) :-
   52	get_toplevel_conds(CondList, ToplevelCondList),
   53	term_variables(ToplevelCondList, Dom).
 get_toplevel_conds(+CondsIn:list, -CondsOut:list)
Extracts from the given list of DRS conditions only those conditions that contribute discourse referents to the toplevel domain. Such conditions are simple toplevel conditions, but also simple conditions in the lists. For example, in the DRS of the sentence

Less than 3 dogs hate less than 3 cats.

all discourse referents are toplevel.

   68get_toplevel_conds([], []).
   69
   70get_toplevel_conds([Cond-Id | Conds], [Cond-Id | SelectedConds]) :-
   71	!,
   72	get_toplevel_conds(Conds, SelectedConds).
   73
   74get_toplevel_conds([[H | T] | Conds], SelectedConds) :-
   75	!,
   76	get_toplevel_conds([H | T], SelectedConds1),
   77	get_toplevel_conds(Conds, SelectedConds2),
   78	append(SelectedConds1, SelectedConds2, SelectedConds).
   79
   80get_toplevel_conds([_ComplexCond | Conds], SelectedConds) :-
   81	get_toplevel_conds(Conds, SelectedConds).
   82
   83
   84termlist_to_termlistlist(TermList, TermListList) :-
   85	termlist_to_termlistlist(TermList, [], TermListList).
   86
   87termlist_to_termlistlist([], Out, Out).
   88
   89termlist_to_termlistlist([Term | TermList], TermListList, Out) :-
   90	(
   91		term_and_termlist_share_variables(Term, TermListList, Included, Excluded)
   92	->
   93		termlist_to_termlistlist(TermList, [[Term | Included] | Excluded], Out)
   94	;
   95		termlist_to_termlistlist(TermList, [[Term] | TermListList], Out)
   96	).
   97
   98
   99term_and_termlist_share_variables(Term, TermListList, IncludedFlat, Excluded) :-
  100	partition(terms_share_variables(Term), TermListList, Included, Excluded),
  101	append(Included, IncludedFlat).
  102
  103terms_share_variables(Term1, Term2) :-
  104	term_variables(Term1, List1),
  105	term_variables(Term2, List2),
  106	exists_intersection(List1, List2).
  107
  108exists_intersection(List1, List2) :-
  109	member(El1, List1),
  110	member(El2, List2),
  111	El1 == El2,
  112	!.
 sort_drslist(+DrsList:list, -DrsListSorted:list) is det
Sorts the list of DRSs. Sorting is done by keysort/2, and the keys are assigned by assign_key/2. See the definition of assign_key/2 to find out how the soring order is determined.
  122sort_drslist([], []) :- !.
  123
  124sort_drslist([Drs], [Drs]) :- !.
  125
  126sort_drslist(DrsList, DrsListSorted) :-
  127	maplist(assign_key, DrsList, DrsListWithKeys),
  128	keysort(DrsListWithKeys, DrsListWithKeysSorted),
  129	maplist(remove_key, DrsListWithKeysSorted, DrsListSorted).
 remove_key(+DrsWithKey:term, -Drs:term)
  134remove_key(_-Drs, Drs).
 assign_key(+Drs:term, -DrsWithKey:term)
The key of a DRS is the smallest (in the standard order of terms) sentence ID and token ID combination (SId/TId) of a DRS condition. The SId/TId of a complex condition is determined recursively. Note that we do not check the 2nd DRS of complex binary conditions (e.g. the then-part of an implication), as there the keys are known to be larger.
  146assign_key(drs(Dom, Conds), Key-drs(Dom, Conds)) :-
  147	assign_key_to_conds(Conds, Key).
  148
  149
  150assign_key_to_conds(Conds, Key) :-
  151	maplist(get_key, Conds, Keys),
  152	sort(Keys, [Key | _]).
  153
  154
  155get_key(_-Key, Key) :- !.
  156
  157get_key(Cond, Key) :-
  158	functor(Cond, Op, _),
  159	drs_operator(Op),
  160	arg(1, Cond, Drs),
  161	assign_key(Drs, Key-_).
  162
  163get_key(_Label:Drs, Key) :-
  164	assign_key(Drs, Key-_).
  165
  166get_key([H | T], Key) :-
  167	assign_key_to_conds([H | T], Key)