← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/pan_genome_post_analysis
  Run on Fri Mar 27 11:43:32 2015
Reported on Fri Mar 27 11:46:15 2015

Filename/Users/ap13/perl5/lib/perl5/Graph.pm
StatementsExecuted 2879358 statements in 2.76s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
2487611617ms858msGraph::::_edgesGraph::_edges
2993542312ms1.88sGraph::::add_edgeGraph::add_edge
3496332253ms276msGraph::::has_edgeGraph::has_edge
2493411241ms491msGraph::::add_vertexGraph::add_vertex
2993511231ms721msGraph::::_add_edgeGraph::_add_edge
1995821222ms1.50sGraph::::set_edge_attributeGraph::set_edge_attribute
7007542193ms251msGraph::::multiedgedGraph::multiedged
2496521152ms152msGraph::::_vertex_idsGraph::_vertex_ids
1500331139ms2.07sGraph::::add_weighted_edgeGraph::add_weighted_edge
399683199.7ms250msGraph::::expect_non_multiedgedGraph::expect_non_multiedged
548713187.9ms87.9msGraph::::has_union_findGraph::has_union_find
361184.6ms1.79sGraph::::_heap_walkGraph::_heap_walk
248762283.3ms1.50sGraph::::successorsGraph::successors
249142174.9ms102msGraph::::omniedgedGraph::omniedged
49912169.3ms861msGraph::::_MST_addGraph::_MST_add
249722167.9ms79.1msGraph::::multivertexedGraph::multivertexed
50071162.8ms325msGraph::::get_edge_attributeGraph::get_edge_attribute
248761145.3ms45.3msGraph::::_edges_fromGraph::_edges_from
21125.5ms1.40sGraph::::_connected_components_computeGraph::_connected_components_compute
100114224.5ms24.5msGraph::::_next_randomGraph::_next_random
151774124.3ms24.3msGraph::::is_compat02Graph::is_compat02
262771122.7ms22.7msGraph::::CORE:sortGraph::CORE:sort (opcode)
49911118.7ms18.7msGraph::::__ANON__[:2754]Graph::__ANON__[:2754]
763118.5ms34.7msGraph::::vertices05Graph::vertices05
4871119.00ms9.00msGraph::::has_vertexGraph::has_vertex
112536.23ms16.6msGraph::::newGraph::new
36115.68ms13.6msGraph::::_root_optGraph::_root_opt
336314.98ms4.98msGraph::::_optGraph::_opt
38113.87ms20.7msGraph::::verticesGraph::vertices
1113.12ms15.2msGraph::::BEGIN@42Graph::BEGIN@42
1112.89ms3.27msGraph::::BEGIN@13Graph::BEGIN@13
1112.79ms2.98msGraph::::BEGIN@38Graph::BEGIN@38
134111.92ms3.24msGraph::::edges05Graph::edges05
148211.89ms1.89msGraph::::_get_optionsGraph::_get_options
1111.61ms1.96msGraph::::BEGIN@28Graph::BEGIN@28
134211.51ms5.98msGraph::::edgesGraph::edges
1111.32ms3.17msGraph::::BEGIN@29Graph::BEGIN@29
2111.21ms12.1msGraph::::unique_verticesGraph::unique_vertices
111949µs1.16msGraph::::BEGIN@86Graph::BEGIN@86
22421743µs743µsGraph::::_opt_getGraph::_opt_get
3611686µs1.80sGraph::::MST_PrimGraph::MST_Prim
17222646µs789µsGraph::::countedgedGraph::countedged
111565µs590µsGraph::::BEGIN@31Graph::BEGIN@31
6711502µs5.56msGraph::::add_edgesGraph::add_edges
111487µs4.77msGraph::::BEGIN@32Graph::BEGIN@32
111472µs809µsGraph::::BEGIN@35Graph::BEGIN@35
111442µs1.34msGraph::::BEGIN@34Graph::BEGIN@34
11211348µs348µsGraph::::_opt_unknownGraph::_opt_unknown
111346µs4.14msGraph::::BEGIN@33Graph::BEGIN@33
111312µs485µsGraph::::BEGIN@36Graph::BEGIN@36
3811238µs293µsGraph::::directedGraph::directed
3821201µs490µsGraph::::expect_undirectedGraph::expect_undirected
3611184µs184µsGraph::::__ANON__[:2745]Graph::__ANON__[:2745]
3811158µs177µsGraph::::countvertexedGraph::countvertexed
21180µs1.40sGraph::::_check_cacheGraph::_check_cache
22161µs1.40sGraph::::connected_componentsGraph::connected_components
21130µs1.40sGraph::::_connected_componentsGraph::_connected_components
11126µs26µsGraph::::BEGIN@55Graph::BEGIN@55
11125µs98µsGraph::::BEGIN@39Graph::BEGIN@39
11118µs40µsGraph::::BEGIN@3Graph::BEGIN@3
11116µs62µsGraph::::BEGIN@40Graph::BEGIN@40
21116µs16µsGraph::::__ANON__[:2741]Graph::__ANON__[:2741]
11113µs56µsGraph::::BEGIN@1733Graph::BEGIN@1733
11113µs29µsGraph::::BEGIN@30Graph::BEGIN@30
11112µs58µsGraph::::BEGIN@116Graph::BEGIN@116
11111µs23µsGraph::::BEGIN@178Graph::BEGIN@178
11110µs10µsGraph::::BEGIN@2155Graph::BEGIN@2155
11110µs29µsGraph::::BEGIN@15Graph::BEGIN@15
1113µs3µsGraph::::BEGIN@5Graph::BEGIN@5
0000s0sGraph::::APSP_Floyd_WarshallGraph::APSP_Floyd_Warshall
0000s0sGraph::::InfinityGraph::Infinity
0000s0sGraph::::MST_KruskalGraph::MST_Kruskal
0000s0sGraph::::SPT_Bellman_FordGraph::SPT_Bellman_Ford
0000s0sGraph::::SPT_Bellman_Ford_clear_cacheGraph::SPT_Bellman_Ford_clear_cache
0000s0sGraph::::SPT_DijkstraGraph::SPT_Dijkstra
0000s0sGraph::::SPT_Dijkstra_clear_cacheGraph::SPT_Dijkstra_clear_cache
0000s0sGraph::::SP_Bellman_FordGraph::SP_Bellman_Ford
0000s0sGraph::::SP_DijkstraGraph::SP_Dijkstra
0000s0sGraph::::TransitiveClosure_Floyd_WarshallGraph::TransitiveClosure_Floyd_Warshall
0000s0sGraph::::_MST_attrGraph::_MST_attr
0000s0sGraph::::_MST_edgesGraph::_MST_edges
0000s0sGraph::::_SPT_Bellman_FordGraph::_SPT_Bellman_Ford
0000s0sGraph::::_SPT_Bellman_Ford_computeGraph::_SPT_Bellman_Ford_compute
0000s0sGraph::::_SPT_Dijkstra_computeGraph::_SPT_Dijkstra_compute
0000s0sGraph::::_SPT_addGraph::_SPT_add
0000s0sGraph::::__ANON__[:1726]Graph::__ANON__[:1726]
0000s0sGraph::::__ANON__[:2211]Graph::__ANON__[:2211]
0000s0sGraph::::__ANON__[:2269]Graph::__ANON__[:2269]
0000s0sGraph::::__ANON__[:2817]Graph::__ANON__[:2817]
0000s0sGraph::::__ANON__[:2904]Graph::__ANON__[:2904]
0000s0sGraph::::__ANON__[:2908]Graph::__ANON__[:2908]
0000s0sGraph::::__ANON__[:2994]Graph::__ANON__[:2994]
0000s0sGraph::::__ANON__[:2998]Graph::__ANON__[:2998]
0000s0sGraph::::__ANON__[:3030]Graph::__ANON__[:3030]
0000s0sGraph::::__ANON__[:3034]Graph::__ANON__[:3034]
0000s0sGraph::::__ANON__[:3047]Graph::__ANON__[:3047]
0000s0sGraph::::__ANON__[:3623]Graph::__ANON__[:3623]
0000s0sGraph::::__ANON__[:3785]Graph::__ANON__[:3785]
0000s0sGraph::::__SPT_Bellman_FordGraph::__SPT_Bellman_Ford
0000s0sGraph::::__carp_confessGraph::__carp_confess
0000s0sGraph::::__factorialGraph::__factorial
0000s0sGraph::::__fisher_yates_shuffleGraph::__fisher_yates_shuffle
0000s0sGraph::::__stringifiedGraph::__stringified
0000s0sGraph::::_all_predecessorsGraph::_all_predecessors
0000s0sGraph::::_all_successorsGraph::_all_successors
0000s0sGraph::::_attr02_012Graph::_attr02_012
0000s0sGraph::::_attr02_123Graph::_attr02_123
0000s0sGraph::::_attr02_234Graph::_attr02_234
0000s0sGraph::::_biconnectivity_computeGraph::_biconnectivity_compute
0000s0sGraph::::_biconnectivity_dfsGraph::_biconnectivity_dfs
0000s0sGraph::::_biconnectivity_outGraph::_biconnectivity_out
0000s0sGraph::::_can_deep_copy_StorableGraph::_can_deep_copy_Storable
0000s0sGraph::::_clear_cacheGraph::_clear_cache
0000s0sGraph::::_deep_copy_DataDumperGraph::_deep_copy_DataDumper
0000s0sGraph::::_deep_copy_StorableGraph::_deep_copy_Storable
0000s0sGraph::::_defattrGraph::_defattr
0000s0sGraph::::_dumpGraph::_dump
0000s0sGraph::::_edges_atGraph::_edges_at
0000s0sGraph::::_edges_id_pathGraph::_edges_id_path
0000s0sGraph::::_edges_toGraph::_edges_to
0000s0sGraph::::_expectedGraph::_expected
0000s0sGraph::::_factorialGraph::_factorial
0000s0sGraph::::_get_edge_attributeGraph::_get_edge_attribute
0000s0sGraph::::_get_union_findGraph::_get_union_find
0000s0sGraph::::_in_degreeGraph::_in_degree
0000s0sGraph::::_minmax_pathGraph::_minmax_path
0000s0sGraph::::_next_alphabeticGraph::_next_alphabetic
0000s0sGraph::::_next_numericGraph::_next_numeric
0000s0sGraph::::_out_degreeGraph::_out_degree
0000s0sGraph::::_set_edge_attributeGraph::_set_edge_attribute
0000s0sGraph::::_strongly_connected_componentsGraph::_strongly_connected_components
0000s0sGraph::::_strongly_connected_components_computeGraph::_strongly_connected_components_compute
0000s0sGraph::::_total_degreeGraph::_total_degree
0000s0sGraph::::_transitive_closure_matrix_computeGraph::_transitive_closure_matrix_compute
0000s0sGraph::::_undirected_copy_computeGraph::_undirected_copy_compute
0000s0sGraph::::_union_find_add_edgeGraph::_union_find_add_edge
0000s0sGraph::::_union_find_add_vertexGraph::_union_find_add_vertex
0000s0sGraph::::add_cycleGraph::add_cycle
0000s0sGraph::::add_edge_by_idGraph::add_edge_by_id
0000s0sGraph::::add_edge_get_idGraph::add_edge_get_id
0000s0sGraph::::add_pathGraph::add_path
0000s0sGraph::::add_vertex_by_idGraph::add_vertex_by_id
0000s0sGraph::::add_vertex_get_idGraph::add_vertex_get_id
0000s0sGraph::::add_verticesGraph::add_vertices
0000s0sGraph::::add_weighted_edge_by_idGraph::add_weighted_edge_by_id
0000s0sGraph::::add_weighted_edgesGraph::add_weighted_edges
0000s0sGraph::::add_weighted_edges_by_idGraph::add_weighted_edges_by_id
0000s0sGraph::::add_weighted_pathGraph::add_weighted_path
0000s0sGraph::::add_weighted_path_by_idGraph::add_weighted_path_by_id
0000s0sGraph::::add_weighted_vertexGraph::add_weighted_vertex
0000s0sGraph::::add_weighted_vertex_by_idGraph::add_weighted_vertex_by_id
0000s0sGraph::::add_weighted_verticesGraph::add_weighted_vertices
0000s0sGraph::::add_weighted_vertices_by_idGraph::add_weighted_vertices_by_id
0000s0sGraph::::all_neighboursGraph::all_neighbours
0000s0sGraph::::all_predecessorsGraph::all_predecessors
0000s0sGraph::::all_reachableGraph::all_reachable
0000s0sGraph::::all_successorsGraph::all_successors
0000s0sGraph::::articulation_pointsGraph::articulation_points
0000s0sGraph::::average_degreeGraph::average_degree
0000s0sGraph::::average_path_lengthGraph::average_path_length
0000s0sGraph::::betweennessGraph::betweenness
0000s0sGraph::::biconnected_component_by_indexGraph::biconnected_component_by_index
0000s0sGraph::::biconnected_component_by_vertexGraph::biconnected_component_by_vertex
0000s0sGraph::::biconnected_componentsGraph::biconnected_components
0000s0sGraph::::biconnected_graphGraph::biconnected_graph
0000s0sGraph::::biconnectivityGraph::biconnectivity
0000s0sGraph::::biconnectivity_clear_cacheGraph::biconnectivity_clear_cache
0000s0sGraph::::bridgesGraph::bridges
0000s0sGraph::::center_verticesGraph::center_vertices
0000s0sGraph::::clustering_coefficientGraph::clustering_coefficient
0000s0sGraph::::complement_graphGraph::complement_graph
0000s0sGraph::::complete_graphGraph::complete_graph
0000s0sGraph::::connected_component_by_indexGraph::connected_component_by_index
0000s0sGraph::::connected_component_by_vertexGraph::connected_component_by_vertex
0000s0sGraph::::connected_graphGraph::connected_graph
0000s0sGraph::::connectivity_clear_cacheGraph::connectivity_clear_cache
0000s0sGraph::::copyGraph::copy
0000s0sGraph::::could_be_isomorphicGraph::could_be_isomorphic
0000s0sGraph::::deep_copyGraph::deep_copy
0000s0sGraph::::degreeGraph::degree
0000s0sGraph::::delete_attributeGraph::delete_attribute
0000s0sGraph::::delete_attributesGraph::delete_attributes
0000s0sGraph::::delete_cycleGraph::delete_cycle
0000s0sGraph::::delete_edgeGraph::delete_edge
0000s0sGraph::::delete_edge_attributeGraph::delete_edge_attribute
0000s0sGraph::::delete_edge_attribute_by_idGraph::delete_edge_attribute_by_id
0000s0sGraph::::delete_edge_attributesGraph::delete_edge_attributes
0000s0sGraph::::delete_edge_attributes_by_idGraph::delete_edge_attributes_by_id
0000s0sGraph::::delete_edge_by_idGraph::delete_edge_by_id
0000s0sGraph::::delete_edge_weightGraph::delete_edge_weight
0000s0sGraph::::delete_edge_weight_by_idGraph::delete_edge_weight_by_id
0000s0sGraph::::delete_edgesGraph::delete_edges
0000s0sGraph::::delete_pathGraph::delete_path
0000s0sGraph::::delete_vertexGraph::delete_vertex
0000s0sGraph::::delete_vertex_attributeGraph::delete_vertex_attribute
0000s0sGraph::::delete_vertex_attribute_by_idGraph::delete_vertex_attribute_by_id
0000s0sGraph::::delete_vertex_attributesGraph::delete_vertex_attributes
0000s0sGraph::::delete_vertex_attributes_by_idGraph::delete_vertex_attributes_by_id
0000s0sGraph::::delete_vertex_by_idGraph::delete_vertex_by_id
0000s0sGraph::::delete_vertex_weightGraph::delete_vertex_weight
0000s0sGraph::::delete_vertex_weight_by_idGraph::delete_vertex_weight_by_id
0000s0sGraph::::delete_verticesGraph::delete_vertices
0000s0sGraph::::densityGraph::density
0000s0sGraph::::density_limitsGraph::density_limits
0000s0sGraph::::diameterGraph::diameter
0000s0sGraph::::directed_copyGraph::directed_copy
0000s0sGraph::::edges02Graph::edges02
0000s0sGraph::::edges_atGraph::edges_at
0000s0sGraph::::edges_fromGraph::edges_from
0000s0sGraph::::edges_toGraph::edges_to
0000s0sGraph::::eqGraph::eq
0000s0sGraph::::expect_acyclicGraph::expect_acyclic
0000s0sGraph::::expect_dagGraph::expect_dag
0000s0sGraph::::expect_directedGraph::expect_directed
0000s0sGraph::::expect_multiedgedGraph::expect_multiedged
0000s0sGraph::::expect_multivertexedGraph::expect_multivertexed
0000s0sGraph::::expect_non_multivertexedGraph::expect_non_multivertexed
0000s0sGraph::::expect_non_unionfindGraph::expect_non_unionfind
0000s0sGraph::::exterior_verticesGraph::exterior_vertices
0000s0sGraph::::find_a_cycleGraph::find_a_cycle
0000s0sGraph::::for_shortest_pathsGraph::for_shortest_paths
0000s0sGraph::::get_attributeGraph::get_attribute
0000s0sGraph::::get_attributesGraph::get_attributes
0000s0sGraph::::get_edge_attribute_by_idGraph::get_edge_attribute_by_id
0000s0sGraph::::get_edge_attribute_namesGraph::get_edge_attribute_names
0000s0sGraph::::get_edge_attribute_names_by_idGraph::get_edge_attribute_names_by_id
0000s0sGraph::::get_edge_attribute_valuesGraph::get_edge_attribute_values
0000s0sGraph::::get_edge_attribute_values_by_idGraph::get_edge_attribute_values_by_id
0000s0sGraph::::get_edge_attributesGraph::get_edge_attributes
0000s0sGraph::::get_edge_attributes_by_idGraph::get_edge_attributes_by_id
0000s0sGraph::::get_edge_countGraph::get_edge_count
0000s0sGraph::::get_edge_weightGraph::get_edge_weight
0000s0sGraph::::get_edge_weight_by_idGraph::get_edge_weight_by_id
0000s0sGraph::::get_multiedge_idsGraph::get_multiedge_ids
0000s0sGraph::::get_multivertex_idsGraph::get_multivertex_ids
0000s0sGraph::::get_vertex_attributeGraph::get_vertex_attribute
0000s0sGraph::::get_vertex_attribute_by_idGraph::get_vertex_attribute_by_id
0000s0sGraph::::get_vertex_attribute_namesGraph::get_vertex_attribute_names
0000s0sGraph::::get_vertex_attribute_names_by_idGraph::get_vertex_attribute_names_by_id
0000s0sGraph::::get_vertex_attribute_valuesGraph::get_vertex_attribute_values
0000s0sGraph::::get_vertex_attribute_values_by_idGraph::get_vertex_attribute_values_by_id
0000s0sGraph::::get_vertex_attributesGraph::get_vertex_attributes
0000s0sGraph::::get_vertex_attributes_by_idGraph::get_vertex_attributes_by_id
0000s0sGraph::::get_vertex_countGraph::get_vertex_count
0000s0sGraph::::get_vertex_weightGraph::get_vertex_weight
0000s0sGraph::::get_vertex_weight_by_idGraph::get_vertex_weight_by_id
0000s0sGraph::::has_a_cycleGraph::has_a_cycle
0000s0sGraph::::has_attributeGraph::has_attribute
0000s0sGraph::::has_attributesGraph::has_attributes
0000s0sGraph::::has_cycleGraph::has_cycle
0000s0sGraph::::has_edge_attributeGraph::has_edge_attribute
0000s0sGraph::::has_edge_attribute_by_idGraph::has_edge_attribute_by_id
0000s0sGraph::::has_edge_attributesGraph::has_edge_attributes
0000s0sGraph::::has_edge_attributes_by_idGraph::has_edge_attributes_by_id
0000s0sGraph::::has_edge_by_idGraph::has_edge_by_id
0000s0sGraph::::has_edge_weightGraph::has_edge_weight
0000s0sGraph::::has_edge_weight_by_idGraph::has_edge_weight_by_id
0000s0sGraph::::has_edgesGraph::has_edges
0000s0sGraph::::has_pathGraph::has_path
0000s0sGraph::::has_vertex_attributeGraph::has_vertex_attribute
0000s0sGraph::::has_vertex_attribute_by_idGraph::has_vertex_attribute_by_id
0000s0sGraph::::has_vertex_attributesGraph::has_vertex_attributes
0000s0sGraph::::has_vertex_attributes_by_idGraph::has_vertex_attributes_by_id
0000s0sGraph::::has_vertex_by_idGraph::has_vertex_by_id
0000s0sGraph::::has_vertex_weightGraph::has_vertex_weight
0000s0sGraph::::has_vertex_weight_by_idGraph::has_vertex_weight_by_id
0000s0sGraph::::has_verticesGraph::has_vertices
0000s0sGraph::::hyperedgedGraph::hyperedged
0000s0sGraph::::hypervertexedGraph::hypervertexed
0000s0sGraph::::in_degreeGraph::in_degree
0000s0sGraph::::in_edgesGraph::in_edges
0000s0sGraph::::interior_verticesGraph::interior_vertices
0000s0sGraph::::is_acyclicGraph::is_acyclic
0000s0sGraph::::is_biconnectedGraph::is_biconnected
0000s0sGraph::::is_connectedGraph::is_connected
0000s0sGraph::::is_dagGraph::is_dag
0000s0sGraph::::is_edge_connectedGraph::is_edge_connected
0000s0sGraph::::is_edge_separableGraph::is_edge_separable
0000s0sGraph::::is_exterior_vertexGraph::is_exterior_vertex
0000s0sGraph::::is_interior_vertexGraph::is_interior_vertex
0000s0sGraph::::is_isolated_vertexGraph::is_isolated_vertex
0000s0sGraph::::is_multi_graphGraph::is_multi_graph
0000s0sGraph::::is_predecessorful_vertexGraph::is_predecessorful_vertex
0000s0sGraph::::is_predecessorless_vertexGraph::is_predecessorless_vertex
0000s0sGraph::::is_pseudo_graphGraph::is_pseudo_graph
0000s0sGraph::::is_reachableGraph::is_reachable
0000s0sGraph::::is_self_loop_vertexGraph::is_self_loop_vertex
0000s0sGraph::::is_simple_graphGraph::is_simple_graph
0000s0sGraph::::is_sink_vertexGraph::is_sink_vertex
0000s0sGraph::::is_source_vertexGraph::is_source_vertex
0000s0sGraph::::is_strongly_connectedGraph::is_strongly_connected
0000s0sGraph::::is_successorful_vertexGraph::is_successorful_vertex
0000s0sGraph::::is_successorless_vertexGraph::is_successorless_vertex
0000s0sGraph::::is_transitiveGraph::is_transitive
0000s0sGraph::::is_weakly_connectedGraph::is_weakly_connected
0000s0sGraph::::isolated_verticesGraph::isolated_vertices
0000s0sGraph::::longest_pathGraph::longest_path
0000s0sGraph::::neGraph::ne
0000s0sGraph::::neighboursGraph::neighbours
0000s0sGraph::::omnivertexedGraph::omnivertexed
0000s0sGraph::::out_degreeGraph::out_degree
0000s0sGraph::::out_edgesGraph::out_edges
0000s0sGraph::::path_lengthGraph::path_length
0000s0sGraph::::path_predecessorGraph::path_predecessor
0000s0sGraph::::path_verticesGraph::path_vertices
0000s0sGraph::::predecessorful_verticesGraph::predecessorful_vertices
0000s0sGraph::::predecessorless_verticesGraph::predecessorless_vertices
0000s0sGraph::::predecessorsGraph::predecessors
0000s0sGraph::::radiusGraph::radius
0000s0sGraph::::random_edgeGraph::random_edge
0000s0sGraph::::random_graphGraph::random_graph
0000s0sGraph::::random_predecessorGraph::random_predecessor
0000s0sGraph::::random_successorGraph::random_successor
0000s0sGraph::::random_vertexGraph::random_vertex
0000s0sGraph::::refvertexedGraph::refvertexed
0000s0sGraph::::refvertexed_stringifiedGraph::refvertexed_stringified
0000s0sGraph::::same_biconnected_componentsGraph::same_biconnected_components
0000s0sGraph::::same_connected_componentsGraph::same_connected_components
0000s0sGraph::::same_strongly_connected_componentsGraph::same_strongly_connected_components
0000s0sGraph::::same_weakly_connected_componentsGraph::same_weakly_connected_components
0000s0sGraph::::self_loop_verticesGraph::self_loop_vertices
0000s0sGraph::::set_attributeGraph::set_attribute
0000s0sGraph::::set_attributesGraph::set_attributes
0000s0sGraph::::set_edge_attribute_by_idGraph::set_edge_attribute_by_id
0000s0sGraph::::set_edge_attributesGraph::set_edge_attributes
0000s0sGraph::::set_edge_attributes_by_idGraph::set_edge_attributes_by_id
0000s0sGraph::::set_edge_weightGraph::set_edge_weight
0000s0sGraph::::set_edge_weight_by_idGraph::set_edge_weight_by_id
0000s0sGraph::::set_vertex_attributeGraph::set_vertex_attribute
0000s0sGraph::::set_vertex_attribute_by_idGraph::set_vertex_attribute_by_id
0000s0sGraph::::set_vertex_attributesGraph::set_vertex_attributes
0000s0sGraph::::set_vertex_attributes_by_idGraph::set_vertex_attributes_by_id
0000s0sGraph::::set_vertex_weightGraph::set_vertex_weight
0000s0sGraph::::set_vertex_weight_by_idGraph::set_vertex_weight_by_id
0000s0sGraph::::shortest_pathGraph::shortest_path
0000s0sGraph::::sink_verticesGraph::sink_vertices
0000s0sGraph::::source_verticesGraph::source_vertices
0000s0sGraph::::stringifyGraph::stringify
0000s0sGraph::::strong_connectivity_clear_cacheGraph::strong_connectivity_clear_cache
0000s0sGraph::::strongly_connected_component_by_indexGraph::strongly_connected_component_by_index
0000s0sGraph::::strongly_connected_component_by_vertexGraph::strongly_connected_component_by_vertex
0000s0sGraph::::strongly_connected_componentsGraph::strongly_connected_components
0000s0sGraph::::strongly_connected_graphGraph::strongly_connected_graph
0000s0sGraph::::subgraph_by_radiusGraph::subgraph_by_radius
0000s0sGraph::::successorful_verticesGraph::successorful_vertices
0000s0sGraph::::successorless_verticesGraph::successorless_vertices
0000s0sGraph::::topological_sortGraph::topological_sort
0000s0sGraph::::transitive_closure_matrixGraph::transitive_closure_matrix
0000s0sGraph::::transpose_edgeGraph::transpose_edge
0000s0sGraph::::transpose_graphGraph::transpose_graph
0000s0sGraph::::undirected_copyGraph::undirected_copy
0000s0sGraph::::undirected_copy_clear_cacheGraph::undirected_copy_clear_cache
0000s0sGraph::::uniqedgedGraph::uniqedged
0000s0sGraph::::unique_edgesGraph::unique_edges
0000s0sGraph::::uniqvertexedGraph::uniqvertexed
0000s0sGraph::::vertexGraph::vertex
0000s0sGraph::::vertex_eccentricityGraph::vertex_eccentricity
0000s0sGraph::::vertices_atGraph::vertices_at
0000s0sGraph::::weakly_connected_component_by_indexGraph::weakly_connected_component_by_index
0000s0sGraph::::weakly_connected_component_by_vertexGraph::weakly_connected_component_by_vertex
0000s0sGraph::::weakly_connected_componentsGraph::weakly_connected_components
0000s0sGraph::::weakly_connected_graphGraph::weakly_connected_graph
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Graph;
2
32109µs261µs
# spent 40µs (18+21) within Graph::BEGIN@3 which was called: # once (18µs+21µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 3
use strict;
# spent 40µs making 1 call to Graph::BEGIN@3 # spent 21µs making 1 call to strict::import
4
5
# spent 3µs within Graph::BEGIN@5 which was called: # once (3µs+0s) by Bio::Roary::OrderGenes::BEGIN@22 at line 11
BEGIN {
614µs if (0) { # SET THIS TO ZERO FOR TESTING AND RELEASES!
7 $SIG{__DIE__ } = \&__carp_confess;
8 $SIG{__WARN__} = \&__carp_confess;
9 }
10 sub __carp_confess { require Carp; Carp::confess(@_) }
11118µs13µs}
# spent 3µs making 1 call to Graph::BEGIN@5
12
132115µs23.57ms
# spent 3.27ms (2.89+384µs) within Graph::BEGIN@13 which was called: # once (2.89ms+384µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 13
use Graph::AdjacencyMap qw(:flags :fields);
# spent 3.27ms making 1 call to Graph::BEGIN@13 # spent 301µs making 1 call to Exporter::import
14
15264µs248µs
# spent 29µs (10+19) within Graph::BEGIN@15 which was called: # once (10µs+19µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 15
use vars qw($VERSION);
# spent 29µs making 1 call to Graph::BEGIN@15 # spent 19µs making 1 call to vars::import
16
1712µs$VERSION = '0.96';
18
19162µsrequire 5.006; # Weak references are absolutely required.
20
21160µsmy $can_deep_copy_Storable =
# spent 326µs executing statements in string eval
22 eval 'require Storable; require B::Deparse; $Storable::VERSION >= 2.05 && $B::Deparse::VERSION >= 0.61' && !$@;
23
24sub _can_deep_copy_Storable () {
25 return $can_deep_copy_Storable;
26}
27
282132µs21.98ms
# spent 1.96ms (1.61+352µs) within Graph::BEGIN@28 which was called: # once (1.61ms+352µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 28
use Graph::AdjacencyMap::Heavy;
# spent 1.96ms making 1 call to Graph::BEGIN@28 # spent 20µs making 1 call to Exporter::import
292128µs23.19ms
# spent 3.17ms (1.32+1.85) within Graph::BEGIN@29 which was called: # once (1.32ms+1.85ms) by Bio::Roary::OrderGenes::BEGIN@22 at line 29
use Graph::AdjacencyMap::Light;
# spent 3.17ms making 1 call to Graph::BEGIN@29 # spent 19µs making 1 call to Exporter::import
30229µs245µs
# spent 29µs (13+16) within Graph::BEGIN@30 which was called: # once (13µs+16µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 30
use Graph::AdjacencyMap::Vertex;
# spent 29µs making 1 call to Graph::BEGIN@30 # spent 16µs making 1 call to Exporter::import
312109µs1590µs
# spent 590µs (565+25) within Graph::BEGIN@31 which was called: # once (565µs+25µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 31
use Graph::UnionFind;
# spent 590µs making 1 call to Graph::BEGIN@31
322129µs14.77ms
# spent 4.77ms (487µs+4.29) within Graph::BEGIN@32 which was called: # once (487µs+4.29ms) by Bio::Roary::OrderGenes::BEGIN@22 at line 32
use Graph::TransitiveClosure;
# spent 4.77ms making 1 call to Graph::BEGIN@32
332184µs14.14ms
# spent 4.14ms (346µs+3.80) within Graph::BEGIN@33 which was called: # once (346µs+3.80ms) by Bio::Roary::OrderGenes::BEGIN@22 at line 33
use Graph::Traversal::DFS;
# spent 4.14ms making 1 call to Graph::BEGIN@33
342200µs21.37ms
# spent 1.34ms (442µs+895µs) within Graph::BEGIN@34 which was called: # once (442µs+895µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 34
use Graph::MSTHeapElem;
# spent 1.34ms making 1 call to Graph::BEGIN@34 # spent 30µs making 1 call to Exporter::import
352172µs2839µs
# spent 809µs (472+337) within Graph::BEGIN@35 which was called: # once (472µs+337µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 35
use Graph::SPTHeapElem;
# spent 809µs making 1 call to Graph::BEGIN@35 # spent 31µs making 1 call to Exporter::import
362169µs1485µs
# spent 485µs (312+173) within Graph::BEGIN@36 which was called: # once (312µs+173µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 36
use Graph::Undirected;
# spent 485µs making 1 call to Graph::BEGIN@36
37
382178µs23.02ms
# spent 2.98ms (2.79+187µs) within Graph::BEGIN@38 which was called: # once (2.79ms+187µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 38
use Heap071::Fibonacci;
# spent 2.98ms making 1 call to Graph::BEGIN@38 # spent 36µs making 1 call to Exporter::import
39250µs2112µs
# spent 98µs (25+73) within Graph::BEGIN@39 which was called: # once (25µs+73µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 39
use List::Util qw(shuffle first);
# spent 98µs making 1 call to Graph::BEGIN@39 # spent 14µs making 1 call to List::Util::import
40243µs2108µs
# spent 62µs (16+46) within Graph::BEGIN@40 which was called: # once (16µs+46µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 40
use Scalar::Util qw(weaken);
# spent 62µs making 1 call to Graph::BEGIN@40 # spent 46µs making 1 call to Exporter::import
41
422371µs115.2ms
# spent 15.2ms (3.12+12.0) within Graph::BEGIN@42 which was called: # once (3.12ms+12.0ms) by Bio::Roary::OrderGenes::BEGIN@22 at line 42
use Safe; # For deep_copy().
# spent 15.2ms making 1 call to Graph::BEGIN@42
43
44sub _F () { 0 } # Flags.
45sub _G () { 1 } # Generation.
46sub _V () { 2 } # Vertices.
47sub _E () { 3 } # Edges.
48sub _A () { 4 } # Attributes.
49sub _U () { 5 } # Union-Find.
50sub _S () { 6 } # Successors.
51sub _P () { 7 } # Predecessors.
52
531500nsmy $Inf;
54
55
# spent 26µs within Graph::BEGIN@55 which was called: # once (26µs+0s) by Bio::Roary::OrderGenes::BEGIN@22 at line 61
BEGIN {
56115µs local $SIG{FPE};
571800ns eval { $Inf = exp(999) } ||
58 eval { $Inf = 9**9**9 } ||
5918µs eval { $Inf = 1e+999 } ||
60 { $Inf = 1e+99 }; # Close enough for most practical purposes.
61155µs126µs}
# spent 26µs making 1 call to Graph::BEGIN@55
62
63sub Infinity () { $Inf }
64
65# Graphs are blessed array references.
66# - The first element contains the flags.
67# - The second element is the vertices.
68# - The third element is the edges.
69# - The fourth element is the attributes of the whole graph.
70# The defined flags for Graph are:
71# - _COMPAT02 for user API compatibility with the Graph 0.20xxx series.
72# The vertices are contained in either a "simplemap"
73# (if no hypervertices) or in a "map".
74# The edges are always in a "map".
75# The defined flags for maps are:
76# - _COUNT for countedness: more than one instance
77# - _HYPER for hyperness: a different number of "coordinates" than usual;
78# expects one for vertices and two for edges
79# - _UNORD for unordered coordinates (a set): if _UNORD is not set
80# the coordinates are assumed to be meaningfully ordered
81# - _UNIQ for unique coordinates: if set duplicates are removed,
82# if not, duplicates are assumed to meaningful
83# - _UNORDUNIQ: just a union of _UNORD and UNIQ
84# Vertices are assumed to be _UNORDUNIQ; edges assume none of these flags.
85
862328µs21.27ms
# spent 1.16ms (949µs+207µs) within Graph::BEGIN@86 which was called: # once (949µs+207µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 86
use Graph::Attribute array => _A, map => 'graph';
# spent 1.16ms making 1 call to Graph::BEGIN@86 # spent 115µs making 1 call to Graph::Attribute::import
87
88sub _COMPAT02 () { 0x00000001 }
89
90sub stringify {
91 my $g = shift;
92 my $u = $g->is_undirected;
93 my $e = $u ? '=' : '-';
94 my @e =
95 map {
96 my @v =
97 map {
98 ref($_) eq 'ARRAY' ? "[" . join(" ", @$_) . "]" : "$_"
99 }
100 @$_;
101 join($e, $u ? sort { "$a" cmp "$b" } @v : @v) } $g->edges05;
102 my @s = sort { "$a" cmp "$b" } @e;
103 push @s, sort { "$a" cmp "$b" } $g->isolated_vertices;
104 join(",", @s);
105}
106
107sub eq {
108 "$_[0]" eq "$_[1]"
109}
110
111sub ne {
112 "$_[0]" ne "$_[1]"
113}
114
115use overload
1161800ns
# spent 58µs (12+46) within Graph::BEGIN@116 which was called: # once (12µs+46µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 118
'""' => \&stringify,
117 'eq' => \&eq,
1181394µs2103µs 'ne' => \≠
# spent 58µs making 1 call to Graph::BEGIN@116 # spent 46µs making 1 call to overload::import
119
120
# spent 4.98ms within Graph::_opt which was called 336 times, avg 15µs/call: # 112 times (2.63ms+0s) by Graph::new at line 205, avg 23µs/call # 112 times (1.62ms+0s) by Graph::new at line 216, avg 15µs/call # 112 times (730µs+0s) by Graph::new at line 224, avg 7µs/call
sub _opt {
121336864µs my ($opt, $flags, %flags) = @_;
1223362.57ms while (my ($flag, $FLAG) = each %flags) {
1231680265µs if (exists $opt->{$flag}) {
12411270µs $$flags |= $FLAG if $opt->{$flag};
12511261µs delete $opt->{$flag};
126 }
1271680680µs if (exists $opt->{my $non = "non$flag"}) {
128 $$flags &= ~$FLAG if $opt->{$non};
129 delete $opt->{$non};
130 }
131 }
132}
133
134
# spent 24.3ms within Graph::is_compat02 which was called 15177 times, avg 2µs/call: # 15003 times (23.9ms+0s) by Graph::add_weighted_edge at line 1932, avg 2µs/call # 134 times (222µs+0s) by Graph::edges at line 593, avg 2µs/call # 38 times (136µs+0s) by Graph::vertices at line 423, avg 4µs/call # 2 times (15µs+0s) by Graph::unique_vertices at line 451, avg 7µs/call
sub is_compat02 {
135151775.46ms my ($g) = @_;
1361517727.9ms $g->[ _F ] & _COMPAT02;
137}
138
13917µs*compat02 = \&is_compat02;
140
141
# spent 87.9ms within Graph::has_union_find which was called 54871 times, avg 2µs/call: # 29935 times (48.5ms+0s) by Graph::add_edge at line 506, avg 2µs/call # 24934 times (39.4ms+0s) by Graph::add_vertex at line 398, avg 2µs/call # 2 times (7µs+0s) by Graph::_connected_components_compute at line 2715, avg 3µs/call
sub has_union_find {
1425487118.3ms my ($g) = @_;
1435487196.7ms ($g->[ _F ] & _UNIONFIND) && defined $g->[ _U ];
144}
145
146sub _get_union_find {
147 my ($g) = @_;
148 $g->[ _U ];
149}
150
151
# spent 743µs within Graph::_opt_get which was called 224 times, avg 3µs/call: # 112 times (548µs+0s) by Graph::new at line 190, avg 5µs/call # 112 times (195µs+0s) by Graph::new at line 191, avg 2µs/call
sub _opt_get {
152224162µs my ($opt, $key, $var) = @_;
153224601µs if (exists $opt->{$key}) {
1547448µs $$var = $opt->{$key};
1557478µs delete $opt->{$key};
156 }
157}
158
159
# spent 348µs within Graph::_opt_unknown which was called 112 times, avg 3µs/call: # 112 times (348µs+0s) by Graph::new at line 256, avg 3µs/call
sub _opt_unknown {
16011254µs my ($opt) = @_;
161112356µs if (my @opt = keys %$opt) {
162 my $f = (caller(1))[3];
163 require Carp;
164 Carp::confess(sprintf
165 "$f: Unknown option%s: @{[map { qq['$_'] } sort @opt]}",
166 @opt > 1 ? 's' : '');
167 }
168}
169
170
# spent 16.6ms (6.23+10.4) within Graph::new which was called 112 times, avg 148µs/call: # 38 times (2.03ms+3.30ms) by Graph::Traversal::reset at line 19 of Graph/Traversal.pm, avg 140µs/call # 36 times (2.05ms+3.42ms) by Bio::Roary::OrderGenes::_reorder_connected_components at line 151 of lib/Bio/Roary/OrderGenes.pm, avg 152µs/call # 36 times (1.91ms+3.37ms) by Graph::Undirected::new at line 46 of Graph/Undirected.pm, avg 147µs/call # once (189µs+195µs) by Bio::Roary::OrderGenes::_build_group_graphs at line 120 of lib/Bio/Roary/OrderGenes.pm # once (53µs+92µs) by Bio::Roary::OrderGenes::_create_accessory_graph at line 288 of lib/Bio/Roary/OrderGenes.pm
sub new {
17111288µs my $class = shift;
17211234µs my $gflags = 0;
17311212µs my $vflags;
17411213µs my $eflags;
175112462µs1121.58ms my %opt = _get_options( \@_ );
# spent 1.58ms making 112 calls to Graph::_get_options, avg 14µs/call
176
17711223µs if (ref $class && $class->isa('Graph')) {
17827.47ms234µs
# spent 23µs (11+12) within Graph::BEGIN@178 which was called: # once (11µs+12µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 178
no strict 'refs';
# spent 23µs making 1 call to Graph::BEGIN@178 # spent 12µs making 1 call to strict::unimport
179 for my $c (qw(undirected refvertexed compat02
180 hypervertexed countvertexed multivertexed
181 hyperedged countedged multiedged omniedged
182 __stringified)) {
183# $opt{$c}++ if $class->$c; # 5.00504-incompatible
184 if (&{"Graph::$c"}($class)) { $opt{$c}++ }
185 }
186# $opt{unionfind}++ if $class->has_union_find; # 5.00504-incompatible
187 if (&{"Graph::has_union_find"}($class)) { $opt{unionfind}++ }
188 }
189
190112328µs112548µs _opt_get(\%opt, undirected => \$opt{omniedged});
# spent 548µs making 112 calls to Graph::_opt_get, avg 5µs/call
191112203µs112195µs _opt_get(\%opt, omnidirected => \$opt{omniedged});
# spent 195µs making 112 calls to Graph::_opt_get, avg 2µs/call
192
19311261µs if (exists $opt{directed}) {
1943836µs $opt{omniedged} = !$opt{directed};
1953836µs delete $opt{directed};
196 }
197
198112118µs my $vnonomni =
199 $opt{nonomnivertexed} ||
200 (exists $opt{omnivertexed} && !$opt{omnivertexed});
20111275µs my $vnonuniq =
202 $opt{nonuniqvertexed} ||
203 (exists $opt{uniqvertexed} && !$opt{uniqvertexed});
204
205112287µs1122.63ms _opt(\%opt, \$vflags,
# spent 2.63ms making 112 calls to Graph::_opt, avg 23µs/call
206 countvertexed => _COUNT,
207 multivertexed => _MULTI,
208 hypervertexed => _HYPER,
209 omnivertexed => _UNORD,
210 uniqvertexed => _UNIQ,
211 refvertexed => _REF,
212 refvertexed_stringified => _REFSTR ,
213 __stringified => _STR,
214 );
215
216112197µs1121.62ms _opt(\%opt, \$eflags,
# spent 1.62ms making 112 calls to Graph::_opt, avg 15µs/call
217 countedged => _COUNT,
218 multiedged => _MULTI,
219 hyperedged => _HYPER,
220 omniedged => _UNORD,
221 uniqedged => _UNIQ,
222 );
223
224112197µs112730µs _opt(\%opt, \$gflags,
# spent 730µs making 112 calls to Graph::_opt, avg 7µs/call
225 compat02 => _COMPAT02,
226 unionfind => _UNIONFIND,
227 );
228
22911247µs if (exists $opt{vertices_unsorted}) { # Graph 0.20103 compat.
230 my $unsorted = $opt{vertices_unsorted};
231 delete $opt{vertices_unsorted};
232 require Carp;
233 Carp::confess("Graph: vertices_unsorted must be true")
234 unless $unsorted;
235 }
236
23711222µs my @V;
23811245µs if ($opt{vertices}) {
239 require Carp;
240 Carp::confess("Graph: vertices should be an array ref")
241 unless ref $opt{vertices} eq 'ARRAY';
242 @V = @{ $opt{vertices} };
243 delete $opt{vertices};
244 }
245
24611220µs my @E;
24711243µs if ($opt{edges}) {
248 unless (ref $opt{edges} eq 'ARRAY') {
249 require Carp;
250 Carp::confess("Graph: edges should be an array ref of array refs");
251 }
252 @E = @{ $opt{edges} };
253 delete $opt{edges};
254 }
255
256112212µs112348µs _opt_unknown(\%opt);
# spent 348µs making 112 calls to Graph::_opt_unknown, avg 3µs/call
257
25811219µs my $uflags;
25911264µs if (defined $vflags) {
260 $uflags = $vflags;
261 $uflags |= _UNORD unless $vnonomni;
262 $uflags |= _UNIQ unless $vnonuniq;
263 } else {
26411240µs $uflags = _UNORDUNIQ;
26511225µs $vflags = 0;
266 }
267
26811258µs if (!($vflags & _HYPER) && ($vflags & _UNORDUNIQ)) {
269 my @but;
270 push @but, 'unordered' if ($vflags & _UNORD);
271 push @but, 'unique' if ($vflags & _UNIQ);
272 require Carp;
273 Carp::confess(sprintf "Graph: not hypervertexed but %s",
274 join(' and ', @but));
275 }
276
27711228µs unless (defined $eflags) {
278 $eflags = ($gflags & _COMPAT02) ? _COUNT : 0;
279 }
280
28111247µs if (!($vflags & _HYPER) && ($vflags & _UNIQ)) {
282 require Carp;
283 Carp::confess("Graph: not hypervertexed but uniqvertexed");
284 }
285
28611228µs if (($vflags & _COUNT) && ($vflags & _MULTI)) {
287 require Carp;
288 Carp::confess("Graph: both countvertexed and multivertexed");
289 }
290
29111223µs if (($eflags & _COUNT) && ($eflags & _MULTI)) {
292 require Carp;
293 Carp::confess("Graph: both countedged and multiedged");
294 }
295
296112245µs my $g = bless [ ], ref $class || $class;
297
298112129µs $g->[ _F ] = $gflags;
29911250µs $g->[ _G ] = 0;
300112611µs1121.71ms $g->[ _V ] = ($vflags & (_HYPER | _MULTI)) ?
# spent 1.71ms making 112 calls to Graph::AdjacencyMap::Light::_new, avg 15µs/call
301 Graph::AdjacencyMap::Heavy->_new($uflags, 1) :
302 (($vflags & ~_UNORD) ?
303 Graph::AdjacencyMap::Vertex->_new($uflags, 1) :
304 Graph::AdjacencyMap::Light->_new($g, $uflags, 1));
305112384µs1121.00ms $g->[ _E ] = (($vflags & _HYPER) || ($eflags & ~_UNORD)) ?
# spent 1.00ms making 112 calls to Graph::AdjacencyMap::Light::_new, avg 9µs/call
306 Graph::AdjacencyMap::Heavy->_new($eflags, 2) :
307 Graph::AdjacencyMap::Light->_new($g, $eflags, 2);
308
30911247µs $g->add_vertices(@V) if @V;
310
31111232µs if (@E) {
312 for my $e (@E) {
313 unless (ref $e eq 'ARRAY') {
314 require Carp;
315 Carp::confess("Graph: edges should be array refs");
316 }
317 $g->add_edge(@$e);
318 }
319 }
320
32111242µs if (($gflags & _UNIONFIND)) {
322 $g->[ _U ] = Graph::UnionFind->new;
323 }
324
325112476µs return $g;
326}
327
32838187µs3819µs
# spent 177µs (158+19) within Graph::countvertexed which was called 38 times, avg 5µs/call: # 38 times (158µs+19µs) by Graph::vertices at line 426, avg 5µs/call
sub countvertexed { $_[0]->[ _V ]->_is_COUNT }
# spent 19µs making 38 calls to Graph::AdjacencyMap::Light::_is_COUNT, avg 508ns/call
3292497293.6ms2497211.2ms
# spent 79.1ms (67.9+11.2) within Graph::multivertexed which was called 24972 times, avg 3µs/call: # 24934 times (67.8ms+11.1ms) by Graph::add_vertex at line 372, avg 3µs/call # 38 times (133µs+22µs) by Graph::vertices at line 426, avg 4µs/call
sub multivertexed { $_[0]->[ _V ]->_is_MULTI }
# spent 11.2ms making 24972 calls to Graph::AdjacencyMap::Light::_is_MULTI, avg 447ns/call
330sub hypervertexed { $_[0]->[ _V ]->_is_HYPER }
331sub omnivertexed { $_[0]->[ _V ]->_is_UNORD }
332sub uniqvertexed { $_[0]->[ _V ]->_is_UNIQ }
333sub refvertexed { $_[0]->[ _V ]->_is_REF }
334sub refvertexed_stringified { $_[0]->[ _V ]->_is_REFSTR }
335sub __stringified { $_[0]->[ _V ]->_is_STR }
336
337172777µs172142µs
# spent 789µs (646+142) within Graph::countedged which was called 172 times, avg 5µs/call: # 134 times (490µs+73µs) by Graph::edges at line 596, avg 4µs/call # 38 times (156µs+70µs) by Graph::Traversal::configure at line 77 of Graph/Traversal.pm, avg 6µs/call
sub countedged { $_[0]->[ _E ]->_is_COUNT }
# spent 77µs making 141 calls to Graph::AdjacencyMap::Light::_is_COUNT, avg 544ns/call # spent 66µs making 31 calls to Graph::AdjacencyMap::_is_COUNT, avg 2µs/call
33870075177ms7007557.8ms
# spent 251ms (193+57.8) within Graph::multiedged which was called 70075 times, avg 4µs/call: # 39968 times (113ms+37.4ms) by Graph::expect_non_multiedged at line 2115, avg 4µs/call # 29935 times (79.2ms+20.3ms) by Graph::add_edge at line 490, avg 3µs/call # 134 times (378µs+67µs) by Graph::edges at line 596, avg 3µs/call # 38 times (135µs+43µs) by Graph::Traversal::configure at line 77 of Graph/Traversal.pm, avg 5µs/call
sub multiedged { $_[0]->[ _E ]->_is_MULTI }
# spent 53.1ms making 59852 calls to Graph::AdjacencyMap::_is_MULTI, avg 887ns/call # spent 4.67ms making 10223 calls to Graph::AdjacencyMap::Light::_is_MULTI, avg 457ns/call
339sub hyperedged { $_[0]->[ _E ]->_is_HYPER }
3402491459.5ms2491427.1ms
# spent 102ms (74.9+27.1) within Graph::omniedged which was called 24914 times, avg 4µs/call: # 24876 times (74.7ms+27.0ms) by Graph::_edges at line 816, avg 4µs/call # 38 times (210µs+79µs) by Graph::expect_undirected at line 2082, avg 8µs/call
sub omniedged { $_[0]->[ _E ]->_is_UNORD }
# spent 27.1ms making 24914 calls to Graph::AdjacencyMap::_is_UNORD, avg 1µs/call
341sub uniqedged { $_[0]->[ _E ]->_is_UNIQ }
342
34312µs*undirected = \&omniedged;
34412µs*omnidirected = \&omniedged;
34538179µs3856µs
# spent 293µs (238+56) within Graph::directed which was called 38 times, avg 8µs/call: # 38 times (238µs+56µs) by Graph::Traversal::reset at line 19 of Graph/Traversal.pm, avg 8µs/call
sub directed { ! $_[0]->[ _E ]->_is_UNORD }
# spent 56µs making 38 calls to Graph::AdjacencyMap::_is_UNORD, avg 1µs/call
346
34711µs*is_directed = \&directed;
34812µs*is_undirected = \&undirected;
349
35012µs*is_countvertexed = \&countvertexed;
35111µs*is_multivertexed = \&multivertexed;
35211µs*is_hypervertexed = \&hypervertexed;
35312µs*is_omnidirected = \&omnidirected;
35412µs*is_uniqvertexed = \&uniqvertexed;
35512µs*is_refvertexed = \&refvertexed;
35611µs*is_refvertexed_stringified = \&refvertexed_stringified;
357
35812µs*is_countedged = \&countedged;
35912µs*is_multiedged = \&multiedged;
36012µs*is_hyperedged = \&hyperedged;
36111µs*is_omniedged = \&omniedged;
36211µs*is_uniqedged = \&uniqedged;
363
364sub _union_find_add_vertex {
365 my ($g, $v) = @_;
366 my $UF = $g->[ _U ];
367 $UF->add( $g->[ _V ]->_get_path_id( $v ) );
368}
369
370
# spent 491ms (241+250) within Graph::add_vertex which was called 24934 times, avg 20µs/call: # 24934 times (241ms+250ms) by Graph::_add_edge at line 469, avg 20µs/call
sub add_vertex {
371249343.55ms my $g = shift;
3722493421.4ms2493478.9ms if ($g->is_multivertexed) {
# spent 78.9ms making 24934 calls to Graph::multivertexed, avg 3µs/call
373 return $g->add_vertex_by_id(@_, _GEN_ID);
374 }
375249342.87ms my @r;
376249344.93ms if (@_ > 1) {
377 unless ($g->is_countvertexed || $g->is_hypervertexed) {
378 require Carp;
379 Carp::croak("Graph::add_vertex: use add_vertices for more than one vertex or use hypervertexed");
380 }
381 for my $v ( @_ ) {
382 if (defined $v) {
383 $g->[ _V ]->set_path( $v ) unless $g->has_vertex( $v );
384 } else {
385 require Carp;
386 Carp::croak("Graph::add_vertex: undef vertex");
387 }
388 }
389 }
390249349.51ms for my $v ( @_ ) {
3912493418.0ms unless (defined $v) {
392 require Carp;
393 Carp::croak("Graph::add_vertex: undef vertex");
394 }
395 }
3962493428.6ms24934132ms $g->[ _V ]->set_path( @_ );
# spent 132ms making 24934 calls to Graph::AdjacencyMap::Light::set_path, avg 5µs/call
397249346.77ms $g->[ _G ]++;
3982493426.7ms2493439.4ms $g->_union_find_add_vertex( @_ ) if $g->has_union_find;
# spent 39.4ms making 24934 calls to Graph::has_union_find, avg 2µs/call
3992493440.2ms return $g;
400}
401
402
# spent 9.00ms within Graph::has_vertex which was called 4871 times, avg 2µs/call: # 4871 times (9.00ms+0s) by Bio::Roary::OrderGenes::_remove_weak_edges_from_graph at line 325 of lib/Bio/Roary/OrderGenes.pm, avg 2µs/call
sub has_vertex {
4034871626µs my $g = shift;
40448711.04ms my $V = $g->[ _V ];
405487110.1ms return exists $V->[ _s ]->{ $_[0] } if ($V->[ _f ] & _LIGHT);
406 $V->has_path( @_ );
407}
408
409
# spent 34.7ms (18.5+16.3) within Graph::vertices05 which was called 76 times, avg 457µs/call: # 38 times (8.94ms+7.46ms) by Graph::vertices at line 422, avg 432µs/call # 36 times (3.83ms+3.60ms) by Graph::_root_opt at line 2329, avg 206µs/call # 2 times (5.69ms+5.19ms) by Graph::unique_vertices at line 450, avg 5.44ms/call
sub vertices05 {
4107629µs my $g = shift;
411762.59ms7616.2ms my @v = $g->[ _V ]->paths( @_ );
# spent 16.2ms making 76 calls to Graph::AdjacencyMap::Light::paths, avg 213µs/call
4127615.9ms7695µs if (wantarray) {
# spent 95µs making 76 calls to Graph::AdjacencyMap::Light::_is_HYPER, avg 1µs/call
413 return $g->[ _V ]->_is_HYPER ?
414 @v : map { ref $_ eq 'ARRAY' ? @$_ : $_ } @v;
415 } else {
416 return scalar @v;
417 }
418}
419
420
# spent 20.7ms (3.87+16.9) within Graph::vertices which was called 38 times, avg 546µs/call: # 38 times (3.87ms+16.9ms) by Graph::Traversal::reset at line 12 of Graph/Traversal.pm, avg 546µs/call
sub vertices {
4213816µs my $g = shift;
422381.81ms3816.4ms my @v = $g->vertices05;
# spent 16.4ms making 38 calls to Graph::vertices05, avg 432µs/call
42338117µs38136µs if ($g->is_compat02) {
# spent 136µs making 38 calls to Graph::is_compat02, avg 4µs/call
424 wantarray ? sort @v : scalar @v;
425 } else {
42638145µs76332µs if ($g->is_multivertexed || $g->is_countvertexed) {
# spent 177µs making 38 calls to Graph::countvertexed, avg 5µs/call # spent 155µs making 38 calls to Graph::multivertexed, avg 4µs/call
427 if (wantarray) {
428 my @V;
429 for my $v ( @v ) {
430 push @V, ($v) x $g->get_vertex_count($v);
431 }
432 return @V;
433 } else {
434 my $V = 0;
435 for my $v ( @v ) {
436 $V += $g->get_vertex_count($v);
437 }
438 return $V;
439 }
440 } else {
441381.67ms return @v;
442 }
443 }
444}
445
44619µs*vertices_unsorted = \&vertices_unsorted; # Graph 0.20103 compat.
447
448
# spent 12.1ms (1.21+10.9) within Graph::unique_vertices which was called 2 times, avg 6.05ms/call: # 2 times (1.21ms+10.9ms) by Graph::_connected_components_compute at line 2737, avg 6.05ms/call
sub unique_vertices {
44921µs my $g = shift;
4502732µs210.9ms my @v = $g->vertices05;
# spent 10.9ms making 2 calls to Graph::vertices05, avg 5.44ms/call
451213µs215µs if ($g->is_compat02) {
# spent 15µs making 2 calls to Graph::is_compat02, avg 7µs/call
452 wantarray ? sort @v : scalar @v;
453 } else {
4542446µs return @v;
455 }
456}
457
458sub has_vertices {
459 my $g = shift;
460 scalar $g->[ _V ]->has_paths( @_ );
461}
462
463
# spent 721ms (231+491) within Graph::_add_edge which was called 29935 times, avg 24µs/call: # 29935 times (231ms+491ms) by Graph::add_edge at line 503, avg 24µs/call
sub _add_edge {
464299356.62ms my $g = shift;
465299358.08ms my $V = $g->[ _V ];
466299352.70ms my @e;
4672993512.0ms if (($V->[ _f ]) & _LIGHT) {
4682993512.8ms for my $v ( @_ ) {
4695987042.5ms24934491ms $g->add_vertex( $v ) unless exists $V->[ _s ]->{ $v };
# spent 491ms making 24934 calls to Graph::add_vertex, avg 20µs/call
4705987054.0ms push @e, $V->[ _s ]->{ $v };
471 }
472 } else {
473 my $h = $g->[ _V ]->_is_HYPER;
474 for my $v ( @_ ) {
475 my @v = ref $v eq 'ARRAY' && $h ? @$v : $v;
476 $g->add_vertex( @v ) unless $V->has_path( @v );
477 push @e, $V->_get_path_id( @v );
478 }
479 }
4802993558.4ms return @e;
481}
482
483sub _union_find_add_edge {
484 my ($g, $u, $v) = @_;
485 $g->[ _U ]->union($u, $v);
486}
487
488
# spent 1.88s (312ms+1.57) within Graph::add_edge which was called 29935 times, avg 63µs/call: # 15003 times (153ms+818ms) by Graph::add_weighted_edge at line 1938, avg 65µs/call # 9910 times (105ms+419ms) by Graph::Traversal::next at line 301 of Graph/Traversal.pm, avg 53µs/call # 4955 times (53.4ms+324ms) by Graph::set_edge_attribute at line 1468, avg 76µs/call # 67 times (828µs+4.23ms) by Graph::add_edges at line 1678, avg 75µs/call
sub add_edge {
489299355.30ms my $g = shift;
4902993523.0ms2993599.4ms if ($g->is_multiedged) {
# spent 99.4ms making 29935 calls to Graph::multiedged, avg 3µs/call
491 unless (@_ == 2 || $g->is_hyperedged) {
492 require Carp;
493 Carp::croak("Graph::add_edge: use add_edges for more than one edge");
494 }
495 return $g->add_edge_by_id(@_, _GEN_ID);
496 }
497299355.01ms unless (@_ == 2) {
498 unless ($g->is_hyperedged) {
499 require Carp;
500 Carp::croak("Graph::add_edge: graph is not hyperedged");
501 }
502 }
5032993545.4ms29935721ms my @e = $g->_add_edge( @_ );
# spent 721ms making 29935 calls to Graph::_add_edge, avg 24µs/call
5042993537.4ms29935697ms $g->[ _E ]->set_path( @e );
# spent 592ms making 19958 calls to Graph::AdjacencyMap::Heavy::set_path, avg 30µs/call # spent 105ms making 9977 calls to Graph::AdjacencyMap::Light::set_path, avg 10µs/call
505299358.35ms $g->[ _G ]++;
5062993532.5ms2993548.5ms $g->_union_find_add_edge( @e ) if $g->has_union_find;
# spent 48.5ms making 29935 calls to Graph::has_union_find, avg 2µs/call
5072993557.9ms return $g;
508}
509
510
# spent 152ms within Graph::_vertex_ids which was called 24965 times, avg 6µs/call: # 19958 times (123ms+0s) by Graph::set_edge_attribute at line 1469, avg 6µs/call # 5007 times (29.0ms+0s) by Graph::get_edge_attribute at line 1568, avg 6µs/call
sub _vertex_ids {
511249655.48ms my $g = shift;
512249655.87ms my $V = $g->[ _V ];
513249651.26ms my @e;
5142496511.5ms if (($V->[ _f ] & _LIGHT)) {
5152496515.3ms for my $v ( @_ ) {
5164993010.5ms return () unless exists $V->[ _s ]->{ $v };
5174993039.4ms push @e, $V->[ _s ]->{ $v };
518 }
519 } else {
520 my $h = $g->[ _V ]->_is_HYPER;
521 for my $v ( @_ ) {
522 my @v = ref $v eq 'ARRAY' && $h ? @$v : $v;
523 return () unless $V->has_path( @v );
524 push @e, $V->_get_path_id( @v );
525 }
526 }
5272496550.4ms return @e;
528}
529
530
# spent 276ms (253+22.7) within Graph::has_edge which was called 34963 times, avg 8µs/call: # 19958 times (139ms+12.8ms) by Graph::set_edge_attribute at line 1468, avg 8µs/call # 9998 times (65.5ms+4.92ms) by Bio::Roary::OrderGenes::_reorder_connected_components at line 162 of lib/Bio/Roary/OrderGenes.pm, avg 7µs/call # 5007 times (48.5ms+4.99ms) by Graph::get_edge_attribute at line 1567, avg 11µs/call
sub has_edge {
531349635.66ms my $g = shift;
532349637.58ms my $E = $g->[ _E ];
533349634.91ms my $V = $g->[ _V ];
534349633.45ms my @i;
5353496313.6ms if (($V->[ _f ] & _LIGHT) && @_ == 2) {
5363496338.5ms return 0 unless
537 exists $V->[ _s ]->{ $_[0] } &&
538 exists $V->[ _s ]->{ $_[1] };
5392627730.5ms @i = @{ $V->[ _s ] }{ @_[ 0, 1 ] };
540 } else {
541 @i = $g->_vertex_ids( @_ );
542 return 0 if @i == 0 && @_;
543 }
544262774.82ms my $f = $E->[ _f ];
5452627711.8ms if ($E->[ _a ] == 2 && @i == 2 && !($f & (_HYPER|_REF|_UNIQ))) { # Fast path.
5462627763.4ms2627722.7ms @i = sort @i if ($f & _UNORD);
# spent 22.7ms making 26277 calls to Graph::CORE:sort, avg 865ns/call
5472627783.4ms return exists $E->[ _s ]->{ $i[0] } &&
548 exists $E->[ _s ]->{ $i[0] }->{ $i[1] } ? 1 : 0;
549 } else {
550 return defined $E->_get_path_id( @i ) ? 1 : 0;
551 }
552}
553
554
# spent 3.24ms (1.92+1.32) within Graph::edges05 which was called 134 times, avg 24µs/call: # 134 times (1.92ms+1.32ms) by Graph::edges at line 611, avg 24µs/call
sub edges05 {
55513442µs my $g = shift;
55613452µs my $V = $g->[ _V ];
557134285µs134709µs my @e = $g->[ _E ]->paths( @_ );
# spent 709µs making 134 calls to Graph::AdjacencyMap::Light::paths, avg 5µs/call
558 wantarray ?
559469936µs201607µs map { [ map { my @v = $V->_get_id_path($_);
# spent 607µs making 201 calls to Graph::AdjacencyMap::Light::_get_id_path, avg 3µs/call
560201160µs @v == 1 ? $v[0] : [ @v ] }
561 @$_ ] }
562 @e : @e;
563}
564
565sub edges02 {
566 my $g = shift;
567 if (@_ && defined $_[0]) {
568 unless (defined $_[1]) {
569 my @e = $g->edges_at($_[0]);
570 wantarray ?
571 map { @$_ }
572 sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @e
573 : @e;
574 } else {
575 die "edges02: unimplemented option";
576 }
577 } else {
578 my @e = map { ($_) x $g->get_edge_count(@$_) } $g->edges05( @_ );
579 wantarray ?
580 map { @$_ }
581 sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @e
582 : @e;
583 }
584}
585
586sub unique_edges {
587 my $g = shift;
588 ($g->is_compat02) ? $g->edges02( @_ ) : $g->edges05( @_ );
589}
590
591
# spent 5.98ms (1.51+4.47) within Graph::edges which was called 134 times, avg 45µs/call: # 67 times (939µs+2.36ms) by Graph::AdjacencyMap::Light::__attr at line 221 of Graph/AdjacencyMap/Light.pm, avg 49µs/call # 67 times (570µs+2.10ms) by Graph::AdjacencyMap::Light::__attr at line 225 of Graph/AdjacencyMap/Light.pm, avg 40µs/call
sub edges {
59213442µs my $g = shift;
593134162µs134222µs if ($g->is_compat02) {
# spent 222µs making 134 calls to Graph::is_compat02, avg 2µs/call
594 return $g->edges02( @_ );
595 } else {
596134359µs2681.01ms if ($g->is_multiedged || $g->is_countedged) {
# spent 563µs making 134 calls to Graph::countedged, avg 4µs/call # spent 445µs making 134 calls to Graph::multiedged, avg 3µs/call
597 if (wantarray) {
598 my @E;
599 for my $e ( $g->edges05 ) {
600 push @E, ($e) x $g->get_edge_count(@$e);
601 }
602 return @E;
603 } else {
604 my $E = 0;
605 for my $e ( $g->edges05 ) {
606 $E += $g->get_edge_count(@$e);
607 }
608 return $E;
609 }
610 } else {
611134482µs1343.24ms return $g->edges05;
# spent 3.24ms making 134 calls to Graph::edges05, avg 24µs/call
612 }
613 }
614}
615
616sub has_edges {
617 my $g = shift;
618 scalar $g->[ _E ]->has_paths( @_ );
619}
620
621###
622# by_id
623#
624
625sub add_vertex_by_id {
626 my $g = shift;
627 $g->expect_multivertexed;
628 $g->[ _V ]->set_path_by_multi_id( @_ );
629 $g->[ _G ]++;
630 $g->_union_find_add_vertex( @_ ) if $g->has_union_find;
631 return $g;
632}
633
634sub add_vertex_get_id {
635 my $g = shift;
636 $g->expect_multivertexed;
637 my $id = $g->[ _V ]->set_path_by_multi_id( @_, _GEN_ID );
638 $g->[ _G ]++;
639 $g->_union_find_add_vertex( @_ ) if $g->has_union_find;
640 return $id;
641}
642
643sub has_vertex_by_id {
644 my $g = shift;
645 $g->expect_multivertexed;
646 $g->[ _V ]->has_path_by_multi_id( @_ );
647}
648
649sub delete_vertex_by_id {
650 my $g = shift;
651 $g->expect_multivertexed;
652 $g->expect_non_unionfind;
653 my $V = $g->[ _V ];
654 return unless $V->has_path_by_multi_id( @_ );
655 # TODO: what to about the edges at this vertex?
656 # If the multiness of this vertex goes to zero, delete the edges?
657 $V->del_path_by_multi_id( @_ );
658 $g->[ _G ]++;
659 return $g;
660}
661
662sub get_multivertex_ids {
663 my $g = shift;
664 $g->expect_multivertexed;
665 $g->[ _V ]->get_multi_ids( @_ );
666}
667
668sub add_edge_by_id {
669 my $g = shift;
670 $g->expect_multiedged;
671 my $id = pop;
672 my @e = $g->_add_edge( @_ );
673 $g->[ _E ]->set_path_by_multi_id( @e, $id );
674 $g->[ _G ]++;
675 $g->_union_find_add_edge( @e ) if $g->has_union_find;
676 return $g;
677}
678
679sub add_edge_get_id {
680 my $g = shift;
681 $g->expect_multiedged;
682 my @i = $g->_add_edge( @_ );
683 my $id = $g->[ _E ]->set_path_by_multi_id( @i, _GEN_ID );
684 $g->_union_find_add_edge( @i ) if $g->has_union_find;
685 $g->[ _G ]++;
686 return $id;
687}
688
689sub has_edge_by_id {
690 my $g = shift;
691 $g->expect_multiedged;
692 my $id = pop;
693 my @i = $g->_vertex_ids( @_ );
694 return 0 if @i == 0 && @_;
695 $g->[ _E ]->has_path_by_multi_id( @i, $id );
696}
697
698sub delete_edge_by_id {
699 my $g = shift;
700 $g->expect_multiedged;
701 $g->expect_non_unionfind;
702 my $V = $g->[ _E ];
703 my $id = pop;
704 my @i = $g->_vertex_ids( @_ );
705 return unless $V->has_path_by_multi_id( @i, $id );
706 $V->del_path_by_multi_id( @i, $id );
707 $g->[ _G ]++;
708 return $g;
709}
710
711sub get_multiedge_ids {
712 my $g = shift;
713 $g->expect_multiedged;
714 my @id = $g->_vertex_ids( @_ );
715 return unless @id;
716 $g->[ _E ]->get_multi_ids( @id );
717}
718
719###
720# Neighbourhood.
721#
722
723sub vertices_at {
724 my $g = shift;
725 my $V = $g->[ _V ];
726 return @_ unless ($V->[ _f ] & _HYPER);
727 my %v;
728 my @i;
729 for my $v ( @_ ) {
730 my $i = $V->_get_path_id( $v );
731 return unless defined $i;
732 push @i, ( $v{ $v } = $i );
733 }
734 my $Vi = $V->_ids;
735 my @v;
736 while (my ($i, $v) = each %{ $Vi }) {
737 my %i;
738 my $h = $V->[_f ] & _HYPER;
739 @i{ @i } = @i if @i; # @todo: nonuniq hyper vertices?
740 for my $u (ref $v eq 'ARRAY' && $h ? @$v : $v) {
741 my $j = exists $v{ $u } ? $v{ $u } : ( $v{ $u } = $i );
742 if (defined $j && exists $i{ $j }) {
743 delete $i{ $j };
744 unless (keys %i) {
745 push @v, $v;
746 last;
747 }
748 }
749 }
750 }
751 return @v;
752}
753
754sub _edges_at {
755 my $g = shift;
756 my $V = $g->[ _V ];
757 my $E = $g->[ _E ];
758 my @e;
759 my $en = 0;
760 my %ev;
761 my $h = $V->[_f ] & _HYPER;
762 for my $v ( $h ? $g->vertices_at( @_ ) : @_ ) {
763 my $vi = $V->_get_path_id( ref $v eq 'ARRAY' && $h ? @$v : $v );
764 next unless defined $vi;
765 my $Ei = $E->_ids;
766 while (my ($ei, $ev) = each %{ $Ei }) {
767 if (wantarray) {
768 for my $j (@$ev) {
769 push @e, [ $ei, $ev ]
770 if $j == $vi && !$ev{$ei}++;
771 }
772 } else {
773 for my $j (@$ev) {
774 $en++ if $j == $vi;
775 }
776 }
777 }
778 }
779 return wantarray ? @e : $en;
780}
781
782
# spent 858ms (617+242) within Graph::_edges which was called 24876 times, avg 35µs/call: # 24876 times (617ms+242ms) by Graph::AdjacencyMap::_successors at line 829, avg 35µs/call
sub _edges {
783248765.85ms my $g = shift;
784248763.48ms my $n = pop;
785248765.65ms my $i = $n == _S ? 0 : -1; # _edges_from() or _edges_to()
786248765.87ms my $V = $g->[ _V ];
787248763.22ms my $E = $g->[ _E ];
788248763.77ms my $N = $g->[ $n ];
789248765.42ms my $h = $V->[ _f ] & _HYPER;
790248768.12ms unless (defined $N && $N->[ 0 ] == $g->[ _G ]) {
79167112µs $g->[ $n ]->[ 1 ] = { };
7926728µs $N = $g->[ $n ];
7936725µs my $u = $E->[ _f ] & _UNORD;
79467146µs67168µs my $Ei = $E->_ids;
# spent 168µs making 67 calls to Graph::AdjacencyMap::_ids, avg 3µs/call
7956717.4ms while (my ($ei, $ev) = each %{ $Ei }) {
796149652.16ms next unless @$ev;
797149658.64ms my $e = [ $ei, $ev ];
798149653.45ms if ($u) {
7991496514.5ms push @{ $N->[ 1 ]->{ $ev->[ 0] } }, $e;
8001496513.5ms push @{ $N->[ 1 ]->{ $ev->[-1] } }, $e;
801 } else {
802 my $e = [ $ei, $ev ];
803 push @{ $N->[ 1 ]->{ $ev->[$i] } }, $e;
804 }
805 }
8066780µs $N->[ 0 ] = $g->[ _G ];
807 }
808248762.08ms my @e;
8092487617.5ms my @at = $h ? $g->vertices_at( @_ ) : @_;
8104975212.9ms my %at; @at{@at} = ();
8112487612.2ms for my $v ( @at ) {
8122487638.0ms2487675.4ms my $vi = $V->_get_path_id( ref $v eq 'ARRAY' && $h ? @$v : $v );
# spent 75.4ms making 24876 calls to Graph::AdjacencyMap::Light::_get_path_id, avg 3µs/call
8132487617.9ms next unless defined $vi && exists $N->[ 1 ]->{ $vi };
8142487638.3ms push @e, @{ $N->[ 1 ]->{ $vi } };
815 }
8162487636.9ms24876102ms if (wantarray && $g->is_undirected) {
# spent 102ms making 24876 calls to Graph::omniedged, avg 4µs/call
8174975258.1ms2487664.5ms my @i = map { $V->_get_path_id( $_ ) } @_;
# spent 64.5ms making 24876 calls to Graph::AdjacencyMap::Light::_get_path_id, avg 3µs/call
8182487612.6ms for my $e ( @e ) {
8195003784.2ms unless ( $e->[ 1 ]->[ $i ] == $i[ $i ] ) {
820 $e = [ $e->[ 0 ], [ reverse @{ $e->[ 1 ] } ] ];
821 }
822 }
823 }
8242487673.0ms return @e;
825}
826
827
# spent 45.3ms within Graph::_edges_from which was called 24876 times, avg 2µs/call: # 24876 times (45.3ms+0s) by Graph::AdjacencyMap::_successors at line 394 of Graph/AdjacencyMap.pm, avg 2µs/call
sub _edges_from {
828248766.81ms push @_, _S;
8292487676.3ms24876858ms goto &_edges;
# spent 858ms making 24876 calls to Graph::_edges, avg 35µs/call
830}
831
832sub _edges_to {
833 push @_, _P;
834 goto &_edges;
835}
836
837sub _edges_id_path {
838 my $g = shift;
839 my $V = $g->[ _V ];
840 [ map { my @v = $V->_get_id_path($_);
841 @v == 1 ? $v[0] : [ @v ] }
842 @{ $_[0]->[1] } ];
843}
844
845sub edges_at {
846 my $g = shift;
847 map { $g->_edges_id_path($_ ) } $g->_edges_at( @_ );
848}
849
850sub edges_from {
851 my $g = shift;
852 map { $g->_edges_id_path($_ ) } $g->_edges_from( @_ );
853}
854
855sub edges_to {
856 my $g = shift;
857 map { $g->_edges_id_path($_ ) } $g->_edges_to( @_ );
858}
859
860
# spent 1.50s (83.3ms+1.42) within Graph::successors which was called 24876 times, avg 60µs/call: # 19885 times (65.5ms+1.11s) by Graph::Traversal::next at line 285 of Graph/Traversal.pm, avg 59µs/call # 4991 times (17.8ms+314ms) by Graph::_MST_add at line 2316, avg 67µs/call
sub successors {
861248764.04ms my $g = shift;
862248767.37ms my $E = $g->[ _E ];
8632487659.2ms248761.42s ($E->[ _f ] & _LIGHT) ?
# spent 1.42s making 24876 calls to Graph::AdjacencyMap::_successors, avg 57µs/call
864 $E->_successors($g, @_) :
865 Graph::AdjacencyMap::_successors($E, $g, @_);
866}
867
868sub predecessors {
869 my $g = shift;
870 my $E = $g->[ _E ];
871 ($E->[ _f ] & _LIGHT) ?
872 $E->_predecessors($g, @_) :
873 Graph::AdjacencyMap::_predecessors($E, $g, @_);
874}
875
876sub _all_successors {
877 my $g = shift;
878 my @init = @_;
879 my %todo;
880 @todo{@init} = @init;
881 my %seen;
882 my %init = %todo;
883 my %self;
884 while (keys %todo) {
885 my @todo = values %todo;
886 for my $t (@todo) {
887 $seen{$t} = delete $todo{$t};
888 for my $s ($g->successors($t)) {
889 $self{$s} = $s if exists $init{$s};
890 $todo{$s} = $s unless exists $seen{$s};
891 }
892 }
893 }
894 for my $v (@init) {
895 delete $seen{$v} unless $g->has_edge($v, $v) || $self{$v};
896 }
897 return values %seen;
898}
899
900sub all_successors {
901 my $g = shift;
902 $g->expect_directed;
903 return $g->_all_successors(@_);
904}
905
906sub _all_predecessors {
907 my $g = shift;
908 my @init = @_;
909 my %todo;
910 @todo{@init} = @init;
911 my %seen;
912 my %init = %todo;
913 my %self;
914 while (keys %todo) {
915 my @todo = values %todo;
916 for my $t (@todo) {
917 $seen{$t} = delete $todo{$t};
918 for my $p ($g->predecessors($t)) {
919 $self{$p} = $p if exists $init{$p};
920 $todo{$p} = $p unless exists $seen{$p};
921 }
922 }
923 }
924 for my $v (@init) {
925 delete $seen{$v} unless $g->has_edge($v, $v) || $self{$v};
926 }
927 return values %seen;
928}
929
930sub all_predecessors {
931 my $g = shift;
932 $g->expect_directed;
933 return $g->_all_predecessors(@_);
934}
935
936sub neighbours {
937 my $g = shift;
938 my $V = $g->[ _V ];
939 my @s = map { my @v = @{ $_->[ 1 ] }; shift @v; @v } $g->_edges_from( @_ );
940 my @p = map { my @v = @{ $_->[ 1 ] }; pop @v; @v } $g->_edges_to ( @_ );
941 my %n;
942 @n{ @s } = @s;
943 @n{ @p } = @p;
944 map { $V->_get_id_path($_) } keys %n;
945}
946
94712µs*neighbors = \&neighbours;
948
949sub all_neighbours {
950 my $g = shift;
951 my @init = @_;
952 my @v = @init;
953 my %n;
954 my $o = 0;
955 while (1) {
956 my @p = $g->_all_predecessors(@v);
957 my @s = $g->_all_successors(@v);
958 @n{@p} = @p;
959 @n{@s} = @s;
960 @v = values %n;
961 last if @v == $o; # Leave if no growth.
962 $o = @v;
963 }
964 for my $v (@init) {
965 delete $n{$v} unless $g->has_edge($v, $v);
966 }
967 return values %n;
968}
969
97012µs*all_neighbors = \&all_neighbours;
971
972sub all_reachable {
973 my $g = shift;
974 $g->directed ? $g->all_successors(@_) : $g->all_neighbors(@_);
975}
976
977sub delete_edge {
978 my $g = shift;
979 $g->expect_non_unionfind;
980 my @i = $g->_vertex_ids( @_ );
981 return $g unless @i;
982 my $i = $g->[ _E ]->_get_path_id( @i );
983 return $g unless defined $i;
984 $g->[ _E ]->_del_id( $i );
985 $g->[ _G ]++;
986 return $g;
987}
988
989sub delete_vertex {
990 my $g = shift;
991 $g->expect_non_unionfind;
992 my $V = $g->[ _V ];
993 return $g unless $V->has_path( @_ );
994 my $E = $g->[ _E ];
995 for my $e ( $g->_edges_at( @_ ) ) {
996 $E->_del_id( $e->[ 0 ] );
997 }
998 $V->del_path( @_ );
999 $g->[ _G ]++;
1000 return $g;
1001}
1002
1003sub get_vertex_count {
1004 my $g = shift;
1005 $g->[ _V ]->_get_path_count( @_ ) || 0;
1006}
1007
1008sub get_edge_count {
1009 my $g = shift;
1010 my @e = $g->_vertex_ids( @_ );
1011 return 0 unless @e;
1012 $g->[ _E ]->_get_path_count( @e ) || 0;
1013}
1014
1015sub delete_vertices {
1016 my $g = shift;
1017 $g->expect_non_unionfind;
1018 while (@_) {
1019 my $v = shift @_;
1020 $g->delete_vertex($v);
1021 }
1022 return $g;
1023}
1024
1025sub delete_edges {
1026 my $g = shift;
1027 $g->expect_non_unionfind;
1028 while (@_) {
1029 my ($u, $v) = splice @_, 0, 2;
1030 $g->delete_edge($u, $v);
1031 }
1032 return $g;
1033}
1034
1035###
1036# Degrees.
1037#
1038
1039sub _in_degree {
1040 my $g = shift;
1041 return undef unless @_ && $g->has_vertex( @_ );
1042 my $in = 0;
1043 $in += $g->get_edge_count( @$_ ) for $g->edges_to( @_ );
1044 return $in;
1045}
1046
1047sub in_degree {
1048 my $g = shift;
1049 $g->_in_degree( @_ );
1050}
1051
1052sub _out_degree {
1053 my $g = shift;
1054 return undef unless @_ && $g->has_vertex( @_ );
1055 my $out = 0;
1056 $out += $g->get_edge_count( @$_ ) for $g->edges_from( @_ );
1057 return $out;
1058}
1059
1060sub out_degree {
1061 my $g = shift;
1062 $g->_out_degree( @_ );
1063}
1064
1065sub _total_degree {
1066 my $g = shift;
1067 return undef unless @_ && $g->has_vertex( @_ );
1068 $g->is_undirected ?
1069 $g->_in_degree( @_ ) :
1070 $g-> in_degree( @_ ) - $g-> out_degree( @_ );
1071}
1072
1073sub degree {
1074 my $g = shift;
1075 if (@_) {
1076 $g->_total_degree( @_ );
1077 } elsif ($g->is_undirected) {
1078 my $total = 0;
1079 $total += $g->_total_degree( $_ ) for $g->vertices05;
1080 return $total;
1081 } else {
1082 return 0;
1083 }
1084}
1085
108612µs*vertex_degree = \&degree;
1087
1088sub is_sink_vertex {
1089 my $g = shift;
1090 return 0 unless @_;
1091 $g->successors( @_ ) == 0 && $g->predecessors( @_ ) > 0;
1092}
1093
1094sub is_source_vertex {
1095 my $g = shift;
1096 return 0 unless @_;
1097 $g->predecessors( @_ ) == 0 && $g->successors( @_ ) > 0;
1098}
1099
1100sub is_successorless_vertex {
1101 my $g = shift;
1102 return 0 unless @_;
1103 $g->successors( @_ ) == 0;
1104}
1105
1106sub is_predecessorless_vertex {
1107 my $g = shift;
1108 return 0 unless @_;
1109 $g->predecessors( @_ ) == 0;
1110}
1111
1112sub is_successorful_vertex {
1113 my $g = shift;
1114 return 0 unless @_;
1115 $g->successors( @_ ) > 0;
1116}
1117
1118sub is_predecessorful_vertex {
1119 my $g = shift;
1120 return 0 unless @_;
1121 $g->predecessors( @_ ) > 0;
1122}
1123
1124sub is_isolated_vertex {
1125 my $g = shift;
1126 return 0 unless @_;
1127 $g->predecessors( @_ ) == 0 && $g->successors( @_ ) == 0;
1128}
1129
1130sub is_interior_vertex {
1131 my $g = shift;
1132 return 0 unless @_;
1133 my $p = $g->predecessors( @_ );
1134 my $s = $g->successors( @_ );
1135 if ($g->is_self_loop_vertex( @_ )) {
1136 $p--;
1137 $s--;
1138 }
1139 $p > 0 && $s > 0;
1140}
1141
1142sub is_exterior_vertex {
1143 my $g = shift;
1144 return 0 unless @_;
1145 $g->predecessors( @_ ) == 0 || $g->successors( @_ ) == 0;
1146}
1147
1148sub is_self_loop_vertex {
1149 my $g = shift;
1150 return 0 unless @_;
1151 for my $s ( $g->successors( @_ ) ) {
1152 return 1 if $s eq $_[0]; # @todo: multiedges, hypervertices
1153 }
1154 return 0;
1155}
1156
1157sub sink_vertices {
1158 my $g = shift;
1159 grep { $g->is_sink_vertex($_) } $g->vertices05;
1160}
1161
1162sub source_vertices {
1163 my $g = shift;
1164 grep { $g->is_source_vertex($_) } $g->vertices05;
1165}
1166
1167sub successorless_vertices {
1168 my $g = shift;
1169 grep { $g->is_successorless_vertex($_) } $g->vertices05;
1170}
1171
1172sub predecessorless_vertices {
1173 my $g = shift;
1174 grep { $g->is_predecessorless_vertex($_) } $g->vertices05;
1175}
1176
1177sub successorful_vertices {
1178 my $g = shift;
1179 grep { $g->is_successorful_vertex($_) } $g->vertices05;
1180}
1181
1182sub predecessorful_vertices {
1183 my $g = shift;
1184 grep { $g->is_predecessorful_vertex($_) } $g->vertices05;
1185}
1186
1187sub isolated_vertices {
1188 my $g = shift;
1189 grep { $g->is_isolated_vertex($_) } $g->vertices05;
1190}
1191
1192sub interior_vertices {
1193 my $g = shift;
1194 grep { $g->is_interior_vertex($_) } $g->vertices05;
1195}
1196
1197sub exterior_vertices {
1198 my $g = shift;
1199 grep { $g->is_exterior_vertex($_) } $g->vertices05;
1200}
1201
1202sub self_loop_vertices {
1203 my $g = shift;
1204 grep { $g->is_self_loop_vertex($_) } $g->vertices05;
1205}
1206
1207###
1208# Paths and cycles.
1209#
1210
1211sub add_path {
1212 my $g = shift;
1213 my $u = shift;
1214 while (@_) {
1215 my $v = shift;
1216 $g->add_edge($u, $v);
1217 $u = $v;
1218 }
1219 return $g;
1220}
1221
1222sub delete_path {
1223 my $g = shift;
1224 $g->expect_non_unionfind;
1225 my $u = shift;
1226 while (@_) {
1227 my $v = shift;
1228 $g->delete_edge($u, $v);
1229 $u = $v;
1230 }
1231 return $g;
1232}
1233
1234sub has_path {
1235 my $g = shift;
1236 my $u = shift;
1237 while (@_) {
1238 my $v = shift;
1239 return 0 unless $g->has_edge($u, $v);
1240 $u = $v;
1241 }
1242 return $g;
1243}
1244
1245sub add_cycle {
1246 my $g = shift;
1247 $g->add_path(@_, $_[0]);
1248}
1249
1250sub delete_cycle {
1251 my $g = shift;
1252 $g->expect_non_unionfind;
1253 $g->delete_path(@_, $_[0]);
1254}
1255
1256sub has_cycle {
1257 my $g = shift;
1258 @_ ? ($g->has_path(@_, $_[0]) ? 1 : 0) : 0;
1259}
1260
1261sub has_a_cycle {
1262 my $g = shift;
1263 my @r = ( back_edge => \&Graph::Traversal::has_a_cycle );
1264 push @r,
1265 down_edge => \&Graph::Traversal::has_a_cycle
1266 if $g->is_undirected;
1267 my $t = Graph::Traversal::DFS->new($g, @r, @_);
1268 $t->dfs;
1269 return $t->get_state('has_a_cycle');
1270}
1271
1272sub find_a_cycle {
1273 my $g = shift;
1274 my @r = ( back_edge => \&Graph::Traversal::find_a_cycle);
1275 push @r,
1276 down_edge => \&Graph::Traversal::find_a_cycle
1277 if $g->is_undirected;
1278 my $t = Graph::Traversal::DFS->new($g, @r, @_);
1279 $t->dfs;
1280 $t->has_state('a_cycle') ? @{ $t->get_state('a_cycle') } : ();
1281}
1282
1283###
1284# Attributes.
1285
1286# Vertex attributes.
1287
1288sub set_vertex_attribute {
1289 my $g = shift;
1290 $g->expect_non_multivertexed;
1291 my $value = pop;
1292 my $attr = pop;
1293 $g->add_vertex( @_ ) unless $g->has_vertex( @_ );
1294 $g->[ _V ]->_set_path_attr( @_, $attr, $value );
1295}
1296
1297sub set_vertex_attribute_by_id {
1298 my $g = shift;
1299 $g->expect_multivertexed;
1300 my $value = pop;
1301 my $attr = pop;
1302 $g->add_vertex_by_id( @_ ) unless $g->has_vertex_by_id( @_ );
1303 $g->[ _V ]->_set_path_attr( @_, $attr, $value );
1304}
1305
1306sub set_vertex_attributes {
1307 my $g = shift;
1308 $g->expect_non_multivertexed;
1309 my $attr = pop;
1310 $g->add_vertex( @_ ) unless $g->has_vertex( @_ );
1311 $g->[ _V ]->_set_path_attrs( @_, $attr );
1312}
1313
1314sub set_vertex_attributes_by_id {
1315 my $g = shift;
1316 $g->expect_multivertexed;
1317 my $attr = pop;
1318 $g->add_vertex_by_id( @_ ) unless $g->has_vertex_by_id( @_ );
1319 $g->[ _V ]->_set_path_attrs( @_, $attr );
1320}
1321
1322sub has_vertex_attributes {
1323 my $g = shift;
1324 $g->expect_non_multivertexed;
1325 return 0 unless $g->has_vertex( @_ );
1326 $g->[ _V ]->_has_path_attrs( @_ );
1327}
1328
1329sub has_vertex_attributes_by_id {
1330 my $g = shift;
1331 $g->expect_multivertexed;
1332 return 0 unless $g->has_vertex_by_id( @_ );
1333 $g->[ _V ]->_has_path_attrs( @_ );
1334}
1335
1336sub has_vertex_attribute {
1337 my $g = shift;
1338 $g->expect_non_multivertexed;
1339 my $attr = pop;
1340 return 0 unless $g->has_vertex( @_ );
1341 $g->[ _V ]->_has_path_attr( @_, $attr );
1342}
1343
1344sub has_vertex_attribute_by_id {
1345 my $g = shift;
1346 $g->expect_multivertexed;
1347 my $attr = pop;
1348 return 0 unless $g->has_vertex_by_id( @_ );
1349 $g->[ _V ]->_has_path_attr( @_, $attr );
1350}
1351
1352sub get_vertex_attributes {
1353 my $g = shift;
1354 $g->expect_non_multivertexed;
1355 return unless $g->has_vertex( @_ );
1356 my $a = $g->[ _V ]->_get_path_attrs( @_ );
1357 ($g->is_compat02) ? (defined $a ? %{ $a } : ()) : $a;
1358}
1359
1360sub get_vertex_attributes_by_id {
1361 my $g = shift;
1362 $g->expect_multivertexed;
1363 return unless $g->has_vertex_by_id( @_ );
1364 $g->[ _V ]->_get_path_attrs( @_ );
1365}
1366
1367sub get_vertex_attribute {
1368 my $g = shift;
1369 $g->expect_non_multivertexed;
1370 my $attr = pop;
1371 return unless $g->has_vertex( @_ );
1372 $g->[ _V ]->_get_path_attr( @_, $attr );
1373}
1374
1375sub get_vertex_attribute_by_id {
1376 my $g = shift;
1377 $g->expect_multivertexed;
1378 my $attr = pop;
1379 return unless $g->has_vertex_by_id( @_ );
1380 $g->[ _V ]->_get_path_attr( @_, $attr );
1381}
1382
1383sub get_vertex_attribute_names {
1384 my $g = shift;
1385 $g->expect_non_multivertexed;
1386 return unless $g->has_vertex( @_ );
1387 $g->[ _V ]->_get_path_attr_names( @_ );
1388}
1389
1390sub get_vertex_attribute_names_by_id {
1391 my $g = shift;
1392 $g->expect_multivertexed;
1393 return unless $g->has_vertex_by_id( @_ );
1394 $g->[ _V ]->_get_path_attr_names( @_ );
1395}
1396
1397sub get_vertex_attribute_values {
1398 my $g = shift;
1399 $g->expect_non_multivertexed;
1400 return unless $g->has_vertex( @_ );
1401 $g->[ _V ]->_get_path_attr_values( @_ );
1402}
1403
1404sub get_vertex_attribute_values_by_id {
1405 my $g = shift;
1406 $g->expect_multivertexed;
1407 return unless $g->has_vertex_by_id( @_ );
1408 $g->[ _V ]->_get_path_attr_values( @_ );
1409}
1410
1411sub delete_vertex_attributes {
1412 my $g = shift;
1413 $g->expect_non_multivertexed;
1414 return undef unless $g->has_vertex( @_ );
1415 $g->[ _V ]->_del_path_attrs( @_ );
1416}
1417
1418sub delete_vertex_attributes_by_id {
1419 my $g = shift;
1420 $g->expect_multivertexed;
1421 return undef unless $g->has_vertex_by_id( @_ );
1422 $g->[ _V ]->_del_path_attrs( @_ );
1423}
1424
1425sub delete_vertex_attribute {
1426 my $g = shift;
1427 $g->expect_non_multivertexed;
1428 my $attr = pop;
1429 return undef unless $g->has_vertex( @_ );
1430 $g->[ _V ]->_del_path_attr( @_, $attr );
1431}
1432
1433sub delete_vertex_attribute_by_id {
1434 my $g = shift;
1435 $g->expect_multivertexed;
1436 my $attr = pop;
1437 return undef unless $g->has_vertex_by_id( @_ );
1438 $g->[ _V ]->_del_path_attr( @_, $attr );
1439}
1440
1441# Edge attributes.
1442
1443sub _set_edge_attribute {
1444 my $g = shift;
1445 my $value = pop;
1446 my $attr = pop;
1447 my $E = $g->[ _E ];
1448 my $f = $E->[ _f ];
1449 my @i;
1450 if ($E->[ _a ] == 2 && @_ == 2 && !($f & (_HYPER|_REF|_UNIQ))) { # Fast path.
1451 @_ = sort @_ if ($f & _UNORD);
1452 my $s = $E->[ _s ];
1453 $g->add_edge( @_ ) unless exists $s->{ $_[0] } && exists $s->{ $_[0] }->{ $_[1] };
1454 @i = @{ $g->[ _V ]->[ _s ] }{ @_ };
1455 } else {
1456 $g->add_edge( @_ ) unless $g->has_edge( @_ );
1457 @i = $g->_vertex_ids( @_ );
1458 }
1459 $g->[ _E ]->_set_path_attr( @i, $attr, $value );
1460}
1461
1462
# spent 1.50s (222ms+1.28) within Graph::set_edge_attribute which was called 19958 times, avg 75µs/call: # 15003 times (157ms+685ms) by Graph::add_weighted_edge at line 1939, avg 56µs/call # 4955 times (64.6ms+597ms) by Graph::_heap_walk at line 2378, avg 133µs/call
sub set_edge_attribute {
1463199584.41ms my $g = shift;
14641995816.9ms19958124ms $g->expect_non_multiedged;
# spent 124ms making 19958 calls to Graph::expect_non_multiedged, avg 6µs/call
1465199584.62ms my $value = pop;
1466199583.02ms my $attr = pop;
1467199585.21ms my $E = $g->[ _E ];
14681995828.3ms24913530ms $g->add_edge( @_ ) unless $g->has_edge( @_ );
# spent 378ms making 4955 calls to Graph::add_edge, avg 76µs/call # spent 152ms making 19958 calls to Graph::has_edge, avg 8µs/call
14691995885.9ms39916628ms $E->_set_path_attr( $g->_vertex_ids( @_ ), $attr, $value );
# spent 505ms making 19958 calls to Graph::AdjacencyMap::_set_path_attr, avg 25µs/call # spent 123ms making 19958 calls to Graph::_vertex_ids, avg 6µs/call
1470}
1471
1472sub set_edge_attribute_by_id {
1473 my $g = shift;
1474 $g->expect_multiedged;
1475 my $value = pop;
1476 my $attr = pop;
1477 # $g->add_edge_by_id( @_ ) unless $g->has_edge_by_id( @_ );
1478 my $id = pop;
1479 $g->[ _E ]->_set_path_attr( $g->_vertex_ids( @_ ), $id, $attr, $value );
1480}
1481
1482sub set_edge_attributes {
1483 my $g = shift;
1484 $g->expect_non_multiedged;
1485 my $attr = pop;
1486 $g->add_edge( @_ ) unless $g->has_edge( @_ );
1487 $g->[ _E ]->_set_path_attrs( $g->_vertex_ids( @_ ), $attr );
1488}
1489
1490sub set_edge_attributes_by_id {
1491 my $g = shift;
1492 $g->expect_multiedged;
1493 my $attr = pop;
1494 $g->add_edge_by_id( @_ ) unless $g->has_edge_by_id( @_ );
1495 my $id = pop;
1496 $g->[ _E ]->_set_path_attrs( $g->_vertex_ids( @_ ), $id, $attr );
1497}
1498
1499sub has_edge_attributes {
1500 my $g = shift;
1501 $g->expect_non_multiedged;
1502 return 0 unless $g->has_edge( @_ );
1503 $g->[ _E ]->_has_path_attrs( $g->_vertex_ids( @_ ) );
1504}
1505
1506sub has_edge_attributes_by_id {
1507 my $g = shift;
1508 $g->expect_multiedged;
1509 return 0 unless $g->has_edge_by_id( @_ );
1510 my $id = pop;
1511 $g->[ _E ]->_has_path_attrs( $g->_vertex_ids( @_ ), $id );
1512}
1513
1514sub has_edge_attribute {
1515 my $g = shift;
1516 $g->expect_non_multiedged;
1517 my $attr = pop;
1518 return 0 unless $g->has_edge( @_ );
1519 $g->[ _E ]->_has_path_attr( $g->_vertex_ids( @_ ), $attr );
1520}
1521
1522sub has_edge_attribute_by_id {
1523 my $g = shift;
1524 $g->expect_multiedged;
1525 my $attr = pop;
1526 return 0 unless $g->has_edge_by_id( @_ );
1527 my $id = pop;
1528 $g->[ _E ]->_has_path_attr( $g->_vertex_ids( @_ ), $id, $attr );
1529}
1530
1531sub get_edge_attributes {
1532 my $g = shift;
1533 $g->expect_non_multiedged;
1534 return unless $g->has_edge( @_ );
1535 my $a = $g->[ _E ]->_get_path_attrs( $g->_vertex_ids( @_ ) );
1536 ($g->is_compat02) ? (defined $a ? %{ $a } : ()) : $a;
1537}
1538
1539sub get_edge_attributes_by_id {
1540 my $g = shift;
1541 $g->expect_multiedged;
1542 return unless $g->has_edge_by_id( @_ );
1543 my $id = pop;
1544 return $g->[ _E ]->_get_path_attrs( $g->_vertex_ids( @_ ), $id );
1545}
1546
1547sub _get_edge_attribute { # Fast path; less checks.
1548 my $g = shift;
1549 my $attr = pop;
1550 my $E = $g->[ _E ];
1551 my $f = $E->[ _f ];
1552 if ($E->[ _a ] == 2 && @_ == 2 && !($f & (_HYPER|_REF|_UNIQ))) { # Fast path.
1553 @_ = sort @_ if ($f & _UNORD);
1554 my $s = $E->[ _s ];
1555 return unless exists $s->{ $_[0] } && exists $s->{ $_[0] }->{ $_[1] };
1556 } else {
1557 return unless $g->has_edge( @_ );
1558 }
1559 my @i = $g->_vertex_ids( @_ );
1560 $E->_get_path_attr( @i, $attr );
1561}
1562
1563
# spent 325ms (62.8+262) within Graph::get_edge_attribute which was called 5007 times, avg 65µs/call: # 5007 times (62.8ms+262ms) by Graph::_MST_add at line 2317, avg 65µs/call
sub get_edge_attribute {
156450071.25ms my $g = shift;
156550074.98ms500733.6ms $g->expect_non_multiedged;
# spent 33.6ms making 5007 calls to Graph::expect_non_multiedged, avg 7µs/call
156650071.48ms my $attr = pop;
156750076.27ms500753.5ms return undef unless $g->has_edge( @_ );
# spent 53.5ms making 5007 calls to Graph::has_edge, avg 11µs/call
156850078.92ms500729.0ms my @i = $g->_vertex_ids( @_ );
# spent 29.0ms making 5007 calls to Graph::_vertex_ids, avg 6µs/call
156950071.21ms return undef if @i == 0 && @_;
157050071.44ms my $E = $g->[ _E ];
1571500716.1ms5007146ms $E->_get_path_attr( @i, $attr );
# spent 146ms making 5007 calls to Graph::AdjacencyMap::_get_path_attr, avg 29µs/call
1572}
1573
1574sub get_edge_attribute_by_id {
1575 my $g = shift;
1576 $g->expect_multiedged;
1577 my $attr = pop;
1578 return unless $g->has_edge_by_id( @_ );
1579 my $id = pop;
1580 $g->[ _E ]->_get_path_attr( $g->_vertex_ids( @_ ), $id, $attr );
1581}
1582
1583sub get_edge_attribute_names {
1584 my $g = shift;
1585 $g->expect_non_multiedged;
1586 return unless $g->has_edge( @_ );
1587 $g->[ _E ]->_get_path_attr_names( $g->_vertex_ids( @_ ) );
1588}
1589
1590sub get_edge_attribute_names_by_id {
1591 my $g = shift;
1592 $g->expect_multiedged;
1593 return unless $g->has_edge_by_id( @_ );
1594 my $id = pop;
1595 $g->[ _E ]->_get_path_attr_names( $g->_vertex_ids( @_ ), $id );
1596}
1597
1598sub get_edge_attribute_values {
1599 my $g = shift;
1600 $g->expect_non_multiedged;
1601 return unless $g->has_edge( @_ );
1602 $g->[ _E ]->_get_path_attr_values( $g->_vertex_ids( @_ ) );
1603}
1604
1605sub get_edge_attribute_values_by_id {
1606 my $g = shift;
1607 $g->expect_multiedged;
1608 return unless $g->has_edge_by_id( @_ );
1609 my $id = pop;
1610 $g->[ _E ]->_get_path_attr_values( $g->_vertex_ids( @_ ), $id );
1611}
1612
1613sub delete_edge_attributes {
1614 my $g = shift;
1615 $g->expect_non_multiedged;
1616 return unless $g->has_edge( @_ );
1617 $g->[ _E ]->_del_path_attrs( $g->_vertex_ids( @_ ) );
1618}
1619
1620sub delete_edge_attributes_by_id {
1621 my $g = shift;
1622 $g->expect_multiedged;
1623 return unless $g->has_edge_by_id( @_ );
1624 my $id = pop;
1625 $g->[ _E ]->_del_path_attrs( $g->_vertex_ids( @_ ), $id );
1626}
1627
1628sub delete_edge_attribute {
1629 my $g = shift;
1630 $g->expect_non_multiedged;
1631 my $attr = pop;
1632 return unless $g->has_edge( @_ );
1633 $g->[ _E ]->_del_path_attr( $g->_vertex_ids( @_ ), $attr );
1634}
1635
1636sub delete_edge_attribute_by_id {
1637 my $g = shift;
1638 $g->expect_multiedged;
1639 my $attr = pop;
1640 return unless $g->has_edge_by_id( @_ );
1641 my $id = pop;
1642 $g->[ _E ]->_del_path_attr( $g->_vertex_ids( @_ ), $id, $attr );
1643}
1644
1645###
1646# Compat.
1647#
1648
1649sub vertex {
1650 my $g = shift;
1651 $g->has_vertex( @_ ) ? @_ : undef;
1652}
1653
1654sub out_edges {
1655 my $g = shift;
1656 return unless @_ && $g->has_vertex( @_ );
1657 my @e = $g->edges_from( @_ );
1658 wantarray ? map { @$_ } @e : @e;
1659}
1660
1661sub in_edges {
1662 my $g = shift;
1663 return unless @_ && $g->has_vertex( @_ );
1664 my @e = $g->edges_to( @_ );
1665 wantarray ? map { @$_ } @e : @e;
1666}
1667
1668sub add_vertices {
1669 my $g = shift;
1670 $g->add_vertex( $_ ) for @_;
1671 return $g;
1672}
1673
1674
# spent 5.56ms (502µs+5.06) within Graph::add_edges which was called 67 times, avg 83µs/call: # 67 times (502µs+5.06ms) by Graph::AdjacencyMap::Light::__attr at line 227 of Graph/AdjacencyMap/Light.pm, avg 83µs/call
sub add_edges {
16756726µs my $g = shift;
16766748µs while (@_) {
16776729µs my $u = shift @_;
167867146µs675.06ms if (ref $u eq 'ARRAY') {
# spent 5.06ms making 67 calls to Graph::add_edge, avg 75µs/call
1679 $g->add_edge( @$u );
1680 } else {
1681 if (@_) {
1682 my $v = shift @_;
1683 $g->add_edge( $u, $v );
1684 } else {
1685 require Carp;
1686 Carp::croak("Graph::add_edges: missing end vertex");
1687 }
1688 }
1689 }
169067158µs return $g;
1691}
1692
1693###
1694# More constructors.
1695#
1696
1697sub copy {
1698 my $g = shift;
1699 my %opt = _get_options( \@_ );
1700
1701 my $c =
1702 (ref $g)->new(map { $_ => $g->$_ ? 1 : 0 }
1703 qw(directed
1704 compat02
1705 refvertexed
1706 hypervertexed
1707 countvertexed
1708 multivertexed
1709 hyperedged
1710 countedged
1711 multiedged
1712 omniedged
1713 __stringified));
1714 for my $v ($g->isolated_vertices) { $c->add_vertex($v) }
1715 for my $e ($g->edges05) { $c->add_edge(@$e) }
1716
1717 return $c;
1718}
1719
172012µs*copy_graph = \©
1721
1722sub _deep_copy_Storable {
1723 my $g = shift;
1724 my $safe = new Safe;
1725 local $Storable::Deparse = 1;
1726 local $Storable::Eval = sub { $safe->reval($_[0]) };
1727 return Storable::thaw(Storable::freeze($g));
1728}
1729
1730sub _deep_copy_DataDumper {
1731 my $g = shift;
1732 my $d = Data::Dumper->new([$g]);
173321.88ms298µs
# spent 56µs (13+42) within Graph::BEGIN@1733 which was called: # once (13µs+42µs) by Bio::Roary::OrderGenes::BEGIN@22 at line 1733
use vars qw($VAR1);
# spent 56µs making 1 call to Graph::BEGIN@1733 # spent 42µs making 1 call to vars::import
1734 $d->Purity(1)->Terse(1)->Deepcopy(1);
1735 $d->Deparse(1) if $] >= 5.008;
1736 eval $d->Dump;
1737}
1738
1739sub deep_copy {
1740 if (_can_deep_copy_Storable()) {
1741 return _deep_copy_Storable(@_);
1742 } else {
1743 return _deep_copy_DataDumper(@_);
1744 }
1745}
1746
174712µs*deep_copy_graph = \&deep_copy;
1748
1749sub transpose_edge {
1750 my $g = shift;
1751 if ($g->is_directed) {
1752 return undef unless $g->has_edge( @_ );
1753 my $c = $g->get_edge_count( @_ );
1754 my $a = $g->get_edge_attributes( @_ );
1755 my @e = reverse @_;
1756 $g->delete_edge( @_ ) unless $g->has_edge( @e );
1757 $g->add_edge( @e ) for 1..$c;
1758 $g->set_edge_attributes(@e, $a) if $a;
1759 }
1760 return $g;
1761}
1762
1763sub transpose_graph {
1764 my $g = shift;
1765 my $t = $g->copy;
1766 if ($t->directed) {
1767 for my $e ($t->edges05) {
1768 $t->transpose_edge(@$e);
1769 }
1770 }
1771 return $t;
1772}
1773
177412µs*transpose = \&transpose_graph;
1775
1776sub complete_graph {
1777 my $g = shift;
1778 my $c = $g->new( directed => $g->directed );
1779 my @v = $g->vertices05;
1780 for (my $i = 0; $i <= $#v; $i++ ) {
1781 for (my $j = 0; $j <= $#v; $j++ ) {
1782 next if $i >= $j;
1783 if ($g->is_undirected) {
1784 $c->add_edge($v[$i], $v[$j]);
1785 } else {
1786 $c->add_edge($v[$i], $v[$j]);
1787 $c->add_edge($v[$j], $v[$i]);
1788 }
1789 }
1790 }
1791 return $c;
1792}
1793
179412µs*complement = \&complement_graph;
1795
1796sub complement_graph {
1797 my $g = shift;
1798 my $c = $g->new( directed => $g->directed );
1799 my @v = $g->vertices05;
1800 for (my $i = 0; $i <= $#v; $i++ ) {
1801 for (my $j = 0; $j <= $#v; $j++ ) {
1802 next if $i >= $j;
1803 if ($g->is_undirected) {
1804 $c->add_edge($v[$i], $v[$j])
1805 unless $g->has_edge($v[$i], $v[$j]);
1806 } else {
1807 $c->add_edge($v[$i], $v[$j])
1808 unless $g->has_edge($v[$i], $v[$j]);
1809 $c->add_edge($v[$j], $v[$i])
1810 unless $g->has_edge($v[$j], $v[$i]);
1811 }
1812 }
1813 }
1814 return $c;
1815}
1816
181712µs*complete = \&complete_graph;
1818
1819###
1820# Transitivity.
1821#
1822
1823sub is_transitive {
1824 my $g = shift;
1825 Graph::TransitiveClosure::is_transitive($g);
1826}
1827
1828###
1829# Weighted vertices.
1830#
1831
18321800nsmy $defattr = 'weight';
1833
1834sub _defattr {
1835 return $defattr;
1836}
1837
1838sub add_weighted_vertex {
1839 my $g = shift;
1840 $g->expect_non_multivertexed;
1841 my $w = pop;
1842 $g->add_vertex(@_);
1843 $g->set_vertex_attribute(@_, $defattr, $w);
1844}
1845
1846sub add_weighted_vertices {
1847 my $g = shift;
1848 $g->expect_non_multivertexed;
1849 while (@_) {
1850 my ($v, $w) = splice @_, 0, 2;
1851 $g->add_vertex($v);
1852 $g->set_vertex_attribute($v, $defattr, $w);
1853 }
1854}
1855
1856sub get_vertex_weight {
1857 my $g = shift;
1858 $g->expect_non_multivertexed;
1859 $g->get_vertex_attribute(@_, $defattr);
1860}
1861
1862sub has_vertex_weight {
1863 my $g = shift;
1864 $g->expect_non_multivertexed;
1865 $g->has_vertex_attribute(@_, $defattr);
1866}
1867
1868sub set_vertex_weight {
1869 my $g = shift;
1870 $g->expect_non_multivertexed;
1871 my $w = pop;
1872 $g->set_vertex_attribute(@_, $defattr, $w);
1873}
1874
1875sub delete_vertex_weight {
1876 my $g = shift;
1877 $g->expect_non_multivertexed;
1878 $g->delete_vertex_attribute(@_, $defattr);
1879}
1880
1881sub add_weighted_vertex_by_id {
1882 my $g = shift;
1883 $g->expect_multivertexed;
1884 my $w = pop;
1885 $g->add_vertex_by_id(@_);
1886 $g->set_vertex_attribute_by_id(@_, $defattr, $w);
1887}
1888
1889sub add_weighted_vertices_by_id {
1890 my $g = shift;
1891 $g->expect_multivertexed;
1892 my $id = pop;
1893 while (@_) {
1894 my ($v, $w) = splice @_, 0, 2;
1895 $g->add_vertex_by_id($v, $id);
1896 $g->set_vertex_attribute_by_id($v, $id, $defattr, $w);
1897 }
1898}
1899
1900sub get_vertex_weight_by_id {
1901 my $g = shift;
1902 $g->expect_multivertexed;
1903 $g->get_vertex_attribute_by_id(@_, $defattr);
1904}
1905
1906sub has_vertex_weight_by_id {
1907 my $g = shift;
1908 $g->expect_multivertexed;
1909 $g->has_vertex_attribute_by_id(@_, $defattr);
1910}
1911
1912sub set_vertex_weight_by_id {
1913 my $g = shift;
1914 $g->expect_multivertexed;
1915 my $w = pop;
1916 $g->set_vertex_attribute_by_id(@_, $defattr, $w);
1917}
1918
1919sub delete_vertex_weight_by_id {
1920 my $g = shift;
1921 $g->expect_multivertexed;
1922 $g->delete_vertex_attribute_by_id(@_, $defattr);
1923}
1924
1925###
1926# Weighted edges.
1927#
1928
1929
# spent 2.07s (139ms+1.93) within Graph::add_weighted_edge which was called 15003 times, avg 138µs/call: # 9767 times (89.9ms+1.18s) by Bio::Roary::OrderGenes::_add_groups_to_graph at line 133 of lib/Bio/Roary/OrderGenes.pm, avg 131µs/call # 5005 times (46.5ms+706ms) by Bio::Roary::OrderGenes::_reorder_connected_components at line 167 of lib/Bio/Roary/OrderGenes.pm, avg 150µs/call # 231 times (2.87ms+39.7ms) by Bio::Roary::OrderGenes::_create_accessory_graph at line 312 of lib/Bio/Roary/OrderGenes.pm, avg 184µs/call
sub add_weighted_edge {
1930150033.11ms my $g = shift;
19311500313.0ms1500392.4ms $g->expect_non_multiedged;
# spent 92.4ms making 15003 calls to Graph::expect_non_multiedged, avg 6µs/call
19321500341.2ms1500323.9ms if ($g->is_compat02) {
# spent 23.9ms making 15003 calls to Graph::is_compat02, avg 2µs/call
1933 my $w = splice @_, 1, 1;
1934 $g->add_edge(@_);
1935 $g->set_edge_attribute(@_, $defattr, $w);
1936 } else {
1937150033.04ms my $w = pop;
19381500314.5ms15003972ms $g->add_edge(@_);
# spent 972ms making 15003 calls to Graph::add_edge, avg 65µs/call
19391500320.7ms15003843ms $g->set_edge_attribute(@_, $defattr, $w);
# spent 843ms making 15003 calls to Graph::set_edge_attribute, avg 56µs/call
1940 }
1941}
1942
1943sub add_weighted_edges {
1944 my $g = shift;
1945 $g->expect_non_multiedged;
1946 if ($g->is_compat02) {
1947 while (@_) {
1948 my ($u, $w, $v) = splice @_, 0, 3;
1949 $g->add_edge($u, $v);
1950 $g->set_edge_attribute($u, $v, $defattr, $w);
1951 }
1952 } else {
1953 while (@_) {
1954 my ($u, $v, $w) = splice @_, 0, 3;
1955 $g->add_edge($u, $v);
1956 $g->set_edge_attribute($u, $v, $defattr, $w);
1957 }
1958 }
1959}
1960
1961sub add_weighted_edges_by_id {
1962 my $g = shift;
1963 $g->expect_multiedged;
1964 my $id = pop;
1965 while (@_) {
1966 my ($u, $v, $w) = splice @_, 0, 3;
1967 $g->add_edge_by_id($u, $v, $id);
1968 $g->set_edge_attribute_by_id($u, $v, $id, $defattr, $w);
1969 }
1970}
1971
1972sub add_weighted_path {
1973 my $g = shift;
1974 $g->expect_non_multiedged;
1975 my $u = shift;
1976 while (@_) {
1977 my ($w, $v) = splice @_, 0, 2;
1978 $g->add_edge($u, $v);
1979 $g->set_edge_attribute($u, $v, $defattr, $w);
1980 $u = $v;
1981 }
1982}
1983
1984sub get_edge_weight {
1985 my $g = shift;
1986 $g->expect_non_multiedged;
1987 $g->get_edge_attribute(@_, $defattr);
1988}
1989
1990sub has_edge_weight {
1991 my $g = shift;
1992 $g->expect_non_multiedged;
1993 $g->has_edge_attribute(@_, $defattr);
1994}
1995
1996sub set_edge_weight {
1997 my $g = shift;
1998 $g->expect_non_multiedged;
1999 my $w = pop;
2000 $g->set_edge_attribute(@_, $defattr, $w);
2001}
2002
2003sub delete_edge_weight {
2004 my $g = shift;
2005 $g->expect_non_multiedged;
2006 $g->delete_edge_attribute(@_, $defattr);
2007}
2008
2009sub add_weighted_edge_by_id {
2010 my $g = shift;
2011 $g->expect_multiedged;
2012 if ($g->is_compat02) {
2013 my $w = splice @_, 1, 1;
2014 $g->add_edge_by_id(@_);
2015 $g->set_edge_attribute_by_id(@_, $defattr, $w);
2016 } else {
2017 my $w = pop;
2018 $g->add_edge_by_id(@_);
2019 $g->set_edge_attribute_by_id(@_, $defattr, $w);
2020 }
2021}
2022
2023sub add_weighted_path_by_id {
2024 my $g = shift;
2025 $g->expect_multiedged;
2026 my $id = pop;
2027 my $u = shift;
2028 while (@_) {
2029 my ($w, $v) = splice @_, 0, 2;
2030 $g->add_edge_by_id($u, $v, $id);
2031 $g->set_edge_attribute_by_id($u, $v, $id, $defattr, $w);
2032 $u = $v;
2033 }
2034}
2035
2036sub get_edge_weight_by_id {
2037 my $g = shift;
2038 $g->expect_multiedged;
2039 $g->get_edge_attribute_by_id(@_, $defattr);
2040}
2041
2042sub has_edge_weight_by_id {
2043 my $g = shift;
2044 $g->expect_multiedged;
2045 $g->has_edge_attribute_by_id(@_, $defattr);
2046}
2047
2048sub set_edge_weight_by_id {
2049 my $g = shift;
2050 $g->expect_multiedged;
2051 my $w = pop;
2052 $g->set_edge_attribute_by_id(@_, $defattr, $w);
2053}
2054
2055sub delete_edge_weight_by_id {
2056 my $g = shift;
2057 $g->expect_multiedged;
2058 $g->delete_edge_attribute_by_id(@_, $defattr);
2059}
2060
2061###
2062# Error helpers.
2063#
2064
20651200nsmy %expected;
206614µs@expected{qw(directed undirected acyclic)} = qw(undirected directed cyclic);
2067
2068sub _expected {
2069 my $exp = shift;
2070 my $got = @_ ? shift : $expected{$exp};
2071 $got = defined $got ? ", got $got" : "";
2072 if (my @caller2 = caller(2)) {
2073 die "$caller2[3]: expected $exp graph$got, at $caller2[1] line $caller2[2].\n";
2074 } else {
2075 my @caller1 = caller(1);
2076 die "$caller1[3]: expected $exp graph$got, at $caller1[1] line $caller1[2].\n";
2077 }
2078}
2079
2080
# spent 490µs (201+289) within Graph::expect_undirected which was called 38 times, avg 13µs/call: # 36 times (186µs+257µs) by Graph::MST_Prim at line 2393, avg 12µs/call # 2 times (15µs+32µs) by Graph::connected_components at line 2784, avg 23µs/call
sub expect_undirected {
20813819µs my $g = shift;
208238168µs38289µs _expected('undirected') unless $g->is_undirected;
# spent 289µs making 38 calls to Graph::omniedged, avg 8µs/call
2083}
2084
2085sub expect_directed {
2086 my $g = shift;
2087 _expected('directed') unless $g->is_directed;
2088}
2089
2090sub expect_acyclic {
2091 my $g = shift;
2092 _expected('acyclic') unless $g->is_acyclic;
2093}
2094
2095sub expect_dag {
2096 my $g = shift;
2097 my @got;
2098 push @got, 'undirected' unless $g->is_directed;
2099 push @got, 'cyclic' unless $g->is_acyclic;
2100 _expected('directed acyclic', "@got") if @got;
2101}
2102
2103sub expect_multivertexed {
2104 my $g = shift;
2105 _expected('multivertexed') unless $g->is_multivertexed;
2106}
2107
2108sub expect_non_multivertexed {
2109 my $g = shift;
2110 _expected('non-multivertexed') if $g->is_multivertexed;
2111}
2112
2113
# spent 250ms (99.7+151) within Graph::expect_non_multiedged which was called 39968 times, avg 6µs/call: # 19958 times (49.1ms+75.3ms) by Graph::set_edge_attribute at line 1464, avg 6µs/call # 15003 times (37.0ms+55.4ms) by Graph::add_weighted_edge at line 1931, avg 6µs/call # 5007 times (13.6ms+19.9ms) by Graph::get_edge_attribute at line 1565, avg 7µs/call
sub expect_non_multiedged {
2114399684.79ms my $g = shift;
21153996878.3ms39968151ms _expected('non-multiedged') if $g->is_multiedged;
# spent 151ms making 39968 calls to Graph::multiedged, avg 4µs/call
2116}
2117
2118sub expect_multiedged {
2119 my $g = shift;
2120 _expected('multiedged') unless $g->is_multiedged;
2121}
2122
2123sub expect_non_unionfind {
2124 my $g = shift;
2125 _expected('non-unionfind') if $g->has_union_find;
2126}
2127
2128
# spent 1.89ms within Graph::_get_options which was called 148 times, avg 13µs/call: # 112 times (1.58ms+0s) by Graph::new at line 175, avg 14µs/call # 36 times (305µs+0s) by Graph::_root_opt at line 2327, avg 8µs/call
sub _get_options {
2129148888µs my @caller = caller(1);
2130148167µs unless (@_ == 1 && ref $_[0] eq 'ARRAY') {
2131 die "$caller[3]: internal error: should be called with only one array ref argument, at $caller[1] line $caller[2].\n";
2132 }
2133148146µs my @opt = @{ $_[0] };
2134148123µs unless (@opt % 2 == 0) {
2135 die "$caller[3]: expected an options hash, got a non-even number of arguments, at $caller[1] line $caller[2].\n";
2136 }
2137148753µs return @opt;
2138}
2139
2140###
2141# Random constructors and accessors.
2142#
2143
2144sub __fisher_yates_shuffle (@) {
2145 # From perlfaq4, but modified to be non-modifying.
2146 my @a = @_;
2147 my $i = @a;
2148 while ($i--) {
2149 my $j = int rand ($i+1);
2150 @a[$i,$j] = @a[$j,$i];
2151 }
2152 return @a;
2153}
2154
2155
# spent 10µs within Graph::BEGIN@2155 which was called: # once (10µs+0s) by Bio::Roary::OrderGenes::BEGIN@22 at line 2166
BEGIN {
2156 sub _shuffle(@);
2157 # Workaround for the Perl bug [perl #32383] where -d:Dprof and
2158 # List::Util::shuffle do not like each other: if any debugging
2159 # (-d) flags are on, fall back to our own Fisher-Yates shuffle.
2160 # The bug was fixed by perl changes #26054 and #26062, which
2161 # went to Perl 5.9.3. If someone tests this with a pre-5.9.3
2162 # bleadperl that calls itself 5.9.3 but doesn't yet have the
2163 # patches, oh, well.
2164111µs *_shuffle = $^P && $] < 5.009003 ?
2165 \&__fisher_yates_shuffle : \&List::Util::shuffle;
216618.76ms110µs}
# spent 10µs making 1 call to Graph::BEGIN@2155
2167
2168sub random_graph {
2169 my $class = (@_ % 2) == 0 ? 'Graph' : shift;
2170 my %opt = _get_options( \@_ );
2171 my $random_edge;
2172 unless (exists $opt{vertices} && defined $opt{vertices}) {
2173 require Carp;
2174 Carp::croak("Graph::random_graph: argument 'vertices' missing or undef");
2175 }
2176 if (exists $opt{random_seed}) {
2177 srand($opt{random_seed});
2178 delete $opt{random_seed};
2179 }
2180 if (exists $opt{random_edge}) {
2181 $random_edge = $opt{random_edge};
2182 delete $opt{random_edge};
2183 }
2184 my @V;
2185 if (my $ref = ref $opt{vertices}) {
2186 if ($ref eq 'ARRAY') {
2187 @V = @{ $opt{vertices} };
2188 } else {
2189 Carp::croak("Graph::random_graph: argument 'vertices' illegal");
2190 }
2191 } else {
2192 @V = 0..($opt{vertices} - 1);
2193 }
2194 delete $opt{vertices};
2195 my $V = @V;
2196 my $C = $V * ($V - 1) / 2;
2197 my $E;
2198 if (exists $opt{edges} && exists $opt{edges_fill}) {
2199 Carp::croak("Graph::random_graph: both arguments 'edges' and 'edges_fill' specified");
2200 }
2201 $E = exists $opt{edges_fill} ? $opt{edges_fill} * $C : $opt{edges};
2202 delete $opt{edges};
2203 delete $opt{edges_fill};
2204 my $g = $class->new(%opt);
2205 $g->add_vertices(@V);
2206 return $g if $V < 2;
2207 $C *= 2 if $g->directed;
2208 $E = $C / 2 unless defined $E;
2209 $E = int($E + 0.5);
2210 my $p = $E / $C;
2211 $random_edge = sub { $p } unless defined $random_edge;
2212 # print "V = $V, E = $E, C = $C, p = $p\n";
2213 if ($p > 1.0 && !($g->countedged || $g->multiedged)) {
2214 require Carp;
2215 Carp::croak("Graph::random_graph: needs to be countedged or multiedged ($E > $C)");
2216 }
2217 my @V1 = @V;
2218 my @V2 = @V;
2219 # Shuffle the vertex lists so that the pairs at
2220 # the beginning of the lists are not more likely.
2221 @V1 = _shuffle @V1;
2222 @V2 = _shuffle @V2;
2223 LOOP:
2224 while ($E) {
2225 for my $v1 (@V1) {
2226 for my $v2 (@V2) {
2227 next if $v1 eq $v2; # TODO: allow self-loops?
2228 my $q = $random_edge->($g, $v1, $v2, $p);
2229 if ($q && ($q == 1 || rand() <= $q) &&
2230 !$g->has_edge($v1, $v2)) {
2231 $g->add_edge($v1, $v2);
2232 $E--;
2233 last LOOP unless $E;
2234 }
2235 }
2236 }
2237 }
2238 return $g;
2239}
2240
2241sub random_vertex {
2242 my $g = shift;
2243 my @V = $g->vertices05;
2244 @V[rand @V];
2245}
2246
2247sub random_edge {
2248 my $g = shift;
2249 my @E = $g->edges05;
2250 @E[rand @E];
2251}
2252
2253sub random_successor {
2254 my ($g, $v) = @_;
2255 my @S = $g->successors($v);
2256 @S[rand @S];
2257}
2258
2259sub random_predecessor {
2260 my ($g, $v) = @_;
2261 my @P = $g->predecessors($v);
2262 @P[rand @P];
2263}
2264
2265###
2266# Algorithms.
2267#
2268
226913µsmy $MST_comparator = sub { ($_[0] || 0) <=> ($_[1] || 0) };
2270
2271sub _MST_attr {
2272 my $attr = shift;
2273 my $attribute =
2274 exists $attr->{attribute} ?
2275 $attr->{attribute} : $defattr;
2276 my $comparator =
2277 exists $attr->{comparator} ?
2278 $attr->{comparator} : $MST_comparator;
2279 return ($attribute, $comparator);
2280}
2281
2282sub _MST_edges {
2283 my ($g, $attr) = @_;
2284 my ($attribute, $comparator) = _MST_attr($attr);
2285 map { $_->[1] }
2286 sort { $comparator->($a->[0], $b->[0], $a->[1], $b->[1]) }
2287 map { [ $g->get_edge_attribute(@$_, $attribute), $_ ] }
2288 $g->edges05;
2289}
2290
2291sub MST_Kruskal {
2292 my ($g, %attr) = @_;
2293
2294 $g->expect_undirected;
2295
2296 my $MST = Graph::Undirected->new;
2297
2298 my $UF = Graph::UnionFind->new;
2299 for my $v ($g->vertices05) { $UF->add($v) }
2300
2301 for my $e ($g->_MST_edges(\%attr)) {
2302 my ($u, $v) = @$e; # TODO: hyperedges
2303 my $t0 = $UF->find( $u );
2304 my $t1 = $UF->find( $v );
2305 unless ($t0 eq $t1) {
2306 $UF->union($u, $v);
2307 $MST->add_edge($u, $v);
2308 }
2309 }
2310
2311 return $MST;
2312}
2313
2314
# spent 861ms (69.3+792) within Graph::_MST_add which was called 4991 times, avg 173µs/call: # 4955 times (68.2ms+759ms) by Graph::_heap_walk at line 2380, avg 167µs/call # 36 times (1.10ms+33.1ms) by Graph::_heap_walk at line 2369, avg 950µs/call
sub _MST_add {
231549914.14ms my ($g, $h, $HF, $r, $attr, $unseen) = @_;
2316499120.7ms4991332ms for my $s ( grep { exists $unseen->{ $_ } } $g->successors( $r ) ) {
# spent 332ms making 4991 calls to Graph::successors, avg 67µs/call
2317500729.1ms15021460ms $HF->add( Graph::MSTHeapElem->new( $r, $s, $g->get_edge_attribute( $r, $s, $attr ) ) );
# spent 325ms making 5007 calls to Graph::get_edge_attribute, avg 65µs/call # spent 117ms making 5007 calls to Heap071::Fibonacci::add, avg 23µs/call # spent 17.0ms making 5007 calls to Graph::MSTHeapElem::new, avg 3µs/call
2318 }
2319}
2320
2321sub _next_alphabetic { shift; (sort keys %{ $_[0] })[0] }
2322sub _next_numeric { shift; (sort { $a <=> $b } keys %{ $_[0] })[0] }
23232002230.2ms
# spent 24.5ms within Graph::_next_random which was called 10011 times, avg 2µs/call: # 9910 times (23.8ms+0s) by Graph::Traversal::next at line 298 of Graph/Traversal.pm, avg 2µs/call # 36 times (348µs+0s) by Graph::Traversal::next at line 324 of Graph/Traversal.pm, avg 10µs/call # 36 times (280µs+0s) by Graph::_heap_walk at line 2385, avg 8µs/call # 29 times (84µs+0s) by Graph::Traversal::next at line 332 of Graph/Traversal.pm, avg 3µs/call
sub _next_random { shift; (values %{ $_[0] })[ rand keys %{ $_[0] } ] }
2324
2325
# spent 13.6ms (5.68+7.92) within Graph::_root_opt which was called 36 times, avg 378µs/call: # 36 times (5.68ms+7.92ms) by Graph::_heap_walk at line 2364, avg 378µs/call
sub _root_opt {
23263616µs my $g = shift;
23273695µs36305µs my %opt = @_ == 1 ? ( first_root => $_[0] ) : _get_options( \@_ );
# spent 305µs making 36 calls to Graph::_get_options, avg 8µs/call
2328367µs my %unseen;
232936648µs367.43ms my @unseen = $g->vertices05;
# spent 7.43ms making 36 calls to Graph::vertices05, avg 206µs/call
2330362.75ms @unseen{ @unseen } = @unseen;
2331361.84ms36187µs @unseen = _shuffle @unseen;
# spent 187µs making 36 calls to List::Util::shuffle, avg 5µs/call
23323611µs my $r;
23333624µs if (exists $opt{ start }) {
2334 $opt{ first_root } = $opt{ start };
2335 $opt{ next_root } = undef;
2336 }
23373614µs if (exists $opt{ get_next_root }) {
2338 $opt{ next_root } = $opt{ get_next_root }; # Graph 0.201 compat.
2339 }
23403626µs if (exists $opt{ first_root }) {
2341 if (ref $opt{ first_root } eq 'CODE') {
2342 $r = $opt{ first_root }->( $g, \%unseen );
2343 } else {
2344 $r = $opt{ first_root };
2345 }
2346 } else {
23473630µs $r = shift @unseen;
2348 }
2349 my $next =
2350 exists $opt{ next_root } ?
2351 $opt{ next_root } :
2352 $opt{ next_alphabetic } ?
2353 \&_next_alphabetic :
23543676µs $opt{ next_numeric } ? \&_next_numeric :
2355 \&_next_random;
23563630µs my $code = ref $next eq 'CODE';
23573617µs my $attr = exists $opt{ attribute } ? $opt{ attribute } : $defattr;
235836194µs return ( \%opt, \%unseen, \@unseen, $r, $next, $code, $attr );
2359}
2360
2361
# spent 1.79s (84.6ms+1.71) within Graph::_heap_walk which was called 36 times, avg 49.8ms/call: # 36 times (84.6ms+1.71s) by Graph::MST_Prim at line 2394, avg 49.8ms/call
sub _heap_walk {
23623663µs my ($g, $h, $add, $etc) = splice @_, 0, 4; # Leave %opt in @_.
2363
236436159µs3613.6ms my ($opt, $unseenh, $unseena, $r, $next, $code, $attr) = $g->_root_opt(@_);
# spent 13.6ms making 36 calls to Graph::_root_opt, avg 378µs/call
236536197µs36189µs my $HF = Heap071::Fibonacci->new;
# spent 189µs making 36 calls to Heap071::Fibonacci::new, avg 5µs/call
2366
23673618µs while (defined $r) {
2368 # print "r = $r\n";
236936110µs3634.2ms $add->($g, $h, $HF, $r, $attr, $unseenh, $etc);
# spent 34.2ms making 36 calls to Graph::_MST_add, avg 950µs/call
23703640µs delete $unseenh->{ $r };
23713691µs36100µs while (defined $HF->top) {
# spent 100µs making 36 calls to Heap071::Fibonacci::top, avg 3µs/call
237250075.94ms5007154ms my $t = $HF->extract_top;
# spent 154ms making 5007 calls to Heap071::Fibonacci::extract_top, avg 31µs/call
2373 # use Data::Dumper; print "t = ", Dumper($t);
2374500718.3ms50088.36ms if (defined $t) {
# spent 8.01ms making 5007 calls to Heap071::Fibonacci::top, avg 2µs/call # spent 355µs making 1 call to AutoLoader::AUTOLOAD
237550079.64ms50079.05ms my ($u, $v, $w) = $t->val;
# spent 9.05ms making 5007 calls to Graph::MSTHeapElem::val, avg 2µs/call
2376 # print "extracted top: $u $v $w\n";
237750074.10ms if (exists $unseenh->{ $v }) {
237849557.57ms4955661ms $h->set_edge_attribute($u, $v, $attr, $w);
# spent 661ms making 4955 calls to Graph::set_edge_attribute, avg 133µs/call
237949553.76ms delete $unseenh->{ $v };
238049557.06ms4955827ms $add->($g, $h, $HF, $v, $attr, $unseenh, $etc);
# spent 827ms making 4955 calls to Graph::_MST_add, avg 167µs/call
2381 }
2382 }
2383 }
2384368µs return $h unless defined $next;
238536108µs36280µs $r = $code ? $next->( $g, $unseenh ) : shift @$unseena;
# spent 280µs making 36 calls to Graph::_next_random, avg 8µs/call
2386 }
2387
238836145µs return $h;
2389}
2390
2391
# spent 1.80s (686µs+1.80) within Graph::MST_Prim which was called 36 times, avg 50.0ms/call: # 36 times (686µs+1.80s) by Bio::Roary::OrderGenes::_reorder_connected_components at line 183 of lib/Bio/Roary/OrderGenes.pm, avg 50.0ms/call
sub MST_Prim {
23923619µs my $g = shift;
239336104µs36443µs $g->expect_undirected;
# spent 443µs making 36 calls to Graph::expect_undirected, avg 12µs/call
2394362.03ms1081.80s $g->_heap_walk(Graph::Undirected->new(), \&_MST_add, undef, @_);
# spent 1.79s making 36 calls to Graph::_heap_walk, avg 49.8ms/call # spent 5.67ms making 36 calls to Graph::Undirected::new, avg 158µs/call # spent 539µs making 36 calls to Heap071::Fibonacci::DESTROY, avg 15µs/call
2395}
2396
239712µs*MST_Dijkstra = \&MST_Prim;
2398
239911µs*minimum_spanning_tree = \&MST_Prim;
2400
2401###
2402# Cycle detection.
2403#
2404
240512µs*is_cyclic = \&has_a_cycle;
2406
2407sub is_acyclic {
2408 my $g = shift;
2409 return !$g->is_cyclic;
2410}
2411
2412sub is_dag {
2413 my $g = shift;
2414 return $g->is_directed && $g->is_acyclic ? 1 : 0;
2415}
2416
241712µs*is_directed_acyclic_graph = \&is_dag;
2418
2419###
2420# Backward compat.
2421#
2422
2423sub average_degree {
2424 my $g = shift;
2425 my $V = $g->vertices05;
2426
2427 return $V ? $g->degree / $V : 0;
2428}
2429
2430sub density_limits {
2431 my $g = shift;
2432
2433 my $V = $g->vertices05;
2434 my $M = $V * ($V - 1);
2435
2436 $M /= 2 if $g->is_undirected;
2437
2438 return ( 0.25 * $M, 0.75 * $M, $M );
2439}
2440
2441sub density {
2442 my $g = shift;
2443 my ($sparse, $dense, $complete) = $g->density_limits;
2444
2445 return $complete ? $g->edges / $complete : 0;
2446}
2447
2448###
2449# Attribute backward compat
2450#
2451
2452sub _attr02_012 {
2453 my ($g, $op, $ga, $va, $ea) = splice @_, 0, 5;
2454 if ($g->is_compat02) {
2455 if (@_ == 0) { return $ga->( $g ) }
2456 elsif (@_ == 1) { return $va->( $g, @_ ) }
2457 elsif (@_ == 2) { return $ea->( $g, @_ ) }
2458 else {
2459 die sprintf "$op: wrong number of arguments (%d)", scalar @_;
2460 }
2461 } else {
2462 die "$op: not a compat02 graph"
2463 }
2464}
2465
2466sub _attr02_123 {
2467 my ($g, $op, $ga, $va, $ea) = splice @_, 0, 5;
2468 if ($g->is_compat02) {
2469 if (@_ == 1) { return $ga->( $g, @_ ) }
2470 elsif (@_ == 2) { return $va->( $g, @_[1, 0] ) }
2471 elsif (@_ == 3) { return $ea->( $g, @_[1, 2, 0] ) }
2472 else {
2473 die sprintf "$op: wrong number of arguments (%d)", scalar @_;
2474 }
2475 } else {
2476 die "$op: not a compat02 graph"
2477 }
2478}
2479
2480sub _attr02_234 {
2481 my ($g, $op, $ga, $va, $ea) = splice @_, 0, 5;
2482 if ($g->is_compat02) {
2483 if (@_ == 2) { return $ga->( $g, @_ ) }
2484 elsif (@_ == 3) { return $va->( $g, @_[1, 0, 2] ) }
2485 elsif (@_ == 4) { return $ea->( $g, @_[1, 2, 0, 3] ) }
2486 else {
2487 die sprintf "$op: wrong number of arguments (%d)", scalar @_;
2488 }
2489 } else {
2490 die "$op: not a compat02 graph";
2491 }
2492}
2493
2494sub set_attribute {
2495 my $g = shift;
2496 $g->_attr02_234('set_attribute',
2497 \&Graph::set_graph_attribute,
2498 \&Graph::set_vertex_attribute,
2499 \&Graph::set_edge_attribute,
2500 @_);
2501
2502}
2503
2504sub set_attributes {
2505 my $g = shift;
2506 my $a = pop;
2507 $g->_attr02_123('set_attributes',
2508 \&Graph::set_graph_attributes,
2509 \&Graph::set_vertex_attributes,
2510 \&Graph::set_edge_attributes,
2511 $a, @_);
2512
2513}
2514
2515sub get_attribute {
2516 my $g = shift;
2517 $g->_attr02_123('get_attribute',
2518 \&Graph::get_graph_attribute,
2519 \&Graph::get_vertex_attribute,
2520 \&Graph::get_edge_attribute,
2521 @_);
2522
2523}
2524
2525sub get_attributes {
2526 my $g = shift;
2527 $g->_attr02_012('get_attributes',
2528 \&Graph::get_graph_attributes,
2529 \&Graph::get_vertex_attributes,
2530 \&Graph::get_edge_attributes,
2531 @_);
2532
2533}
2534
2535sub has_attribute {
2536 my $g = shift;
2537 return 0 unless @_;
2538 $g->_attr02_123('has_attribute',
2539 \&Graph::has_graph_attribute,
2540 \&Graph::has_vertex_attribute,
2541 \&Graph::get_edge_attribute,
2542 @_);
2543
2544}
2545
2546sub has_attributes {
2547 my $g = shift;
2548 $g->_attr02_012('has_attributes',
2549 \&Graph::has_graph_attributes,
2550 \&Graph::has_vertex_attributes,
2551 \&Graph::has_edge_attributes,
2552 @_);
2553
2554}
2555
2556sub delete_attribute {
2557 my $g = shift;
2558 $g->_attr02_123('delete_attribute',
2559 \&Graph::delete_graph_attribute,
2560 \&Graph::delete_vertex_attribute,
2561 \&Graph::delete_edge_attribute,
2562 @_);
2563
2564}
2565
2566sub delete_attributes {
2567 my $g = shift;
2568 $g->_attr02_012('delete_attributes',
2569 \&Graph::delete_graph_attributes,
2570 \&Graph::delete_vertex_attributes,
2571 \&Graph::delete_edge_attributes,
2572 @_);
2573
2574}
2575
2576###
2577# Simple DFS uses.
2578#
2579
2580sub topological_sort {
2581 my $g = shift;
2582 my %opt = _get_options( \@_ );
2583 my $eic = $opt{ empty_if_cyclic };
2584 my $hac;
2585 if ($eic) {
2586 $hac = $g->has_a_cycle;
2587 } else {
2588 $g->expect_dag;
2589 }
2590 delete $opt{ empty_if_cyclic };
2591 my $t = Graph::Traversal::DFS->new($g, %opt);
2592 my @s = $t->dfs;
2593 $hac ? () : reverse @s;
2594}
2595
259612µs*toposort = \&topological_sort;
2597
2598sub _undirected_copy_compute {
2599 my $g = shift;
2600 my $c = Graph::Undirected->new;
2601 for my $v ($g->isolated_vertices) { # TODO: if iv ...
2602 $c->add_vertex($v);
2603 }
2604 for my $e ($g->edges05) {
2605 $c->add_edge(@$e);
2606 }
2607 return $c;
2608}
2609
2610sub undirected_copy {
2611 my $g = shift;
2612 $g->expect_directed;
2613 return _check_cache($g, 'undirected', \&_undirected_copy_compute);
2614}
2615
261612µs*undirected_copy_graph = \&undirected_copy;
2617
2618sub directed_copy {
2619 my $g = shift;
2620 $g->expect_undirected;
2621 my $c = Graph::Directed->new;
2622 for my $v ($g->isolated_vertices) { # TODO: if iv ...
2623 $c->add_vertex($v);
2624 }
2625 for my $e ($g->edges05) {
2626 my @e = @$e;
2627 $c->add_edge(@e);
2628 $c->add_edge(reverse @e);
2629 }
2630 return $c;
2631}
2632
263312µs*directed_copy_graph = \&directed_copy;
2634
2635###
2636# Cache or not.
2637#
2638
263916µsmy %_cache_type =
2640 (
2641 'connectivity' => '_ccc',
2642 'strong_connectivity' => '_scc',
2643 'biconnectivity' => '_bcc',
2644 'SPT_Dijkstra' => '_spt_di',
2645 'SPT_Bellman_Ford' => '_spt_bf',
2646 'undirected' => '_undirected',
2647 );
2648
2649
# spent 1.40s (80µs+1.40) within Graph::_check_cache which was called 2 times, avg 701ms/call: # 2 times (80µs+1.40s) by Graph::_connected_components at line 2763, avg 701ms/call
sub _check_cache {
265025µs my ($g, $type, $code) = splice @_, 0, 3;
265123µs my $c = $_cache_type{$type};
265222µs if (defined $c) {
2653214µs252µs my $a = $g->get_graph_attribute($c);
# spent 52µs making 2 calls to Graph::Attribute::get_attribute, avg 26µs/call
265421µs unless (defined $a && $a->[ 0 ] == $g->[ _G ]) {
265523µs $a->[ 0 ] = $g->[ _G ];
265629µs21.40s $a->[ 1 ] = $code->( $g, @_ );
# spent 1.40s making 2 calls to Graph::_connected_components_compute, avg 701ms/call
2657223µs263µs $g->set_graph_attribute($c, $a);
# spent 63µs making 2 calls to Graph::Attribute::set_attribute, avg 32µs/call
2658 }
2659212µs return $a->[ 1 ];
2660 } else {
2661 Carp::croak("Graph: unknown cache type '$type'");
2662 }
2663}
2664
2665sub _clear_cache {
2666 my ($g, $type) = @_;
2667 my $c = $_cache_type{$type};
2668 if (defined $c) {
2669 $g->delete_graph_attribute($c);
2670 } else {
2671 Carp::croak("Graph: unknown cache type '$type'");
2672 }
2673}
2674
2675sub connectivity_clear_cache {
2676 my $g = shift;
2677 _clear_cache($g, 'connectivity');
2678}
2679
2680sub strong_connectivity_clear_cache {
2681 my $g = shift;
2682 _clear_cache($g, 'strong_connectivity');
2683}
2684
2685sub biconnectivity_clear_cache {
2686 my $g = shift;
2687 _clear_cache($g, 'biconnectivity');
2688}
2689
2690sub SPT_Dijkstra_clear_cache {
2691 my $g = shift;
2692 _clear_cache($g, 'SPT_Dijkstra');
2693 $g->delete_graph_attribute('SPT_Dijkstra_first_root');
2694}
2695
2696sub SPT_Bellman_Ford_clear_cache {
2697 my $g = shift;
2698 _clear_cache($g, 'SPT_Bellman_Ford');
2699}
2700
2701sub undirected_copy_clear_cache {
2702 my $g = shift;
2703 _clear_cache($g, 'undirected_copy');
2704}
2705
2706###
2707# Connected components.
2708#
2709
2710
# spent 1.40s (25.5ms+1.38) within Graph::_connected_components_compute which was called 2 times, avg 701ms/call: # 2 times (25.5ms+1.38s) by Graph::_check_cache at line 2656, avg 701ms/call
sub _connected_components_compute {
271121µs my $g = shift;
27122600ns my %cce;
27132500ns my %cci;
27142600ns my $cc = 0;
2715210µs27µs if ($g->has_union_find) {
# spent 7µs making 2 calls to Graph::has_union_find, avg 3µs/call
2716 my $UF = $g->_get_union_find();
2717 my $V = $g->[ _V ];
2718 my %icce; # Isolated vertices.
2719 my %icci;
2720 my $icc = 0;
2721 for my $v ( $g->unique_vertices ) {
2722 $cc = $UF->find( $V->_get_path_id( $v ) );
2723 if (defined $cc) {
2724 $cce{ $v } = $cc;
2725 push @{ $cci{ $cc } }, $v;
2726 } else {
2727 $icce{ $v } = $icc;
2728 push @{ $icci{ $icc } }, $v;
2729 $icc++;
2730 }
2731 }
2732 if ($icc) {
2733 @cce{ keys %icce } = values %icce;
2734 @cci{ keys %icci } = values %icci;
2735 }
2736 } else {
27372506µs212.1ms my @u = $g->unique_vertices;
# spent 12.1ms making 2 calls to Graph::unique_vertices, avg 6.05ms/call
273844.15ms my %r; @r{ @u } = @u;
2739
# spent 16µs within Graph::__ANON__[/Users/ap13/perl5/lib/perl5/Graph.pm:2741] which was called 2 times, avg 8µs/call: # 2 times (16µs+0s) by Graph::Traversal::next at line 324 of Graph/Traversal.pm, avg 8µs/call
my $froot = sub {
2740219µs (each %r)[1];
2741222µs };
2742
# spent 184µs within Graph::__ANON__[/Users/ap13/perl5/lib/perl5/Graph.pm:2745] which was called 36 times, avg 5µs/call: # 36 times (184µs+0s) by Graph::Traversal::next at line 332 of Graph/Traversal.pm, avg 5µs/call
my $nroot = sub {
27433627µs $cc++ if keys %r;
274436189µs (each %r)[1];
2745214µs };
2746 my $t = Graph::Traversal::DFS->new($g,
2747 first_root => $froot,
2748 next_root => $nroot,
2749
# spent 18.7ms within Graph::__ANON__[/Users/ap13/perl5/lib/perl5/Graph.pm:2754] which was called 4991 times, avg 4µs/call: # 4991 times (18.7ms+0s) by Graph::Traversal::visit at line 193 of Graph/Traversal.pm, avg 4µs/call
pre => sub {
275049912.02ms my ($v, $t) = @_;
275149913.90ms $cce{ $v } = $cc;
275249912.50ms push @{ $cci{ $cc } }, $v;
2753499112.2ms delete $r{ $v };
2754 },
2755276µs218.6ms @_);
# spent 18.6ms making 2 calls to Graph::Traversal::new, avg 9.32ms/call
2756220.7ms21.35s $t->dfs;
# spent 1.35s making 2 calls to Graph::Traversal::postorder, avg 673ms/call
2757 }
2758229µs return [ \%cce, \%cci ];
2759}
2760
2761
# spent 1.40s (30µs+1.40) within Graph::_connected_components which was called 2 times, avg 701ms/call: # 2 times (30µs+1.40s) by Graph::connected_components at line 2785, avg 701ms/call
sub _connected_components {
276222µs my $g = shift;
2763217µs21.40s my $ccc = _check_cache($g, 'connectivity',
# spent 1.40s making 2 calls to Graph::_check_cache, avg 701ms/call
2764 \&_connected_components_compute, @_);
2765212µs return @{ $ccc };
2766}
2767
2768sub connected_component_by_vertex {
2769 my ($g, $v) = @_;
2770 $g->expect_undirected;
2771 my ($CCE, $CCI) = $g->_connected_components();
2772 return $CCE->{ $v };
2773}
2774
2775sub connected_component_by_index {
2776 my ($g, $i) = @_;
2777 $g->expect_undirected;
2778 my ($CCE, $CCI) = $g->_connected_components();
2779 return defined $CCI->{ $i } ? @{ $CCI->{ $i } } : ( );
2780}
2781
2782
# spent 1.40s (61µs+1.40) within Graph::connected_components which was called 2 times, avg 701ms/call: # once (21µs+1.37s) by Bio::Roary::OrderGenes::_build_groups_to_contigs at line 232 of lib/Bio/Roary/OrderGenes.pm # once (39µs+34.7ms) by Bio::Roary::OrderGenes::_build_groups_to_contigs at line 213 of lib/Bio/Roary/OrderGenes.pm
sub connected_components {
278322µs my $g = shift;
278426µs246µs $g->expect_undirected;
# spent 46µs making 2 calls to Graph::expect_undirected, avg 23µs/call
2785211µs21.40s my ($CCE, $CCI) = $g->_connected_components();
# spent 1.40s making 2 calls to Graph::_connected_components, avg 701ms/call
2786231µs return values %{ $CCI };
2787}
2788
2789sub same_connected_components {
2790 my $g = shift;
2791 $g->expect_undirected;
2792 if ($g->has_union_find) {
2793 my $UF = $g->_get_union_find();
2794 my $V = $g->[ _V ];
2795 my $u = shift;
2796 my $c = $UF->find( $V->_get_path_id ( $u ) );
2797 my $d;
2798 for my $v ( @_) {
2799 return 0
2800 unless defined($d = $UF->find( $V->_get_path_id( $v ) )) &&
2801 $d eq $c;
2802 }
2803 return 1;
2804 } else {
2805 my ($CCE, $CCI) = $g->_connected_components();
2806 my $u = shift;
2807 my $c = $CCE->{ $u };
2808 for my $v ( @_ ) {
2809 return 0
2810 unless defined $CCE->{ $v } &&
2811 $CCE->{ $v } eq $c;
2812 }
2813 return 1;
2814 }
2815}
2816
281712µsmy $super_component = sub { join("+", sort @_) };
2818
2819sub connected_graph {
2820 my ($g, %opt) = @_;
2821 $g->expect_undirected;
2822 my $cg = Graph->new(undirected => 1);
2823 if ($g->has_union_find && $g->vertices == 1) {
2824 # TODO: super_component?
2825 $cg->add_vertices($g->vertices);
2826 } else {
2827 my $sc_cb =
2828 exists $opt{super_component} ?
2829 $opt{super_component} : $super_component;
2830 for my $cc ( $g->connected_components() ) {
2831 my $sc = $sc_cb->(@$cc);
2832 $cg->add_vertex($sc);
2833 $cg->set_vertex_attribute($sc, 'subvertices', [ @$cc ]);
2834 }
2835 }
2836 return $cg;
2837}
2838
2839sub is_connected {
2840 my $g = shift;
2841 $g->expect_undirected;
2842 my ($CCE, $CCI) = $g->_connected_components();
2843 return keys %{ $CCI } == 1;
2844}
2845
2846sub is_weakly_connected {
2847 my $g = shift;
2848 $g->expect_directed;
2849 $g->undirected_copy->is_connected(@_);
2850}
2851
285212µs*weakly_connected = \&is_weakly_connected;
2853
2854sub weakly_connected_components {
2855 my $g = shift;
2856 $g->expect_directed;
2857 $g->undirected_copy->connected_components(@_);
2858}
2859
2860sub weakly_connected_component_by_vertex {
2861 my $g = shift;
2862 $g->expect_directed;
2863 $g->undirected_copy->connected_component_by_vertex(@_);
2864}
2865
2866sub weakly_connected_component_by_index {
2867 my $g = shift;
2868 $g->expect_directed;
2869 $g->undirected_copy->connected_component_by_index(@_);
2870}
2871
2872sub same_weakly_connected_components {
2873 my $g = shift;
2874 $g->expect_directed;
2875 $g->undirected_copy->same_connected_components(@_);
2876}
2877
2878sub weakly_connected_graph {
2879 my $g = shift;
2880 $g->expect_directed;
2881 $g->undirected_copy->connected_graph(@_);
2882}
2883
2884sub _strongly_connected_components_compute {
2885 my $g = shift;
2886 my $t = Graph::Traversal::DFS->new($g);
2887 my @d = reverse $t->dfs;
2888 my @c;
2889 my $h = $g->transpose_graph;
2890 my $u =
2891 Graph::Traversal::DFS->new($h,
2892 next_root => sub {
2893 my ($t, $u) = @_;
2894 my $root;
2895 while (defined($root = shift @d)) {
2896 last if exists $u->{ $root };
2897 }
2898 if (defined $root) {
2899 push @c, [];
2900 return $root;
2901 } else {
2902 return;
2903 }
2904 },
2905 pre => sub {
2906 my ($v, $t) = @_;
2907 push @{ $c[-1] }, $v;
2908 },
2909 @_);
2910 $u->dfs;
2911 return \@c;
2912}
2913
2914sub _strongly_connected_components {
2915 my $g = shift;
2916 my $type = 'strong_connectivity';
2917 my $scc = _check_cache($g, $type,
2918 \&_strongly_connected_components_compute, @_);
2919 return defined $scc ? @$scc : ( );
2920}
2921
2922sub strongly_connected_components {
2923 my $g = shift;
2924 $g->expect_directed;
2925 $g->_strongly_connected_components(@_);
2926}
2927
2928sub strongly_connected_component_by_vertex {
2929 my $g = shift;
2930 my $v = shift;
2931 $g->expect_directed;
2932 my @scc = $g->_strongly_connected_components( next_alphabetic => 1, @_ );
2933 for (my $i = 0; $i <= $#scc; $i++) {
2934 for (my $j = 0; $j <= $#{ $scc[$i] }; $j++) {
2935 return $i if $scc[$i]->[$j] eq $v;
2936 }
2937 }
2938 return;
2939}
2940
2941sub strongly_connected_component_by_index {
2942 my $g = shift;
2943 my $i = shift;
2944 $g->expect_directed;
2945 my $c = ( $g->_strongly_connected_components(@_) )[ $i ];
2946 return defined $c ? @{ $c } : ();
2947}
2948
2949sub same_strongly_connected_components {
2950 my $g = shift;
2951 $g->expect_directed;
2952 my @scc = $g->_strongly_connected_components( next_alphabetic => 1, @_ );
2953 my @i;
2954 while (@_) {
2955 my $v = shift;
2956 for (my $i = 0; $i <= $#scc; $i++) {
2957 for (my $j = 0; $j <= $#{ $scc[$i] }; $j++) {
2958 if ($scc[$i]->[$j] eq $v) {
2959 push @i, $i;
2960 return 0 if @i > 1 && $i[-1] ne $i[0];
2961 }
2962 }
2963 }
2964 }
2965 return 1;
2966}
2967
2968sub is_strongly_connected {
2969 my $g = shift;
2970 $g->expect_directed;
2971 my $t = Graph::Traversal::DFS->new($g);
2972 my @d = reverse $t->dfs;
2973 my @c;
2974 my $h = $g->transpose;
2975 my $u =
2976 Graph::Traversal::DFS->new($h,
2977 next_root => sub {
2978 my ($t, $u) = @_;
2979 my $root;
2980 while (defined($root = shift @d)) {
2981 last if exists $u->{ $root };
2982 }
2983 if (defined $root) {
2984 unless (@{ $t->{ roots } }) {
2985 push @c, [];
2986 return $root;
2987 } else {
2988 $t->terminate;
2989 return;
2990 }
2991 } else {
2992 return;
2993 }
2994 },
2995 pre => sub {
2996 my ($v, $t) = @_;
2997 push @{ $c[-1] }, $v;
2998 },
2999 @_);
3000 $u->dfs;
3001 return @{ $u->{ roots } } == 1 && keys %{ $u->{ unseen } } == 0;
3002}
3003
300412µs*strongly_connected = \&is_strongly_connected;
3005
3006sub strongly_connected_graph {
3007 my $g = shift;
3008 my %attr = @_;
3009
3010 $g->expect_directed;
3011
3012 my $t = Graph::Traversal::DFS->new($g);
3013 my @d = reverse $t->dfs;
3014 my @c;
3015 my $h = $g->transpose;
3016 my $u =
3017 Graph::Traversal::DFS->new($h,
3018 next_root => sub {
3019 my ($t, $u) = @_;
3020 my $root;
3021 while (defined($root = shift @d)) {
3022 last if exists $u->{ $root };
3023 }
3024 if (defined $root) {
3025 push @c, [];
3026 return $root;
3027 } else {
3028 return;
3029 }
3030 },
3031 pre => sub {
3032 my ($v, $t) = @_;
3033 push @{ $c[-1] }, $v;
3034 }
3035 );
3036
3037 $u->dfs;
3038
3039 my $sc_cb;
3040 my $hv_cb;
3041
3042 _opt_get(\%attr, super_component => \$sc_cb);
3043 _opt_get(\%attr, hypervertex => \$hv_cb);
3044 _opt_unknown(\%attr);
3045
3046 if (defined $hv_cb && !defined $sc_cb) {
3047 $sc_cb = sub { $hv_cb->( [ @_ ] ) };
3048 }
3049 unless (defined $sc_cb) {
3050 $sc_cb = $super_component;
3051 }
3052
3053 my $s = Graph->new;
3054
3055 my %c;
3056 my @s;
3057 for (my $i = 0; $i < @c; $i++) {
3058 my $c = $c[$i];
3059 $s->add_vertex( $s[$i] = $sc_cb->(@$c) );
3060 $s->set_vertex_attribute($s[$i], 'subvertices', [ @$c ]);
3061 for my $v (@$c) {
3062 $c{$v} = $i;
3063 }
3064 }
3065
3066 my $n = @c;
3067 for my $v ($g->vertices) {
3068 unless (exists $c{$v}) {
3069 $c{$v} = $n;
3070 $s[$n] = $v;
3071 $n++;
3072 }
3073 }
3074
3075 for my $e ($g->edges05) {
3076 my ($u, $v) = @$e; # @TODO: hyperedges
3077 unless ($c{$u} == $c{$v}) {
3078 my ($p, $q) = ( $s[ $c{ $u } ], $s[ $c{ $v } ] );
3079 $s->add_edge($p, $q) unless $s->has_edge($p, $q);
3080 }
3081 }
3082
3083 if (my @i = $g->isolated_vertices) {
3084 $s->add_vertices(map { $s[ $c{ $_ } ] } @i);
3085 }
3086
3087 return $s;
3088}
3089
3090###
3091# Biconnectivity.
3092#
3093
3094sub _biconnectivity_out {
3095 my ($state, $u, $v) = @_;
3096 if (exists $state->{stack}) {
3097 my @BC;
3098 while (@{$state->{stack}}) {
3099 my $e = pop @{$state->{stack}};
3100 push @BC, $e;
3101 last if defined $u && $e->[0] eq $u && $e->[1] eq $v;
3102 }
3103 if (@BC) {
3104 push @{$state->{BC}}, \@BC;
3105 }
3106 }
3107}
3108
3109sub _biconnectivity_dfs {
3110 my ($g, $u, $state) = @_;
3111 $state->{num}->{$u} = $state->{dfs}++;
3112 $state->{low}->{$u} = $state->{num}->{$u};
3113 for my $v ($g->successors($u)) {
3114 unless (exists $state->{num}->{$v}) {
3115 push @{$state->{stack}}, [$u, $v];
3116 $state->{pred}->{$v} = $u;
3117 $state->{succ}->{$u}->{$v}++;
3118 _biconnectivity_dfs($g, $v, $state);
3119 if ($state->{low}->{$v} < $state->{low}->{$u}) {
3120 $state->{low}->{$u} = $state->{low}->{$v};
3121 }
3122 if ($state->{low}->{$v} >= $state->{num}->{$u}) {
3123 _biconnectivity_out($state, $u, $v);
3124 }
3125 } elsif (defined $state->{pred}->{$u} &&
3126 $state->{pred}->{$u} ne $v &&
3127 $state->{num}->{$v} < $state->{num}->{$u}) {
3128 push @{$state->{stack}}, [$u, $v];
3129 if ($state->{num}->{$v} < $state->{low}->{$u}) {
3130 $state->{low}->{$u} = $state->{num}->{$v};
3131 }
3132 }
3133 }
3134}
3135
3136sub _biconnectivity_compute {
3137 my ($g) = @_;
3138 my %state;
3139 @{$state{BC}} = ();
3140 @{$state{BR}} = ();
3141 %{$state{V2BC}} = ();
3142 %{$state{BC2V}} = ();
3143 @{$state{AP}} = ();
3144 $state{dfs} = 0;
3145 my @u = _shuffle $g->vertices;
3146 for my $u (@u) {
3147 unless (exists $state{num}->{$u}) {
3148 _biconnectivity_dfs($g, $u, \%state);
3149 _biconnectivity_out(\%state);
3150 delete $state{stack};
3151 }
3152 }
3153
3154 # Mark the components each vertex belongs to.
3155 my $bci = 0;
3156 for my $bc (@{$state{BC}}) {
3157 for my $e (@$bc) {
3158 for my $v (@$e) {
3159 $state{V2BC}->{$v}->{$bci}++;
3160 }
3161 }
3162 $bci++;
3163 }
3164
3165 # Any isolated vertices get each their own component.
3166 for my $v ($g->vertices) {
3167 unless (exists $state{V2BC}->{$v}) {
3168 $state{V2BC}->{$v}->{$bci++}++;
3169 }
3170 }
3171
3172 for my $v ($g->vertices) {
3173 for my $bc (keys %{$state{V2BC}->{$v}}) {
3174 $state{BC2V}->{$bc}->{$v}->{$bc}++;
3175 }
3176 }
3177
3178 # Articulation points / cut vertices are the vertices
3179 # which belong to more than one component.
3180 for my $v (keys %{$state{V2BC}}) {
3181 if (keys %{$state{V2BC}->{$v}} > 1) {
3182 push @{$state{AP}}, $v;
3183 }
3184 }
3185
3186 # Bridges / cut edges are the components of two vertices.
3187 for my $v (keys %{$state{BC2V}}) {
3188 my @v = keys %{$state{BC2V}->{$v}};
3189 if (@v == 2) {
3190 push @{$state{BR}}, \@v;
3191 }
3192 }
3193
3194 # Create the subgraph components.
3195 my @sg;
3196 for my $bc (@{$state{BC}}) {
3197 my %v;
3198 my $w = Graph::Undirected->new();
3199 for my $e (@$bc) {
3200 my ($u, $v) = @$e;
3201 $v{$u}++;
3202 $v{$v}++;
3203 $w->add_edge($u, $v);
3204 }
3205 push @sg, [ keys %v ];
3206 }
3207
3208 return [ $state{AP}, \@sg, $state{BR}, $state{V2BC}, ];
3209}
3210
3211sub biconnectivity {
3212 my $g = shift;
3213 $g->expect_undirected;
3214 my $bcc = _check_cache($g, 'biconnectivity',
3215 \&_biconnectivity_compute, @_);
3216 return defined $bcc ? @$bcc : ( );
3217}
3218
3219sub is_biconnected {
3220 my $g = shift;
3221 my ($ap) = ($g->biconnectivity(@_))[0];
3222 return $g->edges >= 2 ? @$ap == 0 : undef ;
3223}
3224
3225sub is_edge_connected {
3226 my $g = shift;
3227 my ($br) = ($g->biconnectivity(@_))[2];
3228 return $g->edges >= 2 ? @$br == 0 : undef;
3229}
3230
3231sub is_edge_separable {
3232 my $g = shift;
3233 my ($br) = ($g->biconnectivity(@_))[2];
3234 return $g->edges >= 2 ? @$br > 0 : undef;
3235}
3236
3237sub articulation_points {
3238 my $g = shift;
3239 my ($ap) = ($g->biconnectivity(@_))[0];
3240 return @$ap;
3241}
3242
324312µs*cut_vertices = \&articulation_points;
3244
3245sub biconnected_components {
3246 my $g = shift;
3247 my ($bc) = ($g->biconnectivity(@_))[1];
3248 return @$bc;
3249}
3250
3251sub biconnected_component_by_index {
3252 my $g = shift;
3253 my $i = shift;
3254 my ($bc) = ($g->biconnectivity(@_))[1];
3255 return $bc->[ $i ];
3256}
3257
3258sub biconnected_component_by_vertex {
3259 my $g = shift;
3260 my $v = shift;
3261 my ($v2bc) = ($g->biconnectivity(@_))[3];
3262 return defined $v2bc->{ $v } ? keys %{ $v2bc->{ $v } } : ();
3263}
3264
3265sub same_biconnected_components {
3266 my $g = shift;
3267 my $u = shift;
3268 my @u = $g->biconnected_component_by_vertex($u, @_);
3269 return 0 unless @u;
3270 my %ubc; @ubc{ @u } = ();
3271 while (@_) {
3272 my $v = shift;
3273 my @v = $g->biconnected_component_by_vertex($v);
3274 if (@v) {
3275 my %vbc; @vbc{ @v } = ();
3276 my $vi;
3277 for my $ui (keys %ubc) {
3278 if (exists $vbc{ $ui }) {
3279 $vi = $ui;
3280 last;
3281 }
3282 }
3283 return 0 unless defined $vi;
3284 }
3285 }
3286 return 1;
3287}
3288
3289sub biconnected_graph {
3290 my ($g, %opt) = @_;
3291 my ($bc, $v2bc) = ($g->biconnectivity, %opt)[1, 3];
3292 my $bcg = Graph::Undirected->new;
3293 my $sc_cb =
3294 exists $opt{super_component} ?
3295 $opt{super_component} : $super_component;
3296 for my $c (@$bc) {
3297 $bcg->add_vertex(my $s = $sc_cb->(@$c));
3298 $bcg->set_vertex_attribute($s, 'subvertices', [ @$c ]);
3299 }
3300 my %k;
3301 for my $i (0..$#$bc) {
3302 my @u = @{ $bc->[ $i ] };
3303 my %i; @i{ @u } = ();
3304 for my $j (0..$#$bc) {
3305 if ($i > $j) {
3306 my @v = @{ $bc->[ $j ] };
3307 my %j; @j{ @v } = ();
3308 for my $u (@u) {
3309 if (exists $j{ $u }) {
3310 unless ($k{ $i }{ $j }++) {
3311 $bcg->add_edge($sc_cb->(@{$bc->[$i]}),
3312 $sc_cb->(@{$bc->[$j]}));
3313 }
3314 last;
3315 }
3316 }
3317 }
3318 }
3319 }
3320 return $bcg;
3321}
3322
3323sub bridges {
3324 my $g = shift;
3325 my ($br) = ($g->biconnectivity(@_))[2];
3326 return defined $br ? @$br : ();
3327}
3328
3329###
3330# SPT.
3331#
3332
3333sub _SPT_add {
3334 my ($g, $h, $HF, $r, $attr, $unseen, $etc) = @_;
3335 my $etc_r = $etc->{ $r } || 0;
3336 for my $s ( grep { exists $unseen->{ $_ } } $g->successors( $r ) ) {
3337 my $t = $g->get_edge_attribute( $r, $s, $attr );
3338 $t = 1 unless defined $t;
3339 if ($t < 0) {
3340 require Carp;
3341 Carp::croak("Graph::SPT_Dijkstra: edge $r-$s is negative ($t)");
3342 }
3343 if (!defined($etc->{ $s }) || ($etc_r + $t) < $etc->{ $s }) {
3344 my $etc_s = $etc->{ $s } || 0;
3345 $etc->{ $s } = $etc_r + $t;
3346 # print "$r - $s : setting $s to $etc->{ $s } ($etc_r, $etc_s)\n";
3347 $h->set_vertex_attribute( $s, $attr, $etc->{ $s });
3348 $h->set_vertex_attribute( $s, 'p', $r );
3349 $HF->add( Graph::SPTHeapElem->new($r, $s, $etc->{ $s }) );
3350 }
3351 }
3352}
3353
3354sub _SPT_Dijkstra_compute {
3355}
3356
3357sub SPT_Dijkstra {
3358 my $g = shift;
3359 my %opt = @_ == 1 ? (first_root => $_[0]) : @_;
3360 my $first_root = $opt{ first_root };
3361 unless (defined $first_root) {
3362 $opt{ first_root } = $first_root = $g->random_vertex();
3363 }
3364 my $spt_di = $g->get_graph_attribute('_spt_di');
3365 unless (defined $spt_di && exists $spt_di->{ $first_root } && $spt_di->{ $first_root }->[ 0 ] == $g->[ _G ]) {
3366 my %etc;
3367 my $sptg = $g->_heap_walk($g->new, \&_SPT_add, \%etc, %opt);
3368 $spt_di->{ $first_root } = [ $g->[ _G ], $sptg ];
3369 $g->set_graph_attribute('_spt_di', $spt_di);
3370 }
3371
3372 my $spt = $spt_di->{ $first_root }->[ 1 ];
3373
3374 $spt->set_graph_attribute('SPT_Dijkstra_root', $first_root);
3375
3376 return $spt;
3377}
3378
337912µs*SSSP_Dijkstra = \&SPT_Dijkstra;
3380
338111µs*single_source_shortest_paths = \&SPT_Dijkstra;
3382
3383sub SP_Dijkstra {
3384 my ($g, $u, $v) = @_;
3385 my $sptg = $g->SPT_Dijkstra(first_root => $u);
3386 my @path = ($v);
3387 my %seen;
3388 my $V = $g->vertices;
3389 my $p;
3390 while (defined($p = $sptg->get_vertex_attribute($v, 'p'))) {
3391 last if exists $seen{$p};
3392 push @path, $p;
3393 $v = $p;
3394 $seen{$p}++;
3395 last if keys %seen == $V || $u eq $v;
3396 }
3397 @path = () if @path && $path[-1] ne $u;
3398 return reverse @path;
3399}
3400
3401sub __SPT_Bellman_Ford {
3402 my ($g, $u, $v, $attr, $d, $p, $c0, $c1) = @_;
3403 return unless $c0->{ $u };
3404 my $w = $g->get_edge_attribute($u, $v, $attr);
3405 $w = 1 unless defined $w;
3406 if (defined $d->{ $v }) {
3407 if (defined $d->{ $u }) {
3408 if ($d->{ $v } > $d->{ $u } + $w) {
3409 $d->{ $v } = $d->{ $u } + $w;
3410 $p->{ $v } = $u;
3411 $c1->{ $v }++;
3412 }
3413 } # else !defined $d->{ $u } && defined $d->{ $v }
3414 } else {
3415 if (defined $d->{ $u }) {
3416 # defined $d->{ $u } && !defined $d->{ $v }
3417 $d->{ $v } = $d->{ $u } + $w;
3418 $p->{ $v } = $u;
3419 $c1->{ $v }++;
3420 } # else !defined $d->{ $u } && !defined $d->{ $v }
3421 }
3422}
3423
3424sub _SPT_Bellman_Ford {
3425 my ($g, $opt, $unseenh, $unseena, $r, $next, $code, $attr) = @_;
3426 my %d;
3427 return unless defined $r;
3428 $d{ $r } = 0;
3429 my %p;
3430 my $V = $g->vertices;
3431 my %c0; # Changed during the last iteration?
3432 $c0{ $r }++;
3433 for (my $i = 0; $i < $V; $i++) {
3434 my %c1;
3435 for my $e ($g->edges) {
3436 my ($u, $v) = @$e;
3437 __SPT_Bellman_Ford($g, $u, $v, $attr, \%d, \%p, \%c0, \%c1);
3438 if ($g->undirected) {
3439 __SPT_Bellman_Ford($g, $v, $u, $attr, \%d, \%p, \%c0, \%c1);
3440 }
3441 }
3442 %c0 = %c1 unless $i == $V - 1;
3443 }
3444
3445 for my $e ($g->edges) {
3446 my ($u, $v) = @$e;
3447 if (defined $d{ $u } && defined $d{ $v }) {
3448 my $d = $g->get_edge_attribute($u, $v, $attr);
3449 if (defined $d && $d{ $v } > $d{ $u } + $d) {
3450 require Carp;
3451 Carp::croak("Graph::SPT_Bellman_Ford: negative cycle exists");
3452 }
3453 }
3454 }
3455
3456 return (\%p, \%d);
3457}
3458
3459sub _SPT_Bellman_Ford_compute {
3460}
3461
3462sub SPT_Bellman_Ford {
3463 my $g = shift;
3464
3465 my ($opt, $unseenh, $unseena, $r, $next, $code, $attr) = $g->_root_opt(@_);
3466
3467 unless (defined $r) {
3468 $r = $g->random_vertex();
3469 return unless defined $r;
3470 }
3471
3472 my $spt_bf = $g->get_graph_attribute('_spt_bf');
3473 unless (defined $spt_bf &&
3474 exists $spt_bf->{ $r } && $spt_bf->{ $r }->[ 0 ] == $g->[ _G ]) {
3475 my ($p, $d) =
3476 $g->_SPT_Bellman_Ford($opt, $unseenh, $unseena,
3477 $r, $next, $code, $attr);
3478 my $h = $g->new;
3479 for my $v (keys %$p) {
3480 my $u = $p->{ $v };
3481 $h->add_edge( $u, $v );
3482 $h->set_edge_attribute( $u, $v, $attr,
3483 $g->get_edge_attribute($u, $v, $attr));
3484 $h->set_vertex_attribute( $v, $attr, $d->{ $v } );
3485 $h->set_vertex_attribute( $v, 'p', $u );
3486 }
3487 $spt_bf->{ $r } = [ $g->[ _G ], $h ];
3488 $g->set_graph_attribute('_spt_bf', $spt_bf);
3489 }
3490
3491 my $spt = $spt_bf->{ $r }->[ 1 ];
3492
3493 $spt->set_graph_attribute('SPT_Bellman_Ford_root', $r);
3494
3495 return $spt;
3496}
3497
349812µs*SSSP_Bellman_Ford = \&SPT_Bellman_Ford;
3499
3500sub SP_Bellman_Ford {
3501 my ($g, $u, $v) = @_;
3502 my $sptg = $g->SPT_Bellman_Ford(first_root => $u);
3503 my @path = ($v);
3504 my %seen;
3505 my $V = $g->vertices;
3506 my $p;
3507 while (defined($p = $sptg->get_vertex_attribute($v, 'p'))) {
3508 last if exists $seen{$p};
3509 push @path, $p;
3510 $v = $p;
3511 $seen{$p}++;
3512 last if keys %seen == $V;
3513 }
3514 # @path = () if @path && "$path[-1]" ne "$u";
3515 return reverse @path;
3516}
3517
3518###
3519# Transitive Closure.
3520#
3521
3522sub TransitiveClosure_Floyd_Warshall {
3523 my $self = shift;
3524 my $class = ref $self || $self;
3525 $self = shift unless ref $self;
3526 bless Graph::TransitiveClosure->new($self, @_), $class;
3527}
3528
352912µs*transitive_closure = \&TransitiveClosure_Floyd_Warshall;
3530
3531sub APSP_Floyd_Warshall {
3532 my $self = shift;
3533 my $class = ref $self || $self;
3534 $self = shift unless ref $self;
3535 bless Graph::TransitiveClosure->new($self, path => 1, @_), $class;
3536}
3537
353812µs*all_pairs_shortest_paths = \&APSP_Floyd_Warshall;
3539
3540sub _transitive_closure_matrix_compute {
3541}
3542
3543sub transitive_closure_matrix {
3544 my $g = shift;
3545 my $tcm = $g->get_graph_attribute('_tcm');
3546 if (defined $tcm) {
3547 if (ref $tcm eq 'ARRAY') { # YECHHH!
3548 if ($tcm->[ 0 ] == $g->[ _G ]) {
3549 $tcm = $tcm->[ 1 ];
3550 } else {
3551 undef $tcm;
3552 }
3553 }
3554 }
3555 unless (defined $tcm) {
3556 my $apsp = $g->APSP_Floyd_Warshall(@_);
3557 $tcm = $apsp->get_graph_attribute('_tcm');
3558 $g->set_graph_attribute('_tcm', [ $g->[ _G ], $tcm ]);
3559 }
3560
3561 return $tcm;
3562}
3563
3564sub path_length {
3565 my $g = shift;
3566 my $tcm = $g->transitive_closure_matrix;
3567 $tcm->path_length(@_);
3568}
3569
3570sub path_predecessor {
3571 my $g = shift;
3572 my $tcm = $g->transitive_closure_matrix;
3573 $tcm->path_predecessor(@_);
3574}
3575
3576sub path_vertices {
3577 my $g = shift;
3578 my $tcm = $g->transitive_closure_matrix;
3579 $tcm->path_vertices(@_);
3580}
3581
3582sub is_reachable {
3583 my $g = shift;
3584 my $tcm = $g->transitive_closure_matrix;
3585 $tcm->is_reachable(@_);
3586}
3587
3588sub for_shortest_paths {
3589 my $g = shift;
3590 my $c = shift;
3591 my $t = $g->transitive_closure_matrix;
3592 my @v = $g->vertices;
3593 my $n = 0;
3594 for my $u (@v) {
3595 for my $v (@v) {
3596 next unless $t->is_reachable($u, $v);
3597 $n++;
3598 $c->($t, $u, $v, $n);
3599 }
3600 }
3601 return $n;
3602}
3603
3604sub _minmax_path {
3605 my $g = shift;
3606 my $min;
3607 my $max;
3608 my $minp;
3609 my $maxp;
3610 $g->for_shortest_paths(sub {
3611 my ($t, $u, $v, $n) = @_;
3612 my $l = $t->path_length($u, $v);
3613 return unless defined $l;
3614 my $p;
3615 if ($u ne $v && (!defined $max || $l > $max)) {
3616 $max = $l;
3617 $maxp = $p = [ $t->path_vertices($u, $v) ];
3618 }
3619 if ($u ne $v && (!defined $min || $l < $min)) {
3620 $min = $l;
3621 $minp = $p || [ $t->path_vertices($u, $v) ];
3622 }
3623 });
3624 return ($min, $max, $minp, $maxp);
3625}
3626
3627sub diameter {
3628 my $g = shift;
3629 my ($min, $max, $minp, $maxp) = $g->_minmax_path(@_);
3630 return defined $maxp ? (wantarray ? @$maxp : $max) : undef;
3631}
3632
363312µs*graph_diameter = \&diameter;
3634
3635sub longest_path {
3636 my ($g, $u, $v) = @_;
3637 my $t = $g->transitive_closure_matrix;
3638 if (defined $u) {
3639 if (defined $v) {
3640 return wantarray ?
3641 $t->path_vertices($u, $v) : $t->path_length($u, $v);
3642 } else {
3643 my $max;
3644 my @max;
3645 for my $v ($g->vertices) {
3646 next if $u eq $v;
3647 my $l = $t->path_length($u, $v);
3648 if (defined $l && (!defined $max || $l > $max)) {
3649 $max = $l;
3650 @max = $t->path_vertices($u, $v);
3651 }
3652 }
3653 return wantarray ? @max : $max;
3654 }
3655 } else {
3656 if (defined $v) {
3657 my $max;
3658 my @max;
3659 for my $u ($g->vertices) {
3660 next if $u eq $v;
3661 my $l = $t->path_length($u, $v);
3662 if (defined $l && (!defined $max || $l > $max)) {
3663 $max = $l;
3664 @max = $t->path_vertices($u, $v);
3665 }
3666 }
3667 return wantarray ? @max : @max - 1;
3668 } else {
3669 my ($min, $max, $minp, $maxp) = $g->_minmax_path(@_);
3670 return defined $maxp ? (wantarray ? @$maxp : $max) : undef;
3671 }
3672 }
3673}
3674
3675sub vertex_eccentricity {
3676 my ($g, $u) = @_;
3677 $g->expect_undirected;
3678 if ($g->is_connected) {
3679 my $max;
3680 for my $v ($g->vertices) {
3681 next if $u eq $v;
3682 my $l = $g->path_length($u, $v);
3683 if (defined $l && (!defined $max || $l > $max)) {
3684 $max = $l;
3685 }
3686 }
3687 return $max;
3688 } else {
3689 return Infinity();
3690 }
3691}
3692
3693sub shortest_path {
3694 my ($g, $u, $v) = @_;
3695 $g->expect_undirected;
3696 my $t = $g->transitive_closure_matrix;
3697 if (defined $u) {
3698 if (defined $v) {
3699 return wantarray ?
3700 $t->path_vertices($u, $v) : $t->path_length($u, $v);
3701 } else {
3702 my $min;
3703 my @min;
3704 for my $v ($g->vertices) {
3705 next if $u eq $v;
3706 my $l = $t->path_length($u, $v);
3707 if (defined $l && (!defined $min || $l < $min)) {
3708 $min = $l;
3709 @min = $t->path_vertices($u, $v);
3710 }
3711 }
3712 return wantarray ? @min : $min;
3713 }
3714 } else {
3715 if (defined $v) {
3716 my $min;
3717 my @min;
3718 for my $u ($g->vertices) {
3719 next if $u eq $v;
3720 my $l = $t->path_length($u, $v);
3721 if (defined $l && (!defined $min || $l < $min)) {
3722 $min = $l;
3723 @min = $t->path_vertices($u, $v);
3724 }
3725 }
3726 return wantarray ? @min : $min;
3727 } else {
3728 my ($min, $max, $minp, $maxp) = $g->_minmax_path(@_);
3729 return defined $minp ? (wantarray ? @$minp : $min) : undef;
3730 }
3731 }
3732}
3733
3734sub radius {
3735 my $g = shift;
3736 $g->expect_undirected;
3737 my ($center, $radius) = (undef, Infinity());
3738 for my $v ($g->vertices) {
3739 my $x = $g->vertex_eccentricity($v);
3740 ($center, $radius) = ($v, $x) if defined $x && $x < $radius;
3741 }
3742 return $radius;
3743}
3744
3745sub center_vertices {
3746 my ($g, $delta) = @_;
3747 $g->expect_undirected;
3748 $delta = 0 unless defined $delta;
3749 $delta = abs($delta);
3750 my @c;
3751 my $r = $g->radius;
3752 if (defined $r) {
3753 for my $v ($g->vertices) {
3754 my $e = $g->vertex_eccentricity($v);
3755 next unless defined $e;
3756 push @c, $v if abs($e - $r) <= $delta;
3757 }
3758 }
3759 return @c;
3760}
3761
376212µs*centre_vertices = \&center_vertices;
3763
3764sub average_path_length {
3765 my $g = shift;
3766 my @A = @_;
3767 my $d = 0;
3768 my $m = 0;
3769 my $n = $g->for_shortest_paths(sub {
3770 my ($t, $u, $v, $n) = @_;
3771 my $l = $t->path_length($u, $v);
3772 if ($l) {
3773 my $c = @A == 0 ||
3774 (@A == 1 && $u eq $A[0]) ||
3775 ((@A == 2) &&
3776 (defined $A[0] &&
3777 $u eq $A[0]) ||
3778 (defined $A[1] &&
3779 $v eq $A[1]));
3780 if ($c) {
3781 $d += $l;
3782 $m++;
3783 }
3784 }
3785 });
3786 return $m ? $d / $m : undef;
3787}
3788
3789###
3790# Simple tests.
3791#
3792
3793sub is_multi_graph {
3794 my $g = shift;
3795 return 0 unless $g->is_multiedged || $g->is_countedged;
3796 my $multiedges = 0;
3797 for my $e ($g->edges05) {
3798 my ($u, @v) = @$e;
3799 for my $v (@v) {
3800 return 0 if $u eq $v;
3801 }
3802 $multiedges++ if $g->get_edge_count(@$e) > 1;
3803 }
3804 return $multiedges;
3805}
3806
3807sub is_simple_graph {
3808 my $g = shift;
3809 return 1 unless $g->is_countedged || $g->is_multiedged;
3810 for my $e ($g->edges05) {
3811 return 0 if $g->get_edge_count(@$e) > 1;
3812 }
3813 return 1;
3814}
3815
3816sub is_pseudo_graph {
3817 my $g = shift;
3818 my $m = $g->is_countedged || $g->is_multiedged;
3819 for my $e ($g->edges05) {
3820 my ($u, @v) = @$e;
3821 for my $v (@v) {
3822 return 1 if $u eq $v;
3823 }
3824 return 1 if $m && $g->get_edge_count($u, @v) > 1;
3825 }
3826 return 0;
3827}
3828
3829###
3830# Rough isomorphism guess.
3831#
3832
383313µsmy %_factorial = (0 => 1, 1 => 1);
3834
3835sub __factorial {
3836 my $n = shift;
3837 for (my $i = 2; $i <= $n; $i++) {
3838 next if exists $_factorial{$i};
3839 $_factorial{$i} = $i * $_factorial{$i - 1};
3840 }
3841 $_factorial{$n};
3842}
3843
3844sub _factorial {
3845 my $n = int(shift);
3846 if ($n < 0) {
3847 require Carp;
3848 Carp::croak("factorial of a negative number");
3849 }
3850 __factorial($n) unless exists $_factorial{$n};
3851 return $_factorial{$n};
3852}
3853
3854sub could_be_isomorphic {
3855 my ($g0, $g1) = @_;
3856 return 0 unless $g0->vertices == $g1->vertices;
3857 return 0 unless $g0->edges05 == $g1->edges05;
3858 my %d0;
3859 for my $v0 ($g0->vertices) {
3860 $d0{ $g0->in_degree($v0) }{ $g0->out_degree($v0) }++
3861 }
3862 my %d1;
3863 for my $v1 ($g1->vertices) {
3864 $d1{ $g1->in_degree($v1) }{ $g1->out_degree($v1) }++
3865 }
3866 return 0 unless keys %d0 == keys %d1;
3867 for my $da (keys %d0) {
3868 return 0
3869 unless exists $d1{$da} &&
3870 keys %{ $d0{$da} } == keys %{ $d1{$da} };
3871 for my $db (keys %{ $d0{$da} }) {
3872 return 0
3873 unless exists $d1{$da}{$db} &&
3874 $d0{$da}{$db} == $d1{$da}{$db};
3875 }
3876 }
3877 for my $da (keys %d0) {
3878 for my $db (keys %{ $d0{$da} }) {
3879 return 0 unless $d1{$da}{$db} == $d0{$da}{$db};
3880 }
3881 delete $d1{$da};
3882 }
3883 return 0 unless keys %d1 == 0;
3884 my $f = 1;
3885 for my $da (keys %d0) {
3886 for my $db (keys %{ $d0{$da} }) {
3887 $f *= _factorial(abs($d0{$da}{$db}));
3888 }
3889 }
3890 return $f;
3891}
3892
3893###
3894# Analysis functions.
3895
3896sub subgraph_by_radius
3897{
3898 my ($g, $n, $rad) = @_;
3899
3900 return unless defined $n && defined $rad && $rad >= 0;
3901
3902 my $r = (ref $g)->new;
3903
3904 if ($rad == 0) {
3905 return $r->add_vertex($n);
3906 }
3907
3908 my %h;
3909 $h{1} = [ [ $n, $g->successors($n) ] ];
3910 for my $i (1..$rad) {
3911 $h{$i+1} = [];
3912 for my $arr (@{ $h{$i} }) {
3913 my ($p, @succ) = @{ $arr };
3914 for my $s (@succ) {
3915 $r->add_edge($p, $s);
3916 push(@{ $h{$i+1} }, [$s, $g->successors($s)]) if $i < $rad;
3917 }
3918 }
3919 }
3920
3921 return $r;
3922}
3923
3924sub clustering_coefficient {
3925 my ($g) = @_;
3926 my %clustering;
3927
3928 my $gamma = 0;
3929
3930 for my $n ($g->vertices()) {
3931 my $gamma_v = 0;
3932 my @neigh = $g->successors($n);
3933 my %c;
3934 for my $u (@neigh) {
3935 for my $v (@neigh) {
3936 if (!$c{"$u-$v"} && $g->has_edge($u, $v)) {
3937 $gamma_v++;
3938 $c{"$u-$v"} = 1;
3939 $c{"$v-$u"} = 1;
3940 }
3941 }
3942 }
3943 if (@neigh > 1) {
3944 $clustering{$n} = $gamma_v/(@neigh * (@neigh - 1) / 2);
3945 $gamma += $gamma_v/(@neigh * (@neigh - 1) / 2);
3946 } else {
3947 $clustering{$n} = 0;
3948 }
3949 }
3950
3951 $gamma /= $g->vertices();
3952
3953 return wantarray ? ($gamma, %clustering) : $gamma;
3954}
3955
3956sub betweenness {
3957 my $g = shift;
3958
3959 my @V = $g->vertices();
3960
3961 my %Cb; # C_b{w} = 0
3962
3963 $Cb{$_} = 0 for @V;
3964
3965 for my $s (@V) {
3966 my @S; # stack (unshift, shift)
3967
3968 my %P; # P{w} = empty list
3969 $P{$_} = [] for @V;
3970
3971 my %sigma; # \sigma{t} = 0
3972 $sigma{$_} = 0 for @V;
3973 $sigma{$s} = 1;
3974
3975 my %d; # d{t} = -1;
3976 $d{$_} = -1 for @V;
3977 $d{$s} = 0;
3978
3979 my @Q; # queue (push, shift)
3980 push @Q, $s;
3981
3982 while (@Q) {
3983 my $v = shift @Q;
3984 unshift @S, $v;
3985 for my $w ($g->successors($v)) {
3986 # w found for first time
3987 if ($d{$w} < 0) {
3988 push @Q, $w;
3989 $d{$w} = $d{$v} + 1;
3990 }
3991 # Shortest path to w via v
3992 if ($d{$w} == $d{$v} + 1) {
3993 $sigma{$w} += $sigma{$v};
3994 push @{ $P{$w} }, $v;
3995 }
3996 }
3997 }
3998
3999 my %delta;
4000 $delta{$_} = 0 for @V;
4001
4002 while (@S) {
4003 my $w = shift @S;
4004 for my $v (@{ $P{$w} }) {
4005 $delta{$v} += $sigma{$v}/$sigma{$w} * (1 + $delta{$w});
4006 }
4007 if ($w ne $s) {
4008 $Cb{$w} += $delta{$w};
4009 }
4010 }
4011 }
4012
4013 return %Cb;
4014}
4015
4016###
4017# Debugging.
4018#
4019
4020sub _dump {
4021 require Data::Dumper;
4022 my $d = Data::Dumper->new([$_[0]],[ref $_[0]]);
4023 defined wantarray ? $d->Dump : print $d->Dump;
4024}
4025
4026194µs1;
 
# spent 22.7ms within Graph::CORE:sort which was called 26277 times, avg 865ns/call: # 26277 times (22.7ms+0s) by Graph::has_edge at line 546, avg 865ns/call
sub Graph::CORE:sort; # opcode