| Filename | /Users/ap13/perl5/lib/perl5/Graph/AdjacencyMap/Heavy.pm |
| Statements | Executed 838343 statements in 620ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 19958 | 1 | 1 | 195ms | 592ms | Graph::AdjacencyMap::Heavy::set_path |
| 19958 | 1 | 1 | 176ms | 176ms | Graph::AdjacencyMap::Heavy::__set_path |
| 24965 | 3 | 2 | 154ms | 162ms | Graph::AdjacencyMap::Heavy::__attr |
| 19958 | 1 | 1 | 145ms | 203ms | Graph::AdjacencyMap::Heavy::__set_path_node |
| 44923 | 2 | 1 | 26.7ms | 26.7ms | Graph::AdjacencyMap::Heavy::CORE:sort (opcode) |
| 1 | 1 | 1 | 17µs | 34µs | Graph::AdjacencyMap::Heavy::BEGIN@7 |
| 1 | 1 | 1 | 11µs | 83µs | Graph::AdjacencyMap::Heavy::BEGIN@13 |
| 1 | 1 | 1 | 8µs | 214µs | Graph::AdjacencyMap::Heavy::BEGIN@12 |
| 0 | 0 | 0 | 0s | 0s | Graph::AdjacencyMap::Heavy::__has_path |
| 0 | 0 | 0 | 0s | 0s | Graph::AdjacencyMap::Heavy::_get_id_path |
| 0 | 0 | 0 | 0s | 0s | Graph::AdjacencyMap::Heavy::_get_path_count |
| 0 | 0 | 0 | 0s | 0s | Graph::AdjacencyMap::Heavy::_get_path_id |
| 0 | 0 | 0 | 0s | 0s | Graph::AdjacencyMap::Heavy::_get_path_node |
| 0 | 0 | 0 | 0s | 0s | Graph::AdjacencyMap::Heavy::del_path |
| 0 | 0 | 0 | 0s | 0s | Graph::AdjacencyMap::Heavy::del_path_by_multi_id |
| 0 | 0 | 0 | 0s | 0s | Graph::AdjacencyMap::Heavy::has_path |
| 0 | 0 | 0 | 0s | 0s | Graph::AdjacencyMap::Heavy::has_path_by_multi_id |
| 0 | 0 | 0 | 0s | 0s | Graph::AdjacencyMap::Heavy::paths |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Graph::AdjacencyMap::Heavy; | ||||
| 2 | |||||
| 3 | # THIS IS INTERNAL IMPLEMENTATION ONLY, NOT TO BE USED DIRECTLY. | ||||
| 4 | # THE INTERFACE IS HARD TO USE AND GOING TO STAY THAT WAY AND | ||||
| 5 | # ALMOST GUARANTEED TO CHANGE OR GO AWAY IN FUTURE RELEASES. | ||||
| 6 | |||||
| 7 | 2 | 38µs | 2 | 51µs | # spent 34µs (17+17) within Graph::AdjacencyMap::Heavy::BEGIN@7 which was called:
# once (17µs+17µs) by Graph::BEGIN@28 at line 7 # spent 34µs making 1 call to Graph::AdjacencyMap::Heavy::BEGIN@7
# spent 17µs making 1 call to strict::import |
| 8 | |||||
| 9 | # $SIG{__DIE__ } = sub { use Carp; confess }; | ||||
| 10 | # $SIG{__WARN__} = sub { use Carp; confess }; | ||||
| 11 | |||||
| 12 | 2 | 27µs | 2 | 420µs | # spent 214µs (8+206) within Graph::AdjacencyMap::Heavy::BEGIN@12 which was called:
# once (8µs+206µs) by Graph::BEGIN@28 at line 12 # spent 214µs making 1 call to Graph::AdjacencyMap::Heavy::BEGIN@12
# spent 206µs making 1 call to Exporter::import |
| 13 | 2 | 1.45ms | 2 | 156µs | # spent 83µs (11+72) within Graph::AdjacencyMap::Heavy::BEGIN@13 which was called:
# once (11µs+72µs) by Graph::BEGIN@28 at line 13 # spent 83µs making 1 call to Graph::AdjacencyMap::Heavy::BEGIN@13
# spent 72µs making 1 call to base::import |
| 14 | |||||
| 15 | 1 | 600ns | require overload; # for de-overloading | ||
| 16 | |||||
| 17 | 1 | 500ns | require Data::Dumper; | ||
| 18 | |||||
| 19 | # spent 176ms within Graph::AdjacencyMap::Heavy::__set_path which was called 19958 times, avg 9µs/call:
# 19958 times (176ms+0s) by Graph::AdjacencyMap::Heavy::set_path at line 67, avg 9µs/call | ||||
| 20 | 19958 | 3.76ms | my $m = shift; | ||
| 21 | 19958 | 3.34ms | my $f = $m->[ _f ]; | ||
| 22 | 19958 | 2.55ms | my $id = pop if ($f & _MULTI); | ||
| 23 | 19958 | 4.58ms | if (@_ != $m->[ _a ] && !($f & _HYPER)) { | ||
| 24 | require Carp; | ||||
| 25 | Carp::confess(sprintf "Graph::AdjacencyMap::Heavy: arguments %d expected %d", | ||||
| 26 | scalar @_, $m->[ _a ]); | ||||
| 27 | } | ||||
| 28 | 19958 | 1.64ms | my $p; | ||
| 29 | 19958 | 6.12ms | $p = ($f & _HYPER) ? | ||
| 30 | (( $m->[ _s ] ||= [ ] )->[ @_ ] ||= { }) : | ||||
| 31 | ( $m->[ _s ] ||= { }); | ||||
| 32 | 19958 | 10.2ms | my @p = $p; | ||
| 33 | 19958 | 742µs | my @k; | ||
| 34 | 19958 | 4.40ms | while (@_) { | ||
| 35 | 39916 | 5.55ms | my $k = shift; | ||
| 36 | 39916 | 6.15ms | my $q = ref $k && ($f & _REF) && overload::Method($k, '""') ? overload::StrVal($k) : $k; | ||
| 37 | 39916 | 4.69ms | if (@_) { | ||
| 38 | 19958 | 18.7ms | $p = $p->{ $q } ||= {}; | ||
| 39 | 19958 | 652µs | return unless $p; | ||
| 40 | 19958 | 4.81ms | push @p, $p; | ||
| 41 | } | ||||
| 42 | 39916 | 29.7ms | push @k, $q; | ||
| 43 | } | ||||
| 44 | 19958 | 44.9ms | return (\@p, \@k); | ||
| 45 | } | ||||
| 46 | |||||
| 47 | # spent 203ms (145+57.6) within Graph::AdjacencyMap::Heavy::__set_path_node which was called 19958 times, avg 10µs/call:
# 19958 times (145ms+57.6ms) by Graph::AdjacencyMap::Heavy::set_path at line 70, avg 10µs/call | ||||
| 48 | 19958 | 11.9ms | my ($m, $p, $l) = splice @_, 0, 3; | ||
| 49 | 19958 | 3.16ms | my $f = $m->[ _f ] ; | ||
| 50 | 19958 | 2.52ms | my $id = pop if ($f & _MULTI); | ||
| 51 | 19958 | 9.04ms | unless (exists $p->[-1]->{ $l }) { | ||
| 52 | 14965 | 27.4ms | 14965 | 48.0ms | my $i = $m->_new_node( \$p->[-1]->{ $l }, $id ); # spent 48.0ms making 14965 calls to Graph::AdjacencyMap::_new_node, avg 3µs/call |
| 53 | 14965 | 28.0ms | $m->[ _i ]->{ defined $i ? $i : "" } = [ @_ ]; | ||
| 54 | 14965 | 28.8ms | return defined $id ? ($id eq _GEN_ID ? $$id : $id) : $i; | ||
| 55 | } else { | ||||
| 56 | 4993 | 14.8ms | 4993 | 9.67ms | return $m->_inc_node( \$p->[-1]->{ $l }, $id ); # spent 9.67ms making 4993 calls to Graph::AdjacencyMap::_inc_node, avg 2µs/call |
| 57 | } | ||||
| 58 | } | ||||
| 59 | |||||
| 60 | # spent 592ms (195+397) within Graph::AdjacencyMap::Heavy::set_path which was called 19958 times, avg 30µs/call:
# 19958 times (195ms+397ms) by Graph::add_edge at line 504 of Graph.pm, avg 30µs/call | ||||
| 61 | 19958 | 4.47ms | my $m = shift; | ||
| 62 | 19958 | 3.18ms | my $f = $m->[ _f ]; | ||
| 63 | 19958 | 60.0ms | 19958 | 17.8ms | if (@_ > 1 && ($f & _UNORDUNIQ)) { # spent 17.8ms making 19958 calls to Graph::AdjacencyMap::Heavy::CORE:sort, avg 893ns/call |
| 64 | if (($f & _UNORDUNIQ) == _UNORD && @_ == 2) { @_ = sort @_ } | ||||
| 65 | else { $m->__arg(\@_) } | ||||
| 66 | } | ||||
| 67 | 19958 | 26.8ms | 19958 | 176ms | my ($p, $k) = $m->__set_path( @_ ); # spent 176ms making 19958 calls to Graph::AdjacencyMap::Heavy::__set_path, avg 9µs/call |
| 68 | 19958 | 4.00ms | return unless defined $p && defined $k; | ||
| 69 | 19958 | 8.05ms | my $l = defined $k->[-1] ? $k->[-1] : ""; | ||
| 70 | 19958 | 65.9ms | 19958 | 203ms | return $m->__set_path_node( $p, $l, @_ ); # spent 203ms making 19958 calls to Graph::AdjacencyMap::Heavy::__set_path_node, avg 10µs/call |
| 71 | } | ||||
| 72 | |||||
| 73 | sub __has_path { | ||||
| 74 | my $m = shift; | ||||
| 75 | my $f = $m->[ _f ]; | ||||
| 76 | if (@_ != $m->[ _a ] && !($f & _HYPER)) { | ||||
| 77 | require Carp; | ||||
| 78 | Carp::confess(sprintf "Graph::AdjacencyMap::Heavy: arguments %d expected %d", | ||||
| 79 | scalar @_, $m->[ _a ]); | ||||
| 80 | } | ||||
| 81 | if (@_ > 1 && ($f & _UNORDUNIQ)) { | ||||
| 82 | if (($f & _UNORDUNIQ) == _UNORD && @_ == 2) { @_ = sort @_ } | ||||
| 83 | else { $m->__arg(\@_) } | ||||
| 84 | } | ||||
| 85 | my $p = $m->[ _s ]; | ||||
| 86 | return unless defined $p; | ||||
| 87 | $p = $p->[ @_ ] if ($f & _HYPER); | ||||
| 88 | return unless defined $p; | ||||
| 89 | my @p = $p; | ||||
| 90 | my @k; | ||||
| 91 | while (@_) { | ||||
| 92 | my $k = shift; | ||||
| 93 | my $q = ref $k && ($f & _REF) && overload::Method($k, '""') ? overload::StrVal($k) : $k; | ||||
| 94 | if (@_) { | ||||
| 95 | $p = $p->{ $q }; | ||||
| 96 | return unless defined $p; | ||||
| 97 | push @p, $p; | ||||
| 98 | } | ||||
| 99 | push @k, $q; | ||||
| 100 | } | ||||
| 101 | return (\@p, \@k); | ||||
| 102 | } | ||||
| 103 | |||||
| 104 | sub has_path { | ||||
| 105 | my $m = shift; | ||||
| 106 | my $f = $m->[ _f ]; | ||||
| 107 | if (@_ > 1 && ($f & _UNORDUNIQ)) { | ||||
| 108 | if (($f & _UNORDUNIQ) == _UNORD && @_ == 2) { @_ = sort @_ } | ||||
| 109 | else { $m->__arg(\@_) } | ||||
| 110 | } | ||||
| 111 | my ($p, $k) = $m->__has_path( @_ ); | ||||
| 112 | return unless defined $p && defined $k; | ||||
| 113 | return exists $p->[-1]->{ defined $k->[-1] ? $k->[-1] : "" }; | ||||
| 114 | } | ||||
| 115 | |||||
| 116 | sub has_path_by_multi_id { | ||||
| 117 | my $m = shift; | ||||
| 118 | my $f = $m->[ _f ]; | ||||
| 119 | my $id = pop; | ||||
| 120 | if (@_ > 1 && ($f & _UNORDUNIQ)) { | ||||
| 121 | if (($f & _UNORDUNIQ) == _UNORD && @_ == 2) { @_ = sort @_ } | ||||
| 122 | else { $m->__arg(\@_) } | ||||
| 123 | } | ||||
| 124 | my ($e, $n) = $m->__get_path_node( @_ ); | ||||
| 125 | return undef unless $e; | ||||
| 126 | return exists $n->[ _nm ]->{ $id }; | ||||
| 127 | } | ||||
| 128 | |||||
| 129 | sub _get_path_node { | ||||
| 130 | my $m = shift; | ||||
| 131 | my $f = $m->[ _f ]; | ||||
| 132 | if ($m->[ _a ] == 2 && @_ == 2 && !($f & (_HYPER|_REF|_UNIQ))) { # Fast path. | ||||
| 133 | @_ = sort @_ if ($f & _UNORD); | ||||
| 134 | return unless exists $m->[ _s ]->{ $_[0] }; | ||||
| 135 | my $p = [ $m->[ _s ], $m->[ _s ]->{ $_[0] } ]; | ||||
| 136 | my $k = [ $_[0], $_[1] ]; | ||||
| 137 | my $l = $_[1]; | ||||
| 138 | return ( exists $p->[-1]->{ $l }, $p->[-1]->{ $l }, $p, $k, $l ); | ||||
| 139 | } else { | ||||
| 140 | if (@_ > 1 && ($f & _UNORDUNIQ)) { | ||||
| 141 | if (($f & _UNORDUNIQ) == _UNORD && @_ == 2) { @_ = sort @_ } | ||||
| 142 | else { $m->__arg(\@_) } | ||||
| 143 | } | ||||
| 144 | $m->__get_path_node( @_ ); | ||||
| 145 | } | ||||
| 146 | } | ||||
| 147 | |||||
| 148 | sub _get_path_id { | ||||
| 149 | my $m = shift; | ||||
| 150 | my $f = $m->[ _f ]; | ||||
| 151 | my ($e, $n); | ||||
| 152 | if ($m->[ _a ] == 2 && @_ == 2 && !($f & (_HYPER|_REF|_UNIQ))) { # Fast path. | ||||
| 153 | @_ = sort @_ if ($f & _UNORD); | ||||
| 154 | return unless exists $m->[ _s ]->{ $_[0] }; | ||||
| 155 | my $p = $m->[ _s ]->{ $_[0] }; | ||||
| 156 | $e = exists $p->{ $_[1] }; | ||||
| 157 | $n = $p->{ $_[1] }; | ||||
| 158 | } else { | ||||
| 159 | ($e, $n) = $m->_get_path_node( @_ ); | ||||
| 160 | } | ||||
| 161 | return undef unless $e; | ||||
| 162 | return ref $n ? $n->[ _ni ] : $n; | ||||
| 163 | } | ||||
| 164 | |||||
| 165 | sub _get_path_count { | ||||
| 166 | my $m = shift; | ||||
| 167 | my $f = $m->[ _f ]; | ||||
| 168 | my ($e, $n) = $m->_get_path_node( @_ ); | ||||
| 169 | return undef unless $e && defined $n; | ||||
| 170 | return | ||||
| 171 | ($f & _COUNT) ? $n->[ _nc ] : | ||||
| 172 | ($f & _MULTI) ? scalar keys %{ $n->[ _nm ] } : 1; | ||||
| 173 | } | ||||
| 174 | |||||
| 175 | # spent 162ms (154+8.92) within Graph::AdjacencyMap::Heavy::__attr which was called 24965 times, avg 7µs/call:
# 19891 times (121ms+7.08ms) by Graph::AdjacencyMap::_set_path_attr at line 207 of Graph/AdjacencyMap.pm, avg 6µs/call
# 5007 times (31.8ms+1.79ms) by Graph::AdjacencyMap::_get_path_attr at line 255 of Graph/AdjacencyMap.pm, avg 7µs/call
# 67 times (586µs+55µs) by Graph::AdjacencyMap::_set_path_attr at line 238 of Graph/AdjacencyMap/Light.pm, avg 10µs/call | ||||
| 176 | 24965 | 5.51ms | my $m = shift; | ||
| 177 | 24965 | 47.4ms | if (@_) { | ||
| 178 | 24965 | 11.9ms | if (ref $_[0] && @{ $_[0] }) { | ||
| 179 | 24965 | 5.58ms | if (@{ $_[0] } != $m->[ _a ]) { | ||
| 180 | require Carp; | ||||
| 181 | Carp::confess(sprintf | ||||
| 182 | "Graph::AdjacencyMap::Heavy: arguments %d expected %d\n", | ||||
| 183 | scalar @{ $_[0] }, $m->[ _a ]); | ||||
| 184 | } | ||||
| 185 | 24965 | 3.16ms | my $f = $m->[ _f ]; | ||
| 186 | 24965 | 94.3ms | 24965 | 8.92ms | if (@{ $_[0] } > 1 && ($f & _UNORDUNIQ)) { # spent 8.92ms making 24965 calls to Graph::AdjacencyMap::Heavy::CORE:sort, avg 357ns/call |
| 187 | if (($f & _UNORDUNIQ) == _UNORD && @{ $_[0] } == 2) { | ||||
| 188 | @{ $_[0] } = sort @{ $_[0] } | ||||
| 189 | } else { $m->__arg(\@_) } | ||||
| 190 | } | ||||
| 191 | } | ||||
| 192 | } | ||||
| 193 | } | ||||
| 194 | |||||
| 195 | sub _get_id_path { | ||||
| 196 | my ($m, $i) = @_; | ||||
| 197 | my $p = defined $i ? $m->[ _i ]->{ $i } : undef; | ||||
| 198 | return defined $p ? @$p : ( ); | ||||
| 199 | } | ||||
| 200 | |||||
| 201 | sub del_path { | ||||
| 202 | my $m = shift; | ||||
| 203 | my $f = $m->[ _f ]; | ||||
| 204 | if (@_ > 1 && ($f & _UNORDUNIQ)) { | ||||
| 205 | if (($f & _UNORDUNIQ) == _UNORD && @_ == 2) { @_ = sort @_ } | ||||
| 206 | else { $m->__arg(\@_) } | ||||
| 207 | } | ||||
| 208 | my ($e, $n, $p, $k, $l) = $m->__get_path_node( @_ ); | ||||
| 209 | return unless $e; | ||||
| 210 | my $c = ($f & _COUNT) ? --$n->[ _nc ] : 0; | ||||
| 211 | if ($c == 0) { | ||||
| 212 | delete $m->[ _i ]->{ ref $n ? $n->[ _ni ] : $n }; | ||||
| 213 | delete $p->[-1]->{ $l }; | ||||
| 214 | while (@$p && @$k && keys %{ $p->[-1]->{ $k->[-1] } } == 0) { | ||||
| 215 | delete $p->[-1]->{ $k->[-1] }; | ||||
| 216 | pop @$p; | ||||
| 217 | pop @$k; | ||||
| 218 | } | ||||
| 219 | } | ||||
| 220 | return 1; | ||||
| 221 | } | ||||
| 222 | |||||
| 223 | sub del_path_by_multi_id { | ||||
| 224 | my $m = shift; | ||||
| 225 | my $f = $m->[ _f ]; | ||||
| 226 | my $id = pop; | ||||
| 227 | if (@_ > 1 && ($f & _UNORDUNIQ)) { | ||||
| 228 | if (($f & _UNORDUNIQ) == _UNORD && @_ == 2) { @_ = sort @_ } | ||||
| 229 | else { $m->__arg(\@_) } | ||||
| 230 | } | ||||
| 231 | my ($e, $n, $p, $k, $l) = $m->__get_path_node( @_ ); | ||||
| 232 | return unless $e; | ||||
| 233 | delete $n->[ _nm ]->{ $id }; | ||||
| 234 | unless (keys %{ $n->[ _nm ] }) { | ||||
| 235 | delete $m->[ _i ]->{ $n->[ _ni ] }; | ||||
| 236 | delete $p->[-1]->{ $l }; | ||||
| 237 | while (@$p && @$k && keys %{ $p->[-1]->{ $k->[-1] } } == 0) { | ||||
| 238 | delete $p->[-1]->{ $k->[-1] }; | ||||
| 239 | pop @$p; | ||||
| 240 | pop @$k; | ||||
| 241 | } | ||||
| 242 | } | ||||
| 243 | return 1; | ||||
| 244 | } | ||||
| 245 | |||||
| 246 | sub paths { | ||||
| 247 | my $m = shift; | ||||
| 248 | return values %{ $m->[ _i ] } if defined $m->[ _i ]; | ||||
| 249 | wantarray ? ( ) : 0; | ||||
| 250 | } | ||||
| 251 | |||||
| 252 | 1 | 3µs | 1; | ||
| 253 | __END__ | ||||
sub Graph::AdjacencyMap::Heavy::CORE:sort; # opcode |