1 package Text::Tradition::Language::French;
5 use Lingua::TagSet::Multext;
6 use Lingua::TagSet::TreeTagger::French;
7 use Module::Load qw/ load /;
8 use Text::Tradition::Language::Base qw/ lemmatize_treetagger reading_lookup_treetagger
9 lfs_morph_tags unicode_regularize /;
14 Text::Tradition::Language::French - language-specific module for French
18 Implements morphology lookup for French words in context. This module
19 depends on the Flemm module for French lemmatization
20 (L<http://www.univ-nancy2.fr/pers/namer/Outils.htm#fl3> in conjunction with
21 the TreeTagger software
22 (L<http://www.ims.uni-stuttgart.de/projekte/corplex/TreeTagger/>), which is
23 (for now) expected to be installed in $MORPHDIR/TreeTagger.
27 =head2 lemmatize( $text )
29 Evaluates the string using the Flemm package, and returns the results.
33 binmode STDOUT, ':utf8';
35 use_ok( 'Text::Tradition::Language::French' );
41 skip "Package Flemm not found" if $err;
42 my $tf = Text::Tradition->new(
44 'file' => 't/data/besoin.xml',
45 'language' => 'French' );
47 is( $tf->language, 'French', "Set language okay" );
49 # Test the lemmatization. How many readings now have morphological info?
50 # Do the lexemes match the reading?
53 foreach my $r ( $tf->collation->readings ) {
55 ok( $r->has_lexemes, "Reading $r has one or more lexemes" );
56 my @lex = $r->lexemes;
57 my $lexstr = join( '', map { $_->string } @lex );
58 my $textstr = $r->text;
60 is( $textstr, $lexstr, "Lexemes for reading $r match the reading" );
61 foreach my $l ( @lex ) {
62 # Check to see if Flemm actually ran
63 foreach my $wf ( $l->matching_forms ) {
64 $flemmed++ if $wf->morphology->get_feature('num');
66 next if $l->is_disambiguated;
70 is( $ambig, 102, "Found 102 ambiguous forms as expected" );
71 ok( $flemmed > 500, "Found enough Flemm info in wordforms" );
73 # Try setting the normal form of a reading and re-analyzing
74 my $mr = $tf->collation->reading('r99.2');
75 is( $mr->text, 'minspire', "Picked correct test reading" );
76 is( $mr->language, 'French', "Reading has correct language setting" );
77 $mr->normal_form( "m'inspire" );
80 is( @l, 2, "Got two lexemes for new m'inspire reading" );
81 is( $l[0]->form->to_string,
82 '"French // se|le|lui // cat@pron type@pers pers@1 num@sing case@acc|dat"',
83 "New reading has correct first lexeme" );
91 my $tradition = shift;
93 'language' => 'French',
94 'callback' => sub { _parse_wordform( _flemm_lookup( @_ ) ) }
96 return lemmatize_treetagger( $tradition, %opts );
99 =head2 reading_lookup( $rdg[, $rdg, ...] )
101 Looks up one or more readings using the Flemm package, and returns the
102 possible results. This uses the same logic as L<lemmatize> above for the
103 entire tradition, but can also be used to (re-)analyze individual readings.
110 'language' => 'French',
111 'callback' => sub { _parse_wordform( _flemm_lookup( @_ ) ) },
114 return reading_lookup_treetagger( %opts );
117 =head2 morphology_tags
119 Return a data structure describing the available parts of speech and their attributes.
123 sub morphology_tags {
124 return lfs_morph_tags();
127 # Closure and utility function for the package lemmatizer
132 # First try to load Flemm
133 unless( $lemmatizer ) {
136 $lemmatizer = Flemm->new( 'Encoding' => 'utf8', 'Tagger' => 'treetagger' );
138 warn "Cannot do French word lemmatization without Flemm: @_";
142 return $lemmatizer->lemmatize( @_ )
147 # Utility function to turn a Flemm result into a WordForm
148 sub _parse_wordform {
149 my $flemmobj = shift;
150 # For now just parse the string, until we make sense of the documentation.
151 my @results = split( / \|\| /, $flemmobj->getResult );
153 foreach ( @results ) {
154 my( $orig, $tag, $lemma ) = split( /\t/, $_ );
155 my( $pos, $morph ) = split( /:/, $tag );
158 $morphobj = Lingua::TagSet::Multext->tag2structure( $morph );
160 # Use the TreeTagger info if there is no Flemm morphology.
161 $morphobj = Lingua::TagSet::TreeTagger::French->tag2structure( $pos );
164 my $wf = Text::Tradition::Collation::Reading::WordForm->new(
165 'language' => 'French',
167 'morphology' => $morphobj,
171 warn "No morphology found for word: $_";
177 =head2 regularize( $text )
179 Returns a regularized form of the reading for the purposes of collation.
184 return unicode_regularize( @_ );
193 =item * Try to do more things with Perl objects in Flemm and TT