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   42 use strict;
  5         9  
  5         188  
3 5     5   31 use warnings;
  5         13  
  5         154  
4 5     5   2258 use Lingua::YaTeA::MultiWordPhrase;
  5         15  
  5         70  
5 5     5   2228 use Lingua::YaTeA::MonolexicalPhrase;
  5         12  
  5         31  
6 5     5   1727 use Lingua::YaTeA::XMLEntities;
  5         11  
  5         50  
7 5     5   130 use UNIVERSAL;
  5         8  
  5         14  
8 5     5   125 use Data::Dumper;
  5         10  
  5         264  
9 5     5   32 use Scalar::Util qw(blessed);
  5         9  
  5         304  
10              
11             our $VERSION=$Lingua::YaTeA::VERSION;
12              
13 5     5   31 use Encode qw(:fallbacks);;
  5         10  
  5         37141  
14              
15             sub new
16             {
17 2     2 1 9 my ($class) = @_;
18 2         8 my $this = {};
19 2         5 bless ($this,$class);
20 2         20 $this->{PHRASES} = {}; # contain MultiWordPhrase
21 2         5 $this->{UNPARSED} = ();
22 2         8 $this->{UNPARSABLE} = ();
23 2         6 $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 312 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         206 my $phrase;
33             my $key;
34 122         182 my $complete = 0;
35 122         189 my $corrected = 0;
36 122 50       264 if(scalar @$words_a != 0)
37             {
38 122 50       260 if(scalar @$words_a > 0)
39             {
40 122 100       258 if(scalar @$words_a == 1)
41             {
42 42         179 $phrase = Lingua::YaTeA::MonolexicalPhrase->new(1,$words_a,$tag_set);
43             }
44             else
45             {
46 80         329 $phrase = Lingua::YaTeA::MultiWordPhrase->new($num_content_words,$words_a,$tag_set);
47             }
48 122         466 $key = $phrase->buildKey;
49            
50 122 100       322 if(!exists $this->getPhrases->{$key})
51             {
52 106         277 $this->addPhrase($key,$phrase);
53 106 100 100     377 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         17 $phrase->addTestifiedTerms($term_frontiers_h,$testified_term_set,$fh);
63            
64            
65             }
66 106 100 66     545 if ((blessed($phrase)) && ($phrase->isa('Lingua::YaTeA::MultiWordPhrase')))
67             {
68 72 50       183 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       241 if (defined $phrase->getTestifiedTerms)
76             {
77             #($complete,$corrected) = $phrase->searchExogenousIslands($parsing_pattern_set,$tag_set,$option_set->getParsingDirection,$lexicon,$sentence_set);
78 3         20 $phrase->searchExogenousIslands($parsing_pattern_set,$tag_set,$option_set->getParsingDirection,$lexicon,$sentence_set);
79 3 50       11 if(defined $phrase->getIslandSet)
80             {
81             # ($complete,$corrected) = $phrase->integrateIslands($chunking_data,$tag_set,$lexicon,$parsing_direction,$sentence_set,$fh);
82 3         11 ($complete,$corrected) = $phrase->integrateIslands($tag_set,$lexicon,$option_set->getParsingDirection,$sentence_set,$fh);
83             }
84 3 100       11 if($corrected == 1)
85             {
86             # print "reengistre\n";
87 2         8 $phrase->{LF} = $phrase->getIndexSet->buildLFSequence($phrase->getWords,$tag_set);
88 2         8 $phrase->{POS} = $phrase->getIndexSet->buildPOSSequence($phrase->getWords,$tag_set);
89             }
90 3 50       10 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       183 if($complete == 0)
98             {
99 72 100       198 if($phrase->searchParsingPattern($parsing_pattern_set,$tag_set,$option_set->getParsingDirection))
100             {
101 45         175 $phrase->setTC(1);
102 45         197 $phrase->setParsingMethod('PATTERN_MATCHING');
103 45         122 $this->giveAccess($phrase);
104            
105             }
106             else
107             {
108 27         83 $this->addToUnparsed($phrase);
109             # $this->addToUnparsable($phrase);
110             }
111             }
112             }
113             }
114             else
115             {
116              
117 34 50 33     106 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         103 $this->addToUnparsable($phrase);
128             }
129             }
130             }
131             else{
132             # debaptiser le phrase qui vient d'etre construit
133 16         42 $phrase = $this->getPhrases->{$key};
134             }
135 122         643 $phrase->addOccurrence($words_a,1,$fh);
136             }
137             }
138             }
139              
140              
141              
142              
143             sub addPhrase
144             {
145 106     106 1 239 my ($this,$key,$phrase) = @_;
146 106         189 $this->getPhrases->{$key} = $phrase;
147 106         183 $Lingua::YaTeA::Phrase::counter++;
148 106 100 66     984 if ((blessed($phrase)) && ($phrase->isa('Lingua::YaTeA::MultiWordPhrase')))
149             {
150 72         176 $Lingua::YaTeA::MultiWordPhrase::counter++;
151             }
152             else
153             {
154 34         86 $Lingua::YaTeA::MonolexicalPhrase::counter++;
155             }
156             }
157              
158              
159              
160             sub getPhrases
161             {
162 324     324 1 571 my ($this) = @_;
163 324         1132 return $this->{PHRASES};
164             }
165              
166              
167              
168             sub giveAccess
169             {
170 70     70 1 171 my ($this,$phrase) = @_;
171 70         116 push @{$this->{IF_ACCESS}->{$phrase->getIF}}, $phrase;
  70         206  
172            
173 70         126 push @{$this->{LF_ACCESS}->{$phrase->getLF}}, $phrase;
  70         265  
174             }
175              
176              
177             sub searchFromIF
178             {
179 259     259 1 525 my ($this,$key) = @_;
180 259 100       1179 if(exists $this->{IF_ACCESS}->{$key})
181             {
182 1         6 return $this->{IF_ACCESS}->{$key};
183             }
184            
185             }
186              
187              
188             sub searchFromLF
189             {
190 258     258 1 475 my ($this,$key) = @_;
191 258 100       1406 if(exists $this->{LF_ACCESS}->{$key})
192             {
193 5         26 return $this->{LF_ACCESS}->{$key};
194             }
195             }
196              
197              
198             sub addToUnparsed
199             {
200 27     27 1 84 my ($this,$phrase) = @_;
201              
202 27         66 push @{$this->{UNPARSED}},$phrase;
  27         100  
203             }
204              
205             sub addToUnparsable
206             {
207 36     36 1 101 my ($this,$phrase) = @_;
208              
209             # print STDERR "$phrase\n";
210              
211 36         66 push @{$this->{UNPARSABLE}},$phrase;
  36         112  
212             }
213              
214             sub getUnparsed
215             {
216 58     58 1 190 my ($this) = @_;
217 58         3265 return $this->{UNPARSED};
218             }
219              
220              
221              
222             sub sortUnparsed
223             {
224 2     2 1 19 my ($this) = @_;
225 2 50       14 if(defined $this->{UNPARSED})
226             {
227 2         7 @{$this->{UNPARSED}} = sort{$b->getLength <=> $a->getLength} @{$this->{UNPARSED}};
  2         15  
  73         147  
  2         21  
228             } else {
229 0         0 my @tmp = ();
230 0         0 return(\@tmp);
231             }
232             }
233              
234             sub parseProgressively
235             {
236 2     2 1 10 my ($this,$tag_set,$parsing_direction,$parsing_pattern_set,$chunking_data,$lexicon,$sentence_set,$message_set,$display_language, $fh) = @_;
237 2         5 my $phrase;
238 2         5 my $counter = 0;
239 2         22 my $complete;
240 2         6 my $corrected = 0;
241             #foreach $phrase (@{$this->getUnparsed})
242            
243 2         6 my $Unparsed_size;
244              
245 2         9 my $ref = $this->getUnparsed;
246             #$fh = \*STDERR;
247 2 50       11 if (!defined $ref) {
248 0         0 return (0);
249             }
250 2         5 $Unparsed_size = scalar(@{$ref});
  2         7  
251              
252 2 50       18 if(defined $this->{UNPARSED})
253             {
254 2         6 while ($phrase = pop @{$this->getUnparsed})
  29         161  
255             {
256 27         60 $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         56 $complete = 0;
265 27         48 $corrected = 0;
266 27         162 $phrase->searchEndogenousIslands($this,$chunking_data,$tag_set,$lexicon,$sentence_set,$fh);
267 27 100       89 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         47 ($complete,$corrected) = $phrase->integrateIslands($tag_set,$lexicon,$parsing_direction,$sentence_set,$fh);
273             }
274 27 100       82 if($corrected == 1)
275             {
276 2         12 $this->updateRecord($phrase,$tag_set);
277             }
278 27 50       79 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         140 $phrase->plugInternalFreeNodes($parsing_pattern_set,$parsing_direction,$tag_set,$fh);
287            
288 27 100       118 if($phrase->parseProgressively($tag_set,$parsing_direction,$parsing_pattern_set,$fh))
289             {
290 25         145 $phrase->setParsingMethod('PROGRESSIVE');
291 25         127 $phrase->setTC(1);
292 25         117 $this->giveAccess($phrase);
293             }
294             else
295             {
296 2         13 $phrase->setTC(0);
297 2         12 $this->addToUnparsable($phrase);
298             # $phrase->print($fh);
299              
300             }
301             # $phrase->printForestParenthesised($fh);
302             # print $fh "\n\n";
303 27         200 printf STDERR $message_set->getMessage('UNPARSED_PHRASES')->getContent($display_language) . "... %0.1f%% \r", (scalar(@{$this->getUnparsed}) / $Unparsed_size) * 100 ;
  27         103  
304             }
305             }
306 2         69 print STDERR "\n";
307             }
308            
309             }
310              
311             sub updateRecord
312             {
313 2     2 1 9 my ($this,$phrase,$tag_set) = @_;
314 2         6 my $key;
315             my $reference;
316            
317 2         21 $key = $phrase->buildKey;
318            
319 2 50       12 if(exists $this->getPhrases->{$key})
320             {
321 2         7 delete $this->getPhrases->{$key};
322              
323             }
324              
325 2         10 $phrase->buildLinguisticInfos($phrase->getWords,$tag_set);
326 2         8 $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         16 $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         32 return $this->{IF_ACCESS};
353             }
354              
355             sub addTermCandidates
356             {
357 2     2 1 7 my ($this,$option_set) = @_;
358 2         19 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       9 if(defined $this->getIFaccess)
367             {
368 2         6 foreach $phrase_set (values (%{$this->getIFaccess}))
  2         7  
369             {
370 70         191 foreach $phrase (@$phrase_set){
371 70         171 $phrase->addTermCandidates($this->getTermCandidates,\%mapping_from_phrases_to_TCs_h,$tc_max_length,$option_set,$this->getPhrases,\%monolexical_transfer);
372             }
373             }
374             }
375 2         7 foreach $term_candidate (values (%{$this->getTermCandidates}))
  2         9  
376             {
377            
378 240 100 66     1215 if(
      100        
379             ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
380             &&
381             ($term_candidate->containsIslands)
382             )
383             {
384 16         50 $term_candidate->adjustIslandReferences(\%mapping_from_phrases_to_TCs_h);
385             }
386             }
387 2 50 33     12 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         395 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 9 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       22 if (!defined $fh) {
478 2 50       14 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         9 $fh = FileHandle->new(">".$file->getPath);
485             }
486             }
487             }
488 2         435 binmode($fh, ":utf8");
489 2         122 warn "(tL) term_list_style: $term_list_style\n";
490 2 50       16 if (!defined $sorted_weight) {
491 2         8 $sorted_weight = "Freq";
492             }
493              
494 2         7 my @term_candidates = values(%{$this->getTermCandidates});
  2         10  
