File Coverage

blib/lib/Lingua/YaTeA/PhraseSet.pm
Criterion Covered Total %
statement 339 687 49.3
branch 73 226 32.3
condition 38 144 26.3
subroutine 33 46 71.7
pod 27 37 72.9
total 510 1140 44.7


line stmt bran cond sub pod time code
1             package Lingua::YaTeA::PhraseSet;
2 5     5   36 use strict;
  5         14  
  5         149  
3 5     5   29 use warnings;
  5         9  
  5         152  
4 5     5   2273 use Lingua::YaTeA::MultiWordPhrase;
  5         17  
  5         73  
5 5     5   2207 use Lingua::YaTeA::MonolexicalPhrase;
  5         15  
  5         32  
6 5     5   1785 use Lingua::YaTeA::XMLEntities;
  5         14  
  5         54  
7 5     5   131 use UNIVERSAL;
  5         11  
  5         18  
8 5     5   104 use Data::Dumper;
  5         10  
  5         226  
9 5     5   30 use Scalar::Util qw(blessed);
  5         20  
  5         275  
10              
11             our $VERSION=$Lingua::YaTeA::VERSION;
12              
13 5     5   32 use Encode qw(:fallbacks);;
  5         10  
  5         37040  
14              
15             sub new
16             {
17 2     2 1 10 my ($class) = @_;
18 2         7 my $this = {};
19 2         5 bless ($this,$class);
20 2         20 $this->{PHRASES} = {}; # contain MultiWordPhrase
21 2         6 $this->{UNPARSED} = ();
22 2         7 $this->{UNPARSABLE} = ();
23 2         7 $this->{IF_ACCESS} = ();
24 2         5 $this->{LF_ACCESS} = ();
25 2         7 $this->{TERM_CANDIDATES} = {};
26 2         7 return $this;
27             }
28              
29             sub recordOccurrence
30             {
31 122     122 1 350 my ($this,$words_a,$num_content_words,$tag_set,$parsing_pattern_set,$option_set,$term_frontiers_h,$testified_term_set,$lexicon,$sentence_set,$fh) = @_;
32 122         198 my $phrase;
33             my $key;
34 122         169 my $complete = 0;
35 122         183 my $corrected = 0;
36 122 50       266 if(scalar @$words_a != 0)
37             {
38 122 50       251 if(scalar @$words_a > 0)
39             {
40 122 100       231 if(scalar @$words_a == 1)
41             {
42 42         156 $phrase = Lingua::YaTeA::MonolexicalPhrase->new(1,$words_a,$tag_set);
43             }
44             else
45             {
46 80         594 $phrase = Lingua::YaTeA::MultiWordPhrase->new($num_content_words,$words_a,$tag_set);
47             }
48 122         458 $key = $phrase->buildKey;
49            
50 122 100       309 if(!exists $this->getPhrases->{$key})
51             {
52 106         279 $this->addPhrase($key,$phrase);
53 106 100 100     348 if
54             (
55             ($option_set->optionExists('termino'))
56             &&
57             (scalar keys(%$term_frontiers_h) > 0)
58             )
59             # add testified terms here
60            
61             {
62 3         16 $phrase->addTestifiedTerms($term_frontiers_h,$testified_term_set,$fh);
63            
64            
65             }
66 106 100 66     572 if ((blessed($phrase)) && ($phrase->isa('Lingua::YaTeA::MultiWordPhrase')))
67             {
68 72 50       201 if(!$phrase->checkMaximumLength($option_set->getMaxLength))
69             {
70 0         0 $phrase->setTC(0);
71 0         0 $this->addToUnparsable($phrase);
72             }
73             else
74             {
75 72 100       238 if (defined $phrase->getTestifiedTerms)
76             {
77             #($complete,$corrected) = $phrase->searchExogenousIslands($parsing_pattern_set,$tag_set,$option_set->getParsingDirection,$lexicon,$sentence_set);
78 3         11 $phrase->searchExogenousIslands($parsing_pattern_set,$tag_set,$option_set->getParsingDirection,$lexicon,$sentence_set);
79 3 50       9 if(defined $phrase->getIslandSet)
80             {
81             # ($complete,$corrected) = $phrase->integrateIslands($chunking_data,$tag_set,$lexicon,$parsing_direction,$sentence_set,$fh);
82 3         10 ($complete,$corrected) = $phrase->integrateIslands($tag_set,$lexicon,$option_set->getParsingDirection,$sentence_set,$fh);
83             }
84 3 100       12 if($corrected == 1)
85             {
86             # print "reengistre\n";
87 2         7 $phrase->{LF} = $phrase->getIndexSet->buildLFSequence($phrase->getWords,$tag_set);
88 2         14 $phrase->{POS} = $phrase->getIndexSet->buildPOSSequence($phrase->getWords,$tag_set);
89             }
90 3 50       9 if($complete == 1)
91             {
92 0         0 $phrase->setTC(1);
93 0         0 $phrase->setParsingMethod('TESTIFIED_MATCHING');
94 0         0 $this->giveAccess($phrase);
95             }
96             }
97 72 50       209 if($complete == 0)
98             {
99 72 100       185 if($phrase->searchParsingPattern($parsing_pattern_set,$tag_set,$option_set->getParsingDirection))
100             {
101 45         185 $phrase->setTC(1);
102 45         223 $phrase->setParsingMethod('PATTERN_MATCHING');
103 45         123 $this->giveAccess($phrase);
104            
105             }
106             else
107             {
108 27         96 $this->addToUnparsed($phrase);
109             # $this->addToUnparsable($phrase);
110             }
111             }
112             }
113             }
114             else
115             {
116              
117 34 50 33     109 if ((defined $option_set->getOption('monolexical-all')) && ($option_set->getOption('monolexical-all')->getValue() == 1))
118             {
119 0         0 $phrase->setTC(1);
120 0         0 $phrase->setParsingMethod('MONOLEXICAL');
121 0         0 $this->giveAccess($phrase);
122             }
123             else
124             {
125            
126             # monolexical phrases are added to the unparsable phrase set
127 34         94 $this->addToUnparsable($phrase);
128             }
129             }
130             }
131             else{
132             # debaptiser le phrase qui vient d'etre construit
133 16         37 $phrase = $this->getPhrases->{$key};
134             }
135 122         628 $phrase->addOccurrence($words_a,1,$fh);
136             }
137             }
138             }
139              
140              
141              
142              
143             sub addPhrase
144             {
145 106     106 1 208 my ($this,$key,$phrase) = @_;
146 106         182 $this->getPhrases->{$key} = $phrase;
147 106         170 $Lingua::YaTeA::Phrase::counter++;
148 106 100 66     894 if ((blessed($phrase)) && ($phrase->isa('Lingua::YaTeA::MultiWordPhrase')))
149             {
150 72         167 $Lingua::YaTeA::MultiWordPhrase::counter++;
151             }
152             else
153             {
154 34         70 $Lingua::YaTeA::MonolexicalPhrase::counter++;
155             }
156             }
157              
158              
159              
160             sub getPhrases
161             {
162 324     324 1 558 my ($this) = @_;
163 324         1030 return $this->{PHRASES};
164             }
165              
166              
167              
168             sub giveAccess
169             {
170 70     70 1 139 my ($this,$phrase) = @_;
171 70         107 push @{$this->{IF_ACCESS}->{$phrase->getIF}}, $phrase;
  70         220  
172            
173 70         133 push @{$this->{LF_ACCESS}->{$phrase->getLF}}, $phrase;
  70         559  
174             }
175              
176              
177             sub searchFromIF
178             {
179 259     259 1 450 my ($this,$key) = @_;
180 259 100       1041 if(exists $this->{IF_ACCESS}->{$key})
181             {
182 1         5 return $this->{IF_ACCESS}->{$key};
183             }
184            
185             }
186              
187              
188             sub searchFromLF
189             {
190 258     258 1 452 my ($this,$key) = @_;
191 258 100       1307 if(exists $this->{LF_ACCESS}->{$key})
192             {
193 5         25 return $this->{LF_ACCESS}->{$key};
194             }
195             }
196              
197              
198             sub addToUnparsed
199             {
200 27     27 1 54 my ($this,$phrase) = @_;
201              
202 27         42 push @{$this->{UNPARSED}},$phrase;
  27         89  
203             }
204              
205             sub addToUnparsable
206             {
207 36     36 1 71 my ($this,$phrase) = @_;
208              
209             # print STDERR "$phrase\n";
210              
211 36         64 push @{$this->{UNPARSABLE}},$phrase;
  36         105  
212             }
213              
214             sub getUnparsed
215             {
216 58     58 1 140 my ($this) = @_;
217 58         11607 return $this->{UNPARSED};
218             }
219              
220              
221              
222             sub sortUnparsed
223             {
224 2     2 1 6 my ($this) = @_;
225 2 50       26 if(defined $this->{UNPARSED})
226             {
227 2         7 @{$this->{UNPARSED}} = sort{$b->getLength <=> $a->getLength} @{$this->{UNPARSED}};
  2         13  
  73         138  
  2         17  
228             } else {
229 0         0 my @tmp = ();
230 0         0 return(\@tmp);
231             }
232             }
233              
234             sub parseProgressively
235             {
236 2     2 1 11 my ($this,$tag_set,$parsing_direction,$parsing_pattern_set,$chunking_data,$lexicon,$sentence_set,$message_set,$display_language, $fh) = @_;
237 2         4 my $phrase;
238 2         5 my $counter = 0;
239 2         5 my $complete;
240 2         6 my $corrected = 0;
241             #foreach $phrase (@{$this->getUnparsed})
242            
243 2         3 my $Unparsed_size;
244              
245 2         8 my $ref = $this->getUnparsed;
246             #$fh = \*STDERR;
247 2 50       18 if (!defined $ref) {
248 0         0 return (0);
249             }
250 2         5 $Unparsed_size = scalar(@{$ref});
  2         4  
251              
252 2 50       16 if(defined $this->{UNPARSED})
253             {
254 2         6 while ($phrase = pop @{$this->getUnparsed})
  29         154  
255             {
256 27         63 $counter++;
257             #print $fh "\n\n";
258             #print $fh "COUNTER: " . $counter . " \t" . $phrase->{'IF'} . "\n";
259             #$phrase->print($fh);
260            
261             # if (($phrase->{'IF'} eq "fonction ventriculaire gauche globale") || ($phrase->{'IF'} eq "fonction ventriculaire gauche systolique globale")) {
262             # print STDERR Dumper($phrase);
263             # }
264 27         70 $complete = 0;
265 27         49 $corrected = 0;
266 27         136 $phrase->searchEndogenousIslands($this,$chunking_data,$tag_set,$lexicon,$sentence_set,$fh);
267 27 100       90 if(defined $phrase->getIslandSet)
268             {
269             #$phrase->printIslands($fh);
270             # ($complete,$corrected) = $phrase->integrateIslands($chunking_data,$tag_set,$lexicon,$parsing_direction,$sentence_set,$fh);
271            
272 8         43 ($complete,$corrected) = $phrase->integrateIslands($tag_set,$lexicon,$parsing_direction,$sentence_set,$fh);
273             }
274 27 100       110 if($corrected == 1)
275             {
276 2         11 $this->updateRecord($phrase,$tag_set);
277             }
278 27 50       78 if($complete == 1)
279             {
280 0         0 $phrase->setParsingMethod('PROGRESSIVE');
281 0         0 $phrase->setTC(1);
282 0         0 $this->giveAccess($phrase);
283             }
284             else
285             {
286 27         129 $phrase->plugInternalFreeNodes($parsing_pattern_set,$parsing_direction,$tag_set,$fh);
287            
288 27 100       124 if($phrase->parseProgressively($tag_set,$parsing_direction,$parsing_pattern_set,$fh))
289             {
290 25         121 $phrase->setParsingMethod('PROGRESSIVE');
291 25         131 $phrase->setTC(1);
292 25         96 $this->giveAccess($phrase);
293             }
294             else
295             {
296 2         10 $phrase->setTC(0);
297 2         9 $this->addToUnparsable($phrase);
298             # $phrase->print($fh);
299              
300             }
301             # $phrase->printForestParenthesised($fh);
302             # print $fh "\n\n";
303 27         166 printf STDERR $message_set->getMessage('UNPARSED_PHRASES')->getContent($display_language) . "... %0.1f%% \r", (scalar(@{$this->getUnparsed}) / $Unparsed_size) * 100 ;
  27         80  
304             }
305             }
306 2         32 print STDERR "\n";
307             }
308            
309             }
310              
311             sub updateRecord
312             {
313 2     2 1 9 my ($this,$phrase,$tag_set) = @_;
314 2         25 my $key;
315             my $reference;
316            
317 2         18 $key = $phrase->buildKey;
318            
319 2 50       11 if(exists $this->getPhrases->{$key})
320             {
321 2         6 delete $this->getPhrases->{$key};
322              
323             }
324              
325 2         10 $phrase->buildLinguisticInfos($phrase->getWords,$tag_set);
326 2         7 $key = $phrase->buildKey;
327            
328 2 50       7 if(exists $this->getPhrases->{$key})
329             {
330 0         0 $reference = $this->getPhrases->{$key};
331 0         0 $reference->addOccurrences($phrase->getOccurrences);
332            
333             }
334             else
335             {
336 2         9 $this->getPhrases->{$key} = $phrase;
337             }
338             }
339              
340              
341             sub getUnparsable
342             {
343 0     0 1 0 my ($this) = @_;
344 0         0 return $this->{UNPARSABLE};
345             }
346              
347              
348              
349             sub getIFaccess
350             {
351 4     4 1 10 my ($this) = @_;
352 4         30 return $this->{IF_ACCESS};
353             }
354              
355             sub addTermCandidates
356             {
357 2     2 1 8 my ($this,$option_set) = @_;
358 2         7 my $phrase;
359             my $phrase_set;
360 2         0 my $term_candidate;
361 2         13 my $tc_max_length = $option_set->getTCMaxLength;
362 2         6 my %mapping_from_phrases_to_TCs_h;
363             my %monolexical_transfer;
364            
365            
366 2 50       10 if(defined $this->getIFaccess)
367             {
368 2         4 foreach $phrase_set (values (%{$this->getIFaccess}))
  2         8  
369             {
370 70         174 foreach $phrase (@$phrase_set){
371 70         166 $phrase->addTermCandidates($this->getTermCandidates,\%mapping_from_phrases_to_TCs_h,$tc_max_length,$option_set,$this->getPhrases,\%monolexical_transfer);
372             }
373             }
374             }
375 2         6 foreach $term_candidate (values (%{$this->getTermCandidates}))
  2         11  
376             {
377            
378 240 100 66     1180 if(
      100        
379             ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
380             &&
381             ($term_candidate->containsIslands)
382             )
383             {
384 16         44 $term_candidate->adjustIslandReferences(\%mapping_from_phrases_to_TCs_h);
385             }
386             }
387 2 50 33     10 if ((defined $option_set->getOption('monolexical-included')) && ($option_set->getOption('monolexical-included')->getValue() == 1))
388             {
389 0         0 $this->adjustMonolexicalPhrasesSet(\%monolexical_transfer);
390             }
391             }
392              
393              
394              
395             sub adjustMonolexicalPhrasesSet
396             {
397 0     0 1 0 my ($this,$monolexical_transfer_h) = @_;
398 0         0 my @adjusted_list;
399             my $phrase;
400            
401 0 0       0 if(defined $this->{UNPARSABLE})
402             {
403 0         0 while ($phrase = pop @{$this->getUnparsable})
  0         0  
404             {
405 0 0 0     0 if
      0        
406             (
407             (((blessed($phrase)) && ($phrase->isa('Lingua::YaTeA::MultiWordPhrase'))))
408             ||
409             (!exists $monolexical_transfer_h->{$phrase->getID})
410             )
411             {
412 0         0 push @adjusted_list, $phrase;
413             }
414             }
415             }
416 0         0 @{$this->{UNPARSABLE}} = @adjusted_list;
  0         0  
417             }
418              
419             sub getTermCandidates
420             {
421 80     80 1 157 my ($this) = @_;
422 80         363 return $this->{TERM_CANDIDATES};
423             }
424              
425              
426             sub printBootstrapList
427             {
428 0     0 0 0 my ($this,$file,$source, $fh) = @_;
429            
430 0 0       0 if (!defined $fh) {
431 0 0       0 if ($file eq "stdout") {
432 0         0 $fh = \*STDOUT;
433             } else {
434 0 0       0 if ($file eq "stderr") {
435 0         0 $fh = \*STDERR;
436             } else {
437 0         0 $fh = FileHandle->new(">".$file->getPath);
438             }
439             }
440             }
441 0         0 binmode($fh, ":utf8");
442             # my $fh = FileHandle->new(">".$file->getPath);
443 0         0 my $term_candidate;
444             my $tree;
445 0         0 my $parse;
446 0         0 foreach $term_candidate ( sort ({&sortTermCandidates($a,$b, "Freq")} values(%{$this->getTermCandidates})))
  0         0  
  0         0  
447             {
448 0         0 $parse = "";
449 0 0 0     0 if ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate'))) {
450              
451 0         0 $parse = $term_candidate->getKey;
452             #print STDERR "B :: " . $parse. "\n";
453 0         0 $parse =~ s/(<=[MH])=[^>]+(>)/$1$2/g;
454 0         0 $parse =~ s/<=(IN|TO)=[^>]+>/<=P>/g;
455             # $parse =~ s/<=IN=[^>]+>/<=P>/g;
456 0         0 $parse =~ s/<=[A-Z\$]+=[^>]+>/<=D>/g;
457 0         0 print $fh $parse;
458 0         0 print $fh "\t" . $term_candidate->getIF;
459 0         0 print $fh "\t" . $term_candidate->getPOS;
460 0         0 print $fh "\t" . $term_candidate->getLF;
461 0         0 print $fh "\t" . $source . "\n";
462            
463             }
464             }
465             }
466              
467              
468             sub printTermList
469             {
470 2     2 1 11 my ($this,$file,$term_list_style, $fh, $sorted_weight) = @_;
471              
472 2         9 my $term_candidate;
473             my $mes;
474 2         0 my @Measures;
475              
476             # my $fh;
477 2 50       10 if (!defined $fh) {
478 2 50       12 if ($file eq "stdout") {
479 0         0 $fh = \*STDOUT;
480             } else {
481 2 50       10 if ($file eq "stderr") {
482 0         0 $fh = \*STDERR;
483             } else {
484 2         11 $fh = FileHandle->new(">".$file->getPath);
485             }
486             }
487             }
488 2         453 binmode($fh, ":utf8");
489 2         124 warn "(tL) term_list_style: $term_list_style\n";
490 2 50       15 if (!defined $sorted_weight) {
491 2         8 $sorted_weight = "Freq";
492             }
493              
494 2         5 my @term_candidates = values(%{$this->getTermCandidates});
  2         11  
495              
496 2         8 my $header = "ID\tInflected form\tLemmatised form\tFrequency";
497              
498 2 50       20 if (scalar(@term_candidates) > 0) {
499 2         8 @Measures = sort {lc($a) cmp lc($b)} keys %{$term_candidates[0]->getWeights};
  0         0  
  2         11  
500 2         14 foreach $mes (@Measures) {
501 2         12 $header .= "\t$mes";
502             }
503             }
504 2         6 $header .= "\tHead\tModifier\tMainHead";
505 2         37 print $fh "# $header\n";
506            
507             # warn "term_list_style: $term_list_style\n";
508 2         8 my $printLine;
509 2         17 foreach $term_candidate ( sort ({&sortTermCandidates($a,$b, $sorted_weight)} @term_candidates))
  877         1274  
510             {
511            
512             # warn ($term_candidate->isTerm * 1) . "\n";
513             # warn "term_list_style: $term_list_style\n";
514             # warn $term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate') . "\n";
515 240 100 33     1882 if(
      66        
      66        
      66        
516             (
517             ($term_list_style eq "")
518             ||
519             ($term_list_style eq "all")
520             ||
521             (
522             ($term_list_style eq "multi")
523             &&
524             ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
525             )
526             )
527             )
528             {
529 112         237 $printLine = $term_candidate->getID . "\t" . $term_candidate->getIF. "\t" . $term_candidate->getLF. "\t" . $term_candidate->getFrequency;
530 112         245 foreach $mes (@Measures) {
531 112 50       269 if (defined $term_candidate->getWeight($mes)) {
532 112         244 $printLine .= "\t" . $term_candidate->getWeight($mes);
533             }
534             }
535 112         198 $printLine .= "\t";
536 112 50 33     543 if ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate'))) {
537 112         263 $printLine .= $term_candidate->getRootHead->getID . "\t";
538 112         275 $printLine .= $term_candidate->getRootModifier->getID . "\t" ;
539 112         257 $printLine .= $term_candidate->getHead->getID . "\t";
540             } else {
541 0         0 $printLine .= "\t\t\t";
542             }
543            
544 112         489 print $fh "$printLine\n";
545             }
546             }
547             }
548              
549             sub printTermAndHeadList
550             {
551 0     0 0 0 my ($this,$file,$term_list_style, $fh, $sorted_weight) = @_;
552              
553 0         0 my $term_candidate;
554             my $mes;
555              
556             # my $fh;
557 0 0       0 if (!defined $fh) {
558 0 0       0 if ($file eq "stdout") {
559 0         0 $fh = \*STDOUT;
560             } else {
561 0 0       0 if ($file eq "stderr") {
562 0         0 $fh = \*STDERR;
563             } else {
564 0         0 $fh = FileHandle->new(">".$file->getPath);
565             }
566             }
567             }
568 0         0 binmode($fh, ":utf8");
569 0         0 warn "(tL) term_list_style: $term_list_style\n";
570 0 0       0 if (!defined $sorted_weight) {
571 0         0 $sorted_weight = "Freq";
572             }
573              
574 0         0 my @term_candidates = values(%{$this->getTermCandidates});
  0         0  
575              
576 0         0 my $header = "Inflected form\tFrequency";
577              
578 0         0 my @Measures = keys %{$term_candidates[0]->getWeights};
  0         0  
579 0         0 foreach $mes (@Measures) {
580 0         0 $header .= "\t$mes";
581             }
582 0         0 print $fh "# $header\n";
583              
584 0         0 my $printLine;
585 0         0 foreach $term_candidate ( sort ({&sortTermCandidates($a,$b, $sorted_weight)} @term_candidates))
  0         0  
586             {
587 0 0 0     0 if(
      0        
      0        
      0        
588             (
589             ($term_list_style eq "")
590             ||
591             ($term_list_style eq "all")
592             ||
593             (
594             ($term_list_style eq "multi")
595             &&
596             ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
597             )
598             )
599             )
600            
601             {
602 0 0       0 if ($term_candidate->getIF ne $term_candidate->getHead->getIF) {
603 0         0 $printLine = $term_candidate->getIF. "\t" . $term_candidate->getHead->getIF;
604             }
605             # foreach $mes (@Measures) {
606             # if (defined $term_candidate->getWeight($mes)) {
607             # $printLine .= "\t" . $term_candidate->getWeight($mes);
608             # }
609             # }
610 0         0 print $fh "$printLine\n";
611             }
612             }
613             }
614              
615             sub printTermAndRootHeadList
616             {
617 0     0 0 0 my ($this,$file,$term_list_style, $fh, $sorted_weight) = @_;
618              
619 0         0 my $term_candidate;
620             my $mes;
621              
622 0 0       0 if (!defined $fh) {
623 0 0       0 if ($file eq "stdout") {
624 0         0 $fh = \*STDOUT;
625             } else {
626 0 0       0 if ($file eq "stderr") {
627 0         0 $fh = \*STDERR;
628             } else {
629 0         0 $fh = FileHandle->new(">".$file->getPath);
630             }
631             }
632             }
633 0         0 binmode($fh, ":utf8");
634 0         0 warn "(tL) term_list_style: $term_list_style\n";
635 0 0       0 if (!defined $sorted_weight) {
636 0         0 $sorted_weight = "Freq";
637             }
638              
639 0         0 my @term_candidates = values(%{$this->getTermCandidates});
  0         0  
640              
641 0         0 my $header = "Inflected form\tFrequency";
642              
643 0         0 my @Measures = keys %{$term_candidates[0]->getWeights};
  0         0  
644 0         0 foreach $mes (@Measures) {
645 0         0 $header .= "\t$mes";
646             }
647 0         0 print $fh "# $header\n";
648              
649 0         0 my $printLine;
650 0         0 foreach $term_candidate ( sort ({&sortTermCandidates($a,$b, $sorted_weight)} @term_candidates))
  0         0  
651             {
652 0 0 0     0 if(
      0        
      0        
      0        
653             (
654             ($term_list_style eq "")
655             ||
656             ($term_list_style eq "all")
657             ||
658             (
659             ($term_list_style eq "multi")
660             &&
661             ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
662             )
663             )
664             )
665            
666             {
667 0 0       0 if ($term_candidate->getIF ne $term_candidate->getHead->getIF) {
668 0         0 $printLine = $term_candidate->getIF. "\t" . $term_candidate->getRootHead->getIF;
669             }
670             # foreach $mes (@Measures) {
671             # if (defined $term_candidate->getWeight($mes)) {
672             # $printLine .= "\t" . $term_candidate->getWeight($mes);
673             # }
674             # }
675 0         0 print $fh "$printLine\n";
676             }
677             }
678             }
679              
680             sub printTermCandidatesAndComponents {
681 0     0 0 0 my ($this,$file,$term_list_style, $fh, $tagset) = @_;
682              
683 0         0 my $term_candidate;
684             my $mes;
685              
686 0 0       0 if (!defined $fh) {
687 0 0       0 if ($file eq "stdout") {
688 0         0 $fh = \*STDOUT;
689             } else {
690 0 0       0 if ($file eq "stderr") {
691 0         0 $fh = \*STDERR;
692             } else {
693 0         0 $fh = FileHandle->new(">".$file->getPath);
694             }
695             }
696             }
697 0         0 binmode($fh, ":utf8");
698             # warn "(tL) term_list_style: $term_list_style\n";
699             # if (!defined $sorted_weight) {
700             # $sorted_weight = "Freq";
701             # }
702            
703 0         0 my @term_candidates = values(%{$this->getTermCandidates});
  0         0  
704              
705             # my $header = "Inflected form\tFrequency";
706              
707             # my @Measures = keys %{$term_candidates[0]->getWeights};
708             # foreach $mes (@Measures) {
709             # $header .= "\t$mes";
710             # }
711             # print $fh "# $header\n";
712              
713 0         0 my $header = "Term inflected form\tTerm lemmatised form\tTerm frequency\t";
714 0         0 $header .= "Head inflected form\tHead lemmatised form\tHead frequency\t";
715 0         0 $header .= "Modifier inflected form\tModifier lemmatised form\tModifier frequency\t";
716 0         0 print $fh "# $header\n";
717              
718 0         0 my $printLine;
719             # foreach $term_candidate ( sort ({&sortTermCandidates($a,$b, $sorted_weight)} @term_candidates))
720 0         0 foreach $term_candidate (@term_candidates) {
721 0 0 0     0 if(
      0        
      0        
      0        
722             (
723             ($term_list_style eq "")
724             ||
725             ($term_list_style eq "all")
726             ||
727             (
728             ($term_list_style eq "multi")
729             &&
730             ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
731             )
732             )
733             ) {
734 0         0 $printLine = $term_candidate->getIF . "\t" . $term_candidate->getLF . "\t" . $term_candidate->getFrequency . "\t" ;
735 0 0 0     0 if ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate'))) {
736 0         0 $printLine .= $term_candidate->getRootHead->getIF . "\t" . $term_candidate->getRootHead->getLF . "\t" . $term_candidate->getRootHead->getFrequency . "\t" ;
737 0         0 $printLine .= $term_candidate->getRootModifier->getIF . "\t" . $term_candidate->getRootModifier->getLF . "\t" . $term_candidate->getRootModifier->getFrequency . "\t" ;
738             } else {
739 0         0 $printLine .= "\t\t\t\t";
740             }
741             # foreach $mes (@Measures) {
742             # if (defined $term_candidate->getWeight($mes)) {
743             # $printLine .= "\t" . $term_candidate->getWeight($mes);
744             # }
745             # }
746 0         0 print $fh "$printLine\n";
747             }
748             }
749             }
750              
751             sub sortTermCandidates
752             {
753 877     877 0 1348 my ($a,$b, $weight) = @_;
754              
755 877 50       1698 if (!defined $b->getWeight($weight)) {
756 877         1578 return($b->getFrequency <=> $a->getFrequency);
757             }
758              
759 0 0       0 if($b->getWeight($weight) == $a->getWeight($weight))
760             {
761 0 0       0 if($b->getReliability == $a->getReliability)
762             {
763 0         0 return $b->getFrequency <=> $a->getFrequency;
764             }
765             else
766             {
767 0         0 return $b->getReliability <=> $a->getReliability;
768             }
769             }
770             else
771             {
772 0         0 return $b->getWeight($weight) <=> $a->getWeight($weight);
773             }
774             }
775              
776             sub printUnparsable
777             {
778 0     0 1 0 my ($this,$file,$fh) = @_;
779 0         0 my $phrase;
780              
781 0 0       0 if (!defined $fh) {
782 0 0       0 if ($file eq "stdout") {
783 0         0 $fh = \*STDOUT;
784             } else {
785 0 0       0 if ($file eq "stderr") {
786 0         0 $fh = \*STDERR;
787             } else {
788             # warn $file->getPath . "\n";
789 0         0 $fh = FileHandle->new(">".$file->getPath);
790             }
791             }
792             }
793             # binmode($fh, ":utf8");
794             # my $fh = FileHandle->new(">".$file->getPath);
795              
796             # We should test if there are unparsable or not.
797 0 0       0 if (defined $this->getUnparsable) {
798 0         0 foreach $phrase (@{$this->getUnparsable})
  0         0  
799             {
800 0 0 0     0 if ((blessed($phrase)) && ($phrase->isa('Lingua::YaTeA::MultiWordPhrase')))
801             {
802 0         0 print $fh Lingua::YaTeA::XMLEntities::encode(Encode::encode("UTF-8", $phrase->getIF . "\t" . $phrase->getPOS . "\n"));
803             }
804             }
805             }
806 0 0 0     0 if (($file ne 'stdout') && ($file ne 'stderr')) {
807 0         0 $fh->close;
808             }
809             }
810              
811              
812              
813             sub printUnparsed
814             {
815 0     0 1 0 my ($this,$file, $fh) = @_;
816 0         0 my $phrase;
817              
818 0 0       0 if (!defined $fh) {
819 0 0       0 if ($file eq "stdout") {
820 0         0 $fh = \*STDOUT;
821             } else {
822 0 0       0 if ($file eq "stderr") {
823 0         0 $fh = \*STDERR;
824             } else {
825 0         0 $fh = FileHandle->new(">".$file->getPath);
826             }
827             }
828             }
829             # binmode($fh, ":utf8");
830             # my $fh = FileHandle->new(">".$file->getPath);
831              
832             # We should test if there are unparsable or not.
833 0 0       0 if (defined $this->getUnparsed) {
834 0         0 foreach $phrase (@{$this->getUnparsed})
  0         0  
835             {
836 0 0 0     0 if ((blessed($phrase)) && ($phrase->isa('Lingua::YaTeA::MultiWordPhrase')))
837             {
838 0         0 print $fh $phrase->getIF . "\t" . $phrase->getPOS . "\n";
839             }
840             }
841             }
842 0 0 0     0 if (($file ne 'stdout') && ($file ne 'stderr')) {
843 0         0 $fh->close;
844             }
845             }
846              
847             sub printTermCandidatesTTG
848             {
849 2     2 1 9 my ($this,$file,$ttg_style,$fh) = @_;
850            
851 2 50       10 if (!defined $fh) {
852 2 50       13 if ($file eq "stdout") {
853 0         0 $fh = \*STDOUT;
854             } else {
855 2 50       10 if ($file eq "stderr") {
856 0         0 $fh = \*STDERR;
857             } else {
858 2         18 $fh = FileHandle->new(">".$file->getPath);
859             }
860             }
861             }
862 2         403 binmode($fh, ":utf8");
863             # my $fh = FileHandle->new(">".$file->getPath);
864 2         8 my $term_candidate;
865             my $word;
866            
867 2         5 foreach $term_candidate (values(%{$this->getTermCandidates}))
  2         13  
868             {
869 240 100 33     1700 if
      66        
      66        
      66        
870             (
871             ($ttg_style eq "")
872             ||
873             ($ttg_style eq "all")
874             ||
875             (
876             ($ttg_style eq "multi")
877             &&
878             ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
879             )
880             )
881             {
882 112         162 foreach $word (@{$term_candidate->getWords})
  112         230  
883             {
884 361         718 print $fh $word->getIF . "\t" . $word->getPOS . "\t" . $word->getLF . "\n";
885             }
886 112         295 print $fh "\.\tSENT\t\.\n";
887             }
888             }
889             }
890              
891             sub printTermCandidatesFFandTTG
892             {
893 0     0 0 0 my ($this,$file,$ttg_style,$tagset,$fh) = @_;
894            
895 0         0 my $if;
896             my $pos;
897 0         0 my $lf;
898              
899 0 0       0 if (!defined $fh) {
900 0 0       0 if ($file eq "stdout") {
901 0         0 $fh = \*STDOUT;
902             } else {
903 0 0       0 if ($file eq "stderr") {
904 0         0 $fh = \*STDERR;
905             } else {
906 0         0 $fh = FileHandle->new(">".$file->getPath);
907             }
908             }
909             }
910 0         0 binmode($fh, ":utf8");
911             # my $fh = FileHandle->new(">".$file->getPath);
912 0         0 my $term_candidate;
913             my $word;
914            
915 0         0 foreach $term_candidate (values(%{$this->getTermCandidates}))
  0         0  
916             {
917 0 0 0     0 if
      0        
      0        
      0        
918             (
919             ($ttg_style eq "")
920             ||
921             ($ttg_style eq "all")
922             ||
923             (
924             ($ttg_style eq "multi")
925             &&
926             ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
927             )
928             )
929             {
930 0         0 ($if,$pos,$lf) = $term_candidate->buildLinguisticInfos($tagset);
931 0         0 Lingua::YaTeA::XMLEntities::encode($if);
932 0         0 Lingua::YaTeA::XMLEntities::encode($pos);
933 0         0 Lingua::YaTeA::XMLEntities::encode($lf);
934 0         0 print $fh "$if\t$lf\t$pos\n";
935             # foreach $word (@{$term_candidate->getWords})
936             # {
937             # print $fh $word->getIF . "\t" . $word->getPOS . "\t" . $word->getLF . "\n";
938             # }
939             # print $fh "\.\tSENT\t\.\n";
940             }
941             }
942             }
943              
944             sub printTermCandidatesXML
945             {
946 2     2 1 8 my ($this,$file,$tagset,$fh) = @_;
947            
948 2 50       12 if (!defined $fh) {
949 2 50       13 if ($file eq "stdout") {
950 0         0 $fh = \*STDOUT;
951             } else {
952 2 50       17 if ($file eq "stderr") {
953 0         0 $fh = \*STDERR;
954             } else {
955 2         9 $fh = FileHandle->new(">".$file->getPath);
956             }
957             }
958             }
959 2         428 binmode($fh,":utf8");
960 2         21 my $term_candidate;
961             my $if;
962 2         0 my $pos;
963 2         0 my $lf;
964 2         0 my $occurrence;
965 2         0 my $island;
966 2         0 my $position;
967              
968             # header
969 2         22 print $fh "\n";
970 2         9 print $fh "\n";
971 2         7 print $fh "\n";
972 2         7 print $fh "\n";
973              
974 2         14 $this->printListTermCandidatesXML($file, $tagset, $fh);
975              
976 2         101 print $fh "\n";
977            
978             }
979              
980              
981             sub printListTermCandidatesXML {
982 2     2 0 8 my ($this,$file,$tagset, $fh) = @_;
983              
984 2 50       11 if (!defined $fh) {
985 0 0       0 if ($file eq "stdout") {
986 0         0 $fh = \*STDOUT;
987             } else {
988 0 0       0 if ($file eq "stderr") {
989 0         0 $fh = \*STDERR;
990             } else {
991 0         0 $fh = FileHandle->new(">".$file->getPath);
992             }
993             }
994             }
995 2         9 binmode($fh,":utf8");
996             # my $fh = FileHandle->new(">".$file->getPath);
997 2         23 my $term_candidate;
998             my $word;
999 2         0 my $if;
1000 2         0 my $pos;
1001 2         0 my $lf;
1002 2         0 my $occurrence;
1003 2         0 my $island;
1004 2         0 my $position;
1005              
1006              
1007 2         6 print $fh " \n";
1008              
1009 2         5 foreach $term_candidate (values(%{$this->getTermCandidates}))
  2         14  
1010             {
1011 240         657 ($if,$pos,$lf) = $term_candidate->buildLinguisticInfos($tagset);
1012 240         750 Lingua::YaTeA::XMLEntities::encode($if);
1013 240         546 Lingua::YaTeA::XMLEntities::encode($pos);
1014 240         534 Lingua::YaTeA::XMLEntities::encode($lf);
1015 240         595 print $fh " getMNPStatus . "\">\n"; # added by SA 13/02/2009
1016             # print $fh " \n";
1017 240         635 print $fh " term" . $term_candidate->getID . "\n";
1018 240         684 print $fh "
" . $if . "
\n";
1019 240         625 print $fh " " . $lf . "\n";
1020 240         461 print $fh " \n";
1021 240         662 print $fh " " .$pos . "\n";
1022 240         434 print $fh " \n";
1023 240         557 print $fh " term" . $term_candidate->getHead->getID . "\n";
1024              
1025             # occurrences
1026 240         607 print $fh " ". $term_candidate->getFrequency . "\n";
1027 240         513 print $fh " \n";
1028 240         333 foreach $occurrence (@{$term_candidate->getOccurrences})
  240         451  
1029             {
1030 330         555 print $fh " \n";
1031 330         869 print $fh " occ" . $occurrence->getID . "\n";
1032 330         751 print $fh " " . (($occurrence->isMaximal) * 1) . "\n"; # && $term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate') -- remove by Thierry Hamon 29/09/2008
1033 330         737 print $fh " " .$occurrence->getDocument->getID . "\n";
1034 330         760 print $fh " " .$occurrence->getSentence->getInDocID . "\n";
1035 330         646 print $fh " ";
1036 330         690 print $fh $occurrence->getStartChar;
1037 330         646 print $fh "\n";
1038 330         499 print $fh " ";
1039 330         660 print $fh $occurrence->getEndChar;
1040 330         596 print $fh "\n";
1041 330         634 print $fh " \n";
1042             }
1043 240         412 print $fh " \n";
1044 240         572 print $fh " " . $term_candidate->getReliability . "\n";
1045 240         537 print $fh " \n";
1046 240         560 foreach my $weight ($term_candidate->getWeightNames) {
1047 240         559 print $fh " ";
1048 240         531 print $fh $term_candidate->getWeight($weight);
1049 240         595 print $fh "\n";
1050             }
1051 240         446 print $fh " \n";
1052              
1053             # islands of reliability
1054 240 100 66     1713 if(
      100        
1055             ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
1056             &&
1057             ($term_candidate->containsIslands)
1058             )
1059             {
1060 16         48 print $fh " \n";
1061 16         29 foreach $island (@{$term_candidate->getIslands})
  16         37  
1062             {
1063 16         34 print $fh " \n";
1064 16 100 66     127 if((blessed($island)) && ($island->isa('Lingua::YaTeA::TermCandidate')))
1065             {
1066 11         26 print $fh " term";
1067 11         31 print $fh $island->getID;
1068             }
1069             else
1070             {
1071 5         10 print $fh " testified_term";
1072 5         26 print $fh $island->getID;
1073             }
1074 16         61 print $fh "\n";
1075 16         37 print $fh "
";
1076 16         55 $if = $island->getIF;
1077 16         60 Lingua::YaTeA::XMLEntities::encode($if);
1078 16         30 print $fh $if;
1079 16         32 print $fh "\n";
1080 16         30 print $fh " ";
1081 16         46 print $fh $island->getIslandType;
1082 16         32 print $fh "\n";
1083 16         36 print $fh " \n";
1084             }
1085 16         41 print $fh " \n";
1086             }
1087 240         516 print $fh " YaTeA\n";
1088 240 100 66     1121 if ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
1089             {
1090 112         213 print $fh " \n";
1091 112         176 print $fh " \n term";
1092 112         297 print $fh $term_candidate->getRootHead->getID;
1093 112         255 print $fh "\n \n";
1094 112         182 print $fh "
1095 112         271 print $fh $term_candidate->getModifierPosition;
1096 112         192 print $fh "\">\n term";
1097 112         251 print $fh $term_candidate->getRootModifier->getID;
1098 112         208 print $fh "\n \n";
1099 112 100       245 if(defined $term_candidate->getPreposition)
1100             {
1101 26         51 print $fh " \n ";
1102 26         55 print $fh $term_candidate->getPreposition->getIF;
1103 26         58 print $fh "\n \n";
1104             }
1105 112 100       237 if(defined $term_candidate->getDeterminer)
1106             {
1107 6         15 print $fh " \n ";
1108 6         18 print $fh $term_candidate->getDeterminer->getIF;
1109 6         15 print $fh "\n \n";
1110             }
1111 112         261 print $fh " \n";
1112             }
1113 240         584 print $fh " \n";
1114             }
1115 2         10 print $fh " \n";
1116            
1117              
1118             }
1119              
1120             sub printTermCandidatesDot2
1121             {
1122 0     0 0 0 my ($this,$file,$tagset,$fh) = @_;
1123            
1124 0 0       0 if (!defined $fh) {
1125 0 0       0 if ($file eq "stdout") {
1126 0         0 $fh = \*STDOUT;
1127             } else {
1128 0 0       0 if ($file eq "stderr") {
1129 0         0 $fh = \*STDERR;
1130             } else {
1131 0         0 $fh = FileHandle->new(">".$file->getPath);
1132             }
1133             }
1134             }
1135 0         0 binmode($fh,":utf8");
1136 0         0 my $term_candidate;
1137             my $if;
1138 0         0 my $pos;
1139 0         0 my $lf;
1140 0         0 my $occurrence;
1141 0         0 my $island;
1142 0         0 my $position;
1143              
1144             # header
1145 0         0 print $fh "graph Terms {\n\n";
1146 0         0 print $fh "label=\"Full set of terms\"\n";
1147 0         0 print $fh "overlap=false\n";
1148              
1149 0         0 $this->printListTermCandidatesDot2($file, $tagset, $fh);
1150              
1151 0         0 print $fh "}\n";
1152            
1153             }
1154              
1155              
1156             sub printListTermCandidatesDot {
1157 0     0 0 0 my ($this,$tagset) = @_;
1158              
1159 0         0 my %term2CC;
1160             my %termLabel;
1161 0         0 my %CC2terms;
1162 0         0 my %CC2relations;
1163 0         0 my %relationLabel;
1164 0         0 my %relationLabelH;
1165 0         0 my $term;
1166 0         0 my $CC;
1167 0         0 my $fh;
1168 0         0 my $rel;
1169 0         0 my $oldCC;
1170              
1171 0         0 warn "Making dot files\n";
1172             # my $fh = FileHandle->new(">".$file->getPath);
1173 0         0 my $term_candidate;
1174             my $word;
1175 0         0 my $if;
1176 0         0 my $pos;
1177 0         0 my $lf;
1178 0         0 my $occurrence;
1179 0         0 my $island;
1180 0         0 my $position;
1181              
1182 0         0 foreach $term_candidate (values(%{$this->getTermCandidates}))
  0         0  
1183             {
1184 0         0 ($if,$pos,$lf) = $term_candidate->buildLinguisticInfos($tagset);
1185 0         0 Lingua::YaTeA::XMLEntities::encode($if);
1186 0         0 Lingua::YaTeA::XMLEntities::encode($pos);
1187 0         0 Lingua::YaTeA::XMLEntities::encode($lf);
1188              
1189 0 0       0 if (!exists $term2CC{$term_candidate->getID}) {
1190 0         0 $term2CC{$term_candidate->getID} = 'CC' . $term_candidate->getID;
1191 0         0 $CC2terms{$term2CC{$term_candidate->getID}} = {$term_candidate->getID => 1};
1192 0         0 $CC2relations{$term2CC{$term_candidate->getID}} = {};
1193             # } else {
1194             # # merge
1195             # foreach $term (@{$CC2terms{$term_candidate->getID}}) {
1196             # $term2CC{$term} = $term_candidate->getID;
1197             # push @{$CC2terms{$term_candidate->getID}}, $term;
1198             # delete $term2CC{$term};
1199             # }
1200             # delete $CC2terms{$term_candidate->getHead->getID};
1201             }
1202 0         0 $termLabel{$term_candidate->getID} = "[label=\"" . $if . '\n(' . $term_candidate->getFrequency . ")\"]";
1203             # print $fh $term_candidate->getID ;
1204             # print $fh " [label=\"" . $if . "\"];\n";
1205            
1206 0 0       0 if ($term_candidate->getID ne $term_candidate->getHead->getID) {
1207             # # print $fh $term_candidate->getID . " -- " . $term_candidate->getHead->getID . "[label=\"main head\" color=\"red\"];\n";
1208             # if (exists $term2CC{$term_candidate->getHead->getID}) {
1209             # # merge
1210             # # $oldCC = $term2CC{$term_candidate->getHead->getID};
1211             # # foreach $term (keys %{$CC2terms{$oldCC}}) {
1212             # # $term2CC{$term} = $term2CC{$term_candidate->getID};
1213             # # $CC2terms{$term2CC{$term_candidate->getID}}->{$term}++;
1214             # # delete $term2CC{$term};
1215             # # }
1216             # # delete $CC2terms{$oldCC};
1217              
1218             # # if (defined $CC2relations{$oldCC}) {
1219             # # foreach $rel (keys %{$CC2relations{$oldCC}}) {
1220             # # $CC2relations{$oldCC}->{$rel}++;
1221             # # }
1222             # # delete $CC2relations{$oldCC};
1223             # # }
1224             # } else {
1225             # $term2CC{$term_candidate->getHead->getID} = $term2CC{$term_candidate->getID};
1226             # $CC2terms{$term_candidate->getID}->{$term_candidate->getHead->getID}++;
1227             # # if (defined $CC2relations{$term_candidate->getHead->getID}) {
1228             # # foreach $rel (keys %{$CC2relations{$term_candidate->getHead->getID}}) {
1229             # # $CC2relations{$term2CC{$term_candidate->getID}}->{$rel}++;
1230             # # }
1231             # # delete $CC2relations{$term_candidate->getHead->getID};
1232             # # }
1233             # }
1234 0         0 $CC2relations{$term_candidate->getID}->{$term_candidate->getID . " -- " . $term_candidate->getHead->getID}++;
1235 0         0 $relationLabelH{$term_candidate->getID . " -- " . $term_candidate->getHead->getID} = "[label=\"main head\" weight=1 color=\"yellow\"];";
1236             }
1237              
1238             # occurrences
1239             # print $fh " ". $term_candidate->getFrequency . "\n";
1240             # print $fh " \n";
1241             # foreach $occurrence (@{$term_candidate->getOccurrences})
1242             # {
1243             # print $fh " \n";
1244             # print $fh " occ" . $occurrence->getID . "\n";
1245             # print $fh " " . (($occurrence->isMaximal) * 1) . "\n"; # && $term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate') -- remove by Thierry Hamon 29/09/2008
1246             # print $fh " " .$occurrence->getDocument->getID . "\n";
1247             # print $fh " " .$occurrence->getSentence->getInDocID . "\n";
1248             # print $fh " ";
1249             # print $fh $occurrence->getStartChar;
1250             # print $fh "\n";
1251             # print $fh " ";
1252             # print $fh $occurrence->getEndChar;
1253             # print $fh "\n";
1254             # print $fh " \n";
1255             # }
1256             # print $fh " \n";
1257             # print $fh " " . $term_candidate->getReliability . "\n";
1258             # print $fh " \n";
1259             # foreach my $weight ($term_candidate->getWeightNames) {
1260             # print $fh " ";
1261             # print $fh $term_candidate->getWeight($weight);
1262             # print $fh "\n";
1263             # }
1264             # print $fh " \n";
1265              
1266             # islands of reliability
1267             # if(
1268             # ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate'))
1269             # &&
1270             # ($term_candidate->containsIslands)
1271             # )
1272             # {
1273             # print $fh " \n";
1274             # foreach $island (@{$term_candidate->getIslands})
1275             # {
1276             # print $fh " \n";
1277             # if($island->isa('Lingua::YaTeA::TermCandidate'))
1278             # {
1279             # print $fh " term";
1280             # print $fh $island->getID;
1281             # }
1282             # else
1283             # {
1284             # print $fh " testified_term";
1285             # print $fh $island->getID;
1286             # }
1287             # print $fh "\n";
1288             # print $fh "
";
1289             # $if = $island->getIF;
1290             # Lingua::YaTeA::XMLEntities::encode($if);
1291             # print $fh $if;
1292             # print $fh "\n";
1293             # print $fh " ";
1294             # print $fh $island->getIslandType;
1295             # print $fh "\n";
1296             # print $fh " \n";
1297             # }
1298             # print $fh " \n";
1299             # }
1300             # print $fh " YaTeA\n";
1301 0 0 0     0 if ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate'))) {
1302             # print $fh " \n";
1303             # print $fh " \n term";
1304              
1305 0 0 0     0 if ((exists $term2CC{$term_candidate->getRootHead->getID}) && ($term2CC{$term_candidate->getRootHead->getID} ne $term2CC{$term_candidate->getID})) {
1306             # merge
1307 0         0 $oldCC = $term2CC{$term_candidate->getRootHead->getID};
1308 0         0 foreach $term (keys %{$CC2terms{$term2CC{$term_candidate->getRootHead->getID}}}) {
  0         0  
1309 0         0 $term2CC{$term} = $term2CC{$term_candidate->getID};
1310 0         0 $CC2terms{$term2CC{$term_candidate->getID}}->{$term}++;
1311             }
1312 0         0 delete $CC2terms{$oldCC};
1313 0 0       0 if (defined $CC2relations{$oldCC}) {
1314 0         0 foreach $rel (keys %{$CC2relations{$oldCC}}) {
  0         0  
1315 0         0 $CC2relations{$term2CC{$term_candidate->getID}}->{$rel}++;
1316             }
1317 0         0 delete $CC2relations{$oldCC};
1318              
1319             # push @{$CC2relations{$term_candidate->getID}}, @{$CC2relations{$term_candidate->getRootHead->getID}};
1320             # delete $CC2relations{$term_candidate->getRootHead->getID};
1321             }
1322             } else {
1323 0         0 $term2CC{$term_candidate->getRootHead->getID} = $term2CC{$term_candidate->getID};
1324 0         0 $CC2terms{$term2CC{$term_candidate->getID}}->{$term_candidate->getRootHead->getID}++;
1325             # if (defined $CC2relations{$term2CC{$term_candidate->getRootHead->getID}}) {
1326             # foreach $rel (keys %{$CC2relations{$term2CC{$term_candidate->getRootHead->getID}}}) {
1327             # $CC2relations{$term2CC{$term_candidate->getID}}->{$rel}++;
1328             # }
1329             # delete $CC2relations{$term2CC{$term_candidate->getRootHead->getID}};
1330              
1331             # # push @{$CC2relations{$term_candidate->getID}}, @{$CC2relations{$term_candidate->getRootHead->getID}};
1332             # # delete $CC2relations{$term_candidate->getRootHead->getID};
1333             # }
1334             }
1335              
1336 0 0 0     0 if ((exists $term2CC{$term_candidate->getRootModifier->getID}) && ($term2CC{$term_candidate->getRootModifier->getID} ne $term2CC{$term_candidate->getID})) {
1337             # merge
1338             # warn "merge " . $term2CC{$term_candidate->getRootModifier->getID} . "\n";
1339 0         0 $oldCC = $term2CC{$term_candidate->getRootModifier->getID};
1340 0         0 foreach $term (keys %{$CC2terms{$term2CC{$term_candidate->getRootModifier->getID}}}) {
  0         0  
1341             # warn"\t$term\n";
1342 0         0 $term2CC{$term} = $term2CC{$term_candidate->getID};
1343 0         0 $CC2terms{$term2CC{$term_candidate->getID}}->{$term}++;
1344             }
1345 0         0 delete $CC2terms{$oldCC};
1346 0 0       0 if (defined $CC2relations{$oldCC}) {
1347 0         0 foreach $rel (keys %{$CC2relations{$oldCC}}) {
  0         0  
1348 0         0 $CC2relations{$term2CC{$term_candidate->getID}}->{$rel}++;
1349             }
1350 0         0 delete $CC2relations{$term_candidate->getRootModifier->getID};
1351              
1352             # push @{$CC2relations{$term_candidate->getID}}, @{$CC2relations{$term_candidate->getRootModifier->getID}};
1353             # delete $CC2relations{$term_candidate->getRootModifier->getID};
1354             }
1355             } else {
1356 0         0 $term2CC{$term_candidate->getRootModifier->getID} = $term2CC{$term_candidate->getID};
1357 0         0 $CC2terms{$term2CC{$term_candidate->getID}}->{$term_candidate->getRootModifier->getID}++;
1358             # if (defined $CC2relations{$term2CC{$term_candidate->getRootModifier->getID}}) {
1359             # foreach $rel (keys %{$CC2relations{$term2CC{$term_candidate->getRootModifier->getID}}}) {
1360             # $CC2relations{$term2CC{$term_candidate->getID}}->{$rel}++;
1361             # }
1362             # delete $CC2relations{$term2CC{$term_candidate->getRootModifier->getID}};
1363              
1364             # # push @{$CC2relations{$term_candidate->getID}}, @{$CC2relations{$term_candidate->getRootModifier->getID}};
1365             # # delete $CC2relations{$term_candidate->getRootModifier->getID};
1366             # }
1367             }
1368             # XX
1369              
1370             # XX
1371 0         0 $CC2relations{$term2CC{$term_candidate->getID}}->{$term_candidate->getRootHead->getID . " -- " . $term_candidate->getRootModifier->getID}++;
1372 0         0 $relationLabel{$term_candidate->getRootHead->getID . " -- " . $term_candidate->getRootModifier->getID} = "[label=\"head / modifier\" color=\"black\" weight=1]";
1373              
1374              
1375             # print $fh $term_candidate->getRootHead->getID;
1376             # # print $fh "\n \n";
1377             # print $fh " -- ";
1378             # # print $fh $term_candidate->getModifierPosition;
1379             # print $fh $term_candidate->getRootModifier->getID;
1380             # print $fh "[label=\"Head / Modifier\" color=\"black\" weight=1]\n";
1381              
1382 0         0 $CC2relations{$term2CC{$term_candidate->getID}}->{$term_candidate->getID . " -- " . $term_candidate->getRootHead->getID}++;
1383 0         0 $relationLabel{$term_candidate->getID . " -- " . $term_candidate->getRootHead->getID} = "[label=\"term / head\" color=\"black\" weight=3]";
1384             # print $fh $term_candidate->getID ;
1385             # print $fh " -- ";
1386             # print $fh $term_candidate->getRootHead->getID;
1387             # print $fh "[label=\"Term / Head\" color=\"black\" weight=2]\n";
1388              
1389             # XX
1390 0         0 $CC2relations{$term2CC{$term_candidate->getID}}->{$term_candidate->getID . " -- " . $term_candidate->getRootModifier->getID}++;
1391 0         0 $relationLabel{$term_candidate->getID . " -- " . $term_candidate->getRootModifier->getID} = "[label=\"term / modifier\" color=\"black\" weight=3]";
1392              
1393             # print $fh $term_candidate->getID ;
1394             # print $fh " -- ";
1395             # print $fh $term_candidate->getRootModifier->getID;
1396             # print $fh "[label=\"Term / Modifier\" color=\"black\" weight=2]\n";
1397              
1398             # print $fh "\n \n";
1399             # if(defined $term_candidate->getPreposition)
1400             # {
1401             # print $fh " \n ";
1402             # print $fh $term_candidate->getPreposition->getIF;
1403             # print $fh "\n \n";
1404             # }
1405             # if(defined $term_candidate->getDeterminer)
1406             # {
1407             # print $fh " \n ";
1408             # print $fh $term_candidate->getDeterminer->getIF;
1409             # print $fh "\n \n";
1410             # }
1411             # print $fh " \n";
1412             }
1413             # print $fh " \n";
1414             }
1415             # print $fh " \n";
1416              
1417 0         0 foreach $CC (keys %CC2terms) {
1418             # my $filename = $file->getPath;
1419             # $filename =~ s/.xml//;
1420             # $fh = FileHandle->new(">" . $filename . "/$CC" . ".dot");
1421 0         0 $fh = FileHandle->new(">$CC" . ".dot");
1422 0         0 binmode($fh,":utf8");
1423              
1424 0         0 print $fh "graph Terms {\n\n";
1425 0         0 print $fh "label=\"Full set of terms $CC\"\n";
1426 0         0 print $fh "overlap=false\n";
1427 0         0 foreach $term (keys %{$CC2terms{$CC}}) {
  0         0  
1428 0         0 print $fh $term . " " . $termLabel{$term} . "\n";
1429             }
1430 0         0 foreach $rel (keys %{$CC2relations{$CC}}) {
  0         0  
1431 0 0       0 if (exists $relationLabel{$rel}) {
1432 0         0 print $fh $rel . " " . $relationLabel{$rel} . "\n";
1433             }
1434 0 0       0 if (exists $relationLabelH{$rel}) {
1435 0         0 print $fh $rel . " " . $relationLabelH{$rel} . "\n";
1436             }
1437             }
1438              
1439 0         0 print $fh "}\n";
1440             }
1441              
1442             }
1443              
1444             sub printListTermCandidatesDot2 {
1445 0     0 0 0 my ($this,$file,$tagset, $fh) = @_;
1446              
1447 0 0       0 if (!defined $fh) {
1448 0 0       0 if ($file eq "stdout") {
1449 0         0 $fh = \*STDOUT;
1450             } else {
1451 0 0       0 if ($file eq "stderr") {
1452 0         0 $fh = \*STDERR;
1453             } else {
1454 0         0 $fh = FileHandle->new(">".$file->getPath);
1455             }
1456             }
1457 0         0 binmode($fh,":utf8");
1458             }
1459             # my $fh = FileHandle->new(">".$file->getPath);
1460 0         0 my $term_candidate;
1461             my $word;
1462 0         0 my $if;
1463 0         0 my $pos;
1464 0         0 my $lf;
1465 0         0 my $occurrence;
1466 0         0 my $island;
1467 0         0 my $position;
1468              
1469              
1470             # print $fh " \n";
1471              
1472 0         0 foreach $term_candidate (values(%{$this->getTermCandidates}))
  0         0  
1473             {
1474 0         0 ($if,$pos,$lf) = $term_candidate->buildLinguisticInfos($tagset);
1475 0         0 Lingua::YaTeA::XMLEntities::encode($if);
1476 0         0 Lingua::YaTeA::XMLEntities::encode($pos);
1477 0         0 Lingua::YaTeA::XMLEntities::encode($lf);
1478             # print $fh " getMNPStatus . "\">\n"; # added by SA 13/02/2009
1479             # print $fh " \n";
1480 0         0 print $fh $term_candidate->getID ;
1481 0         0 print $fh " [label=\"" . $if . "\"];\n";
1482             # print $fh " " . $lf . "\n";
1483             # print $fh " \n";
1484             # print $fh " " .$pos . "\n";
1485             # print $fh " \n";
1486            
1487 0 0       0 if ($term_candidate->getID ne $term_candidate->getHead->getID) {
1488 0         0 print $fh $term_candidate->getID . " -- " . $term_candidate->getHead->getID . "[label=\"main head\" weight=1 color=\"yellow\"];\n";
1489             }
1490             # occurrences
1491             # print $fh " ". $term_candidate->getFrequency . "\n";
1492             # print $fh " \n";
1493             # foreach $occurrence (@{$term_candidate->getOccurrences})
1494             # {
1495             # print $fh " \n";
1496             # print $fh " occ" . $occurrence->getID . "\n";
1497             # print $fh " " . (($occurrence->isMaximal) * 1) . "\n"; # && $term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate') -- remove by Thierry Hamon 29/09/2008
1498             # print $fh " " .$occurrence->getDocument->getID . "\n";
1499             # print $fh " " .$occurrence->getSentence->getInDocID . "\n";
1500             # print $fh " ";
1501             # print $fh $occurrence->getStartChar;
1502             # print $fh "\n";
1503             # print $fh " ";
1504             # print $fh $occurrence->getEndChar;
1505             # print $fh "\n";
1506             # print $fh " \n";
1507             # }
1508             # print $fh " \n";
1509             # print $fh " " . $term_candidate->getReliability . "\n";
1510             # print $fh " \n";
1511             # foreach my $weight ($term_candidate->getWeightNames) {
1512             # print $fh " ";
1513             # print $fh $term_candidate->getWeight($weight);
1514             # print $fh "\n";
1515             # }
1516             # print $fh " \n";
1517              
1518             # islands of reliability
1519             # if(
1520             # ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate'))
1521             # &&
1522             # ($term_candidate->containsIslands)
1523             # )
1524             # {
1525             # print $fh " \n";
1526             # foreach $island (@{$term_candidate->getIslands})
1527             # {
1528             # print $fh " \n";
1529             # if($island->isa('Lingua::YaTeA::TermCandidate'))
1530             # {
1531             # print $fh " term";
1532             # print $fh $island->getID;
1533             # }
1534             # else
1535             # {
1536             # print $fh " testified_term";
1537             # print $fh $island->getID;
1538             # }
1539             # print $fh "\n";
1540             # print $fh "
";
1541             # $if = $island->getIF;
1542             # Lingua::YaTeA::XMLEntities::encode($if);
1543             # print $fh $if;
1544             # print $fh "\n";
1545             # print $fh " ";
1546             # print $fh $island->getIslandType;
1547             # print $fh "\n";
1548             # print $fh " \n";
1549             # }
1550             # print $fh " \n";
1551             # }
1552             # print $fh " YaTeA\n";
1553 0 0 0     0 if ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
1554             {
1555             # print $fh " \n";
1556             # print $fh " \n term";
1557 0         0 print $fh $term_candidate->getRootHead->getID;
1558             # print $fh "\n \n";
1559 0         0 print $fh " -- ";
1560             # print $fh $term_candidate->getModifierPosition;
1561 0         0 print $fh $term_candidate->getRootModifier->getID;
1562 0         0 print $fh "[label=\"Head / Modifier\" color=\"black\" weight=1]\n";
1563              
1564 0         0 print $fh $term_candidate->getID ;
1565 0         0 print $fh " -- ";
1566 0         0 print $fh $term_candidate->getRootHead->getID;
1567 0         0 print $fh "[label=\"Term / Head\" color=\"black\" weight=3]\n";
1568              
1569 0         0 print $fh $term_candidate->getID ;
1570 0         0 print $fh " -- ";
1571 0         0 print $fh $term_candidate->getRootModifier->getID;
1572 0         0 print $fh "[label=\"Term / Modifier\" color=\"black\" weight=3]\n";
1573              
1574             # print $fh "\n \n";
1575             # if(defined $term_candidate->getPreposition)
1576             # {
1577             # print $fh " \n ";
1578             # print $fh $term_candidate->getPreposition->getIF;
1579             # print $fh "\n \n";
1580             # }
1581             # if(defined $term_candidate->getDeterminer)
1582             # {
1583             # print $fh " \n ";
1584             # print $fh $term_candidate->getDeterminer->getIF;
1585             # print $fh "\n \n";
1586             # }
1587             # print $fh " \n";
1588             }
1589             # print $fh " \n";
1590             }
1591             # print $fh " \n";
1592            
1593              
1594             }
1595              
1596              
1597              
1598             sub print
1599             {
1600 0     0 1 0 my ($this,$fh) = @_;
1601 0         0 my $phrase;
1602 0 0       0 if(!defined $fh)
1603             {
1604 0         0 $fh = "STDOUT";
1605             }
1606 0         0 foreach $phrase (values(%{$this->getPhrases}))
  0         0  
1607             {
1608 0         0 print $fh "$phrase\n";
1609 0         0 $phrase->print($fh);
1610 0         0 print $fh "\n";
1611             }
1612             }
1613              
1614              
1615             sub printPhrases
1616             {
1617 2     2 1 7 my ($this,$fh) = @_;
1618 2         5 my $phrase;
1619            
1620 2 50       8 if(!defined $fh)
1621             {
1622 0         0 $fh = \*STDERR;
1623             }
1624             # binmode($fh,":utf8");
1625              
1626 2         6 foreach $phrase (values(%{$this->getPhrases}))
  2         8  
1627             {
1628 106         306 $phrase->print($fh);
1629 106         270 print $fh "\n-----------------\n\n";
1630             }
1631             }
1632              
1633             sub printChunkingStatistics
1634             {
1635 2     2 1 6 my ($this,$message_set,$display_language) = @_;
1636 2         17 print STDERR "\t" . $message_set->getMessage('PHRASES_NUMBER')->getContent($display_language) . $Lingua::YaTeA::Phrase::counter . "\n";
1637 2         19 print STDERR "\t -" . $message_set->getMessage('MULTIWORDPHRASES_NUMBER')->getContent($display_language) . $Lingua::YaTeA::MultiWordPhrase::counter . "\n";
1638 2         15 print STDERR "\t -" . $message_set->getMessage('MONOLEXICALPHRASES_NUMBER')->getContent($display_language) . $Lingua::YaTeA::MonolexicalPhrase::counter . "\n";
1639             }
1640              
1641             sub printParsingStatistics
1642             {
1643 2     2 1 9 my ($this,$message_set,$display_language) = @_;
1644 2         543 print STDERR "\t" . $message_set->getMessage('PARSED_PHRASES_NUMBER')->getContent($display_language) . $Lingua::YaTeA::MultiWordPhrase::parsed . "\n";
1645             }
1646              
1647             1;
1648              
1649             __END__