| Filename | /Users/ap13/perl5/lib/perl5/Graph/Traversal.pm |
| Statements | Executed 725291 statements in 678ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 10013 | 1 | 1 | 459ms | 2.58s | Graph::Traversal::next |
| 9975 | 1 | 1 | 82.8ms | 124ms | Graph::Traversal::visit |
| 9975 | 1 | 1 | 72.0ms | 115ms | Graph::Traversal::visit_postorder |
| 9975 | 1 | 1 | 63.3ms | 187ms | Graph::Traversal::visit_preorder |
| 9975 | 1 | 1 | 36.9ms | 36.9ms | Graph::Traversal::_callbacks |
| 9975 | 1 | 1 | 31.9ms | 42.7ms | Graph::Traversal::__ANON__[:26] |
| 19988 | 2 | 1 | 26.3ms | 26.3ms | Graph::Traversal::seeing |
| 38 | 1 | 1 | 23.2ms | 2.60s | Graph::Traversal::_order |
| 9975 | 1 | 1 | 22.5ms | 22.5ms | Graph::Traversal::add_order |
| 38 | 1 | 1 | 10.4ms | 36.7ms | Graph::Traversal::reset |
| 38 | 1 | 1 | 1.20ms | 1.76ms | Graph::Traversal::configure |
| 38 | 2 | 2 | 771µs | 39.3ms | Graph::Traversal::new |
| 38 | 2 | 2 | 242µs | 2.60s | Graph::Traversal::postorder |
| 76 | 1 | 1 | 151µs | 151µs | Graph::Traversal::graph |
| 1 | 1 | 1 | 14µs | 30µs | Graph::Traversal::BEGIN@3 |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::__ANON__[:31] |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::__ANON__[:72] |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::delete_state |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::find_a_cycle |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::get_state |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::has_a_cycle |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::has_state |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::is_root |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::postorder_by_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::postorder_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::preorder |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::preorder_by_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::preorder_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::roots |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::seen |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::set_state |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::terminate |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::tree |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::unseen |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::vertex_by_postorder |
| 0 | 0 | 0 | 0s | 0s | Graph::Traversal::vertex_by_preorder |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Graph::Traversal; | ||||
| 2 | |||||
| 3 | 2 | 3.47ms | 2 | 45µs | # spent 30µs (14+15) within Graph::Traversal::BEGIN@3 which was called:
# once (14µs+15µs) by Graph::Traversal::DFS::BEGIN@5 at line 3 # spent 30µs making 1 call to Graph::Traversal::BEGIN@3
# spent 15µs making 1 call to strict::import |
| 4 | |||||
| 5 | # $SIG{__DIE__ } = sub { use Carp; confess }; | ||||
| 6 | # $SIG{__WARN__} = sub { use Carp; confess }; | ||||
| 7 | |||||
| 8 | sub DEBUG () { 0 } | ||||
| 9 | |||||
| 10 | # spent 36.7ms (10.4+26.4) within Graph::Traversal::reset which was called 38 times, avg 967µs/call:
# 38 times (10.4ms+26.4ms) by Graph::Traversal::new at line 167, avg 967µs/call | ||||
| 11 | 342 | 10.2ms | my $self = shift; | ||
| 12 | 38 | 20.7ms | $self->{ unseen } = { map { $_ => $_ } $self->{ graph }->vertices }; # spent 20.7ms making 38 calls to Graph::vertices, avg 546µs/call | ||
| 13 | $self->{ seen } = { }; | ||||
| 14 | $self->{ order } = [ ]; | ||||
| 15 | $self->{ preorder } = [ ]; | ||||
| 16 | $self->{ postorder } = [ ]; | ||||
| 17 | $self->{ roots } = [ ]; | ||||
| 18 | $self->{ tree } = | ||||
| 19 | 76 | 5.62ms | Graph->new( directed => $self->{ graph }->directed ); # spent 5.33ms making 38 calls to Graph::new, avg 140µs/call
# spent 293µs making 38 calls to Graph::directed, avg 8µs/call | ||
| 20 | delete $self->{ terminate }; | ||||
| 21 | } | ||||
| 22 | |||||
| 23 | # spent 42.7ms (31.9+10.8) within Graph::Traversal::__ANON__[/Users/ap13/perl5/lib/perl5/Graph/Traversal.pm:26] which was called 9975 times, avg 4µs/call:
# 9975 times (31.9ms+10.8ms) by Graph::Traversal::visit_postorder at line 210, avg 4µs/call | ||||
| 24 | 19950 | 23.5ms | my $self = shift; | ||
| 25 | 9975 | 10.8ms | $self->see; # spent 10.8ms making 9975 calls to Graph::Traversal::DFS::see, avg 1µs/call | ||
| 26 | 1 | 4µs | }; | ||
| 27 | |||||
| 28 | my $see_active = sub { | ||||
| 29 | my $self = shift; | ||||
| 30 | delete @{ $self->{ active } }{ $self->see }; | ||||
| 31 | 1 | 2µs | }; | ||
| 32 | |||||
| 33 | sub has_a_cycle { | ||||
| 34 | my ($u, $v, $t, $s) = @_; | ||||
| 35 | $s->{ has_a_cycle } = 1; | ||||
| 36 | $t->terminate; | ||||
| 37 | } | ||||
| 38 | |||||
| 39 | sub find_a_cycle { | ||||
| 40 | my ($u, $v, $t, $s) = @_; | ||||
| 41 | my @cycle = ( $u ); | ||||
| 42 | push @cycle, $v unless $u eq $v; | ||||
| 43 | my $path = $t->{ order }; | ||||
| 44 | if (@$path) { | ||||
| 45 | my $i = $#$path; | ||||
| 46 | while ($i >= 0 && $path->[ $i ] ne $v) { $i-- } | ||||
| 47 | if ($i >= 0) { | ||||
| 48 | unshift @cycle, @{ $path }[ $i+1 .. $#$path ]; | ||||
| 49 | } | ||||
| 50 | } | ||||
| 51 | $s->{ a_cycle } = \@cycle; | ||||
| 52 | $t->terminate; | ||||
| 53 | } | ||||
| 54 | |||||
| 55 | # spent 1.76ms (1.20+556µs) within Graph::Traversal::configure which was called 38 times, avg 46µs/call:
# 38 times (1.20ms+556µs) by Graph::Traversal::new at line 168, avg 46µs/call | ||||
| 56 | 988 | 1.02ms | my ($self, %attr) = @_; | ||
| 57 | $self->{ pre } = $attr{ pre } if exists $attr{ pre }; | ||||
| 58 | $self->{ post } = $attr{ post } if exists $attr{ post }; | ||||
| 59 | $self->{ pre_vertex } = $attr{ pre_vertex } if exists $attr{ pre_vertex }; | ||||
| 60 | $self->{ post_vertex } = $attr{ post_vertex } if exists $attr{ post_vertex }; | ||||
| 61 | $self->{ pre_edge } = $attr{ pre_edge } if exists $attr{ pre_edge }; | ||||
| 62 | $self->{ post_edge } = $attr{ post_edge } if exists $attr{ post_edge }; | ||||
| 63 | if (exists $attr{ successor }) { # Graph 0.201 compatibility. | ||||
| 64 | $self->{ tree_edge } = $self->{ non_tree_edge } = $attr{ successor }; | ||||
| 65 | } | ||||
| 66 | if (exists $attr{ unseen_successor }) { | ||||
| 67 | if (exists $self->{ tree_edge }) { # Graph 0.201 compatibility. | ||||
| 68 | my $old_tree_edge = $self->{ tree_edge }; | ||||
| 69 | $self->{ tree_edge } = sub { | ||||
| 70 | $old_tree_edge->( @_ ); | ||||
| 71 | $attr{ unseen_successor }->( @_ ); | ||||
| 72 | }; | ||||
| 73 | } else { | ||||
| 74 | $self->{ tree_edge } = $attr{ unseen_successor }; | ||||
| 75 | } | ||||
| 76 | } | ||||
| 77 | 152 | 556µs | if ($self->graph->multiedged || $self->graph->countedged) { # spent 226µs making 38 calls to Graph::countedged, avg 6µs/call
# spent 178µs making 38 calls to Graph::multiedged, avg 5µs/call
# spent 151µs making 76 calls to Graph::Traversal::graph, avg 2µs/call | ||
| 78 | $self->{ seen_edge } = $attr{ seen_edge } if exists $attr{ seen_edge }; | ||||
| 79 | if (exists $attr{ seen_successor }) { # Graph 0.201 compatibility. | ||||
| 80 | $self->{ seen_edge } = $attr{ seen_edge }; | ||||
| 81 | } | ||||
| 82 | } | ||||
| 83 | $self->{ non_tree_edge } = $attr{ non_tree_edge } if exists $attr{ non_tree_edge }; | ||||
| 84 | $self->{ pre_edge } = $attr{ tree_edge } if exists $attr{ tree_edge }; | ||||
| 85 | $self->{ back_edge } = $attr{ back_edge } if exists $attr{ back_edge }; | ||||
| 86 | $self->{ down_edge } = $attr{ down_edge } if exists $attr{ down_edge }; | ||||
| 87 | $self->{ cross_edge } = $attr{ cross_edge } if exists $attr{ cross_edge }; | ||||
| 88 | if (exists $attr{ start }) { | ||||
| 89 | $attr{ first_root } = $attr{ start }; | ||||
| 90 | $attr{ next_root } = undef; | ||||
| 91 | } | ||||
| 92 | if (exists $attr{ get_next_root }) { | ||||
| 93 | $attr{ next_root } = $attr{ get_next_root }; # Graph 0.201 compat. | ||||
| 94 | } | ||||
| 95 | $self->{ next_root } = | ||||
| 96 | exists $attr{ next_root } ? | ||||
| 97 | $attr{ next_root } : | ||||
| 98 | $attr{ next_alphabetic } ? | ||||
| 99 | \&Graph::_next_alphabetic : | ||||
| 100 | $attr{ next_numeric } ? | ||||
| 101 | \&Graph::_next_numeric : | ||||
| 102 | \&Graph::_next_random; | ||||
| 103 | $self->{ first_root } = | ||||
| 104 | exists $attr{ first_root } ? | ||||
| 105 | $attr{ first_root } : | ||||
| 106 | exists $attr{ next_root } ? | ||||
| 107 | $attr{ next_root } : | ||||
| 108 | $attr{ next_alphabetic } ? | ||||
| 109 | \&Graph::_next_alphabetic : | ||||
| 110 | $attr{ next_numeric } ? | ||||
| 111 | \&Graph::_next_numeric : | ||||
| 112 | \&Graph::_next_random; | ||||
| 113 | $self->{ next_successor } = | ||||
| 114 | exists $attr{ next_successor } ? | ||||
| 115 | $attr{ next_successor } : | ||||
| 116 | $attr{ next_alphabetic } ? | ||||
| 117 | \&Graph::_next_alphabetic : | ||||
| 118 | $attr{ next_numeric } ? | ||||
| 119 | \&Graph::_next_numeric : | ||||
| 120 | \&Graph::_next_random; | ||||
| 121 | if (exists $attr{ has_a_cycle }) { | ||||
| 122 | my $has_a_cycle = | ||||
| 123 | ref $attr{ has_a_cycle } eq 'CODE' ? | ||||
| 124 | $attr{ has_a_cycle } : \&has_a_cycle; | ||||
| 125 | $self->{ back_edge } = $has_a_cycle; | ||||
| 126 | if ($self->{ graph }->is_undirected) { | ||||
| 127 | $self->{ down_edge } = $has_a_cycle; | ||||
| 128 | } | ||||
| 129 | } | ||||
| 130 | if (exists $attr{ find_a_cycle }) { | ||||
| 131 | my $find_a_cycle = | ||||
| 132 | ref $attr{ find_a_cycle } eq 'CODE' ? | ||||
| 133 | $attr{ find_a_cycle } : \&find_a_cycle; | ||||
| 134 | $self->{ back_edge } = $find_a_cycle; | ||||
| 135 | if ($self->{ graph }->is_undirected) { | ||||
| 136 | $self->{ down_edge } = $find_a_cycle; | ||||
| 137 | } | ||||
| 138 | } | ||||
| 139 | $self->{ add } = \&add_order; | ||||
| 140 | $self->{ see } = $see; | ||||
| 141 | delete @attr{ qw( | ||||
| 142 | pre post pre_edge post_edge | ||||
| 143 | successor unseen_successor seen_successor | ||||
| 144 | tree_edge non_tree_edge | ||||
| 145 | back_edge down_edge cross_edge seen_edge | ||||
| 146 | start get_next_root | ||||
| 147 | next_root next_alphabetic next_numeric next_random next_successor | ||||
| 148 | first_root | ||||
| 149 | has_a_cycle find_a_cycle | ||||
| 150 | ) }; | ||||
| 151 | if (keys %attr) { | ||||
| 152 | require Carp; | ||||
| 153 | my @attr = sort keys %attr; | ||||
| 154 | Carp::croak(sprintf "Graph::Traversal: unknown attribute%s @{[map { qq['$_'] } @attr]}\n", @attr == 1 ? '' : 's'); | ||||
| 155 | } | ||||
| 156 | } | ||||
| 157 | |||||
| 158 | # spent 39.3ms (771µs+38.6) within Graph::Traversal::new which was called 38 times, avg 1.04ms/call:
# 36 times (644µs+20.1ms) by Bio::Roary::OrderGenes::_reorder_connected_components at line 184 of lib/Bio/Roary/OrderGenes.pm, avg 575µs/call
# 2 times (126µs+18.5ms) by Graph::_connected_components_compute at line 2755 of Graph.pm, avg 9.32ms/call | ||||
| 159 | 304 | 818µs | my $class = shift; | ||
| 160 | my $g = shift; | ||||
| 161 | 38 | 92µs | unless (ref $g && $g->isa('Graph')) { # spent 92µs making 38 calls to UNIVERSAL::isa, avg 2µs/call | ||
| 162 | require Carp; | ||||
| 163 | Carp::croak("Graph::Traversal: first argument is not a Graph"); | ||||
| 164 | } | ||||
| 165 | my $self = { graph => $g, state => { } }; | ||||
| 166 | bless $self, $class; | ||||
| 167 | 38 | 36.7ms | $self->reset; # spent 36.7ms making 38 calls to Graph::Traversal::reset, avg 967µs/call | ||
| 168 | 38 | 1.76ms | $self->configure( @_ ); # spent 1.76ms making 38 calls to Graph::Traversal::configure, avg 46µs/call | ||
| 169 | return $self; | ||||
| 170 | } | ||||
| 171 | |||||
| 172 | sub terminate { | ||||
| 173 | my $self = shift; | ||||
| 174 | $self->{ terminate } = 1; | ||||
| 175 | } | ||||
| 176 | |||||
| 177 | # spent 22.5ms within Graph::Traversal::add_order which was called 9975 times, avg 2µs/call:
# 9975 times (22.5ms+0s) by Graph::Traversal::visit at line 188, avg 2µs/call | ||||
| 178 | 19950 | 30.9ms | my ($self, @next) = @_; | ||
| 179 | push @{ $self->{ order } }, @next; | ||||
| 180 | } | ||||
| 181 | |||||
| 182 | # spent 124ms (82.8+41.1) within Graph::Traversal::visit which was called 9975 times, avg 12µs/call:
# 9975 times (82.8ms+41.1ms) by Graph::Traversal::visit_preorder at line 205, avg 12µs/call | ||||
| 183 | 49875 | 52.3ms | my ($self, @next) = @_; | ||
| 184 | delete @{ $self->{ unseen } }{ @next }; | ||||
| 185 | print "unseen = @{[sort keys %{$self->{unseen}}]}\n" if DEBUG; | ||||
| 186 | @{ $self->{ seen } }{ @next } = @next; | ||||
| 187 | print "seen = @{[sort keys %{$self->{seen}}]}\n" if DEBUG; | ||||
| 188 | 9975 | 22.5ms | $self->{ add }->( $self, @next ); # spent 22.5ms making 9975 calls to Graph::Traversal::add_order, avg 2µs/call | ||
| 189 | print "order = @{$self->{order}}\n" if DEBUG; | ||||
| 190 | 9982 | 6.91ms | if (exists $self->{ pre }) { | ||
| 191 | my $p = $self->{ pre }; | ||||
| 192 | for my $v (@next) { | ||||
| 193 | 4991 | 8.32ms | 4991 | 18.7ms | $p->( $v, $self ); # spent 18.7ms making 4991 calls to Graph::__ANON__[Graph.pm:2754], avg 4µs/call |
| 194 | } | ||||
| 195 | } | ||||
| 196 | } | ||||
| 197 | |||||
| 198 | # spent 187ms (63.3+124) within Graph::Traversal::visit_preorder which was called 9975 times, avg 19µs/call:
# 9975 times (63.3ms+124ms) by Graph::Traversal::next at line 339, avg 19µs/call | ||||
| 199 | 39900 | 39.8ms | my ($self, @next) = @_; | ||
| 200 | push @{ $self->{ preorder } }, @next; | ||||
| 201 | for my $v (@next) { | ||||
| 202 | 9975 | 13.0ms | $self->{ preordern }->{ $v } = $self->{ preorderi }++; | ||
| 203 | } | ||||
| 204 | print "preorder = @{$self->{preorder}}\n" if DEBUG; | ||||
| 205 | 9975 | 124ms | $self->visit( @next ); # spent 124ms making 9975 calls to Graph::Traversal::visit, avg 12µs/call | ||
| 206 | } | ||||
| 207 | |||||
| 208 | # spent 115ms (72.0+42.7) within Graph::Traversal::visit_postorder which was called 9975 times, avg 12µs/call:
# 9975 times (72.0ms+42.7ms) by Graph::Traversal::next at line 312, avg 12µs/call | ||||
| 209 | 59850 | 49.9ms | my ($self) = @_; | ||
| 210 | 9975 | 42.7ms | my @post = reverse $self->{ see }->( $self ); # spent 42.7ms making 9975 calls to Graph::Traversal::__ANON__[Graph/Traversal.pm:26], avg 4µs/call | ||
| 211 | push @{ $self->{ postorder } }, @post; | ||||
| 212 | for my $v (@post) { | ||||
| 213 | 9975 | 13.6ms | $self->{ postordern }->{ $v } = $self->{ postorderi }++; | ||
| 214 | } | ||||
| 215 | print "postorder = @{$self->{postorder}}\n" if DEBUG; | ||||
| 216 | if (exists $self->{ post }) { | ||||
| 217 | my $p = $self->{ post }; | ||||
| 218 | for my $v (@post) { | ||||
| 219 | $p->( $v, $self ) ; | ||||
| 220 | } | ||||
| 221 | } | ||||
| 222 | if (exists $self->{ post_edge }) { | ||||
| 223 | my $p = $self->{ post_edge }; | ||||
| 224 | my $u = $self->current; | ||||
| 225 | if (defined $u) { | ||||
| 226 | for my $v (@post) { | ||||
| 227 | $p->( $u, $v, $self, $self->{ state }); | ||||
| 228 | } | ||||
| 229 | } | ||||
| 230 | } | ||||
| 231 | } | ||||
| 232 | |||||
| 233 | # spent 36.9ms within Graph::Traversal::_callbacks which was called 9975 times, avg 4µs/call:
# 9975 times (36.9ms+0s) by Graph::Traversal::next at line 315, avg 4µs/call | ||||
| 234 | 89775 | 36.2ms | my ($self, $current, @all) = @_; | ||
| 235 | return unless @all; | ||||
| 236 | my $nontree = $self->{ non_tree_edge }; | ||||
| 237 | my $back = $self->{ back_edge }; | ||||
| 238 | my $down = $self->{ down_edge }; | ||||
| 239 | my $cross = $self->{ cross_edge }; | ||||
| 240 | my $seen = $self->{ seen_edge }; | ||||
| 241 | my $bdc = defined $back || defined $down || defined $cross; | ||||
| 242 | if (defined $nontree || $bdc || defined $seen) { | ||||
| 243 | my $u = $current; | ||||
| 244 | my $preu = $self->{ preordern }->{ $u }; | ||||
| 245 | my $postu = $self->{ postordern }->{ $u }; | ||||
| 246 | for my $v ( @all ) { | ||||
| 247 | my $e = $self->{ tree }->has_edge( $u, $v ); | ||||
| 248 | if ( !$e && (defined $nontree || $bdc) ) { | ||||
| 249 | if ( exists $self->{ seen }->{ $v }) { | ||||
| 250 | $nontree->( $u, $v, $self, $self->{ state }) | ||||
| 251 | if $nontree; | ||||
| 252 | if ($bdc) { | ||||
| 253 | my $postv = $self->{ postordern }->{ $v }; | ||||
| 254 | if ($back && | ||||
| 255 | (!defined $postv || $postv >= $postu)) { | ||||
| 256 | $back ->( $u, $v, $self, $self->{ state }); | ||||
| 257 | } else { | ||||
| 258 | my $prev = $self->{ preordern }->{ $v }; | ||||
| 259 | if ($down && $prev > $preu) { | ||||
| 260 | $down ->( $u, $v, $self, $self->{ state }); | ||||
| 261 | } elsif ($cross && $prev < $preu) { | ||||
| 262 | $cross->( $u, $v, $self, $self->{ state }); | ||||
| 263 | } | ||||
| 264 | } | ||||
| 265 | } | ||||
| 266 | } | ||||
| 267 | } | ||||
| 268 | if ($seen) { | ||||
| 269 | my $c = $self->graph->get_edge_count($u, $v); | ||||
| 270 | while ($c-- > 1) { | ||||
| 271 | $seen->( $u, $v, $self, $self->{ state } ); | ||||
| 272 | } | ||||
| 273 | } | ||||
| 274 | } | ||||
| 275 | } | ||||
| 276 | } | ||||
| 277 | |||||
| 278 | # spent 2.58s (459ms+2.12) within Graph::Traversal::next which was called 10013 times, avg 257µs/call:
# 10013 times (459ms+2.12s) by Graph::Traversal::_order at line 347, avg 257µs/call | ||||
| 279 | 70015 | 48.3ms | my $self = shift; | ||
| 280 | return undef if $self->{ terminate }; | ||||
| 281 | my @next; | ||||
| 282 | 10013 | 11.7ms | while ($self->seeing) { # spent 11.7ms making 10013 calls to Graph::Traversal::seeing, avg 1µs/call | ||
| 283 | 198915 | 184ms | 19885 | 31.9ms | my $current = $self->current; # spent 31.9ms making 19885 calls to Graph::Traversal::DFS::current, avg 2µs/call |
| 284 | print "current = $current\n" if DEBUG; | ||||
| 285 | 19885 | 1.17s | @next = $self->{ graph }->successors( $current ); # spent 1.17s making 19885 calls to Graph::successors, avg 59µs/call | ||
| 286 | print "next.0 - @next\n" if DEBUG; | ||||
| 287 | my %next; @next{ @next } = @next; | ||||
| 288 | print "next.1 - @next\n" if DEBUG; | ||||
| 289 | @next = keys %next; | ||||
| 290 | my @all = @next; | ||||
| 291 | print "all = @all\n" if DEBUG; | ||||
| 292 | for my $s (keys %next) { | ||||
| 293 | 40007 | 36.8ms | delete $next{$s} if exists $self->{seen}->{$s}; | ||
| 294 | } | ||||
| 295 | @next = keys %next; | ||||
| 296 | print "next.2 - @next\n" if DEBUG; | ||||
| 297 | 49615 | 48.0ms | if (@next) { | ||
| 298 | 9910 | 23.8ms | @next = $self->{ next_successor }->( $self, \%next ); # spent 23.8ms making 9910 calls to Graph::_next_random, avg 2µs/call | ||
| 299 | print "next.3 - @next\n" if DEBUG; | ||||
| 300 | for my $v (@next) { | ||||
| 301 | 9910 | 17.6ms | 9910 | 524ms | $self->{ tree }->add_edge( $current, $v ); # spent 524ms making 9910 calls to Graph::add_edge, avg 53µs/call |
| 302 | } | ||||
| 303 | if (exists $self->{ pre_edge }) { | ||||
| 304 | my $p = $self->{ pre_edge }; | ||||
| 305 | my $u = $self->current; | ||||
| 306 | for my $v (@next) { | ||||
| 307 | $p->( $u, $v, $self, $self->{ state }); | ||||
| 308 | } | ||||
| 309 | } | ||||
| 310 | last; | ||||
| 311 | } else { | ||||
| 312 | 9975 | 115ms | $self->visit_postorder; # spent 115ms making 9975 calls to Graph::Traversal::visit_postorder, avg 12µs/call | ||
| 313 | } | ||||
| 314 | return undef if $self->{ terminate }; | ||||
| 315 | 19950 | 51.4ms | $self->_callbacks($current, @all); # spent 36.9ms making 9975 calls to Graph::Traversal::_callbacks, avg 4µs/call
# spent 14.5ms making 9975 calls to Graph::Traversal::seeing, avg 1µs/call | ||
| 316 | } | ||||
| 317 | print "next.4 - @next\n" if DEBUG; | ||||
| 318 | 329 | 216µs | unless (@next) { | ||
| 319 | 76 | 34µs | unless ( @{ $self->{ roots } } ) { | ||
| 320 | my $first = $self->{ first_root }; | ||||
| 321 | 76 | 136µs | if (defined $first) { | ||
| 322 | @next = | ||||
| 323 | ref $first eq 'CODE' ? | ||||
| 324 | 38 | 364µs | $self->{ first_root }->( $self, $self->{ unseen } ) : # spent 348µs making 36 calls to Graph::_next_random, avg 10µs/call
# spent 16µs making 2 calls to Graph::__ANON__[Graph.pm:2741], avg 8µs/call | ||
| 325 | $first; | ||||
| 326 | return unless @next; | ||||
| 327 | } | ||||
| 328 | } | ||||
| 329 | 130 | 256µs | unless (@next) { | ||
| 330 | return unless defined $self->{ next_root }; | ||||
| 331 | return unless @next = | ||||
| 332 | 65 | 268µs | $self->{ next_root }->( $self, $self->{ unseen } ); # spent 184µs making 36 calls to Graph::__ANON__[Graph.pm:2745], avg 5µs/call
# spent 84µs making 29 calls to Graph::_next_random, avg 3µs/call | ||
| 333 | } | ||||
| 334 | return if exists $self->{ seen }->{ $next[0] }; # Sanity check. | ||||
| 335 | print "next.5 - @next\n" if DEBUG; | ||||
| 336 | push @{ $self->{ roots } }, $next[0]; | ||||
| 337 | } | ||||
| 338 | print "next.6 - @next\n" if DEBUG; | ||||
| 339 | 9975 | 187ms | if (@next) { # spent 187ms making 9975 calls to Graph::Traversal::visit_preorder, avg 19µs/call | ||
| 340 | $self->visit_preorder( @next ); | ||||
| 341 | } | ||||
| 342 | return $next[0]; | ||||
| 343 | } | ||||
| 344 | |||||
| 345 | # spent 2.60s (23.2ms+2.58) within Graph::Traversal::_order which was called 38 times, avg 68.4ms/call:
# 38 times (23.2ms+2.58s) by Graph::Traversal::postorder at line 363, avg 68.4ms/call | ||||
| 346 | 152 | 1.70ms | my ($self, $order) = @_; | ||
| 347 | 1 | 13.1ms | 10013 | 2.58s | 1 while defined $self->next; # spent 2.58s making 10013 calls to Graph::Traversal::next, avg 257µs/call |
| 348 | my $wantarray = wantarray; | ||||
| 349 | if ($wantarray) { | ||||
| 350 | @{ $self->{ $order } }; | ||||
| 351 | } elsif (defined $wantarray) { | ||||
| 352 | shift @{ $self->{ $order } }; | ||||
| 353 | } | ||||
| 354 | } | ||||
| 355 | |||||
| 356 | sub preorder { | ||||
| 357 | my $self = shift; | ||||
| 358 | $self->_order( 'preorder' ); | ||||
| 359 | } | ||||
| 360 | |||||
| 361 | # spent 2.60s (242µs+2.60) within Graph::Traversal::postorder which was called 38 times, avg 68.4ms/call:
# 36 times (219µs+1.26s) by Bio::Roary::OrderGenes::_reorder_connected_components at line 185 of lib/Bio/Roary/OrderGenes.pm, avg 34.9ms/call
# 2 times (23µs+1.35s) by Graph::_connected_components_compute at line 2756 of Graph.pm, avg 673ms/call | ||||
| 362 | 76 | 232µs | my $self = shift; | ||
| 363 | 38 | 2.60s | $self->_order( 'postorder' ); # spent 2.60s making 38 calls to Graph::Traversal::_order, avg 68.4ms/call | ||
| 364 | } | ||||
| 365 | |||||
| 366 | sub unseen { | ||||
| 367 | my $self = shift; | ||||
| 368 | values %{ $self->{ unseen } }; | ||||
| 369 | } | ||||
| 370 | |||||
| 371 | sub seen { | ||||
| 372 | my $self = shift; | ||||
| 373 | values %{ $self->{ seen } }; | ||||
| 374 | } | ||||
| 375 | |||||
| 376 | sub seeing { | ||||
| 377 | 39976 | 38.1ms | my $self = shift; | ||
| 378 | @{ $self->{ order } }; | ||||
| 379 | } | ||||
| 380 | |||||
| 381 | sub roots { | ||||
| 382 | my $self = shift; | ||||
| 383 | @{ $self->{ roots } }; | ||||
| 384 | } | ||||
| 385 | |||||
| 386 | sub is_root { | ||||
| 387 | my ($self, $v) = @_; | ||||
| 388 | for my $u (@{ $self->{ roots } }) { | ||||
| 389 | return 1 if $u eq $v; | ||||
| 390 | } | ||||
| 391 | return 0; | ||||
| 392 | } | ||||
| 393 | |||||
| 394 | sub tree { | ||||
| 395 | my $self = shift; | ||||
| 396 | $self->{ tree }; | ||||
| 397 | } | ||||
| 398 | |||||
| 399 | # spent 151µs within Graph::Traversal::graph which was called 76 times, avg 2µs/call:
# 76 times (151µs+0s) by Graph::Traversal::configure at line 77, avg 2µs/call | ||||
| 400 | 152 | 192µs | my $self = shift; | ||
| 401 | $self->{ graph }; | ||||
| 402 | } | ||||
| 403 | |||||
| 404 | sub vertex_by_postorder { | ||||
| 405 | my ($self, $i) = @_; | ||||
| 406 | exists $self->{ postorder } && $self->{ postorder }->[ $i ]; | ||||
| 407 | } | ||||
| 408 | |||||
| 409 | sub postorder_by_vertex { | ||||
| 410 | my ($self, $v) = @_; | ||||
| 411 | exists $self->{ postordern } && $self->{ postordern }->{ $v }; | ||||
| 412 | } | ||||
| 413 | |||||
| 414 | sub postorder_vertices { | ||||
| 415 | my ($self, $v) = @_; | ||||
| 416 | exists $self->{ postordern } ? %{ $self->{ postordern } } : (); | ||||
| 417 | } | ||||
| 418 | |||||
| 419 | sub vertex_by_preorder { | ||||
| 420 | my ($self, $i) = @_; | ||||
| 421 | exists $self->{ preorder } && $self->{ preorder }->[ $i ]; | ||||
| 422 | } | ||||
| 423 | |||||
| 424 | sub preorder_by_vertex { | ||||
| 425 | my ($self, $v) = @_; | ||||
| 426 | exists $self->{ preordern } && $self->{ preordern }->{ $v }; | ||||
| 427 | } | ||||
| 428 | |||||
| 429 | sub preorder_vertices { | ||||
| 430 | my ($self, $v) = @_; | ||||
| 431 | exists $self->{ preordern } ? %{ $self->{ preordern } } : (); | ||||
| 432 | } | ||||
| 433 | |||||
| 434 | sub has_state { | ||||
| 435 | my ($self, $var) = @_; | ||||
| 436 | exists $self->{ state } && exists $self->{ state }->{ $var }; | ||||
| 437 | } | ||||
| 438 | |||||
| 439 | sub get_state { | ||||
| 440 | my ($self, $var) = @_; | ||||
| 441 | exists $self->{ state } ? $self->{ state }->{ $var } : undef; | ||||
| 442 | } | ||||
| 443 | |||||
| 444 | sub set_state { | ||||
| 445 | my ($self, $var, $val) = @_; | ||||
| 446 | $self->{ state }->{ $var } = $val; | ||||
| 447 | return 1; | ||||
| 448 | } | ||||
| 449 | |||||
| 450 | sub delete_state { | ||||
| 451 | my ($self, $var) = @_; | ||||
| 452 | delete $self->{ state }->{ $var }; | ||||
| 453 | delete $self->{ state } unless keys %{ $self->{ state } }; | ||||
| 454 | return 1; | ||||
| 455 | } | ||||
| 456 | |||||
| 457 | 1 | 9µs | 1; | ||
| 458 | __END__ |