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 | set_path | Graph::AdjacencyMap::Heavy::
19958 | 1 | 1 | 176ms | 176ms | __set_path | Graph::AdjacencyMap::Heavy::
24965 | 3 | 2 | 154ms | 162ms | __attr | Graph::AdjacencyMap::Heavy::
19958 | 1 | 1 | 145ms | 203ms | __set_path_node | Graph::AdjacencyMap::Heavy::
44923 | 2 | 1 | 26.7ms | 26.7ms | CORE:sort (opcode) | Graph::AdjacencyMap::Heavy::
1 | 1 | 1 | 17µs | 34µs | BEGIN@7 | Graph::AdjacencyMap::Heavy::
1 | 1 | 1 | 11µs | 83µs | BEGIN@13 | Graph::AdjacencyMap::Heavy::
1 | 1 | 1 | 8µs | 214µs | BEGIN@12 | Graph::AdjacencyMap::Heavy::
0 | 0 | 0 | 0s | 0s | __has_path | Graph::AdjacencyMap::Heavy::
0 | 0 | 0 | 0s | 0s | _get_id_path | Graph::AdjacencyMap::Heavy::
0 | 0 | 0 | 0s | 0s | _get_path_count | Graph::AdjacencyMap::Heavy::
0 | 0 | 0 | 0s | 0s | _get_path_id | Graph::AdjacencyMap::Heavy::
0 | 0 | 0 | 0s | 0s | _get_path_node | Graph::AdjacencyMap::Heavy::
0 | 0 | 0 | 0s | 0s | del_path | Graph::AdjacencyMap::Heavy::
0 | 0 | 0 | 0s | 0s | del_path_by_multi_id | Graph::AdjacencyMap::Heavy::
0 | 0 | 0 | 0s | 0s | has_path | Graph::AdjacencyMap::Heavy::
0 | 0 | 0 | 0s | 0s | has_path_by_multi_id | Graph::AdjacencyMap::Heavy::
0 | 0 | 0 | 0s | 0s | paths | Graph::AdjacencyMap::Heavy::
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 | 419118 | 152ms | my $m = shift; | ||
21 | my $f = $m->[ _f ]; | ||||
22 | my $id = pop if ($f & _MULTI); | ||||
23 | 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 | my $p; | ||||
29 | $p = ($f & _HYPER) ? | ||||
30 | (( $m->[ _s ] ||= [ ] )->[ @_ ] ||= { }) : | ||||
31 | ( $m->[ _s ] ||= { }); | ||||
32 | my @p = $p; | ||||
33 | my @k; | ||||
34 | while (@_) { | ||||
35 | my $k = shift; | ||||
36 | my $q = ref $k && ($f & _REF) && overload::Method($k, '""') ? overload::StrVal($k) : $k; | ||||
37 | if (@_) { | ||||
38 | $p = $p->{ $q } ||= {}; | ||||
39 | return unless $p; | ||||
40 | push @p, $p; | ||||
41 | } | ||||
42 | push @k, $q; | ||||
43 | } | ||||
44 | 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 | 129720 | 126ms | my ($m, $p, $l) = splice @_, 0, 3; | ||
49 | my $f = $m->[ _f ] ; | ||||
50 | my $id = pop if ($f & _MULTI); | ||||
51 | unless (exists $p->[-1]->{ $l }) { | ||||
52 | 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 | $m->[ _i ]->{ defined $i ? $i : "" } = [ @_ ]; | ||||
54 | return defined $id ? ($id eq _GEN_ID ? $$id : $id) : $i; | ||||
55 | } else { | ||||
56 | 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 | 139706 | 172ms | my $m = shift; | ||
62 | my $f = $m->[ _f ]; | ||||
63 | 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 | 176ms | my ($p, $k) = $m->__set_path( @_ ); # spent 176ms making 19958 calls to Graph::AdjacencyMap::Heavy::__set_path, avg 9µs/call | ||
68 | return unless defined $p && defined $k; | ||||
69 | my $l = defined $k->[-1] ? $k->[-1] : ""; | ||||
70 | 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 | 149790 | 168ms | my $m = shift; | ||
177 | if (@_) { | ||||
178 | if (ref $_[0] && @{ $_[0] }) { | ||||
179 | 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 | my $f = $m->[ _f ]; | ||||
186 | 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 |