← Index
NYTProf Performance Profile   « block view • line view • sub view »
For reply.pl
  Run on Thu Oct 21 22:40:13 2010
Reported on Thu Oct 21 22:44:43 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Hailo/Engine/Default.pm
StatementsExecuted 25813311 statements in 120s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
4795121143.8s80.7sHailo::Engine::Default::::_pos_tokenHailo::Engine::Default::_pos_token
600002110.7s103sHailo::Engine::Default::::_construct_replyHailo::Engine::Default::_construct_reply
445416115.97s10.9sHailo::Engine::Default::::_token_infoHailo::Engine::Default::_token_info
419579215.00s11.0sHailo::Engine::Default::::_expr_idHailo::Engine::Default::_expr_id
30000114.59s120sHailo::Engine::Default::::replyHailo::Engine::Default::reply
3000011569ms1.12sHailo::Engine::Default::::_random_exprHailo::Engine::Default::_random_expr
3000011147ms147msHailo::Engine::Default::::_find_rare_tokensHailo::Engine::Default::_find_rare_tokens
6000121100.0ms100.0msHailo::Engine::Default::::orderHailo::Engine::Default::order (xsub)
600001186.7ms86.7msHailo::Engine::Default::::repeat_limitHailo::Engine::Default::repeat_limit (xsub)
600012182.5ms82.5msHailo::Engine::Default::::storageHailo::Engine::Default::storage (xsub)
111755µs1.77msHailo::Engine::Default::::BEGIN@12Hailo::Engine::Default::BEGIN@12
11175µs79µsHailo::Engine::Default::::BUILDHailo::Engine::Default::BUILD
11175µs191µsHailo::Engine::Default::::BEGIN@9Hailo::Engine::Default::BEGIN@9
11132µs32µsHailo::Engine::Default::::BEGIN@2Hailo::Engine::Default::BEGIN@2
11120µs111µsHailo::Engine::Default::::BEGIN@11Hailo::Engine::Default::BEGIN@11
11119µs116µsHailo::Engine::Default::::BEGIN@9.11Hailo::Engine::Default::BEGIN@9.11
11118µs925µsHailo::Engine::Default::::BEGIN@10Hailo::Engine::Default::BEGIN@10
11117µs21µsHailo::Engine::Default::::__ANON__[:24]Hailo::Engine::Default::__ANON__[:24]
1117µs7µsHailo::Engine::Default::::BEGIN@5Hailo::Engine::Default::BEGIN@5
0000s0sHailo::Engine::Default::::__ANON__[:76]Hailo::Engine::Default::__ANON__[:76]
0000s0sHailo::Engine::Default::::_add_exprHailo::Engine::Default::_add_expr
0000s0sHailo::Engine::Default::::_add_tokenHailo::Engine::Default::_add_token
0000s0sHailo::Engine::Default::::_inc_linkHailo::Engine::Default::_inc_link
0000s0sHailo::Engine::Default::::_token_idHailo::Engine::Default::_token_id
0000s0sHailo::Engine::Default::::_token_id_addHailo::Engine::Default::_token_id_add
0000s0sHailo::Engine::Default::::_token_similarHailo::Engine::Default::_token_similar
0000s0sHailo::Engine::Default::::learnHailo::Engine::Default::learn
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Hailo::Engine::Default;
2
# spent 32µs within Hailo::Engine::Default::BEGIN@2 which was called: # once (32µs+0s) by Hailo::_new_class at line 4
BEGIN {
3110µs $Hailo::Engine::Default::AUTHORITY = 'cpan:AVAR';
4138µs132µs}
# spent 32µs making 1 call to Hailo::Engine::Default::BEGIN@2
5
# spent 7µs within Hailo::Engine::Default::BEGIN@5 which was called: # once (7µs+0s) by Hailo::_new_class at line 7
BEGIN {
618µs $Hailo::Engine::Default::VERSION = '0.57';
7129µs17µs}
# spent 7µs making 1 call to Hailo::Engine::Default::BEGIN@5
8
94118µs3405µs
# spent 116µs (19+97) within Hailo::Engine::Default::BEGIN@9.11 which was called: # once (19µs+97µs) by Hailo::Engine::Default::BEGIN@9 at line 9 # spent 191µs (75+116) within Hailo::Engine::Default::BEGIN@9 which was called: # once (75µs+116µs) by Hailo::_new_class at line 9
use 5.010;
# spent 191µs making 1 call to Hailo::Engine::Default::BEGIN@9 # spent 116µs making 1 call to Hailo::Engine::Default::BEGIN@9.11 # spent 98µs making 1 call to feature::import
10251µs21.83ms
# spent 925µs (18+906) within Hailo::Engine::Default::BEGIN@10 which was called: # once (18µs+906µs) by Hailo::_new_class at line 10
use Any::Moose;
# spent 925µs making 1 call to Hailo::Engine::Default::BEGIN@10 # spent 906µs making 1 call to Any::Moose::import
11248µs2203µs
# spent 111µs (20+92) within Hailo::Engine::Default::BEGIN@11 which was called: # once (20µs+92µs) by Hailo::_new_class at line 11
use List::Util qw<min first shuffle>;
# spent 111µs making 1 call to Hailo::Engine::Default::BEGIN@11 # spent 92µs making 1 call to Exporter::import
1222.57ms21.99ms
# spent 1.77ms (755µs+1.01) within Hailo::Engine::Default::BEGIN@12 which was called: # once (755µs+1.01ms) by Hailo::_new_class at line 12
use List::MoreUtils qw<uniq>;
# spent 1.77ms making 1 call to Hailo::Engine::Default::BEGIN@12 # spent 226µs making 1 call to Exporter::import
13
1416µs110.3mswith qw[ Hailo::Role::Arguments Hailo::Role::Engine ];
# spent 10.3ms making 1 call to Mouse::with
15
16has repeat_limit => (
17 isa => 'Int',
18 is => 'rw',
19 lazy => 1,
20
# spent 21µs (17+4) within Hailo::Engine::Default::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Hailo/Engine/Default.pm:24] which was called: # once (17µs+4µs) by Hailo::Engine::Default::repeat_limit at line 287
default => sub {
2112µs my ($self) = @_;
2217µs12µs my $order = $self->order;
# spent 2µs making 1 call to Hailo::Engine::Default::order
23114µs12µs return min(($order * 10), 50);
# spent 2µs making 1 call to List::Util::min
24 }
25110µs1271µs);
# spent 271µs making 1 call to Mouse::has
26
27
# spent 79µs (75+3) within Hailo::Engine::Default::BUILD which was called: # once (75µs+3µs) by Mouse::Object::new at line 207 of Hailo.pm
sub BUILD {
2811µs my ($self) = @_;
29
30 # This performance hack is here because in our tight loops calling
31 # $self->storage->sth->{...} is actually a significant part of the
32 # overall program execution time since we're doing two method
33 # calls and hash dereferences for each call to the database.
34
35113µs23µs my $sth = $self->storage->sth;
# spent 2µs making 1 call to Hailo::Storage::sth # spent 2µs making 1 call to Hailo::Engine::Default::storage
36161µs while (my ($k, $v) = each %$sth) {
37 $self->{"_sth_$k"} = $v;
38 }
39
4015µs return;
41}
42
43## no critic (Subroutines::ProhibitExcessComplexity)
44
# spent 120s (4.59+115) within Hailo::Engine::Default::reply which was called 30000 times, avg 4.00ms/call: # 30000 times (4.59s+115s) by Hailo::reply at line 325 of Hailo.pm, avg 4.00ms/call
sub reply {
453000035.9ms my $self = shift;
463000043.5ms my $tokens = shift // [];
47
48 # we will favor these tokens when making the reply> shuffle them
49 # and discard half.
503000074.7ms my @key_tokens = do {
513000032.4ms my $i = 0;
5230000190ms3000062.4ms grep { $i++ % 2 == 0 } shuffle(@$tokens);
# spent 62.4ms making 30000 calls to List::Util::shuffle, avg 2µs/call
53 };
54
553000039.2ms my (@key_ids, %token_cache);
563000081.0ms for my $token_info (@key_tokens) {
57 my $text = $token_info->[1];
58 my $info = $self->_token_similar($text);
59 next unless defined $info;
60 my ($id, $spacing) = @$info;
61 next unless defined $id;
62 push @key_ids, $id;
63 next if exists $token_cache{$id};
64 $token_cache{$id} = [$spacing, $text];
65 }
66
67 # sort the rest by rareness
6830000140ms30000147ms @key_ids = $self->_find_rare_tokens(\@key_ids, 2);
# spent 147ms making 30000 calls to Hailo::Engine::Default::_find_rare_tokens, avg 5µs/call
69
70 # get the middle expression
713000035.7ms my $seed_token_id = shift @key_ids;
7230000140ms300001.12s my ($orig_expr_id, @token_ids) = $self->_random_expr($seed_token_id);
# spent 1.12s making 30000 calls to Hailo::Engine::Default::_random_expr, avg 37µs/call
733000030.7ms return unless defined $orig_expr_id; # we don't know any expressions yet
74
75 # remove key tokens we're already using
763000040.5ms @key_ids = grep { my $used = $_; !first { $_ == $used } @token_ids } @key_ids;
77
783000031.3ms my $expr_id = $orig_expr_id;
79
80 # construct the end of the reply
8130000138ms3000048.0s $self->_construct_reply('next', $expr_id, \@token_ids, \@key_ids);
# spent 48.0s making 30000 calls to Hailo::Engine::Default::_construct_reply, avg 1.60ms/call
82
83 # construct the beginning of the reply
8430000141ms3000055.1s $self->_construct_reply('prev', $expr_id, \@token_ids, \@key_ids);
# spent 55.1s making 30000 calls to Hailo::Engine::Default::_construct_reply, avg 1.84ms/call
85
86 # translate token ids to token spacing/text
874795792.20s44541610.9s my @reply = map {
# spent 10.9s making 445416 calls to Hailo::Engine::Default::_token_info, avg 25µs/call
8830000737ms $token_cache{$_} // ($token_cache{$_} = $self->_token_info($_))
89 } @token_ids;
9030000236ms return \@reply;
91}
92
93
# spent 10.9s (5.97+4.95) within Hailo::Engine::Default::_token_info which was called 445416 times, avg 25µs/call: # 445416 times (5.97s+4.95s) by Hailo::Engine::Default::reply at line 87, avg 25µs/call
sub _token_info {
94445416617ms my ($self, $id) = @_;
95
964454165.05s4454163.24s $self->{_sth_token_info}->execute($id);
# spent 3.24s making 445416 calls to DBI::st::execute, avg 7µs/call
974454163.86s4454161.71s my @res = $self->{_sth_token_info}->fetchrow_array;
# spent 1.71s making 445416 calls to DBI::st::fetchrow_array, avg 4µs/call
984454161.64s return \@res;
99}
100
101sub learn {
102 my ($self, $tokens) = @_;
103 my $order = $self->order;
104
105 # only learn from inputs which are long enough
106 return if @$tokens < $order;
107
108 my %token_cache;
109
110 for my $token (@$tokens) {
111 my $key = join '', @$token;
112 next if exists $token_cache{$key};
113 $token_cache{$key} = $self->_token_id_add($token);
114 }
115
116 # process every expression of length $order
117 for my $i (0 .. @$tokens - $order) {
118 my @expr = map { $token_cache{ join('', @{ $tokens->[$_] }) } } $i .. $i+$order-1;
119 my $expr_id = $self->_expr_id(\@expr);
120
121 if (!defined $expr_id) {
122 $expr_id = $self->_add_expr(\@expr);
123 $self->{_sth_inc_token_count}->execute($_) for uniq(@expr);
124 }
125
126 # add link to next token for this expression, if any
127 if ($i < @$tokens - $order) {
128 my $next_id = $token_cache{ join('', @{ $tokens->[$i+$order] }) };
129 $self->_inc_link('next_token', $expr_id, $next_id);
130 }
131
132 # add link to previous token for this expression, if any
133 if ($i > 0) {
134 my $prev_id = $token_cache{ join('', @{ $tokens->[$i-1] }) };
135 $self->_inc_link('prev_token', $expr_id, $prev_id);
136 }
137
138 # add links to boundary token if appropriate
139 my $b = $self->storage->_boundary_token_id;
140 $self->_inc_link('prev_token', $expr_id, $b) if $i == 0;
141 $self->_inc_link('next_token', $expr_id, $b) if $i == @$tokens-$order;
142 }
143
144 return;
145}
146
147# sort token ids based on how rare they are
148
# spent 147ms within Hailo::Engine::Default::_find_rare_tokens which was called 30000 times, avg 5µs/call: # 30000 times (147ms+0s) by Hailo::Engine::Default::reply at line 68, avg 5µs/call
sub _find_rare_tokens {
1493000048.0ms my ($self, $token_ids, $min) = @_;
15030000127ms return unless @$token_ids;
151
152 my %links;
153 for my $id (@$token_ids) {
154 next if exists $links{$id};
155 $self->{_sth_token_count}->execute($id);
156 $links{$id} = $self->{_sth_token_count}->fetchrow_array;
157 }
158
159 # remove tokens which are too rare
160 my @ids = grep { $links{$_} >= $min } @$token_ids;
161
162 @ids = sort { $links{$a} <=> $links{$b} } @ids;
163
164 return @ids;
165}
166
167# increase the link weight between an expression and a token
168sub _inc_link {
169 my ($self, $type, $expr_id, $token_id) = @_;
170
171 $self->{"_sth_${type}_count"}->execute($expr_id, $token_id);
172 my $count = $self->{"_sth_${type}_count"}->fetchrow_array;
173
174 if (defined $count) {
175 $self->{"_sth_${type}_inc"}->execute($expr_id, $token_id);
176 }
177 else {
178 $self->{"_sth_${type}_add"}->execute($expr_id, $token_id);
179 }
180
181 return;
182}
183
184# add new expression to the database
185sub _add_expr {
186 my ($self, $token_ids) = @_;
187
188 # add the expression
189 $self->{_sth_add_expr}->execute(@$token_ids);
190 return $self->storage->dbh->last_insert_id(undef, undef, "expr", undef);
191}
192
193# look up an expression id based on tokens
194
# spent 11.0s (5.00+6.01) within Hailo::Engine::Default::_expr_id which was called 419579 times, avg 26µs/call: # 223787 times (2.66s+3.19s) by Hailo::Engine::Default::_construct_reply at line 308, avg 26µs/call # 195792 times (2.33s+2.81s) by Hailo::Engine::Default::_construct_reply at line 304, avg 26µs/call
sub _expr_id {
195419579584ms my ($self, $tokens) = @_;
1964195796.01s4195794.19s $self->{_sth_expr_id}->execute(@$tokens);
# spent 4.19s making 419579 calls to DBI::st::execute, avg 10µs/call
1974195794.63s4195791.81s return $self->{_sth_expr_id}->fetchrow_array();
# spent 1.81s making 419579 calls to DBI::st::fetchrow_array, avg 4µs/call
198}
199
200# return token id if the token exists
201sub _token_id {
202 my ($self, $token_info) = @_;
203
204 $self->{_sth_token_id}->execute(@$token_info);
205 my $token_id = $self->{_sth_token_id}->fetchrow_array();
206
207 return unless defined $token_id;
208 return $token_id;
209}
210
211# get token id (adding the token if it doesn't exist)
212sub _token_id_add {
213 my ($self, $token_info) = @_;
214
215 my $token_id = $self->_token_id($token_info);
216 $token_id = $self->_add_token($token_info) unless defined $token_id;
217 return $token_id;
218}
219
220# return all tokens (regardless of spacing) that consist of this text
221sub _token_similar {
222 my ($self, $token_text) = @_;
223 $self->{_sth_token_similar}->execute($token_text);
224 return $self->{_sth_token_similar}->fetchrow_arrayref;
225}
226
227# add a new token and return its id
228sub _add_token {
229 my ($self, $token_info) = @_;
230 $self->{_sth_add_token}->execute(@$token_info);
231 return $self->storage->dbh->last_insert_id(undef, undef, "token", undef);
232}
233
234# return a random expression containing the given token
235
# spent 1.12s (569ms+550ms) within Hailo::Engine::Default::_random_expr which was called 30000 times, avg 37µs/call: # 30000 times (569ms+550ms) by Hailo::Engine::Default::reply at line 72, avg 37µs/call
sub _random_expr {
2363000040.7ms my ($self, $token_id) = @_;
237
2383000029.5ms my $expr;
239
2403000072.2ms if (!defined $token_id) {
24130000553ms30000406ms $self->{_sth_random_expr}->execute();
# spent 406ms making 30000 calls to DBI::st::execute, avg 14µs/call
24230000290ms30000143ms $expr = $self->{_sth_random_expr}->fetchrow_arrayref();
# spent 143ms making 30000 calls to DBI::st::fetchrow_arrayref, avg 5µs/call
243 }
244 else {
245 # try the positions in a random order
246 for my $pos (shuffle 0 .. $self->order-1) {
247 my $column = "token${pos}_id";
248
249 # get a random expression which includes the token at this position
250 $self->{"_sth_expr_by_$column"}->execute($token_id);
251 $expr = $self->{"_sth_expr_by_$column"}->fetchrow_arrayref();
252 last if defined $expr;
253 }
254 }
255
2563000033.1ms return unless defined $expr;
25730000119ms return @$expr;
258}
259
260# return a new next/previous token
261
# spent 80.7s (43.8+36.9) within Hailo::Engine::Default::_pos_token which was called 479512 times, avg 168µs/call: # 479512 times (43.8s+36.9s) by Hailo::Engine::Default::_construct_reply at line 298, avg 168µs/call
sub _pos_token {
262479512733ms my ($self, $pos, $expr_id, $key_tokens) = @_;
263
2644795127.27s4795125.11s $self->{"_sth_${pos}_token_get"}->execute($expr_id);
# spent 5.11s making 479512 calls to DBI::st::execute, avg 11µs/call
26547951234.1s47951231.8s my $pos_tokens = $self->{"_sth_${pos}_token_get"}->fetchall_arrayref();
# spent 31.8s making 479512 calls to DBI::st::fetchall_arrayref, avg 66µs/call
266
2674795121.07s if (defined $key_tokens) {
2684795121.46s for my $i (0 .. $#{ $key_tokens }) {
269 my $want_id = $key_tokens->[$i];
270 my @ids = map { $_->[0] } @$pos_tokens;
271 my $has_id = grep { $_ == $want_id } @ids;
272 next unless $has_id;
273 return splice @$key_tokens, $i, 1;
274 }
275 }
276
277479512476ms my @novel_tokens;
2784795121.11s for my $token (@$pos_tokens) {
2791391644030.5s push @novel_tokens, ($token->[0]) x $token->[1];
280 }
2814795124.42s return $novel_tokens[rand @novel_tokens];
282}
283
284
# spent 103s (10.7+92.3) within Hailo::Engine::Default::_construct_reply which was called 60000 times, avg 1.72ms/call: # 30000 times (5.76s+49.3s) by Hailo::Engine::Default::reply at line 84, avg 1.84ms/call # 30000 times (4.95s+43.0s) by Hailo::Engine::Default::reply at line 81, avg 1.60ms/call
sub _construct_reply {
2856000098.7ms my ($self, $what, $expr_id, $token_ids, $key_ids) = @_;
28660000336ms60000100.0ms my $order = $self->order;
# spent 100.0ms making 60000 calls to Hailo::Engine::Default::order, avg 2µs/call
28760000300ms6000386.7ms my $repeat_limit = $self->repeat_limit;
# spent 86.7ms making 60000 calls to Hailo::Engine::Default::repeat_limit, avg 1µs/call # spent 21µs making 1 call to Hailo::Engine::Default::__ANON__[Hailo/Engine/Default.pm:24] # spent 2µs making 1 call to Mouse::Meta::TypeConstraint::_compiled_type_constraint # spent 2µs making 1 call to Mouse::Meta::Attribute::default
28860000535ms120000171ms my $boundary_token = $self->storage->_boundary_token_id;
# spent 88.5ms making 60000 calls to Hailo::Storage::_boundary_token_id, avg 1µs/call # spent 82.5ms making 60000 calls to Hailo::Engine::Default::storage, avg 1µs/call
289
2906000061.7ms my $i = 0;
291600001.16s while (1) {
2924795791.05s19583276ms if (($i % $order) == 0 and
# spent 276ms making 19583 calls to List::MoreUtils::uniq, avg 14µs/call
293 (($i >= $repeat_limit * 3) ||
294 ($i >= $repeat_limit and uniq(@$token_ids) <= $order))) {
2956798µs last;
296 }
297
2984795121.96s47951280.7s my $id = $self->_pos_token($what, $expr_id, $key_ids);
# spent 80.7s making 479512 calls to Hailo::Engine::Default::_pos_token, avg 168µs/call
299479512636ms last if $id eq $boundary_token;
300
301419579507ms given ($what) {
302419579631ms when ('next') {
303195792271ms push @$token_ids, $id;
3041957921.09s1957925.15s $expr_id = $self->_expr_id([@$token_ids[-$order..-1]]);
# spent 5.15s making 195792 calls to Hailo::Engine::Default::_expr_id, avg 26µs/call
305 }
306223787259ms when ('prev') {
307223787337ms unshift @$token_ids, $id;
3082237871.28s2237875.86s $expr_id = $self->_expr_id([@$token_ids[0..$order-1]]);
# spent 5.86s making 223787 calls to Hailo::Engine::Default::_expr_id, avg 26µs/call
309 }
310 }
311 } continue {
312 $i++;
313 }
314
31560000233ms return;
316}
317
318115µs2127µs__PACKAGE__->meta->make_immutable;
# spent 114µs making 1 call to Mouse::Meta::Class::make_immutable # spent 13µs making 1 call to Hailo::Engine::Default::meta
319
320=encoding utf8
321
322=head1 NAME
323
324Hailo::Engine::Default - The default engine backend for L<Hailo|Hailo>
325
326=head1 DESCRIPTION
327
328This backend implements the logic of replying to and learning from
329input using the resources given to the L<engine
330roles|Hailo::Role::Engine>.
331
332=head1 AUTHORS
333
334Hinrik E<Ouml>rn SigurE<eth>sson, hinrik.sig@gmail.com
335
336E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason <avar@cpan.org>
337
338=head1 LICENSE AND COPYRIGHT
339
340Copyright 2010 Hinrik E<Ouml>rn SigurE<eth>sson and
341E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason <avar@cpan.org>
342
343This program is free software, you can redistribute it and/or modify
344it under the same terms as Perl itself.
345
346=cut
 
# spent 100.0ms within Hailo::Engine::Default::order which was called 60001 times, avg 2µs/call: # 60000 times (100.0ms+0s) by Hailo::Engine::Default::_construct_reply at line 286, avg 2µs/call # once (2µs+0s) by Hailo::Engine::Default::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Hailo/Engine/Default.pm:24] at line 22
sub Hailo::Engine::Default::order; # xsub
# spent 86.7ms (86.7+24µs) within Hailo::Engine::Default::repeat_limit which was called 60000 times, avg 1µs/call: # 60000 times (86.7ms+24µs) by Hailo::Engine::Default::_construct_reply at line 287, avg 1µs/call
sub Hailo::Engine::Default::repeat_limit; # xsub
# spent 82.5ms within Hailo::Engine::Default::storage which was called 60001 times, avg 1µs/call: # 60000 times (82.5ms+0s) by Hailo::Engine::Default::_construct_reply at line 288, avg 1µs/call # once (2µs+0s) by Hailo::Engine::Default::BUILD at line 35
sub Hailo::Engine::Default::storage; # xsub