495              
496 2         7 my $header = "ID\tInflected form\tLemmatised form\tFrequency";
497              
498 2 50       10 if (scalar(@term_candidates) > 0) {
499 2         8 @Measures = sort {lc($a) cmp lc($b)} keys %{$term_candidates[0]->getWeights};
  0         0  
  2         12  
500 2         16 foreach $mes (@Measures) {
501 2         11 $header .= "\t$mes";
502             }
503             }
504 2         7 $header .= "\tHead\tModifier\tMainHead";
505 2         23 print $fh "# $header\n";
506            
507             # warn "term_list_style: $term_list_style\n";
508 2         7 my $printLine;
509 2         17 foreach $term_candidate ( sort ({&sortTermCandidates($a,$b, $sorted_weight)} @term_candidates))
  852         1343  
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     1727 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         247 $printLine = $term_candidate->getID . "\t" . $term_candidate->getIF. "\t" . $term_candidate->getLF. "\t" . $term_candidate->getFrequency;
530 112         265 foreach $mes (@Measures) {
531 112 50       252 if (defined $term_candidate->getWeight($mes)) {
532 112         255 $printLine .= "\t" . $term_candidate->getWeight($mes);
533             }
534             }
535 112         205 $printLine .= "\t";
536 112 50 33     599 if ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate'))) {
537 112         277 $printLine .= $term_candidate->getRootHead->getID . "\t";
538 112         272 $printLine .= $term_candidate->getRootModifier->getID . "\t" ;
539 112         271 $printLine .= $term_candidate->getHead->getID . "\t";
540             } else {
541 0         0 $printLine .= "\t\t\t";
542             }
543            
544 112         664 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 852     852 0 1336 my ($a,$b, $weight) = @_;
754              
755 852 50       1636 if (!defined $b->getWeight($weight)) {
756 852         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       11 if (!defined $fh) {
852 2 50       15 if ($file eq "stdout") {
853 0         0 $fh = \*STDOUT;
854             } else {
855 2 50       11 if ($file eq "stderr") {
856 0         0 $fh = \*STDERR;
857             } else {
858 2         10 $fh = FileHandle->new(">".$file->getPath);
859             }
860             }
861             }
862 2         424 binmode($fh, ":utf8");
863             # my $fh = FileHandle->new(">".$file->getPath);
864 2         9 my $term_candidate;
865             my $word;
866            
867 2         5 foreach $term_candidate (values(%{$this->getTermCandidates}))
  2         13  
868             {
869 240 100 33     1694 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         161 foreach $word (@{$term_candidate->getWords})
  112         212  
883             {
884 361         747 print $fh $word->getIF . "\t" . $word->getPOS . "\t" . $word->getLF . "\n";
885             }
886 112         350 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 10 my ($this,$file,$tagset,$fh) = @_;
947            
948 2 50       10 if (!defined $fh) {
949 2 50       24 if ($file eq "stdout") {
950 0         0 $fh = \*STDOUT;
951             } else {
952 2 50       11 if ($file eq "stderr") {
953 0         0 $fh = \*STDERR;
954             } else {
955 2         10 $fh = FileHandle->new(">".$file->getPath);
956             }
957             }
958             }
959 2         436 binmode($fh,":utf8");
960 2         22 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         24 print $fh "\n";
970 2         11 print $fh "\n";
971 2         6 print $fh "\n";
972 2         6 print $fh "\n";
973              
974 2         13 $this->printListTermCandidatesXML($file, $tagset, $fh);
975              
976 2         104 print $fh "\n";
977            
978             }
979              
980              
981             sub printListTermCandidatesXML {
982 2     2 0 9 my ($this,$file,$tagset, $fh) = @_;
983              
984 2 50       10 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         10 binmode($fh,":utf8");
996             # my $fh = FileHandle->new(">".$file->getPath);
997 2         21 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         22  
1010             {
1011 240         646 ($if,$pos,$lf) = $term_candidate->buildLinguisticInfos($tagset);
1012 240         766 Lingua::YaTeA::XMLEntities::encode($if);
1013 240         631 Lingua::YaTeA::XMLEntities::encode($pos);
1014 240         557 Lingua::YaTeA::XMLEntities::encode($lf);
1015 240         599 print $fh " getMNPStatus . "\">\n"; # added by SA 13/02/2009
1016             # print $fh " \n";
1017 240         612 print $fh " term" . $term_candidate->getID . "\n";
1018 240         658 print $fh "
" . $if . "
\n";
1019 240         582 print $fh " " . $lf . "\n";
1020 240         389 print $fh " \n";
1021 240         657 print $fh " " .$pos . "\n";
1022 240         400 print $fh " \n";
1023 240         542 print $fh " term" . $term_candidate->getHead->getID . "\n";
1024              
1025             # occurrences
1026 240         585 print $fh " ". $term_candidate->getFrequency . "\n";
1027 240         490 print $fh " \n";
1028 240         339 foreach $occurrence (@{$term_candidate->getOccurrences})
  240         473  
1029             {
1030 330         603 print $fh " \n";
1031 330         843 print $fh " occ" . $occurrence->getID . "\n";
1032 330         773 print $fh " " . (($occurrence->isMaximal) * 1) . "\n"; # && $term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate') -- remove by Thierry Hamon 29/09/2008
1033 330         747 print $fh " " .$occurrence->getDocument->getID . "\n";
1034 330         1145 print $fh " " .$occurrence->getSentence->getInDocID . "\n";
1035 330         660 print $fh " ";
1036 330         721 print $fh $occurrence->getStartChar;
1037 330         592 print $fh "\n";
1038 330         554 print $fh " ";
1039 330         637 print $fh $occurrence->getEndChar;
1040 330         595 print $fh "\n";
1041 330         678 print $fh " \n";
1042             }
1043 240         424 print $fh " \n";
1044 240         939 print $fh " " . $term_candidate->getReliability . "\n";
1045 240         548 print $fh " \n";
1046 240         531 foreach my $weight ($term_candidate->getWeightNames) {
1047 240         568 print $fh " ";
1048 240         567 print $fh $term_candidate->getWeight($weight);
1049 240         522 print $fh "\n";
1050             }
1051 240         413 print $fh " \n";
1052              
1053             # islands of reliability
1054 240 100 66     1826 if(
      100        
1055             ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
1056             &&
1057             ($term_candidate->containsIslands)
1058             )
1059             {
1060 16         37 print $fh " \n";
1061 16         26 foreach $island (@{$term_candidate->getIslands})
  16         37  
1062             {
1063 16         33 print $fh " \n";
1064 16 100 66     123 if((blessed($island)) && ($island->isa('Lingua::YaTeA::TermCandidate')))
1065             {
1066 11         34 print $fh " term";
1067 11         36 print $fh $island->getID;
1068             }
1069             else
1070             {
1071 5         13 print $fh " testified_term";
1072 5         24 print $fh $island->getID;
1073             }
1074 16         37 print $fh "\n";
1075 16         39 print $fh "
";
1076 16         62 $if = $island->getIF;
1077 16         61 Lingua::YaTeA::XMLEntities::encode($if);
1078 16         34 print $fh $if;
1079 16         33 print $fh "\n";
1080 16         24 print $fh " ";
1081 16         51 print $fh $island->getIslandType;
1082 16         30 print $fh "\n";
1083 16         38 print $fh " \n";
1084             }
1085 16         34 print $fh " \n";
1086             }
1087 240         548 print $fh " YaTeA\n";
1088 240 100 66     1159 if ((blessed($term_candidate)) && ($term_candidate->isa('Lingua::YaTeA::MultiWordTermCandidate')))
1089             {
1090 112         236 print $fh " \n";
1091 112         185 print $fh " \n term";
1092 112         264 print $fh $term_candidate->getRootHead->getID;
1093 112         224 print $fh "\n \n";
1094 112         181 print $fh "
1095 112         253 print $fh $term_candidate->getModifierPosition;
1096 112         205 print $fh "\">\n term";
1097 112         253 print $fh $term_candidate->getRootModifier->getID;
1098 112         507 print $fh "\n \n";
1099 112 100       241 if(defined $term_candidate->getPreposition)
1100             {
1101 26         49 print $fh " \n ";
1102 26         63 print $fh $term_candidate->getPreposition->getIF;
1103 26         53 print $fh "\n \n";
1104             }
1105 112 100       258 if(defined $term_candidate->getDeterminer)
1106             {
1107 6         17 print $fh " \n ";
1108 6         19 print $fh $term_candidate->getDeterminer->getIF;
1109 6         12 print $fh "\n \n";
1110             }
1111 112         237 print $fh " \n";
1112             }
1113 240         583 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 8 my ($this,$fh) = @_;
1618 2         5 my $phrase;
1619            
1620 2 50       10 if(!defined $fh)
1621             {
1622 0         0 $fh = \*STDERR;
1623             }
1624             # binmode($fh,":utf8");
1625              
1626 2         6 foreach $phrase (values(%{$this->getPhrases}))
  2         7  
1627             {
1628 106         359 $phrase->print($fh);
1629 106         259 print $fh "\n-----------------\n\n";
1630             }
1631             }
1632              
1633             sub printChunkingStatistics
1634             {
1635 2     2 1 9 my ($this,$message_set,$display_language) = @_;
1636 2         16 print STDERR "\t" . $message_set->getMessage('PHRASES_NUMBER')->getContent($display_language) . $Lingua::YaTeA::Phrase::counter . "\n";
1637 2         20 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         481 print STDERR "\t" . $message_set->getMessage('PARSED_PHRASES_NUMBER')->getContent($display_language) . $Lingua::YaTeA::MultiWordPhrase::parsed . "\n";
1645             }
1646              
1647             1;
1648              
1649             __END__