File Coverage

blib/lib/Lingua/PTD/More.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Lingua::PTD::More;
2 1     1   21912 use Exporter 'import';
  1         2  
  1         30  
3              
4 1     1   21 use 5.006;
  1         3  
  1         31  
5 1     1   5 use strict;
  1         6  
  1         38  
6 1     1   5 use warnings;
  1         1  
  1         38  
7              
8 1     1   432 use Lingua::PTD;
  0            
  0            
9              
10             our @EXPORT_OK = qw(pss pssml);
11              
12             =head1 NAME
13              
14             Lingua::PTD::More - more things to do with PTD
15              
16             =head1 VERSION
17              
18             Version 0.02
19              
20             =cut
21              
22             our $VERSION = '0.02';
23              
24             =head1 SYNOPSIS
25              
26             use Lingua::PTD;
27             use Lingua::PTD::More qw/pss pssml/;
28              
29             my $ptdA = Lingua::PTD->new('ptd.en-pt.sqlite');
30             my $ptdB = Lingua::PTD->new('ptd.en-pt.sqlite');
31              
32             my %pss = pss($ptdA, $ptdB, $term);
33             my %pssml = pssml($ptdA, $ptdB, $term);
34              
35             =head1 EXPORT
36              
37             =head2 pss
38              
39             Create a Probabilistic Synonymous Set (PSS) given a PTD pair and a term.
40             The minimum probability can be passed as an extra argument to this
41             function.
42              
43             =cut
44              
45             sub pss {
46             my ($ptdA, $ptdB, $term, $minp) = @_;
47             $minp = 0.2 unless $minp;
48              
49             my %pss;
50             my %trans = $ptdA->transHash($term);
51             foreach (keys %trans) {
52             $pss{$_} = $trans{$_} if $trans{$_} >= $minp;
53             my %transI = $ptdB->transHash($_);
54             foreach my $j (keys %transI) {
55             $pss{$j} = $transI{$j} if $transI{$j} >= $minp;
56             }
57             }
58              
59             return %pss;
60             }
61              
62             =head2 pssml
63              
64             Same as C function, but doesn't add translations to the PSS.
65              
66             =cut
67              
68             sub pssml {
69             my ($ptdA, $ptdB, $term, $minp) = @_;
70             $minp = 0.2 unless $minp;
71              
72             my %pssml;
73             my %trans = $ptdA->transHash($term);
74             foreach (keys %trans) {
75             my %transI = $ptdB->transHash($_);
76             foreach my $j (keys %transI) {
77             $pssml{$j} = $transI{$j} if $transI{$j} >= $minp;
78             }
79             }
80              
81             return %pssml;
82             }
83              
84             =head1 AUTHOR
85              
86             Nuno Carvalho, C<< >>
87              
88             =head1 BUGS
89              
90             Please report any bugs or feature requests to C, or through
91             the web interface at L. I will be notified, and then you'll
92             automatically be notified of progress on your bug as I make changes.
93              
94             =head1 SUPPORT
95              
96             You can find documentation for this module with the perldoc command.
97              
98             perldoc Lingua::PTD::More
99              
100              
101             You can also look for information at:
102              
103             =over 4
104              
105             =item * RT: CPAN's request tracker (report bugs here)
106              
107             L
108              
109             =item * AnnoCPAN: Annotated CPAN documentation
110              
111             L
112              
113             =item * CPAN Ratings
114              
115             L
116              
117             =item * Search CPAN
118              
119             L
120              
121             =back
122              
123              
124             =head1 ACKNOWLEDGEMENTS
125              
126              
127             =head1 LICENSE AND COPYRIGHT
128              
129             Copyright 2013 by Project Natura
130              
131             This library is free software; you can redistribute it and/or modify
132             it under the same terms as Perl itself.
133              
134              
135             =cut
136              
137             1; # End of Lingua::PTD::More