# ABSTRACT: Driver for a Norwegian tagset.
# Copyright © 2013, 2014 Dan Zeman <zeman@ufal.mff.cuni.cz>
# Based on code that someone sent me from Norway.

package Lingua::Interset::Tagset::NO::Conll;
use strict;
use warnings;
our $VERSION = '2.035';

use utf8;
use open ':utf8';
use namespace::autoclean;
use Moose;
extends 'Lingua::Interset::Tagset::Conll';



#------------------------------------------------------------------------------
# Returns the tagset id that should be set as the value of the 'tagset' feature
# during decoding. Every derived class must (re)define this method! The result
# should correspond to the last two parts in package name, lowercased.
# Specifically, it should be the ISO 639-2 language code, followed by '::' and
# a language-specific tagset id. Example: 'cs::multext'.
#------------------------------------------------------------------------------
sub get_tagset_id
{
    return 'no::conll';
}



#------------------------------------------------------------------------------
# Creates atomic drivers for surface features.
#------------------------------------------------------------------------------
sub _create_atoms
{
    my $self = shift;
    my %atoms;
    # PART OF SPEECH ####################
    $atoms{pos} = $self->create_atom
    (
        'surfeature' => 'pos',
        'decode_map' =>
        {
            'adj'              => ['pos' => 'adj'],
            'adv'              => ['pos' => 'adv'],
            '<anf>'            => ['pos' => 'punc', 'punctype' => 'quot'],
            'clb'              => ['pos' => 'punc', 'other' => {'punctype' => 'clb'}], # something for spoken language?
            'det'              => ['pos' => 'adj', 'prontype' => 'prn'],
            'inf-merke'        => ['pos' => 'conj', 'parttype' => 'inf'],
            'interj'           => ['pos' => 'int'],
            '<komma>'          => ['pos' => 'punc', 'punctype' => 'comm'],
            'konj'             => ['pos' => 'conj', 'conjtype' => 'coor'],
            '<parentes-beg>'   => ['pos' => 'punc', 'punctype' => 'brck', 'puncside' => 'ini'],
            '<parentes-slutt>' => ['pos' => 'punc', 'punctype' => 'brck', 'puncside' => 'fin'],
            'prep'             => ['pos' => 'adp', 'adpostype' => 'prep'],
            'prep+subst'       => ['pos' => 'noun'], # 'i_tilfelle'. Probably corpus bug.
            'pron'             => ['pos' => 'noun', 'prontype' => 'prn'],
            'sbu'              => ['pos' => 'conj', 'conjtype' => 'sub'],
            '<strek>'          => ['pos' => 'punc', 'punctype' => 'dash'],
            'subst'            => ['pos' => 'noun'],
            'symb'             => ['pos' => 'sym'],
            'ukjent'           => [],
            'verb'             => ['pos' => 'verb']
        },
        'encode_map' =>
        {
            'pos' => { 'noun' => { 'prontype' => { ''  => 'subst',
                                                   '@' => 'pron' }},
                       'adj'  => { 'prontype' => { ''  => 'adj',
                                                   '@' => 'det' }},
                       'verb' => 'verb',
                       'adv'  => 'adv',
                       'adp'  => 'prep',
                       'conj' => { 'parttype' => { 'inf' => 'inf-merke',
                                                   '@'   => { 'conjtype' => { 'sub' => 'sbu',
                                                                              '@'   => 'konj' }}}},
                       'int'  => 'interj',
                       'punc' => { 'punctype' => { 'quot' => '<anf>',
                                                   'comm' => '<komma>',
                                                   'dash' => '<strek>',
                                                   'brck' => { 'puncside' => { 'ini' => '<parentes-beg>',
                                                                               '@'   => '<parentes-slutt>' }},
                                                   '@'    => 'clb' }},
                       'sym'  => 'symb',
                       '@'    => 'ukjent' }
        }
    );
    # NOUN TYPE ####################
    $atoms{nountype} = $self->create_simple_atom
    (
        'intfeature' => 'nountype',
        'simple_decode_map' =>
        {
            'prop' => 'prop'
        }
    );
    # PRONOUN TYPE ####################
    $atoms{prontype} = $self->create_atom
    (
        'surfeature' => 'prontype',
        'decode_map' =>
        {
            'refl'   => ['reflex'      => 'reflex'],
            'hum'    => ['animateness' => 'anim'], # not strictly animate
            'pers'   => ['prontype'    => 'prs'],
            'høflig' => ['politeness'  => 'pol'],
            'sp'     => ['prontype'    => 'int'],
            'res'    => ['prontype'    => 'rcp']
        },
        'encode_map' =>
        {
            'reflex' => { 'reflex' => 'refl',
                          '@'      => { 'animateness' => { 'anim' => 'hum',
                                                           '@'    => { 'politeness' => { 'pol' => 'høflig',
                                                                                         '@'   => { 'prs' => 'pers',
                                                                                                    'rcp' => 'res',
                                                                                                    'int' => 'sp' }}}}}}
        }
    );
    # POSSESSIVITY ####################
    $atoms{poss} = $self->create_simple_atom
    (
        'intfeature' => 'poss',
        'simple_decode_map' =>
        {
            'poss' => 'poss'
        }
    );
    # SPECIAL TYPE ####################
    $atoms{spectype} = $self->create_atom
    (
        'surfeature' => 'spectype',
        'decode_map' =>
        {
            'unorm' => ['typo' => 'typo'],
            'fork'  => ['abbr' => 'abbr']
        },
        'encode_map' =>
        {
            'typo' => { 'typo' => 'unorm',
                        '@'    => { 'abbr' => { 'abbr' => 'fork' }}}
        }
    );
    # PUNCTUATION TYPE ####################
    $atoms{punctype} = $self->create_simple_atom
    (
        'intfeature' => 'punctype',
        'simple_decode_map' =>
        {
            '<anf>'     => 'quot',
            '<kolon>'   => 'colo',
            '<komma>'   => 'comm',
            '<ellipse>' => 'peri', # ellipsis = "..."; Interset does not have a value for this ###!!! yet
            '<punkt>'   => 'peri',
            '<semi>'    => 'semi',
            '<spm>'     => 'qest',
            '<utrop>'   => 'excl'
        }
    );
    # PERSON ####################
    $atoms{person} = $self->create_simple_atom
    (
        'intfeature' => 'person',
        'simple_decode_map' =>
        {
            '1' => '1',
            '2' => '2',
            '3' => '3'
        }
    );
    # CASE ####################
    $atoms{case} = $self->create_simple_atom
    (
        'intfeature' => 'case',
        'simple_decode_map' =>
        {
            'nom' => 'nom',
            'gen' => 'gen',
            'akk' => 'acc'
        }
    );
    # DEFINITENESS ####################
    $atoms{definiteness} = $self->create_simple_atom
    (
        'intfeature' => 'definiteness',
        'simple_decode_map' =>
        {
            'be' => 'def',
            'ub' => 'ind'
        }
    );
    # DEGREE ####################
    $atoms{degree} = $self->create_simple_atom
    (
        'intfeature' => 'degree',
        'simple_decode_map' =>
        {
            'pos'  => 'pos',
            'komp' => 'comp',
            'sup'  => 'sup'
        }
    );
    # GENDER ####################
    $atoms{gender} = $self->create_atom
    (
        'surfeature' => 'gender',
        'decode_map' =>
        {
            'mask' => ['gender' => 'masc'],
            'fem'  => ['gender' => 'fem'],
            'nøyt' => ['gender' => 'neut'],
            'n'    => ['gender' => 'neut'], ###!!! Corpus bug?
            'm/f'  => ['gender' => 'masc|fem'],
            'ubøy' => [] # Indeclinable nouns.
        },
        'encode_map' =>
        {
            'gender' => { 'masc'     => 'mask',
                          'fem'      => 'fem',
                          'fem|masc' => 'm/f',
                          'neut'     => 'nøyt',
                          '@'        => 'ubøy' }
        }
    );
    # NUMBER ####################
    $atoms{number} = $self->create_simple_atom
    (
        'intfeature' => 'number',
        'simple_decode_map' =>
        {
            'ent' => 'sing',
            'fl'  => 'plur'
        }
    );
    # VERB FORM ####################
    $atoms{verbform} = $self->create_atom
    (
        'surfeature' => 'verbform',
        'decode_map' =>
        {
            'inf'       => ['verbform' => 'inf'],
            'pres'      => ['verbform' => 'fin', 'mood' => 'ind', 'tense' => 'pres'],
            'pret'      => ['verbform' => 'fin', 'mood' => 'ind', 'tense' => 'past'],
            'imp'       => ['verbform' => 'fin', 'mood' => 'imp'],
            'perf-part' => ['verbform' => 'part', 'aspect' => 'perf', 'tense' => 'past'],
            'pass'      => ['voice' => 'pass']
        },
        'encode_map' =>
        {
            'verbform' => { 'inf'  => 'inf',
                            'part' => 'perf-part',
                            '@'    => { 'mood' => { 'imp' => 'imp',
                                                    '@'   => { 'tense' => { 'pres' => 'pres',
                                                                            'past' => 'pret',
                                                                            '@'    => { 'voice' => { 'pass' => 'pass' }}}}}}}
        }
    );
    # Classifying tags for multi-word expressions.
    #'adj+kon+adj'         => [qw/field value/],
    #'adj+verb'            => [qw/field value/],
    #'adv+adj'             => [qw/field value/],
    #'adv+adv+prep'        => [qw/field value/],
    #'det+subst'           => [qw/field value/],
    #'interj+adv'          => [qw/field value/],
    #'prep+adj'            => [qw/field value/],
    #'prep+adv'            => [qw/field value/],
    #'prep+adv+subst'      => [qw/field value/],
    #'prep+det+sbu'        => [qw/field value/],
    #'prep+det+subst'      => [qw/field value/],
    #'prep+konj+prep'      => [qw/field value/],
    #'prep+prep'           => [qw/field value/],
    #'prep+subst'          => [qw/field value/],
    #'prep+subst+prep'     => [qw/field value/],
    #'prep+subst+prep+sbu' => [qw/field value/],
    #'prep+subst+subst'    => [qw/field value/],
    #'pron+verb+verb'      => [qw/field value/],
    #'subst+perf-part'     => [qw/field value/],
    #'subst+prep'          => [qw/field value/],

    ###### UNSORTED ######
    #'<adj>'               => [qw/field value/],
    #'<adv>'               => [qw/field value/],
    #appell                => [qw/field value/], # Appellative (common nouns). Can probably be ignored.
    #'<aux1/inf>'          => [qw/field value/],
    #'<aux1/infinitiv>'    => [qw/field value/],
    #'<aux1/perf_part>'    => [qw/field value/],
    #clb                   => [qw/field value/], # Clause boundary. Can probably be ignored.
    #'<dato>'              => [qw/field value/],
    #dem                   => [qw/field value/], # TODO: Demonstrative
    #forst                 => [qw/field value/], # TODO: Emphasis
    #g                     => [qw/field value/], # Corpus bug?
    #'<ikke-clb>'          => [qw/field value/], # Non-clause boundary. Can probably be ignored.
    #'<klokke>'            => [qw/field value/],
    #kvant                 => [qw/field value/], # TODO
    #'<ordenstall>'        => [qw/field value/],
    #'<overskrift>'        => [qw/field value/],
    #pa                    => [qw/field value/],
    #pa1refl4              => [qw/field value/],
    #pa6                   => [qw/field value/],
    #'pa/til'              => [qw/field value/],
    #'<perf-part>'         => [qw/field value/],
    #pr2                   => [qw/field value/],
    #'<pres-part>'         => [qw/field value/],
    #'<romertall>'         => [qw/field value/],
    #samset                => [qw/field value/], # Compound word. Can probably be ignored.
    #sbu                   => [qw/field value/], # Probably corpus bug.
    #'<s-verb>'            => [qw/field value/],
    #tr                    => [qw/field value/], # Subcat frame.
    #w                     => [qw/field value/], # Corpus bug?
    # MERGED ATOM TO DECODE ANY FEATURE VALUE ####################
    my @fatoms = map {$atoms{$_}} (@{$self->features_all()});
    $atoms{feature} = $self->create_merged_atom
    (
        'surfeature' => 'feature',
        'atoms'      => \@fatoms
    );
    return \%atoms;
}



