← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/pan_genome_post_analysis
  Run on Fri Mar 27 11:43:32 2015
Reported on Fri Mar 27 11:46:17 2015

Filename/Users/ap13/perl5/lib/perl5/Heap071/Fibonacci.pm
StatementsExecuted 299398 statements in 208ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
44381169.8ms81.9msHeap071::Fibonacci::::consolidateHeap071::Fibonacci::consolidate
50071157.7ms154msHeap071::Fibonacci::::extract_topHeap071::Fibonacci::extract_top
50071155.7ms117msHeap071::Fibonacci::::addHeap071::Fibonacci::add
50071131.8ms39.5msHeap071::Fibonacci::::elemHeap071::Fibonacci::elem
139059123.7ms23.7msHeap071::Fibonacci::::link_to_left_ofHeap071::Fibonacci::link_to_left_of
5043218.11ms8.11msHeap071::Fibonacci::::topHeap071::Fibonacci::top
166111.20ms1.52msHeap071::Fibonacci::::link_as_parent_ofHeap071::Fibonacci::link_as_parent_of
3611350µs350µsHeap071::Fibonacci::::elem_DESTROYHeap071::Fibonacci::elem_DESTROY
3611189µs189µsHeap071::Fibonacci::::newHeap071::Fibonacci::new
3611189µs539µsHeap071::Fibonacci::::DESTROYHeap071::Fibonacci::DESTROY
11128µs48µsHeap071::Fibonacci::::BEGIN@3Heap071::Fibonacci::BEGIN@3
11113µs103µsHeap071::Fibonacci::::BEGIN@4Heap071::Fibonacci::BEGIN@4
0000s0sHeap071::Fibonacci::::absorbHeap071::Fibonacci::absorb
0000s0sHeap071::Fibonacci::::ascending_cutHeap071::Fibonacci::ascending_cut
0000s0sHeap071::Fibonacci::::bhcheckHeap071::Fibonacci::bhcheck
0000s0sHeap071::Fibonacci::::debugHeap071::Fibonacci::debug
0000s0sHeap071::Fibonacci::::decrease_keyHeap071::Fibonacci::decrease_key
0000s0sHeap071::Fibonacci::::deleteHeap071::Fibonacci::delete
0000s0sHeap071::Fibonacci::::hdumpHeap071::Fibonacci::hdump
0000s0sHeap071::Fibonacci::::heapcheckHeap071::Fibonacci::heapcheck
0000s0sHeap071::Fibonacci::::heapdumpHeap071::Fibonacci::heapdump
0000s0sHeap071::Fibonacci::::set_widthHeap071::Fibonacci::set_width
0000s0sHeap071::Fibonacci::::validateHeap071::Fibonacci::validate
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Heap071::Fibonacci;
2
3250µs268µs
# spent 48µs (28+20) within Heap071::Fibonacci::BEGIN@3 which was called: # once (28µs+20µs) by Graph::BEGIN@38 at line 3
use strict;
# spent 48µs making 1 call to Heap071::Fibonacci::BEGIN@3 # spent 20µs making 1 call to strict::import
422.59ms2193µs
# spent 103µs (13+90) within Heap071::Fibonacci::BEGIN@4 which was called: # once (13µs+90µs) by Graph::BEGIN@38 at line 4
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
# spent 103µs making 1 call to Heap071::Fibonacci::BEGIN@4 # spent 90µs making 1 call to vars::import
5
611µsrequire Exporter;
71600nsrequire AutoLoader;
8
9116µs@ISA = qw(Exporter AutoLoader);
10
11# No names exported.
12# No names available for export.
131600ns@EXPORT = ( );
14
151800ns$VERSION = '0.71';
16
17
18# Preloaded methods go here.
19
20# common names
21# h - heap head
22# el - linkable element, contains user-provided value
23# v - user-provided value
24
25################################################# debugging control
26
271500nsmy $debug = 0;
281200nsmy $validate = 0;
29
30# enable/disable debugging output
31sub debug {
32 @_ ? ($debug = shift) : $debug;
33}
34
35# enable/disable validation checks on values
36sub validate {
37 @_ ? ($validate = shift) : $validate;
38}
39
401100nsmy $width = 3;
411500nsmy $bar = ' | ';
421400nsmy $corner = ' +-';
431200nsmy $vfmt = "%3d";
44
45sub set_width {
46 $width = shift;
47 $width = 2 if $width < 2;
48
49 $vfmt = "%${width}d";
50 $bar = $corner = ' ' x $width;
51 substr($bar,-2,1) = '|';
52 substr($corner,-2,2) = '+-';
53}
54
55sub hdump;
56
57sub hdump {
58 my $el = shift;
59 my $l1 = shift;
60 my $b = shift;
61
62 my $ch;
63 my $ch1;
64
65 unless( $el ) {
66 print $l1, "\n";
67 return;
68 }
69
70 hdump $ch1 = $el->{child},
71 $l1 . sprintf( $vfmt, $el->{val}->val),
72 $b . $bar;
73
74 if( $ch1 ) {
75 for( $ch = $ch1->{right}; $ch != $ch1; $ch = $ch->{right} ) {
76 hdump $ch, $b . $corner, $b . $bar;
77 }
78 }
79}
80
81sub heapdump {
82 my $h;
83
84 while( $h = shift ) {
85 my $top = $$h or last;
86 my $el = $top;
87
88 do {
89 hdump $el, sprintf( "%02d: ", $el->{degree}), ' ';
90 $el = $el->{right};
91 } until $el == $top;
92 print "\n";
93 }
94}
95
96sub bhcheck;
97
98sub bhcheck {
99 my $el = shift;
100 my $p = shift;
101
102 my $cur = $el;
103 my $prev;
104 my $ch;
105 do {
106 $prev = $cur;
107 $cur = $cur->{right};
108 die "bad back link" unless $cur->{left} == $prev;
109 die "bad parent link"
110 unless (defined $p && defined $cur->{p} && $cur->{p} == $p)
111 || (!defined $p && !defined $cur->{p});
112 die "bad degree( $cur->{degree} > $p->{degree} )"
113 if $p && $p->{degree} <= $cur->{degree};
114 die "not heap ordered"
115 if $p && $p->{val}->cmp($cur->{val}) > 0;
116 $ch = $cur->{child} and bhcheck $ch, $cur;
117 } until $cur == $el;
118}
119
120
121sub heapcheck {
122 my $h;
123 my $el;
124 while( $h = shift ) {
125 heapdump $h if $validate >= 2;
126 $el = $$h and bhcheck $el, undef;
127 }
128}
129
130
131################################################# forward declarations
132
133sub ascending_cut;
134sub elem;
135sub elem_DESTROY;
136sub link_to_left_of;
137
138################################################# heap methods
139
140# Cormen et al. use two values for the heap, a pointer to an element in the
141# list at the top, and a count of the number of elements. The count is only
142# used to determine the size of array required to hold log(count) pointers,
143# but perl can set array sizes as needed and doesn't need to know their size
144# when they are created, so we're not maintaining that field.
145
# spent 189µs within Heap071::Fibonacci::new which was called 36 times, avg 5µs/call: # 36 times (189µs+0s) by Graph::_heap_walk at line 2365 of Graph.pm, avg 5µs/call
sub new {
1463622µs my $self = shift;
1473619µs my $class = ref($self) || $self;
1483612µs my $h = undef;
14936152µs bless \$h, $class;
150}
151
152
# spent 539µs (189+350) within Heap071::Fibonacci::DESTROY which was called 36 times, avg 15µs/call: # 36 times (189µs+350µs) by Graph::_heap_walk at line 2394 of Graph.pm, avg 15µs/call
sub DESTROY {
1533614µs my $h = shift;
154
15536153µs36350µs elem_DESTROY $$h;
# spent 350µs making 36 calls to Heap071::Fibonacci::elem_DESTROY, avg 10µs/call
156}
157
158
# spent 117ms (55.7+61.7) within Heap071::Fibonacci::add which was called 5007 times, avg 23µs/call: # 5007 times (55.7ms+61.7ms) by Graph::_MST_add at line 2317 of Graph.pm, avg 23µs/call
sub add {
15950071.21ms my $h = shift;
1605007400µs my $v = shift;
1615007583µs $validate && do {
162 die "Method 'heap' required for element on heap"
163 unless $v->can('heap');
164 die "Method 'cmp' required for element on heap"
165 unless $v->can('cmp');
166 };
16750075.09ms500739.5ms my $el = elem $v;
# spent 39.5ms making 5007 calls to Heap071::Fibonacci::elem, avg 8µs/call
1685007231µs my $top;
16950079.82ms if( !($top = $$h) ) {
170569131µs $$h = $el;
171 } else {
172443810.7ms44388.79ms link_to_left_of $top->{left}, $el ;
# spent 8.79ms making 4438 calls to Heap071::Fibonacci::link_to_left_of, avg 2µs/call
17344383.31ms44386.89ms link_to_left_of $el,$top;
# spent 6.89ms making 4438 calls to Heap071::Fibonacci::link_to_left_of, avg 2µs/call
17444386.92ms44386.53ms $$h = $el if $v->cmp($top->{val}) < 0;
# spent 6.53ms making 4438 calls to Graph::MSTHeapElem::cmp, avg 1µs/call
175 }
176}
177
178
# spent 8.11ms within Heap071::Fibonacci::top which was called 5043 times, avg 2µs/call: # 5007 times (8.01ms+0s) by Graph::_heap_walk at line 2374 of Graph.pm, avg 2µs/call # 36 times (100µs+0s) by Graph::_heap_walk at line 2371 of Graph.pm, avg 3µs/call
sub top {
17950431.23ms my $h = shift;
180504310.4ms $$h && $$h->{val};
181}
182
18313µs*minimum = \&top;
184
185
# spent 154ms (57.7+96.2) within Heap071::Fibonacci::extract_top which was called 5007 times, avg 31µs/call: # 5007 times (57.7ms+96.2ms) by Graph::_heap_walk at line 2372 of Graph.pm, avg 31µs/call
sub extract_top {
1865007899µs my $h = shift;
18750071.18ms my $el = $$h or return undef;
18850071.26ms my $ltop = $el->{left};
1895007187µs my $cur;
1905007133µs my $next;
191
192 # $el is the heap with the lowest value on it
193 # move all of $el's children (if any) to the top list (between
194 # $ltop and $el)
19550071.33ms if( $cur = $el->{child} ) {
196 # remember the beginning of the list of children
1979316µs my $first = $cur;
19893217µs do {
199 # the children are moving to the top, clear the p
200 # pointer for all of them
201 $cur->{p} = undef;
202 } until ($cur = $cur->{right}) == $first;
203
204 # remember the end of the list
2059329µs $cur = $cur->{left};
2069383µs93157µs link_to_left_of $ltop, $first;
# spent 157µs making 93 calls to Heap071::Fibonacci::link_to_left_of, avg 2µs/call
2079395µs93147µs link_to_left_of $cur, $el;
# spent 147µs making 93 calls to Heap071::Fibonacci::link_to_left_of, avg 2µs/call
208 }
209
21050074.18ms if( $el->{right} == $el ) {
211 # $el had no siblings or children, the top only contains $el
212 # and $el is being removed
213569147µs $$h = undef;
214 } else {
21544384.96ms44387.10ms link_to_left_of $el->{left}, $$h = $el->{right};
# spent 7.10ms making 4438 calls to Heap071::Fibonacci::link_to_left_of, avg 2µs/call
216 # now all those loose ends have to be merged together as we
217 # search for the
218 # new smallest element
21944384.72ms443881.9ms $h->consolidate;
# spent 81.9ms making 4438 calls to Heap071::Fibonacci::consolidate, avg 18µs/call
220 }
221
222 # extract the actual value and return that, $el is no longer used
223 # but break all of its links so that it won't be pointed to...
22450071.76ms my $top = $el->{val};
22550074.76ms50076.87ms $top->heap(undef);
# spent 6.87ms making 5007 calls to Heap071::Elem::heap, avg 1µs/call
22650074.24ms $el->{left} = $el->{right} = $el->{p} = $el->{child} = $el->{val} =
227 undef;
228500712.4ms $top;
229}
230
2311800ns*extract_minimum = \&extract_top;
232
233sub absorb {
234 my $h = shift;
235 my $h2 = shift;
236
237 my $el = $$h;
238 unless( $el ) {
239 $$h = $$h2;
240 $$h2 = undef;
241 return $h;
242 }
243
244 my $el2 = $$h2 or return $h;
245
246 # add $el2 and its siblings to the head list for $h
247 # at start, $ell -> $el -> ... -> $ell is on $h (where $ell is
248 # $el->{left})
249 # $el2l -> $el2 -> ... -> $el2l are on $h2
250 # at end, $ell -> $el2l -> ... -> $el2 -> $el -> ... -> $ell are
251 # all on $h
252 my $el2l = $el2->{left};
253 link_to_left_of $el->{left}, $el2;
254 link_to_left_of $el2l, $el;
255
256 # change the top link if needed
257 $$h = $el2 if $el->{val}->cmp( $el2->{val} ) > 0;
258
259 # clean out $h2
260 $$h2 = undef;
261
262 # return the heap
263 $h;
264}
265
266# a key has been decreased, it may have to percolate up in its heap
267sub decrease_key {
268 my $h = shift;
269 my $top = $$h;
270 my $v = shift;
271 my $el = $v->heap or return undef;
272 my $p;
273
274 # first, link $h to $el if it is now the smallest (we will
275 # soon link $el to $top to properly put it up to the top list,
276 # if it isn't already there)
277 $$h = $el if $top->{val}->cmp( $v ) > 0;
278
279 if( $p = $el->{p} and $v->cmp($p->{val}) < 0 ) {
280 # remove $el from its parent's list - it is now smaller
281
282 ascending_cut $top, $p, $el;
283 }
284
285 $v;
286}
287
288
289# to delete an item, we bubble it to the top of its heap (as if its key
290# had been decreased to -infinity), and then remove it (as in extract_top)
291sub delete {
292 my $h = shift;
293 my $v = shift;
294 my $el = $v->heap or return undef;
295
296 # if there is a parent, cut $el to the top (as if it had just had its
297 # key decreased to a smaller value than $p's value
298 my $p;
299 $p = $el->{p} and ascending_cut $$h, $p, $el;
300
301 # $el is in the top list now, make it look like the smallest and
302 # remove it
303 $$h = $el;
304 $h->extract_top;
305}
306
307
308################################################# internal utility functions
309
310
# spent 39.5ms (31.8+7.69) within Heap071::Fibonacci::elem which was called 5007 times, avg 8µs/call: # 5007 times (31.8ms+7.69ms) by Heap071::Fibonacci::add at line 167, avg 8µs/call
sub elem {
3115007694µs my $v = shift;
3125007799µs my $el = undef;
313500710.7ms $el = {
314 p => undef,
315 degree => 0,
316 mark => 0,
317 child => undef,
318 val => $v,
319 left => undef,
320 right => undef,
321 };
32250072.43ms $el->{left} = $el->{right} = $el;
32350074.94ms50077.69ms $v->heap($el);
# spent 7.69ms making 5007 calls to Heap071::Elem::heap, avg 2µs/call
32450077.89ms $el;
325}
326
327
# spent 350µs within Heap071::Fibonacci::elem_DESTROY which was called 36 times, avg 10µs/call: # 36 times (350µs+0s) by Heap071::Fibonacci::DESTROY at line 155, avg 10µs/call
sub elem_DESTROY {
3283614µs my $el = shift;
329368µs my $ch;
330369µs my $next;
3313660µs $el->{left}->{right} = undef;
332
33336123µs while( $el ) {
3343616µs $ch = $el->{child} and elem_DESTROY $ch;
3353612µs $next = $el->{right};
336
3373611µs defined $el->{val} and $el->{val}->heap(undef);
3383686µs $el->{child} = $el->{right} = $el->{left} = $el->{p} = $el->{val}
339 = undef;
3403632µs $el = $next;
341 }
342}
343
344
# spent 23.7ms within Heap071::Fibonacci::link_to_left_of which was called 13905 times, avg 2µs/call: # 4438 times (8.79ms+0s) by Heap071::Fibonacci::add at line 172, avg 2µs/call # 4438 times (7.10ms+0s) by Heap071::Fibonacci::extract_top at line 215, avg 2µs/call # 4438 times (6.89ms+0s) by Heap071::Fibonacci::add at line 173, avg 2µs/call # 166 times (273µs+0s) by Heap071::Fibonacci::consolidate at line 393, avg 2µs/call # 93 times (157µs+0s) by Heap071::Fibonacci::extract_top at line 206, avg 2µs/call # 93 times (147µs+0s) by Heap071::Fibonacci::extract_top at line 207, avg 2µs/call # 93 times (120µs+0s) by Heap071::Fibonacci::link_as_parent_of at line 362, avg 1µs/call # 73 times (103µs+0s) by Heap071::Fibonacci::link_as_parent_of at line 360, avg 1µs/call # 73 times (97µs+0s) by Heap071::Fibonacci::link_as_parent_of at line 359, avg 1µs/call
sub link_to_left_of {
345139052.34ms my $l = shift;
346139051.22ms my $r = shift;
347
348139053.45ms $l->{right} = $r;
3491390523.6ms $r->{left} = $l;
350}
351
352
# spent 1.52ms (1.20+320µs) within Heap071::Fibonacci::link_as_parent_of which was called 166 times, avg 9µs/call: # 166 times (1.20ms+320µs) by Heap071::Fibonacci::consolidate at line 395, avg 9µs/call
sub link_as_parent_of {
35316633µs my $p = shift;
3541668µs my $c = shift;
355
35616611µs my $pc;
357
35816687µs if( $pc = $p->{child} ) {
3597355µs7397µs link_to_left_of $pc->{left}, $c;
# spent 97µs making 73 calls to Heap071::Fibonacci::link_to_left_of, avg 1µs/call
3607369µs73103µs link_to_left_of $c, $pc;
# spent 103µs making 73 calls to Heap071::Fibonacci::link_to_left_of, avg 1µs/call
361 } else {
3629382µs93120µs link_to_left_of $c, $c;
# spent 120µs making 93 calls to Heap071::Fibonacci::link_to_left_of, avg 1µs/call
363 }
36416662µs $p->{child} = $c;
36516646µs $c->{p} = $p;
36616633µs $p->{degree}++;
36716648µs $c->{mark} = 0;
368166310µs $p;
369}
370
371
# spent 81.9ms (69.8+12.1) within Heap071::Fibonacci::consolidate which was called 4438 times, avg 18µs/call: # 4438 times (69.8ms+12.1ms) by Heap071::Fibonacci::extract_top at line 219, avg 18µs/call
sub consolidate {
3724438989µs my $h = shift;
373
3744438485µs my $cur;
375443885µs my $this;
3764438668µs my $next = $$h;
3774438809µs my $last = $next->{left};
3784438550µs my @a;
37944384.16ms do {
380 # examine next item on top list
38173771.28ms $this = $cur = $next;
38273771.27ms $next = $cur->{right};
38373771.31ms my $d = $cur->{degree};
3847377152µs my $alt;
38573772.57ms while( $alt = $a[$d] ) {
386 # we already saw another item of the same degree,
387 # put the larger valued one under the smaller valued
388 # one - switch $cur and $alt if necessary so that $cur
389 # is the smaller
390166278µs166257µs ($cur,$alt) = ($alt,$cur)
# spent 257µs making 166 calls to Graph::MSTHeapElem::cmp, avg 2µs/call
391 if $cur->{val}->cmp( $alt->{val} ) > 0;
392 # remove $alt from the top list
393166191µs166273µs link_to_left_of $alt->{left}, $alt->{right};
# spent 273µs making 166 calls to Heap071::Fibonacci::link_to_left_of, avg 2µs/call
394 # and put it under $cur
3951664.80ms1661.52ms link_as_parent_of $cur, $alt;
# spent 1.52ms making 166 calls to Heap071::Fibonacci::link_as_parent_of, avg 9µs/call
396 # make sure that $h still points to a node at the top
39716637µs $$h = $cur;
398 # we've removed the old $d degree entry
39916641µs $a[$d] = undef;
400 # and we now have a $d+1 degree entry to try to insert
401 # into @a
40216687µs ++$d;
403 }
404 # found a previously unused degree
40573772.80ms $a[$d] = $cur;
406 } until $this == $last;
4074438577µs $cur = $$h;
408443812.1ms for $cur (grep defined, @a) {
409721118.1ms721110.0ms $$h = $cur if $$h->{val}->cmp( $cur->{val} ) > 0;
# spent 10.0ms making 7211 calls to Graph::MSTHeapElem::cmp, avg 1µs/call
410 }
411}
412
413sub ascending_cut {
414 my $top = shift;
415 my $p = shift;
416 my $el = shift;
417
418 while( 1 ) {
419 if( --$p->{degree} ) {
420 # there are still other children below $p
421 my $l = $el->{left};
422 $p->{child} = $l;
423 link_to_left_of $l, $el->{right};
424 } else {
425 # $el was the only child of $p
426 $p->{child} = undef;
427 }
428 link_to_left_of $top->{left}, $el;
429 link_to_left_of $el, $top;
430 $el->{p} = undef;
431 $el->{mark} = 0;
432
433 # propagate up the list
434 $el = $p;
435
436 # quit at the top
437 last unless $p = $el->{p};
438
439 # quit if we can mark $el
440 $el->{mark} = 1, last unless $el->{mark};
441 }
442}
443
444
445120µs1;
446
447__END__