—

              
package Treex::Core::Node::T;
BEGIN {
  $Treex::Core::Node::T::VERSION = '0.08083';
}
use Moose;
use Treex::Core::Common;
extends 'Treex::Core::Node';
with 'Treex::Core::Node::Ordered';
with 'Treex::Core::Node::InClause';
with 'Treex::Core::Node::EffectiveRelations';
# t-layer attributes
has [
    qw( nodetype t_lemma functor subfunctor formeme tfa
        is_dsp_root sentmod is_parenthesis is_passive is_generated
        is_relclause_head is_name_of_person voice
        t_lemma_origin formeme_origin is_infin
        )
] => ( is => 'rw' );
sub get_pml_type_name {
    my ($self) = @_;
    return $self->is_root() ? 't-root.type' : 't-node.type';
}
# the node is a root of a coordination/apposition construction
# analogy of PML_T::IsCoord
sub is_coap_root {
    my ($self) = @_;
    log_fatal("Incorrect number of arguments") if @_ != 1;
    return ( $self->functor || '' ) =~ /^(CONJ|CONFR|DISJ|GRAD|ADVS|CSQ|REAS|CONTRA|APPS|OPER)$/;
}
#----------- helpers for reference lists ------------
sub _get_node_list {
    my ( $self, $list, $arg_ref ) = @_;
    $list = $self->get_attr($list);
    my $doc = $self->get_document();
    my @nodes = $list ? ( map { $doc->get_node_by_id($_) } @{$list} ) : ();
    return $arg_ref ? $self->_process_switches( $arg_ref, @nodes ) : @nodes;
}
sub _set_node_list {
    my $self = shift;
    my $list = shift;
    $self->set_attr( $list, [ map { $_->get_attr('id') } @_ ] );
    return;
}
sub _add_to_node_list {
    my $self = shift;
    my $list = shift;
    # get the current elements of the list
    my $cur_ref = $self->get_attr($list);
    my @cur = $cur_ref ? @{$cur_ref} : ();
    # grep only those that aren't already in the list
    my @new = grep {
        my $id = $_;
        !any { $_ eq $id } @cur
    } map { $_->get_attr('id') } @_;
    # set the new list value
    $self->set_attr( $list, [ @cur, @new ] );
    return;
}
sub _remove_from_node_list {
    my $self = shift;
    my $list = shift;
    my @prev = $self->_get_node_list($list);
    my @remain;
    foreach my $node (@prev) {
        if ( !grep { $_ == $node } @_ ) {
            push @remain, $node;
        }
    }
    $self->_set_node_list( $list, @remain );
    return;
}
# TODO: with backrefs this method is no more needed
# remove unindexed IDs from a list attribute
sub _update_list {
    my ( $self, $list ) = @_;
    my $doc = $self->get_document();
    my $ref = $self->get_attr($list);
    my (@nodes, @invalid);
    return if (!$ref);
    foreach my $id (@{$ref}){
        if ($doc->id_is_indexed($id)){
            push @nodes, $id;
        }
        else {
            push @invalid, $id;
        }
    }
    $self->set_attr( $list, @nodes > 0 ? [@nodes] : undef );
    return;
}
#----------- a-layer (analytical) nodes -------------
sub get_lex_anode {
    my ($self)   = @_;
    my $lex_rf   = $self->get_attr('a/lex.rf');
    my $document = $self->get_document();
    return $document->get_node_by_id($lex_rf) if $lex_rf;
    return;
}
sub set_lex_anode {
    my ( $self, $lex_anode ) = @_;
    my $new_id = defined $lex_anode ? $lex_anode->get_attr('id') : undef;
    $self->set_attr( 'a/lex.rf', $new_id );
    return;
}
sub get_aux_anodes {
    my ( $self, $arg_ref ) = @_;
    log_fatal('Switches preceding_only and following_only cannot be used with get_aux_anodes (t-nodes vs. a-nodes).')
        if $arg_ref and ( $arg_ref->{preceding_only} or $arg_ref->{following_only} );
    return $self->_get_node_list( 'a/aux.rf', $arg_ref );
}
sub set_aux_anodes {
    my $self = shift;
    return $self->_set_node_list( 'a/aux.rf', @_ );
}
sub add_aux_anodes {
    my $self = shift;
    return $self->_add_to_node_list( 'a/aux.rf', @_ );
}
sub remove_aux_anodes {
    my $self = shift;
    return $self->_remove_from_node_list( 'a/aux.rf', @_ );
}
sub get_anodes {
    my ( $self, $arg_ref ) = @_;
    my $lex_anode = $self->get_lex_anode();
    my @nodes = ( ( defined $lex_anode ? ($lex_anode) : () ), $self->get_aux_anodes() );
    return @nodes if !$arg_ref;
    log_fatal('Switches preceding_only and following_only cannot be used with get_anodes (t-nodes vs. a-nodes).')
        if $arg_ref->{preceding_only} || $arg_ref->{following_only};
    return $self->_process_switches( $arg_ref, @nodes );
}
#------------ coreference nodes -------------------
sub get_coref_nodes {
    my ( $self, $arg_ref ) = @_;
    my @nodes = ( $self->_get_node_list('coref_gram.rf'), $self->_get_node_list('coref_text.rf') );
    return $self->_process_switches( $arg_ref, @nodes );
}
sub get_coref_gram_nodes {
    my ( $self, $arg_ref ) = @_;
    return $self->_get_node_list( 'coref_gram.rf', $arg_ref );
}
sub get_coref_text_nodes {
    my ( $self, $arg_ref ) = @_;
    return $self->_get_node_list( 'coref_text.rf', $arg_ref );
}
# it doesn't return a complete chain, just the members which are accessible
# from the current node
# TODO: with backrefs the whole chain is accessible now
sub get_coref_chain {
    my ( $self, $arg_ref ) = @_;
    my %visited_nodes = ();
    my @nodes;
    my @queue = ( $self->_get_node_list('coref_gram.rf'), $self->_get_node_list('coref_text.rf') );
    while ( my $node = shift @queue ) {
        $visited_nodes{$node} = 1;
        push @nodes, $node;
        my @antes = ( $node->_get_node_list('coref_gram.rf'), $node->_get_node_list('coref_text.rf') );
        foreach my $ante (@antes) {
            if ( !defined $visited_nodes{$ante} ) {
                push @queue, $ante;
            }
        }
    }
    return $self->_process_switches( $arg_ref, @nodes );
}
sub add_coref_gram_nodes {
    my $self = shift;
    return $self->_add_to_node_list( 'coref_gram.rf', @_ );
}
sub add_coref_text_nodes {
    my $self = shift;
    return $self->_add_to_node_list( 'coref_text.rf', @_ );
}
sub remove_coref_nodes {
    my $self = shift;
    $self->_remove_from_node_list( 'coref_gram.rf', @_ );
    $self->_remove_from_node_list( 'coref_text.rf', @_ );
    return;
}
# remove unindexed IDs from coreference lists
sub update_coref_nodes {
    my $self = shift;
    $self->_update_list('coref_gram.rf');
    $self->_update_list('coref_text.rf');
    return;
}
# ----------- complement nodes -------------
sub add_compl_nodes {
    my $self = shift;
    return $self->_add_to_node_list( 'compl.rf', @_ );
}
sub remove_compl_nodes {
    my $self = shift;
    $self->_remove_from_node_list( 'compl.rf', @_ );
    return;
}
sub update_compl_nodes {
    my $self = shift;
    $self->_update_list('compl.rf');
    return;
}
#----------- n-layer (named entity) nodes -------------
sub get_n_node {
    my ($self) = @_;
    my $lex_anode = $self->get_lex_anode() or return;
    return $lex_anode->n_node();
}
#----------- source t-layer (source-language in MT) nodes -------------
sub src_tnode {
    my ($self) = @_;
    my $source_node_id = $self->get_attr('src_tnode.rf') or return;
    return $self->get_document->get_node_by_id($source_node_id);
}
sub set_src_tnode {
    my ( $self, $source_node ) = @_;
    $self->set_attr( 'src_tnode.rf', $source_node->id );
    return;
}
# ---- attributes that contain references
override '_get_reference_attrs' => sub {
    my ($self) = @_;
    return ('a/lex.rf', 'original_parent.rf', 'src_tnode.rf', 'a/aux.rf', 'compl.rf', 'coref_gram.rf', 'coref_text.rf');
};
#----------- grammatemes -------------
#TODO: make these real Moose attributes
sub gram_sempos        { return $_[0]->get_attr('gram/sempos'); }
sub gram_gender        { return $_[0]->get_attr('gram/gender'); }
sub gram_number        { return $_[0]->get_attr('gram/number'); }
sub gram_degcmp        { return $_[0]->get_attr('gram/degcmp'); }
sub gram_verbmod       { return $_[0]->get_attr('gram/verbmod'); }
sub gram_deontmod      { return $_[0]->get_attr('gram/deontmod'); }
sub gram_tense         { return $_[0]->get_attr('gram/tense'); }
sub gram_aspect        { return $_[0]->get_attr('gram/aspect'); }
sub gram_resultative   { return $_[0]->get_attr('gram/resultative'); }
sub gram_dispmod       { return $_[0]->get_attr('gram/dispmod'); }
sub gram_iterativeness { return $_[0]->get_attr('gram/iterativeness'); }
sub gram_indeftype     { return $_[0]->get_attr('gram/indeftype'); }
sub gram_person        { return $_[0]->get_attr('gram/person'); }
sub gram_numertype     { return $_[0]->get_attr('gram/numertype'); }
sub gram_politeness    { return $_[0]->get_attr('gram/politeness'); }
sub gram_negation      { return $_[0]->get_attr('gram/negation'); }
sub gram_definiteness  { return $_[0]->get_attr('gram/definiteness'); }
sub gram_diathesis     { return $_[0]->get_attr('gram/diathesis'); }
sub set_gram_sempos        { return $_[0]->set_attr( 'gram/sempos',        $_[1] ); }
sub set_gram_gender        { return $_[0]->set_attr( 'gram/gender',        $_[1] ); }
sub set_gram_number        { return $_[0]->set_attr( 'gram/number',        $_[1] ); }
sub set_gram_degcmp        { return $_[0]->set_attr( 'gram/degcmp',        $_[1] ); }
sub set_gram_verbmod       { return $_[0]->set_attr( 'gram/verbmod',       $_[1] ); }
sub set_gram_deontmod      { return $_[0]->set_attr( 'gram/deontmod',      $_[1] ); }
sub set_gram_tense         { return $_[0]->set_attr( 'gram/tense',         $_[1] ); }
sub set_gram_aspect        { return $_[0]->set_attr( 'gram/aspect',        $_[1] ); }
sub set_gram_resultative   { return $_[0]->set_attr( 'gram/resultative',   $_[1] ); }
sub set_gram_dispmod       { return $_[0]->set_attr( 'gram/dispmod',       $_[1] ); }
sub set_gram_iterativeness { return $_[0]->set_attr( 'gram/iterativeness', $_[1] ); }
sub set_gram_indeftype     { return $_[0]->set_attr( 'gram/indeftype',     $_[1] ); }
sub set_gram_person        { return $_[0]->set_attr( 'gram/person',        $_[1] ); }
sub set_gram_numertype     { return $_[0]->set_attr( 'gram/numertype',     $_[1] ); }
sub set_gram_politeness    { return $_[0]->set_attr( 'gram/politeness',    $_[1] ); }
sub set_gram_negation      { return $_[0]->set_attr( 'gram/negation',      $_[1] ); }
sub set_gram_definiteness  { return $_[0]->set_attr( 'gram/definiteness',  $_[1] ); }
sub set_gram_diathesis     { return $_[0]->set_attr( 'gram/diathesis',     $_[1] ); }
1;
__END__
HideShow 143 lines of Pod
=encoding utf-8
=head1 NAME
Treex::Core::Node::T
=head1 VERSION
version 0.08083
=head1 DESCRIPTION
t-layer (tectogrammatical) node
=head1 METHODS
=head2 Access to a-layer (analytical nodes)
=over
=item $node->add_aux_anodes(@aux_anodes)
Add auxiliary a-nodes (to C<a/aux.rf>)
=item $anodes = $node->get_anodes()
Return a-nodes (both auxiliary and lexical, ie. C<a/aux.rf> and C<a/lex.rf>)
=item @aux_anodes = $node->get_aux_anodes()
Return auxiliary a-nodes (from C<a/aux.rf>).
=item $lex_anod = $node->get_lex_anode()
Return the lexical a-nodes (from C<a/lex.rf>).
=item $node->set_aux_anodes(@aux_anodes)
Set the auxiliary a-nodes (to C<a/aux.rf>).
=item set_lex_anode
Set the lexical a-node (to C<a/lex.rf>).
=item $node->remove_aux_anodes(@to_remove)
Remove the specified a-nodes from C<a/aux.rf> (if they are contained in it).
=item $node->get_coref_nodes()
Return textual and grammatical coreference nodes (from C<coref_gram.rf> and C<coref_text.rf>).
=item $node->get_coref_gram_nodes()
Return grammatical coreference nodes (from C<coref_gram.rf>).
=item $node->get_coref_text_nodes()
Return textual coreference nodes (from C<coref_text.rf>).
=item $node->add_coref_gram_nodes(@nodes)
Add grammatical coreference nodes (to C<coref_gram.rf>).
=item $node->add_coref_gram_nodes(@nodes)
Add textual coreference nodes (to C<coref_text.rf>).
=item $node->remove_coref_nodes()
Remove the specified nodes from C<coref_gram.rf> or C<coref_text.rf> (if they are contained in one or both of them).
=item $node->update_coref_nodes()
Remove all invalid coreferences from C<coref_gram.rf> and C<coref_text.rf>.
=back
=head2 Access to source language t-layer (in MT)
=over
=item $src_tnode = $node->src_tnode()
Return the source language (in MT) t-node (from C<src_tnode.rf>).
=item set_src_tnode
Set the source language (in MT) t-node (to C<src_tnode.rf>).
=back
=head2 Access to n-layer (named entity nodes)
Note there is no C<set_n_node> method.
You must set the link from n-node to a a-node.
=over
=item $node->get_n_node()
This is a shortcut for C<< $self->get_lex_anode()->n_node; >>
If this t-node is a part of a named entity,
this method returns the corresponding n-node (L<Treex::Core::Node::N>).
If this node is a part of more than one named entities,
only the most nested one is returned.
For example: "Bank of China"
 $n_node_for_china = $t_node_china->get_n_node();
 print $n_node_for_china->get_attr('normalized_name'); # China
 $n_node_for_bank_of_china = $n_node_for_china->get_parent();
 print $n_node_for_bank_of_china->get_attr('normalized_name'); # Bank of China
=back
=head2 Other methods
=over
=item is_coap_root
Is this node a root (or head) of a coordination/apposition construction?
On t-layer this is decided based on C<functor =~ /^(CONJ|CONFR|DISJ|GRAD|ADVS|CSQ|REAS|CONTRA|APPS|OPER)/>.
=back
=head1 AUTHOR
Zdeněk Žabokrtský <zabokrtsky@ufal.mff.cuni.cz>
Martin Popel <popel@ufal.mff.cuni.cz>
Ondřej Dušek <odusek@ufal.mff.cuni.cz>
=head1 COPYRIGHT AND LICENSE
Copyright © 2011-2012 by Institute of Formal and Applied Linguistics, Charles University in Prague
This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.