#------------------------------------------------------------------------------
# Creates the list of all surface CoNLL features that can appear in the FEATS
# column. This list will be used in decode().
#------------------------------------------------------------------------------
sub _create_features_all
{
    my $self = shift;
    my @features = ('nountype', 'prontype', 'poss', 'spectype', 'punctype', 'person', 'case', 'definiteness', 'degree', 'gender', 'number', 'verbform');
    return \@features;
}



#------------------------------------------------------------------------------
# Creates the list of surface CoNLL features that can appear in the FEATS
# column with particular parts of speech. This list will be used in encode().
#------------------------------------------------------------------------------
sub _create_features_pos
{
    my $self = shift;
    my %features =
    (
        '@' => ['nountype', 'prontype', 'poss', 'spectype', 'punctype', 'person', 'case', 'definiteness', 'degree', 'gender', 'number', 'verbform']
    );
    return \%features;
}



#------------------------------------------------------------------------------
# Decodes a physical tag (string) and returns the corresponding feature
# structure.
#------------------------------------------------------------------------------
sub decode
{
    my $self = shift;
    my $tag = shift;
    ###!!! Our list of known tags currently contains only the main part of speech but not the features.
    ###!!!my $fs = $self->decode_conll($tag);
    my $fs = Lingua::Interset::FeatureStructure->new();
    $fs->set_tagset($self->get_tagset_id());
    my $atoms = $self->atoms();
    $atoms->{pos}->decode_and_merge_hard($tag, $fs);
    return $fs;
}



