File Coverage

blib/lib/Lingua/YALI/Builder.pm
Criterion Covered Total %
statement 104 106 98.1
branch 25 30 83.3
condition n/a
subroutine 17 17 100.0
pod 7 7 100.0
total 153 160 95.6


line stmt bran cond sub pod time code
1             package Lingua::YALI::Builder;
2             # ABSTRACT: Constructs language models for language identification.
3              
4 10     10   168577 use strict;
  10         17  
  10         228  
5 10     10   56 use warnings;
  10         12  
  10         203  
6 10     10   4360 use Moose;
  10         3126617  
  10         60  
7 10     10   47250 use Carp;
  10         14  
  10         610  
8 10     10   5298 use Lingua::YALI;
  10         17  
  10         306  
9 10     10   51 use Moose::Util::TypeConstraints;
  10         97  
  10         82  
10 10     10   18035 use List::MoreUtils qw(uniq);
  10         70458  
  10         50  
11 10     10   8484 use POSIX;
  10         45415  
  10         47  
12              
13             our $VERSION = '0.014_01'; # VERSION
14              
15              
16             subtype 'PositiveInt',
17             as 'Int',
18             where { $_ > 0 },
19             message { "The number you provided, $_, was not a positive number" };
20              
21              
22             # list of all n-gram sizes that will be used during training
23             has 'ngrams' => (
24             is => 'ro',
25             isa => 'ArrayRef[PositiveInt]',
26             required => 1
27             );
28              
29             # the greatest n-gram size
30             # i.e. ngrams = [1, 2, 3]; _max_ngram = 3
31             has '_max_ngram' => (
32             is => 'rw',
33             isa => 'Int'
34             );
35              
36             # hash of all n-grams
37             # After procissing string 'ab' and n-grams set to [ 1, 2]:
38             # _dict => { 1 => { 'a' => 1, 'b' => 1}; 2 => { 'ab' => 1 } }
39             has '_dict' => (
40             is => 'rw',
41             isa => 'HashRef'
42             );
43              
44              
45             sub BUILD
46             {
47 10     10 1 11194 my $self = shift;
48              
49             # keep only unique n-gram sizes
50 10         26 my @unique = uniq( @{$self->{ngrams}} );
  10         105  
51 10         73 my @sorted = sort { $a <=> $b } @unique;
  30         66  
52 10         28 $self->{ngrams} = \@sorted;
53              
54             # select the greatest n-gram
55 10         21 $self->{_max_ngram} = $sorted[-1];
56              
57 10         216 return;
58             }
59              
60              
61              
62             sub get_ngrams
63             {
64 2     2 1 17 my $self = shift;
65 2         55 return $self->ngrams;
66             }
67              
68              
69             sub get_max_ngram
70             {
71 21     21 1 719 my $self = shift;
72 21         71 return $self->{_max_ngram};
73             }
74              
75              
76             sub train_file
77             {
78 5     5 1 223 my ( $self, $file ) = @_;
79              
80             # parameter check
81 5 100       17 if ( ! defined($file) ) {
82 1         4 return;
83             }
84              
85 4         23 my $fh = Lingua::YALI::_open($file);
86              
87 3         62 return $self->train_handle($fh);
88             }
89              
90              
91             sub train_string
92             {
93 3     3 1 237 my ( $self, $string ) = @_;
94              
95             # parameter check
96 3 100       11 if ( ! defined($string) ) {
97 1         3 return;
98             }
99              
100 2 50   6   68 open(my $fh, "<", \$string) or croak $!;
  6         52  
  6         8  
  6         48  
101              
102 2         1507 my $result = $self->train_handle($fh);
103              
104 2         5 close($fh);
105              
106 2         16 return $result;
107             }
108              
109              
110             sub train_handle
111             {
112 10     10 1 271 my ($self, $fh) = @_;
113              
114             # print STDERR "\nX\n" . (ref $fh) . "\nX\n";
115              
116             # parameter check
117 10 100       74 if ( ! defined($fh) ) {
    100          
118 1         4 return;
119             } elsif ( ref $fh ne "GLOB" ) {
120 1         17 croak("Expected file handler but " . (ref $fh) . " was used.");
121             }
122              
123             # my $padding = $self->{_padding};
124 8         12 my @ngrams = @{$self->ngrams};
  8         387  
125 8         22 my $padding = "";
126 8         15 my $subsub = "";
127 8         12 my $sub = "";
128              
129 8         12 my $total_length = 0;
130              
131 8         185 while ( <$fh> ) {
132 28         38 chomp;
133 28         250 s/ +/ /g;
134 28         38 s/^ +//g;
135 28         65 s/ +$//g;
136 28 50       50 if ( ! $_ ) {
137 0         0 next;
138             }
139              
140 28         51 $_ = $padding . $_ . $padding;
141              
142             {
143 10     10   29628 use bytes;
  10         83  
  10         39  
  28         24  
144              
145 28         99 my $act_length = bytes::length($_);
146 28         5037 $total_length += $act_length;
147              
148 28         81 for my $i (0 .. $act_length - $self->{_max_ngram}) {
149 2240         1617 $sub = substr($_, $i, $self->{_max_ngram});
150 2240         1562 for my $j (@ngrams) {
151 6720         6790 $subsub = bytes::substr($sub, 0, $j);
152             # if ( $subsub =~ /[[:digit:][:punct:]]/ ) {
153             # next;
154             # }
155              
156 6720         14542 $self->{_dict}->{$j}{$subsub}++;
157 6720         5526 $self->{_dict}->{$j}{___total___}++;
158             }
159             }
160             }
161             }
162              
163 8         101 return $total_length;
164             }
165              
166              
167             sub store
168             {
169 37     37 1 3521 my ($self, $file, $ngram, $count) = @_;
170              
171             # parameter check
172 37 100       160 if ( ! defined($file) ) {
173 2         42 croak("parametr file has to be specified");
174             }
175              
176             # if ( -f $file && ! -w $file ) {
177             # croak("file $file has to be writeable");
178             # }
179              
180 35 100       82 if ( ! defined($ngram) ) {
181 1         29 croak("parametr ngram has to be specified");
182             }
183              
184 34 100       121 if ( ! defined($self->{_dict}->{$ngram}) ) {
185 13         228 croak("$ngram-grams were not counted.");
186             }
187              
188 21 100       60 if ( ! defined($count) ) {
189 1         5 $count = POSIX::INT_MAX;
190             }
191              
192 21 100       55 if ( $count < 1 ) {
193 2         63 croak("At least one n-gram has to be saved. Count was set to: $count");
194             }
195              
196 19 50       80 if ( ! defined($self->{_dict}->{$self->get_max_ngram()}) ) {
197 0         0 croak("No training data was used.");
198             }
199              
200             # open file
201 19 50       2330 open(my $fhModel, ">:gzip:bytes", $file) or croak($!);
202              
203             # prints out n-gram size
204 19         5269 print $fhModel $ngram . "\n";
205              
206             # store n-grams
207 19         34 my $i = 0;
208 19         25 for my $k (sort {
209 137 50       315 $self->{_dict}->{$ngram}{$b} <=> $self->{_dict}->{$ngram}{$a}
210             ||
211             $a cmp $b
212 19         246 } keys %{$self->{_dict}->{$ngram}}) {
213 76         129 print $fhModel "$k\t$self->{_dict}->{$ngram}{$k}\n";
214 76 100       126 if ( ++$i > $count ) {
215 9         13 last;
216             }
217             }
218              
219              
220 19         1474 close($fhModel);
221              
222 19         142 return ($i - 1);
223             }
224              
225              
226             1;
227              
228             __END__
229              
230             =pod
231              
232             =encoding UTF-8
233              
234             =head1 NAME
235              
236             Lingua::YALI::Builder - Constructs language models for language identification.
237              
238             =head1 VERSION
239              
240             version 0.014_01
241              
242             =head1 SYNOPSIS
243              
244             This modul creates models for L<Lingua::YALI::Identifier|Lingua::YALI::Identifier>.
245              
246             If your texts are from specific domain you can achive better
247             results when your models will be trained on texts from the same domain.
248              
249             Creating bigram and trigram models from a string.
250              
251             use Lingua::YALI::Builder;
252             my $builder = Lingua::YALI::Builder->new(ngrams=>[2, 3]);
253             $builder->train_string("aaaaa aaaa aaa aaa aaa aaaaa aa");
254             $builder->train_string("aa aaaaaa aa aaaaa aaaaaa aaaaa");
255             $builder->store("model_a.2_4.gz", 2, 4);
256             $builder->store("model_a.2_all.gz", 2);
257             $builder->store("model_a.3_all.gz", 3);
258             $builder->store("model_a.4_all.gz", 4);
259             # croaks because 4-grams were not trained
260              
261             More examples is presented in L<Lingua::YALI::Examples|Lingua::YALI::Examples>.
262              
263             =head1 METHODS
264              
265             =head2 BUILD
266              
267             BUILD()
268              
269             Constructs C<Builder>.
270              
271             my $builder = Lingua::YALI::Builder->new(ngrams=>[2, 3, 4]);
272              
273             =head2 get_ngrams
274              
275             my \@ngrams = $builder->get_ngrams()
276              
277             Returns all n-grams that will be used during training.
278              
279             my $builder = Lingua::YALI::Builder->new(ngrams=>[2, 3, 4, 2, 3]);
280             my $ngrams = $builder->get_ngrams();
281             print join(", ", @$ngrams) . "\n";
282             # prints out 2, 3, 4
283              
284             =head2 get_max_ngram
285              
286             my $max_ngram = $builder->get_max_ngram()
287              
288             Returns the highest n-gram size that will be used during training.
289              
290             my $builder = Lingua::YALI::Builder->new(ngrams=>[2, 3, 4]);
291             print $builder->get_max_ngram() . "\n";
292             # prints out 4
293              
294             =head2 train_file
295              
296             my $used_bytes = $builder->train_file($file)
297              
298             Uses file C<$file> for training and returns the amount of bytes used.
299              
300             =over
301              
302             =item * It returns undef if C<$file> is undef.
303              
304             =item * It croaks if the file C<$file> does not exist or is not readable.
305              
306             =item * It returns the amount of bytes used for trainig otherwise.
307              
308             =back
309              
310             For more details look at method L</train_handle>.
311              
312             =head2 train_string
313              
314             my $used_bytes = $builder->train_string($string)
315              
316             Uses string C<$string> for training and returns the amount of bytes used.
317              
318             =over
319              
320             =item * It returns undef if C<$string> is undef.
321              
322             =item * It returns the amount of bytes used for trainig otherwise.
323              
324             =back
325              
326             For more details look at method L</train_handle>.
327              
328             =head2 train_handle
329              
330             my $used_bytes = $builder->train_handle($fh)
331              
332             Uses file handle C<$fh> for training and returns the amount of bytes used.
333              
334             =over
335              
336             =item * It returns undef if C<$fh> is undef.
337              
338             =item * It croaks if the C<$fh> is not file handle.
339              
340             =item * It returns the amount of bytes used for trainig otherwise.
341              
342             =back
343              
344             =head2 store
345              
346             my $stored_count = $builder->store($file, $ngram, $count)
347              
348             Stores trained model with at most C<$count> C<$ngram>-grams to file C<$file>.
349             If count is not specified all C<$ngram>-grams are stored.
350              
351             =over
352              
353             =item * It croaks if incorrect parameters are passed or it was not trained.
354              
355             =item * It returns the amount of stored n-grams.
356              
357             =back
358              
359             =head1 SEE ALSO
360              
361             =over
362              
363             =item * Trained models are suitable for L<Lingua::YALI::Identifier|Lingua::YALI::Identifier>.
364              
365             =item * There is also command line tool L<yali-builder|Lingua::YALI::yali-builder> with similar functionality.
366              
367             =item * Source codes are available at L<https://github.com/martin-majlis/YALI>.
368              
369             =back
370              
371             =head1 AUTHOR
372              
373             Martin Majlis <martin@majlis.cz>
374              
375             =head1 COPYRIGHT AND LICENSE
376              
377             This software is Copyright (c) 2012 by Martin Majlis.
378              
379             This is free software, licensed under:
380              
381             The (three-clause) BSD License
382              
383             =cut