1 package Text::Tradition::Language::Latin;
6 use Text::Tradition::Language::Base qw/ lemmatize_treetagger treetagger_struct /;
11 Text::Tradition::Language::Latin - language-specific module for Latin
15 Implements morphology lookup for French words in context. This module
16 depends on the Morph::Perseus module for access to PhiloLogic database data.
17 It also depends on the TreeTagger software
18 (L<http://www.ims.uni-stuttgart.de/projekte/corplex/TreeTagger/>), which is
19 (for now) expected to be installed in $MORPHDIR/TreeTagger.
23 =head2 lemmatize( $text )
25 Evaluates the string using the Flemm package, and returns the results.
30 use_ok( 'Text::Tradition::Language::Latin' );
32 eval "use Morph::Perseus";
36 skip "Package Morph::Perseus not found" if $err;
38 my $trad = Text::Tradition->new(
39 'language' => 'Latin',
40 'file' => 't/data/legendfrag.xml',
44 foreach my $r ( $trad->collation->readings ) {
46 ok( $r->has_lexemes, "Reading $r has one or more lexemes" );
47 my @lex = $r->lexemes;
48 my $lexstr = join( '', map { $_->string } @lex );
49 my $textstr = $r->text;
51 is( $textstr, $lexstr, "Lexemes for reading $r match the reading" );
52 foreach my $l ( @lex ) {
53 next if $l->is_disambiguated;
54 printf( "Ambiguous lexeme %s for reading %s:\n\t%s\n", $l->string, $r->id,
55 join( "\n\t", map { $_->lemma . ': ' . $_->morphology->to_string } $l->matching_forms ) );
59 is( $ambig, 19, "Found 19 ambiguous forms as expected" );
67 my $tradition = shift;
69 'language' => 'Latin',
70 'callback' => sub { _perseus_lookup_tt( @_ ) }
72 return lemmatize_treetagger( $tradition, %opts );
75 =head2 reading_lookup( $rdg[, $rdg, ...] )
77 Looks up one or more readings using the Perseus package, and returns the
78 possible results. This skips the tree tagger / tokenizer, returning any
79 match for the word string(s) in the morphology DB.
85 return map { _perseus_lookup_str( $_ ) } @words;
94 load 'Morph::Perseus';
95 load 'Morph::Perseus::Structure';
96 $morph = Morph::Perseus->connect( 'Latin' );
98 warn "Cannot do Latin word lemmatization without Morph::Perseus: @_";
104 sub _perseus_lookup_tt {
105 my( $orig, $pos, $lemma ) = split( /\t/, $_[0] );
107 my $result = $morph->lookup( $orig );
108 # Discard results that don't match the lemma, unless lemma is unknown
110 unless( $lemma eq '<unknown>' ) {
111 # TODO Perseus lemma might have a number on the end, yuck.
112 @ret = grep { $_->lemma =~ /^$lemma(\d*)$/ } @{$result->{'objects'}};
115 @ret = @{$result->{'objects'}};
116 warn "TreeTagger lemma $lemma matched no results from Perseus for $orig"
120 # Discard results that don't match the given TreeTagger POS, unless
121 # that leaves zero results
123 foreach my $obj ( @ret ) {
124 push( @wordforms, _wordform_from_row( $obj ) );
126 ## TODO Use TreeTagger info - requires serious hacking of Lingua::TagSet
127 # my $ttstruct = treetagger_struct( $pos );
128 # my @ttmatch = grep { $ttstruct->is_compatible( $_->morphology ) } @wordforms;
129 # unless( @ttmatch ) {
130 # warn "TreeTagger POS $pos matched no results from Perseus for $orig";
131 # @ttmatch = @wordforms;
137 sub _perseus_lookup_str {
140 # Simple morph DB lookup, and return the results.
141 my $result = $morph->lookup( $orig );
142 return map { _wordform_from_row( $_ ) } @{$result->{'objects'}};
145 sub _wordform_from_row {
147 my $mpstruct = Morph::Perseus::Structure->from_tag( $rowobj->code );
148 my $wf = Text::Tradition::Collation::Reading::WordForm->new(
149 'language' => 'Latin',
150 'lemma' => $rowobj->lemma,
151 'morphology' => $mpstruct,