| 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 | Heap071::Fibonacci::consolidate |
| 5007 | 1 | 1 | 57.7ms | 154ms | Heap071::Fibonacci::extract_top |
| 5007 | 1 | 1 | 55.7ms | 117ms | Heap071::Fibonacci::add |
| 5007 | 1 | 1 | 31.8ms | 39.5ms | Heap071::Fibonacci::elem |
| 13905 | 9 | 1 | 23.7ms | 23.7ms | Heap071::Fibonacci::link_to_left_of |
| 5043 | 2 | 1 | 8.11ms | 8.11ms | Heap071::Fibonacci::top |
| 166 | 1 | 1 | 1.20ms | 1.52ms | Heap071::Fibonacci::link_as_parent_of |
| 36 | 1 | 1 | 350µs | 350µs | Heap071::Fibonacci::elem_DESTROY |
| 36 | 1 | 1 | 189µs | 189µs | Heap071::Fibonacci::new |
| 36 | 1 | 1 | 189µs | 539µs | Heap071::Fibonacci::DESTROY |
| 1 | 1 | 1 | 28µs | 48µs | Heap071::Fibonacci::BEGIN@3 |
| 1 | 1 | 1 | 13µs | 103µs | Heap071::Fibonacci::BEGIN@4 |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::absorb |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::ascending_cut |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::bhcheck |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::debug |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::decrease_key |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::delete |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::hdump |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::heapcheck |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::heapdump |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::set_width |
| 0 | 0 | 0 | 0s | 0s | Heap071::Fibonacci::validate |
| 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__ |