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:- module(tree_utils, [
   17		unsplit_pronouns_in_tree/2,  % +TreeIn, -TreeOut
   18		remove_gaps_in_tree/2,       % +TreeIn, -TreeOut
   19		unify_coords_in_tree/2       % +TreeIn, -TreeOut
   20	]).

Tree Utils

author
- Tobias Kuhn */
   27:- use_module(ace_niceace, [
   28		pronoun_split/2
   29	]).
 unsplit_pronouns_in_tree(+TreeIn, -TreeOut)
   34unsplit_pronouns_in_tree([], []).
   35
   36unsplit_pronouns_in_tree([np, [det, T1], [nbar, [n, T2]|RestIn]], [np, [pn, T]|RestOut]) :-
   37    pronoun_split(T, (T1, T2)),
   38    !,
   39    unsplit_pronouns_in_tree(RestIn, RestOut).
   40
   41unsplit_pronouns_in_tree([HeadIn|TailIn], [HeadOut|TailOut]) :-
   42    !,
   43    unsplit_pronouns_in_tree(HeadIn, HeadOut),
   44    unsplit_pronouns_in_tree(TailIn, TailOut).
   45
   46unsplit_pronouns_in_tree(Term, Term).
 remove_gaps_in_tree(+TreeIn, -TreeOut)
   51remove_gaps_in_tree([], []).
   52
   53remove_gaps_in_tree([HeadIn|TailIn], TailOut) :-
   54    empty_branch(HeadIn),
   55    !,
   56    remove_gaps_in_tree(TailIn, TailOut).
   57
   58remove_gaps_in_tree([HeadIn|TailIn], [HeadOut|TailOut]) :-
   59    !,
   60    remove_gaps_in_tree(HeadIn, HeadOut),
   61    remove_gaps_in_tree(TailIn, TailOut).
   62
   63remove_gaps_in_tree(Term, Term).
 empty_branch(+Branch)
   68empty_branch([]).
   69
   70empty_branch([_|Tail]) :-
   71    empty_branches(Tail).
 empty_branches(+BranchList)
   76empty_branches([]).
   77
   78empty_branches([Head|Tail]) :-
   79    empty_branch(Head),
   80    empty_branches(Tail).
 unify_coords_in_tree(TreeIn, -TreeOut)
   85unify_coords_in_tree(Leaf, Leaf) :-
   86    atomic(Leaf).
   87
   88unify_coords_in_tree(TreeIn, TreeOut) :-
   89    TreeIn = [Node, VP1, Coord, [Node|VP2Rest]],
   90    member(Node, [np_coord, vp_coord, s_coord, ap_coord]),
   91    !,
   92    unify_coords_in_tree(VP1, VP1T),
   93    unify_coords_in_tree([Node|VP2Rest], [Node|VP2RestT]),
   94    TreeOut = [Node, VP1T, Coord|VP2RestT].
   95
   96unify_coords_in_tree([Node|ChildrenIn], [Node|ChildrenOut]) :-
   97    atom(Node),
   98    !,
   99    unify_coords_in_tree(ChildrenIn, ChildrenOut).
  100
  101unify_coords_in_tree([FirstIn|RestIn], [FirstOut|RestOut]) :-
  102    unify_coords_in_tree(FirstIn, FirstOut),
  103    unify_coords_in_tree(RestIn, RestOut)