Filename | /Users/ap13/perl5/lib/perl5/Heap071/Fibonacci.pm |
Statements | Executed 299398 statements in 208ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
4438 | 1 | 1 | 69.8ms | 81.9ms | consolidate | Heap071::Fibonacci::
5007 | 1 | 1 | 57.7ms | 154ms | extract_top | Heap071::Fibonacci::
5007 | 1 | 1 | 55.7ms | 117ms | add | Heap071::Fibonacci::
5007 | 1 | 1 | 31.8ms | 39.5ms | elem | Heap071::Fibonacci::
13905 | 9 | 1 | 23.7ms | 23.7ms | link_to_left_of | Heap071::Fibonacci::
5043 | 2 | 1 | 8.11ms | 8.11ms | top | Heap071::Fibonacci::
166 | 1 | 1 | 1.20ms | 1.52ms | link_as_parent_of | Heap071::Fibonacci::
36 | 1 | 1 | 350µs | 350µs | elem_DESTROY | Heap071::Fibonacci::
36 | 1 | 1 | 189µs | 189µs | new | Heap071::Fibonacci::
36 | 1 | 1 | 189µs | 539µs | DESTROY | Heap071::Fibonacci::
1 | 1 | 1 | 28µs | 48µs | BEGIN@3 | Heap071::Fibonacci::
1 | 1 | 1 | 13µs | 103µs | BEGIN@4 | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | absorb | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | ascending_cut | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | bhcheck | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | debug | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | decrease_key | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | delete | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | hdump | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | heapcheck | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | heapdump | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | set_width | Heap071::Fibonacci::
0 | 0 | 0 | 0s | 0s | validate | Heap071::Fibonacci::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Heap071::Fibonacci; | ||||
2 | |||||
3 | 2 | 50µs | 2 | 68µ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 # spent 48µs making 1 call to Heap071::Fibonacci::BEGIN@3
# spent 20µs making 1 call to strict::import |
4 | 2 | 2.59ms | 2 | 193µ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 # spent 103µs making 1 call to Heap071::Fibonacci::BEGIN@4
# spent 90µs making 1 call to vars::import |
5 | |||||
6 | 1 | 1µs | require Exporter; | ||
7 | 1 | 600ns | require AutoLoader; | ||
8 | |||||
9 | 1 | 16µs | @ISA = qw(Exporter AutoLoader); | ||
10 | |||||
11 | # No names exported. | ||||
12 | # No names available for export. | ||||
13 | 1 | 600ns | @EXPORT = ( ); | ||
14 | |||||
15 | 1 | 800ns | $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 | |||||
27 | 1 | 500ns | my $debug = 0; | ||
28 | 1 | 200ns | my $validate = 0; | ||
29 | |||||
30 | # enable/disable debugging output | ||||
31 | sub debug { | ||||
32 | @_ ? ($debug = shift) : $debug; | ||||
33 | } | ||||
34 | |||||
35 | # enable/disable validation checks on values | ||||
36 | sub validate { | ||||
37 | @_ ? ($validate = shift) : $validate; | ||||
38 | } | ||||
39 | |||||
40 | 1 | 100ns | my $width = 3; | ||
41 | 1 | 500ns | my $bar = ' | '; | ||
42 | 1 | 400ns | my $corner = ' +-'; | ||
43 | 1 | 200ns | my $vfmt = "%3d"; | ||
44 | |||||
45 | sub 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 | |||||
55 | sub hdump; | ||||
56 | |||||
57 | sub 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 | |||||
81 | sub 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 | |||||
96 | sub bhcheck; | ||||
97 | |||||
98 | sub 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 | |||||
121 | sub 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 | |||||
133 | sub ascending_cut; | ||||
134 | sub elem; | ||||
135 | sub elem_DESTROY; | ||||
136 | sub 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 | ||||
146 | 36 | 22µs | my $self = shift; | ||
147 | 36 | 19µs | my $class = ref($self) || $self; | ||
148 | 36 | 12µs | my $h = undef; | ||
149 | 36 | 152µ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 | ||||
153 | 36 | 14µs | my $h = shift; | ||
154 | |||||
155 | 36 | 153µs | 36 | 350µ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 | ||||
159 | 5007 | 1.21ms | my $h = shift; | ||
160 | 5007 | 400µs | my $v = shift; | ||
161 | 5007 | 583µ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 | }; | ||||
167 | 5007 | 5.09ms | 5007 | 39.5ms | my $el = elem $v; # spent 39.5ms making 5007 calls to Heap071::Fibonacci::elem, avg 8µs/call |
168 | 5007 | 231µs | my $top; | ||
169 | 5007 | 9.82ms | if( !($top = $$h) ) { | ||
170 | 569 | 131µs | $$h = $el; | ||
171 | } else { | ||||
172 | 4438 | 10.7ms | 4438 | 8.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 |
173 | 4438 | 3.31ms | 4438 | 6.89ms | link_to_left_of $el,$top; # spent 6.89ms making 4438 calls to Heap071::Fibonacci::link_to_left_of, avg 2µs/call |
174 | 4438 | 6.92ms | 4438 | 6.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 | ||||
179 | 5043 | 1.23ms | my $h = shift; | ||
180 | 5043 | 10.4ms | $$h && $$h->{val}; | ||
181 | } | ||||
182 | |||||
183 | 1 | 3µs | *minimum = \⊤ | ||
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 | ||||
186 | 5007 | 899µs | my $h = shift; | ||
187 | 5007 | 1.18ms | my $el = $$h or return undef; | ||
188 | 5007 | 1.26ms | my $ltop = $el->{left}; | ||
189 | 5007 | 187µs | my $cur; | ||
190 | 5007 | 133µ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) | ||||
195 | 5007 | 1.33ms | if( $cur = $el->{child} ) { | ||
196 | # remember the beginning of the list of children | ||||
197 | 93 | 16µs | my $first = $cur; | ||
198 | 93 | 217µ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 | ||||
205 | 93 | 29µs | $cur = $cur->{left}; | ||
206 | 93 | 83µs | 93 | 157µs | link_to_left_of $ltop, $first; # spent 157µs making 93 calls to Heap071::Fibonacci::link_to_left_of, avg 2µs/call |
207 | 93 | 95µs | 93 | 147µ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 | |||||
210 | 5007 | 4.18ms | if( $el->{right} == $el ) { | ||
211 | # $el had no siblings or children, the top only contains $el | ||||
212 | # and $el is being removed | ||||
213 | 569 | 147µs | $$h = undef; | ||
214 | } else { | ||||
215 | 4438 | 4.96ms | 4438 | 7.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 | ||||
219 | 4438 | 4.72ms | 4438 | 81.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... | ||||
224 | 5007 | 1.76ms | my $top = $el->{val}; | ||
225 | 5007 | 4.76ms | 5007 | 6.87ms | $top->heap(undef); # spent 6.87ms making 5007 calls to Heap071::Elem::heap, avg 1µs/call |
226 | 5007 | 4.24ms | $el->{left} = $el->{right} = $el->{p} = $el->{child} = $el->{val} = | ||
227 | undef; | ||||
228 | 5007 | 12.4ms | $top; | ||
229 | } | ||||
230 | |||||
231 | 1 | 800ns | *extract_minimum = \&extract_top; | ||
232 | |||||
233 | sub 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 | ||||
267 | sub 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) | ||||
291 | sub 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 | ||||
311 | 5007 | 694µs | my $v = shift; | ||
312 | 5007 | 799µs | my $el = undef; | ||
313 | 5007 | 10.7ms | $el = { | ||
314 | p => undef, | ||||
315 | degree => 0, | ||||
316 | mark => 0, | ||||
317 | child => undef, | ||||
318 | val => $v, | ||||
319 | left => undef, | ||||
320 | right => undef, | ||||
321 | }; | ||||
322 | 5007 | 2.43ms | $el->{left} = $el->{right} = $el; | ||
323 | 5007 | 4.94ms | 5007 | 7.69ms | $v->heap($el); # spent 7.69ms making 5007 calls to Heap071::Elem::heap, avg 2µs/call |
324 | 5007 | 7.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 | ||||
328 | 36 | 14µs | my $el = shift; | ||
329 | 36 | 8µs | my $ch; | ||
330 | 36 | 9µs | my $next; | ||
331 | 36 | 60µs | $el->{left}->{right} = undef; | ||
332 | |||||
333 | 36 | 123µs | while( $el ) { | ||
334 | 36 | 16µs | $ch = $el->{child} and elem_DESTROY $ch; | ||
335 | 36 | 12µs | $next = $el->{right}; | ||
336 | |||||
337 | 36 | 11µs | defined $el->{val} and $el->{val}->heap(undef); | ||
338 | 36 | 86µs | $el->{child} = $el->{right} = $el->{left} = $el->{p} = $el->{val} | ||
339 | = undef; | ||||
340 | 36 | 32µ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 | ||||
345 | 13905 | 2.34ms | my $l = shift; | ||
346 | 13905 | 1.22ms | my $r = shift; | ||
347 | |||||
348 | 13905 | 3.45ms | $l->{right} = $r; | ||
349 | 13905 | 23.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 | ||||
353 | 166 | 33µs | my $p = shift; | ||
354 | 166 | 8µs | my $c = shift; | ||
355 | |||||
356 | 166 | 11µs | my $pc; | ||
357 | |||||
358 | 166 | 87µs | if( $pc = $p->{child} ) { | ||
359 | 73 | 55µs | 73 | 97µ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 |
360 | 73 | 69µs | 73 | 103µ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 { | ||||
362 | 93 | 82µs | 93 | 120µ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 | } | ||||
364 | 166 | 62µs | $p->{child} = $c; | ||
365 | 166 | 46µs | $c->{p} = $p; | ||
366 | 166 | 33µs | $p->{degree}++; | ||
367 | 166 | 48µs | $c->{mark} = 0; | ||
368 | 166 | 310µ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 | ||||
372 | 4438 | 989µs | my $h = shift; | ||
373 | |||||
374 | 4438 | 485µs | my $cur; | ||
375 | 4438 | 85µs | my $this; | ||
376 | 4438 | 668µs | my $next = $$h; | ||
377 | 4438 | 809µs | my $last = $next->{left}; | ||
378 | 4438 | 550µs | my @a; | ||
379 | 4438 | 4.16ms | do { | ||
380 | # examine next item on top list | ||||
381 | 7377 | 1.28ms | $this = $cur = $next; | ||
382 | 7377 | 1.27ms | $next = $cur->{right}; | ||
383 | 7377 | 1.31ms | my $d = $cur->{degree}; | ||
384 | 7377 | 152µs | my $alt; | ||
385 | 7377 | 2.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 | ||||
390 | 166 | 278µs | 166 | 257µ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 | ||||
393 | 166 | 191µs | 166 | 273µ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 | ||||
395 | 166 | 4.80ms | 166 | 1.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 | ||||
397 | 166 | 37µs | $$h = $cur; | ||
398 | # we've removed the old $d degree entry | ||||
399 | 166 | 41µs | $a[$d] = undef; | ||
400 | # and we now have a $d+1 degree entry to try to insert | ||||
401 | # into @a | ||||
402 | 166 | 87µs | ++$d; | ||
403 | } | ||||
404 | # found a previously unused degree | ||||
405 | 7377 | 2.80ms | $a[$d] = $cur; | ||
406 | } until $this == $last; | ||||
407 | 4438 | 577µs | $cur = $$h; | ||
408 | 4438 | 12.1ms | for $cur (grep defined, @a) { | ||
409 | 7211 | 18.1ms | 7211 | 10.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 | |||||
413 | sub 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 | |||||
445 | 1 | 20µs | 1; | ||
446 | |||||
447 | __END__ |