#------------------------------------------------------------------------------
# Takes feature structure and returns the corresponding physical tag (string).
#------------------------------------------------------------------------------
sub encode
{
    my $self = shift;
    my $fs = shift; # Lingua::Interset::FeatureStructure
    my $atoms = $self->atoms();
    my $pos = $atoms->{pos}->encode($fs);
    my $fpos = $pos;
    my $feature_names = $self->get_feature_names($fpos);
    my $tag = $self->encode_conll($fs, $pos, $pos, $feature_names);
    ###!!!return $tag;
    return $pos;
}



#------------------------------------------------------------------------------
# Returns reference to list of known tags.
#------------------------------------------------------------------------------
sub list
{
    my $self = shift;
    my $list = <<end_of_list
adj
adv
<anf>
clb
det
inf-merke
interj
<komma>
konj
<parentes-beg>
<parentes-slutt>
prep
pron
sbu
<strek>
subst
symb
ukjent
verb
end_of_list
    ;
    # Protect from editors that replace tabs by spaces.
    $list =~ s/ \s+/\t/sg;
    my @list = split(/\r?\n/, $list);
    return \@list;
}



1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Lingua::Interset::Tagset::NO::Conll - Driver for a Norwegian tagset.

=head1 VERSION

version 2.035

=head1 SYNOPSIS

  use Lingua::Interset::Tagset::NO::Conll;
  my $driver = Lingua::Interset::Tagset::NO::Conll->new();
  my $fs = $driver->decode('subst');

or

  use Lingua::Interset qw(decode);
  my $fs = decode('no::conll', 'subst');

=head1 DESCRIPTION

Interset driver for the Norwegian tagset,
based on code that someone sent me from Norway (sorry, could not find the e-mail with the name of the person).
CoNLL tagsets in Interset are traditionally three values separated by tabs.
The values come from the CoNLL columns CPOS, POS and FEAT.

=head1 SEE ALSO

L<Lingua::Interset>,
L<Lingua::Interset::Tagset>,
L<Lingua::Interset::Tagset::Conll>,
L<Lingua::Interset::FeatureStructure>

=head1 AUTHOR

Dan Zeman <zeman@ufal.mff.cuni.cz>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2014 by Univerzita Karlova v Praze (Charles University in Prague).

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
