| Filename | /Users/ap13/perl5/lib/perl5/Graph.pm |
| Statements | Executed 2879358 statements in 2.76s |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 24876 | 1 | 1 | 617ms | 858ms | Graph::_edges |
| 29935 | 4 | 2 | 312ms | 1.88s | Graph::add_edge |
| 34963 | 3 | 2 | 253ms | 276ms | Graph::has_edge |
| 24934 | 1 | 1 | 241ms | 491ms | Graph::add_vertex |
| 29935 | 1 | 1 | 231ms | 721ms | Graph::_add_edge |
| 19958 | 2 | 1 | 222ms | 1.50s | Graph::set_edge_attribute |
| 70075 | 4 | 2 | 193ms | 251ms | Graph::multiedged |
| 24965 | 2 | 1 | 152ms | 152ms | Graph::_vertex_ids |
| 15003 | 3 | 1 | 139ms | 2.07s | Graph::add_weighted_edge |
| 39968 | 3 | 1 | 99.7ms | 250ms | Graph::expect_non_multiedged |
| 54871 | 3 | 1 | 87.9ms | 87.9ms | Graph::has_union_find |
| 36 | 1 | 1 | 84.6ms | 1.79s | Graph::_heap_walk |
| 24876 | 2 | 2 | 83.3ms | 1.50s | Graph::successors |
| 24914 | 2 | 1 | 74.9ms | 102ms | Graph::omniedged |
| 4991 | 2 | 1 | 69.3ms | 861ms | Graph::_MST_add |
| 24972 | 2 | 1 | 67.9ms | 79.1ms | Graph::multivertexed |
| 5007 | 1 | 1 | 62.8ms | 325ms | Graph::get_edge_attribute |
| 24876 | 1 | 1 | 45.3ms | 45.3ms | Graph::_edges_from |
| 2 | 1 | 1 | 25.5ms | 1.40s | Graph::_connected_components_compute |
| 10011 | 4 | 2 | 24.5ms | 24.5ms | Graph::_next_random |
| 15177 | 4 | 1 | 24.3ms | 24.3ms | Graph::is_compat02 |
| 26277 | 1 | 1 | 22.7ms | 22.7ms | Graph::CORE:sort (opcode) |
| 4991 | 1 | 1 | 18.7ms | 18.7ms | Graph::__ANON__[:2754] |
| 76 | 3 | 1 | 18.5ms | 34.7ms | Graph::vertices05 |
| 4871 | 1 | 1 | 9.00ms | 9.00ms | Graph::has_vertex |
| 112 | 5 | 3 | 6.23ms | 16.6ms | Graph::new |
| 36 | 1 | 1 | 5.68ms | 13.6ms | Graph::_root_opt |
| 336 | 3 | 1 | 4.98ms | 4.98ms | Graph::_opt |
| 38 | 1 | 1 | 3.87ms | 20.7ms | Graph::vertices |
| 1 | 1 | 1 | 3.12ms | 15.2ms | Graph::BEGIN@42 |
| 1 | 1 | 1 | 2.89ms | 3.27ms | Graph::BEGIN@13 |
| 1 | 1 | 1 | 2.79ms | 2.98ms | Graph::BEGIN@38 |
| 134 | 1 | 1 | 1.92ms | 3.24ms | Graph::edges05 |
| 148 | 2 | 1 | 1.89ms | 1.89ms | Graph::_get_options |
| 1 | 1 | 1 | 1.61ms | 1.96ms | Graph::BEGIN@28 |
| 134 | 2 | 1 | 1.51ms | 5.98ms | Graph::edges |
| 1 | 1 | 1 | 1.32ms | 3.17ms | Graph::BEGIN@29 |
| 2 | 1 | 1 | 1.21ms | 12.1ms | Graph::unique_vertices |
| 1 | 1 | 1 | 949µs | 1.16ms | Graph::BEGIN@86 |
| 224 | 2 | 1 | 743µs | 743µs | Graph::_opt_get |
| 36 | 1 | 1 | 686µs | 1.80s | Graph::MST_Prim |
| 172 | 2 | 2 | 646µs | 789µs | Graph::countedged |
| 1 | 1 | 1 | 565µs | 590µs | Graph::BEGIN@31 |
| 67 | 1 | 1 | 502µs | 5.56ms | Graph::add_edges |
| 1 | 1 | 1 | 487µs | 4.77ms | Graph::BEGIN@32 |
| 1 | 1 | 1 | 472µs | 809µs | Graph::BEGIN@35 |
| 1 | 1 | 1 | 442µs | 1.34ms | Graph::BEGIN@34 |
| 112 | 1 | 1 | 348µs | 348µs | Graph::_opt_unknown |
| 1 | 1 | 1 | 346µs | 4.14ms | Graph::BEGIN@33 |
| 1 | 1 | 1 | 312µs | 485µs | Graph::BEGIN@36 |
| 38 | 1 | 1 | 238µs | 293µs | Graph::directed |
| 38 | 2 | 1 | 201µs | 490µs | Graph::expect_undirected |
| 36 | 1 | 1 | 184µs | 184µs | Graph::__ANON__[:2745] |
| 38 | 1 | 1 | 158µs | 177µs | Graph::countvertexed |
| 2 | 1 | 1 | 80µs | 1.40s | Graph::_check_cache |
| 2 | 2 | 1 | 61µs | 1.40s | Graph::connected_components |
| 2 | 1 | 1 | 30µs | 1.40s | Graph::_connected_components |
| 1 | 1 | 1 | 26µs | 26µs | Graph::BEGIN@55 |
| 1 | 1 | 1 | 25µs | 98µs | Graph::BEGIN@39 |
| 1 | 1 | 1 | 18µs | 40µs | Graph::BEGIN@3 |
| 1 | 1 | 1 | 16µs | 62µs | Graph::BEGIN@40 |
| 2 | 1 | 1 | 16µs | 16µs | Graph::__ANON__[:2741] |
| 1 | 1 | 1 | 13µs | 56µs | Graph::BEGIN@1733 |
| 1 | 1 | 1 | 13µs | 29µs | Graph::BEGIN@30 |
| 1 | 1 | 1 | 12µs | 58µs | Graph::BEGIN@116 |
| 1 | 1 | 1 | 11µs | 23µs | Graph::BEGIN@178 |
| 1 | 1 | 1 | 10µs | 10µs | Graph::BEGIN@2155 |
| 1 | 1 | 1 | 10µs | 29µs | Graph::BEGIN@15 |
| 1 | 1 | 1 | 3µs | 3µs | Graph::BEGIN@5 |
| 0 | 0 | 0 | 0s | 0s | Graph::APSP_Floyd_Warshall |
| 0 | 0 | 0 | 0s | 0s | Graph::Infinity |
| 0 | 0 | 0 | 0s | 0s | Graph::MST_Kruskal |
| 0 | 0 | 0 | 0s | 0s | Graph::SPT_Bellman_Ford |
| 0 | 0 | 0 | 0s | 0s | Graph::SPT_Bellman_Ford_clear_cache |
| 0 | 0 | 0 | 0s | 0s | Graph::SPT_Dijkstra |
| 0 | 0 | 0 | 0s | 0s | Graph::SPT_Dijkstra_clear_cache |
| 0 | 0 | 0 | 0s | 0s | Graph::SP_Bellman_Ford |
| 0 | 0 | 0 | 0s | 0s | Graph::SP_Dijkstra |
| 0 | 0 | 0 | 0s | 0s | Graph::TransitiveClosure_Floyd_Warshall |
| 0 | 0 | 0 | 0s | 0s | Graph::_MST_attr |
| 0 | 0 | 0 | 0s | 0s | Graph::_MST_edges |
| 0 | 0 | 0 | 0s | 0s | Graph::_SPT_Bellman_Ford |
| 0 | 0 | 0 | 0s | 0s | Graph::_SPT_Bellman_Ford_compute |
| 0 | 0 | 0 | 0s | 0s | Graph::_SPT_Dijkstra_compute |
| 0 | 0 | 0 | 0s | 0s | Graph::_SPT_add |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:1726] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:2211] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:2269] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:2817] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:2904] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:2908] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:2994] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:2998] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:3030] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:3034] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:3047] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:3623] |
| 0 | 0 | 0 | 0s | 0s | Graph::__ANON__[:3785] |
| 0 | 0 | 0 | 0s | 0s | Graph::__SPT_Bellman_Ford |
| 0 | 0 | 0 | 0s | 0s | Graph::__carp_confess |
| 0 | 0 | 0 | 0s | 0s | Graph::__factorial |
| 0 | 0 | 0 | 0s | 0s | Graph::__fisher_yates_shuffle |
| 0 | 0 | 0 | 0s | 0s | Graph::__stringified |
| 0 | 0 | 0 | 0s | 0s | Graph::_all_predecessors |
| 0 | 0 | 0 | 0s | 0s | Graph::_all_successors |
| 0 | 0 | 0 | 0s | 0s | Graph::_attr02_012 |
| 0 | 0 | 0 | 0s | 0s | Graph::_attr02_123 |
| 0 | 0 | 0 | 0s | 0s | Graph::_attr02_234 |
| 0 | 0 | 0 | 0s | 0s | Graph::_biconnectivity_compute |
| 0 | 0 | 0 | 0s | 0s | Graph::_biconnectivity_dfs |
| 0 | 0 | 0 | 0s | 0s | Graph::_biconnectivity_out |
| 0 | 0 | 0 | 0s | 0s | Graph::_can_deep_copy_Storable |
| 0 | 0 | 0 | 0s | 0s | Graph::_clear_cache |
| 0 | 0 | 0 | 0s | 0s | Graph::_deep_copy_DataDumper |
| 0 | 0 | 0 | 0s | 0s | Graph::_deep_copy_Storable |
| 0 | 0 | 0 | 0s | 0s | Graph::_defattr |
| 0 | 0 | 0 | 0s | 0s | Graph::_dump |
| 0 | 0 | 0 | 0s | 0s | Graph::_edges_at |
| 0 | 0 | 0 | 0s | 0s | Graph::_edges_id_path |
| 0 | 0 | 0 | 0s | 0s | Graph::_edges_to |
| 0 | 0 | 0 | 0s | 0s | Graph::_expected |
| 0 | 0 | 0 | 0s | 0s | Graph::_factorial |
| 0 | 0 | 0 | 0s | 0s | Graph::_get_edge_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::_get_union_find |
| 0 | 0 | 0 | 0s | 0s | Graph::_in_degree |
| 0 | 0 | 0 | 0s | 0s | Graph::_minmax_path |
| 0 | 0 | 0 | 0s | 0s | Graph::_next_alphabetic |
| 0 | 0 | 0 | 0s | 0s | Graph::_next_numeric |
| 0 | 0 | 0 | 0s | 0s | Graph::_out_degree |
| 0 | 0 | 0 | 0s | 0s | Graph::_set_edge_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::_strongly_connected_components |
| 0 | 0 | 0 | 0s | 0s | Graph::_strongly_connected_components_compute |
| 0 | 0 | 0 | 0s | 0s | Graph::_total_degree |
| 0 | 0 | 0 | 0s | 0s | Graph::_transitive_closure_matrix_compute |
| 0 | 0 | 0 | 0s | 0s | Graph::_undirected_copy_compute |
| 0 | 0 | 0 | 0s | 0s | Graph::_union_find_add_edge |
| 0 | 0 | 0 | 0s | 0s | Graph::_union_find_add_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::add_cycle |
| 0 | 0 | 0 | 0s | 0s | Graph::add_edge_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::add_edge_get_id |
| 0 | 0 | 0 | 0s | 0s | Graph::add_path |
| 0 | 0 | 0 | 0s | 0s | Graph::add_vertex_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::add_vertex_get_id |
| 0 | 0 | 0 | 0s | 0s | Graph::add_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::add_weighted_edge_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::add_weighted_edges |
| 0 | 0 | 0 | 0s | 0s | Graph::add_weighted_edges_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::add_weighted_path |
| 0 | 0 | 0 | 0s | 0s | Graph::add_weighted_path_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::add_weighted_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::add_weighted_vertex_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::add_weighted_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::add_weighted_vertices_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::all_neighbours |
| 0 | 0 | 0 | 0s | 0s | Graph::all_predecessors |
| 0 | 0 | 0 | 0s | 0s | Graph::all_reachable |
| 0 | 0 | 0 | 0s | 0s | Graph::all_successors |
| 0 | 0 | 0 | 0s | 0s | Graph::articulation_points |
| 0 | 0 | 0 | 0s | 0s | Graph::average_degree |
| 0 | 0 | 0 | 0s | 0s | Graph::average_path_length |
| 0 | 0 | 0 | 0s | 0s | Graph::betweenness |
| 0 | 0 | 0 | 0s | 0s | Graph::biconnected_component_by_index |
| 0 | 0 | 0 | 0s | 0s | Graph::biconnected_component_by_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::biconnected_components |
| 0 | 0 | 0 | 0s | 0s | Graph::biconnected_graph |
| 0 | 0 | 0 | 0s | 0s | Graph::biconnectivity |
| 0 | 0 | 0 | 0s | 0s | Graph::biconnectivity_clear_cache |
| 0 | 0 | 0 | 0s | 0s | Graph::bridges |
| 0 | 0 | 0 | 0s | 0s | Graph::center_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::clustering_coefficient |
| 0 | 0 | 0 | 0s | 0s | Graph::complement_graph |
| 0 | 0 | 0 | 0s | 0s | Graph::complete_graph |
| 0 | 0 | 0 | 0s | 0s | Graph::connected_component_by_index |
| 0 | 0 | 0 | 0s | 0s | Graph::connected_component_by_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::connected_graph |
| 0 | 0 | 0 | 0s | 0s | Graph::connectivity_clear_cache |
| 0 | 0 | 0 | 0s | 0s | Graph::copy |
| 0 | 0 | 0 | 0s | 0s | Graph::could_be_isomorphic |
| 0 | 0 | 0 | 0s | 0s | Graph::deep_copy |
| 0 | 0 | 0 | 0s | 0s | Graph::degree |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_cycle |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_edge |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_edge_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_edge_attribute_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_edge_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_edge_attributes_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_edge_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_edge_weight |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_edge_weight_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_edges |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_path |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_vertex_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_vertex_attribute_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_vertex_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_vertex_attributes_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_vertex_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_vertex_weight |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_vertex_weight_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::delete_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::density |
| 0 | 0 | 0 | 0s | 0s | Graph::density_limits |
| 0 | 0 | 0 | 0s | 0s | Graph::diameter |
| 0 | 0 | 0 | 0s | 0s | Graph::directed_copy |
| 0 | 0 | 0 | 0s | 0s | Graph::edges02 |
| 0 | 0 | 0 | 0s | 0s | Graph::edges_at |
| 0 | 0 | 0 | 0s | 0s | Graph::edges_from |
| 0 | 0 | 0 | 0s | 0s | Graph::edges_to |
| 0 | 0 | 0 | 0s | 0s | Graph::eq |
| 0 | 0 | 0 | 0s | 0s | Graph::expect_acyclic |
| 0 | 0 | 0 | 0s | 0s | Graph::expect_dag |
| 0 | 0 | 0 | 0s | 0s | Graph::expect_directed |
| 0 | 0 | 0 | 0s | 0s | Graph::expect_multiedged |
| 0 | 0 | 0 | 0s | 0s | Graph::expect_multivertexed |
| 0 | 0 | 0 | 0s | 0s | Graph::expect_non_multivertexed |
| 0 | 0 | 0 | 0s | 0s | Graph::expect_non_unionfind |
| 0 | 0 | 0 | 0s | 0s | Graph::exterior_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::find_a_cycle |
| 0 | 0 | 0 | 0s | 0s | Graph::for_shortest_paths |
| 0 | 0 | 0 | 0s | 0s | Graph::get_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::get_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::get_edge_attribute_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::get_edge_attribute_names |
| 0 | 0 | 0 | 0s | 0s | Graph::get_edge_attribute_names_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::get_edge_attribute_values |
| 0 | 0 | 0 | 0s | 0s | Graph::get_edge_attribute_values_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::get_edge_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::get_edge_attributes_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::get_edge_count |
| 0 | 0 | 0 | 0s | 0s | Graph::get_edge_weight |
| 0 | 0 | 0 | 0s | 0s | Graph::get_edge_weight_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::get_multiedge_ids |
| 0 | 0 | 0 | 0s | 0s | Graph::get_multivertex_ids |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_attribute_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_attribute_names |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_attribute_names_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_attribute_values |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_attribute_values_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_attributes_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_count |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_weight |
| 0 | 0 | 0 | 0s | 0s | Graph::get_vertex_weight_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::has_a_cycle |
| 0 | 0 | 0 | 0s | 0s | Graph::has_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::has_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::has_cycle |
| 0 | 0 | 0 | 0s | 0s | Graph::has_edge_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::has_edge_attribute_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::has_edge_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::has_edge_attributes_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::has_edge_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::has_edge_weight |
| 0 | 0 | 0 | 0s | 0s | Graph::has_edge_weight_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::has_edges |
| 0 | 0 | 0 | 0s | 0s | Graph::has_path |
| 0 | 0 | 0 | 0s | 0s | Graph::has_vertex_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::has_vertex_attribute_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::has_vertex_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::has_vertex_attributes_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::has_vertex_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::has_vertex_weight |
| 0 | 0 | 0 | 0s | 0s | Graph::has_vertex_weight_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::has_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::hyperedged |
| 0 | 0 | 0 | 0s | 0s | Graph::hypervertexed |
| 0 | 0 | 0 | 0s | 0s | Graph::in_degree |
| 0 | 0 | 0 | 0s | 0s | Graph::in_edges |
| 0 | 0 | 0 | 0s | 0s | Graph::interior_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::is_acyclic |
| 0 | 0 | 0 | 0s | 0s | Graph::is_biconnected |
| 0 | 0 | 0 | 0s | 0s | Graph::is_connected |
| 0 | 0 | 0 | 0s | 0s | Graph::is_dag |
| 0 | 0 | 0 | 0s | 0s | Graph::is_edge_connected |
| 0 | 0 | 0 | 0s | 0s | Graph::is_edge_separable |
| 0 | 0 | 0 | 0s | 0s | Graph::is_exterior_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::is_interior_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::is_isolated_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::is_multi_graph |
| 0 | 0 | 0 | 0s | 0s | Graph::is_predecessorful_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::is_predecessorless_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::is_pseudo_graph |
| 0 | 0 | 0 | 0s | 0s | Graph::is_reachable |
| 0 | 0 | 0 | 0s | 0s | Graph::is_self_loop_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::is_simple_graph |
| 0 | 0 | 0 | 0s | 0s | Graph::is_sink_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::is_source_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::is_strongly_connected |
| 0 | 0 | 0 | 0s | 0s | Graph::is_successorful_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::is_successorless_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::is_transitive |
| 0 | 0 | 0 | 0s | 0s | Graph::is_weakly_connected |
| 0 | 0 | 0 | 0s | 0s | Graph::isolated_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::longest_path |
| 0 | 0 | 0 | 0s | 0s | Graph::ne |
| 0 | 0 | 0 | 0s | 0s | Graph::neighbours |
| 0 | 0 | 0 | 0s | 0s | Graph::omnivertexed |
| 0 | 0 | 0 | 0s | 0s | Graph::out_degree |
| 0 | 0 | 0 | 0s | 0s | Graph::out_edges |
| 0 | 0 | 0 | 0s | 0s | Graph::path_length |
| 0 | 0 | 0 | 0s | 0s | Graph::path_predecessor |
| 0 | 0 | 0 | 0s | 0s | Graph::path_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::predecessorful_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::predecessorless_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::predecessors |
| 0 | 0 | 0 | 0s | 0s | Graph::radius |
| 0 | 0 | 0 | 0s | 0s | Graph::random_edge |
| 0 | 0 | 0 | 0s | 0s | Graph::random_graph |
| 0 | 0 | 0 | 0s | 0s | Graph::random_predecessor |
| 0 | 0 | 0 | 0s | 0s | Graph::random_successor |
| 0 | 0 | 0 | 0s | 0s | Graph::random_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::refvertexed |
| 0 | 0 | 0 | 0s | 0s | Graph::refvertexed_stringified |
| 0 | 0 | 0 | 0s | 0s | Graph::same_biconnected_components |
| 0 | 0 | 0 | 0s | 0s | Graph::same_connected_components |
| 0 | 0 | 0 | 0s | 0s | Graph::same_strongly_connected_components |
| 0 | 0 | 0 | 0s | 0s | Graph::same_weakly_connected_components |
| 0 | 0 | 0 | 0s | 0s | Graph::self_loop_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::set_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::set_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::set_edge_attribute_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::set_edge_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::set_edge_attributes_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::set_edge_weight |
| 0 | 0 | 0 | 0s | 0s | Graph::set_edge_weight_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::set_vertex_attribute |
| 0 | 0 | 0 | 0s | 0s | Graph::set_vertex_attribute_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::set_vertex_attributes |
| 0 | 0 | 0 | 0s | 0s | Graph::set_vertex_attributes_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::set_vertex_weight |
| 0 | 0 | 0 | 0s | 0s | Graph::set_vertex_weight_by_id |
| 0 | 0 | 0 | 0s | 0s | Graph::shortest_path |
| 0 | 0 | 0 | 0s | 0s | Graph::sink_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::source_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::stringify |
| 0 | 0 | 0 | 0s | 0s | Graph::strong_connectivity_clear_cache |
| 0 | 0 | 0 | 0s | 0s | Graph::strongly_connected_component_by_index |
| 0 | 0 | 0 | 0s | 0s | Graph::strongly_connected_component_by_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::strongly_connected_components |
| 0 | 0 | 0 | 0s | 0s | Graph::strongly_connected_graph |
| 0 | 0 | 0 | 0s | 0s | Graph::subgraph_by_radius |
| 0 | 0 | 0 | 0s | 0s | Graph::successorful_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::successorless_vertices |
| 0 | 0 | 0 | 0s | 0s | Graph::topological_sort |
| 0 | 0 | 0 | 0s | 0s | Graph::transitive_closure_matrix |
| 0 | 0 | 0 | 0s | 0s | Graph::transpose_edge |
| 0 | 0 | 0 | 0s | 0s | Graph::transpose_graph |
| 0 | 0 | 0 | 0s | 0s | Graph::undirected_copy |
| 0 | 0 | 0 | 0s | 0s | Graph::undirected_copy_clear_cache |
| 0 | 0 | 0 | 0s | 0s | Graph::uniqedged |
| 0 | 0 | 0 | 0s | 0s | Graph::unique_edges |
| 0 | 0 | 0 | 0s | 0s | Graph::uniqvertexed |
| 0 | 0 | 0 | 0s | 0s | Graph::vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::vertex_eccentricity |
| 0 | 0 | 0 | 0s | 0s | Graph::vertices_at |
| 0 | 0 | 0 | 0s | 0s | Graph::weakly_connected_component_by_index |
| 0 | 0 | 0 | 0s | 0s | Graph::weakly_connected_component_by_vertex |
| 0 | 0 | 0 | 0s | 0s | Graph::weakly_connected_components |
| 0 | 0 | 0 | 0s | 0s | Graph::weakly_connected_graph |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Graph; | ||||
| 2 | |||||
| 3 | 2 | 109µs | 2 | 61µ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 # 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 | ||||
| 6 | 1 | 4µ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(@_) } | ||||
| 11 | 1 | 18µs | 1 | 3µs | } # spent 3µs making 1 call to Graph::BEGIN@5 |
| 12 | |||||
| 13 | 2 | 115µs | 2 | 3.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 # spent 3.27ms making 1 call to Graph::BEGIN@13
# spent 301µs making 1 call to Exporter::import |
| 14 | |||||
| 15 | 2 | 64µs | 2 | 48µ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 # spent 29µs making 1 call to Graph::BEGIN@15
# spent 19µs making 1 call to vars::import |
| 16 | |||||
| 17 | 1 | 2µs | $VERSION = '0.96'; | ||
| 18 | |||||
| 19 | 1 | 62µs | require 5.006; # Weak references are absolutely required. | ||
| 20 | |||||
| 21 | 1 | 60µs | my $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 | |||||
| 24 | sub _can_deep_copy_Storable () { | ||||
| 25 | return $can_deep_copy_Storable; | ||||
| 26 | } | ||||
| 27 | |||||
| 28 | 2 | 132µs | 2 | 1.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 # spent 1.96ms making 1 call to Graph::BEGIN@28
# spent 20µs making 1 call to Exporter::import |
| 29 | 2 | 128µs | 2 | 3.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 # spent 3.17ms making 1 call to Graph::BEGIN@29
# spent 19µs making 1 call to Exporter::import |
| 30 | 2 | 29µs | 2 | 45µ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 # spent 29µs making 1 call to Graph::BEGIN@30
# spent 16µs making 1 call to Exporter::import |
| 31 | 2 | 109µs | 1 | 590µ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 # spent 590µs making 1 call to Graph::BEGIN@31 |
| 32 | 2 | 129µs | 1 | 4.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 # spent 4.77ms making 1 call to Graph::BEGIN@32 |
| 33 | 2 | 184µs | 1 | 4.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 # spent 4.14ms making 1 call to Graph::BEGIN@33 |
| 34 | 2 | 200µs | 2 | 1.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 # spent 1.34ms making 1 call to Graph::BEGIN@34
# spent 30µs making 1 call to Exporter::import |
| 35 | 2 | 172µs | 2 | 839µ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 # spent 809µs making 1 call to Graph::BEGIN@35
# spent 31µs making 1 call to Exporter::import |
| 36 | 2 | 169µs | 1 | 485µ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 # spent 485µs making 1 call to Graph::BEGIN@36 |
| 37 | |||||
| 38 | 2 | 178µs | 2 | 3.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 # spent 2.98ms making 1 call to Graph::BEGIN@38
# spent 36µs making 1 call to Exporter::import |
| 39 | 2 | 50µs | 2 | 112µ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 # spent 98µs making 1 call to Graph::BEGIN@39
# spent 14µs making 1 call to List::Util::import |
| 40 | 2 | 43µs | 2 | 108µ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 # spent 62µs making 1 call to Graph::BEGIN@40
# spent 46µs making 1 call to Exporter::import |
| 41 | |||||
| 42 | 2 | 371µs | 1 | 15.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 # spent 15.2ms making 1 call to Graph::BEGIN@42 |
| 43 | |||||
| 44 | sub _F () { 0 } # Flags. | ||||
| 45 | sub _G () { 1 } # Generation. | ||||
| 46 | sub _V () { 2 } # Vertices. | ||||
| 47 | sub _E () { 3 } # Edges. | ||||
| 48 | sub _A () { 4 } # Attributes. | ||||
| 49 | sub _U () { 5 } # Union-Find. | ||||
| 50 | sub _S () { 6 } # Successors. | ||||
| 51 | sub _P () { 7 } # Predecessors. | ||||
| 52 | |||||
| 53 | 1 | 500ns | my $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 | ||||
| 56 | 3 | 24µs | local $SIG{FPE}; | ||
| 57 | eval { $Inf = exp(999) } || | ||||
| 58 | eval { $Inf = 9**9**9 } || | ||||
| 59 | eval { $Inf = 1e+999 } || | ||||
| 60 | { $Inf = 1e+99 }; # Close enough for most practical purposes. | ||||
| 61 | 1 | 55µs | 1 | 26µs | } # spent 26µs making 1 call to Graph::BEGIN@55 |
| 62 | |||||
| 63 | sub 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 | |||||
| 86 | 2 | 328µs | 2 | 1.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 # spent 1.16ms making 1 call to Graph::BEGIN@86
# spent 115µs making 1 call to Graph::Attribute::import |
| 87 | |||||
| 88 | sub _COMPAT02 () { 0x00000001 } | ||||
| 89 | |||||
| 90 | sub 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 | |||||
| 107 | sub eq { | ||||
| 108 | "$_[0]" eq "$_[1]" | ||||
| 109 | } | ||||
| 110 | |||||
| 111 | sub ne { | ||||
| 112 | "$_[0]" ne "$_[1]" | ||||
| 113 | } | ||||
| 114 | |||||
| 115 | use overload | ||||
| 116 | 2 | 9µs | # 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 | ||
| 117 | 'eq' => \&eq, | ||||
| 118 | 1 | 386µs | 2 | 103µs | 'ne' => \≠ # spent 58µs making 1 call to Graph::BEGIN@116
# spent 46µs making 1 call to overload::import |
| 119 | |||||
| 120 | sub _opt { | ||||
| 121 | 4256 | 4.51ms | my ($opt, $flags, %flags) = @_; | ||
| 122 | while (my ($flag, $FLAG) = each %flags) { | ||||
| 123 | if (exists $opt->{$flag}) { | ||||
| 124 | $$flags |= $FLAG if $opt->{$flag}; | ||||
| 125 | delete $opt->{$flag}; | ||||
| 126 | } | ||||
| 127 | 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 | ||||
| 135 | 30354 | 33.3ms | my ($g) = @_; | ||
| 136 | $g->[ _F ] & _COMPAT02; | ||||
| 137 | } | ||||
| 138 | |||||
| 139 | 1 | 7µ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 | ||||
| 142 | 109742 | 115ms | my ($g) = @_; | ||
| 143 | ($g->[ _F ] & _UNIONFIND) && defined $g->[ _U ]; | ||||
| 144 | } | ||||
| 145 | |||||
| 146 | sub _get_union_find { | ||||
| 147 | my ($g) = @_; | ||||
| 148 | $g->[ _U ]; | ||||
| 149 | } | ||||
| 150 | |||||
| 151 | sub _opt_get { | ||||
| 152 | 596 | 889µs | my ($opt, $key, $var) = @_; | ||
| 153 | if (exists $opt->{$key}) { | ||||
| 154 | $$var = $opt->{$key}; | ||||
| 155 | 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 | ||||
| 160 | 224 | 410µs | my ($opt) = @_; | ||
| 161 | 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 | ||||
| 171 | 4332 | 4.90ms | my $class = shift; | ||
| 172 | my $gflags = 0; | ||||
| 173 | my $vflags; | ||||
| 174 | my $eflags; | ||||
| 175 | 112 | 1.58ms | my %opt = _get_options( \@_ ); # spent 1.58ms making 112 calls to Graph::_get_options, avg 14µs/call | ||
| 176 | |||||
| 177 | if (ref $class && $class->isa('Graph')) { | ||||
| 178 | 2 | 7.47ms | 2 | 34µ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 # 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 | |||||
| 190 | 112 | 548µs | _opt_get(\%opt, undirected => \$opt{omniedged}); # spent 548µs making 112 calls to Graph::_opt_get, avg 5µs/call | ||
| 191 | 112 | 195µs | _opt_get(\%opt, omnidirected => \$opt{omniedged}); # spent 195µs making 112 calls to Graph::_opt_get, avg 2µs/call | ||
| 192 | |||||
| 193 | if (exists $opt{directed}) { | ||||
| 194 | $opt{omniedged} = !$opt{directed}; | ||||
| 195 | delete $opt{directed}; | ||||
| 196 | } | ||||
| 197 | |||||
| 198 | my $vnonomni = | ||||
| 199 | $opt{nonomnivertexed} || | ||||
| 200 | (exists $opt{omnivertexed} && !$opt{omnivertexed}); | ||||
| 201 | my $vnonuniq = | ||||
| 202 | $opt{nonuniqvertexed} || | ||||
| 203 | (exists $opt{uniqvertexed} && !$opt{uniqvertexed}); | ||||
| 204 | |||||
| 205 | 112 | 2.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 | |||||
| 216 | 112 | 1.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 | |||||
| 224 | 112 | 730µ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 | |||||
| 229 | 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 | |||||
| 237 | my @V; | ||||
| 238 | 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 | |||||
| 246 | my @E; | ||||
| 247 | 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 | |||||
| 256 | 112 | 348µs | _opt_unknown(\%opt); # spent 348µs making 112 calls to Graph::_opt_unknown, avg 3µs/call | ||
| 257 | |||||
| 258 | my $uflags; | ||||
| 259 | if (defined $vflags) { | ||||
| 260 | $uflags = $vflags; | ||||
| 261 | $uflags |= _UNORD unless $vnonomni; | ||||
| 262 | $uflags |= _UNIQ unless $vnonuniq; | ||||
| 263 | } else { | ||||
| 264 | $uflags = _UNORDUNIQ; | ||||
| 265 | $vflags = 0; | ||||
| 266 | } | ||||
| 267 | |||||
| 268 | 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 | |||||
| 277 | unless (defined $eflags) { | ||||
| 278 | $eflags = ($gflags & _COMPAT02) ? _COUNT : 0; | ||||
| 279 | } | ||||
| 280 | |||||
| 281 | if (!($vflags & _HYPER) && ($vflags & _UNIQ)) { | ||||
| 282 | require Carp; | ||||
| 283 | Carp::confess("Graph: not hypervertexed but uniqvertexed"); | ||||
| 284 | } | ||||
| 285 | |||||
| 286 | if (($vflags & _COUNT) && ($vflags & _MULTI)) { | ||||
| 287 | require Carp; | ||||
| 288 | Carp::confess("Graph: both countvertexed and multivertexed"); | ||||
| 289 | } | ||||
| 290 | |||||
| 291 | if (($eflags & _COUNT) && ($eflags & _MULTI)) { | ||||
| 292 | require Carp; | ||||
| 293 | Carp::confess("Graph: both countedged and multiedged"); | ||||
| 294 | } | ||||
| 295 | |||||
| 296 | my $g = bless [ ], ref $class || $class; | ||||
| 297 | |||||
| 298 | $g->[ _F ] = $gflags; | ||||
| 299 | $g->[ _G ] = 0; | ||||
| 300 | 112 | 1.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)); | ||||
| 305 | 112 | 1.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 | |||||
| 309 | $g->add_vertices(@V) if @V; | ||||
| 310 | |||||
| 311 | 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 | |||||
| 321 | if (($gflags & _UNIONFIND)) { | ||||
| 322 | $g->[ _U ] = Graph::UnionFind->new; | ||||
| 323 | } | ||||
| 324 | |||||
| 325 | return $g; | ||||
| 326 | } | ||||
| 327 | |||||
| 328 | 38 | 187µs | 38 | 19µ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 # spent 19µs making 38 calls to Graph::AdjacencyMap::Light::_is_COUNT, avg 508ns/call |
| 329 | 24972 | 93.6ms | 24972 | 11.2ms | sub multivertexed { $_[0]->[ _V ]->_is_MULTI } # spent 11.2ms making 24972 calls to Graph::AdjacencyMap::Light::_is_MULTI, avg 447ns/call |
| 330 | sub hypervertexed { $_[0]->[ _V ]->_is_HYPER } | ||||
| 331 | sub omnivertexed { $_[0]->[ _V ]->_is_UNORD } | ||||
| 332 | sub uniqvertexed { $_[0]->[ _V ]->_is_UNIQ } | ||||
| 333 | sub refvertexed { $_[0]->[ _V ]->_is_REF } | ||||
| 334 | sub refvertexed_stringified { $_[0]->[ _V ]->_is_REFSTR } | ||||
| 335 | sub __stringified { $_[0]->[ _V ]->_is_STR } | ||||
| 336 | |||||
| 337 | 172 | 777µs | 172 | 142µ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 # 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 |
| 338 | 70075 | 177ms | 70075 | 57.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 # 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 |
| 339 | sub hyperedged { $_[0]->[ _E ]->_is_HYPER } | ||||
| 340 | 24914 | 59.5ms | 24914 | 27.1ms | sub omniedged { $_[0]->[ _E ]->_is_UNORD } # spent 27.1ms making 24914 calls to Graph::AdjacencyMap::_is_UNORD, avg 1µs/call |
| 341 | sub uniqedged { $_[0]->[ _E ]->_is_UNIQ } | ||||
| 342 | |||||
| 343 | 1 | 2µs | *undirected = \&omniedged; | ||
| 344 | 1 | 2µs | *omnidirected = \&omniedged; | ||
| 345 | 38 | 179µs | 38 | 56µ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 # spent 56µs making 38 calls to Graph::AdjacencyMap::_is_UNORD, avg 1µs/call |
| 346 | |||||
| 347 | 1 | 1µs | *is_directed = \&directed; | ||
| 348 | 1 | 2µs | *is_undirected = \&undirected; | ||
| 349 | |||||
| 350 | 1 | 2µs | *is_countvertexed = \&countvertexed; | ||
| 351 | 1 | 1µs | *is_multivertexed = \&multivertexed; | ||
| 352 | 1 | 1µs | *is_hypervertexed = \&hypervertexed; | ||
| 353 | 1 | 2µs | *is_omnidirected = \&omnidirected; | ||
| 354 | 1 | 2µs | *is_uniqvertexed = \&uniqvertexed; | ||
| 355 | 1 | 2µs | *is_refvertexed = \&refvertexed; | ||
| 356 | 1 | 1µs | *is_refvertexed_stringified = \&refvertexed_stringified; | ||
| 357 | |||||
| 358 | 1 | 2µs | *is_countedged = \&countedged; | ||
| 359 | 1 | 2µs | *is_multiedged = \&multiedged; | ||
| 360 | 1 | 2µs | *is_hyperedged = \&hyperedged; | ||
| 361 | 1 | 1µs | *is_omniedged = \&omniedged; | ||
| 362 | 1 | 1µs | *is_uniqedged = \&uniqedged; | ||
| 363 | |||||
| 364 | sub _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 | ||||
| 371 | 249340 | 163ms | my $g = shift; | ||
| 372 | 24934 | 78.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 | } | ||||
| 375 | my @r; | ||||
| 376 | 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 | } | ||||
| 390 | for my $v ( @_ ) { | ||||
| 391 | unless (defined $v) { | ||||
| 392 | require Carp; | ||||
| 393 | Carp::croak("Graph::add_vertex: undef vertex"); | ||||
| 394 | } | ||||
| 395 | } | ||||
| 396 | 24934 | 132ms | $g->[ _V ]->set_path( @_ ); # spent 132ms making 24934 calls to Graph::AdjacencyMap::Light::set_path, avg 5µs/call | ||
| 397 | $g->[ _G ]++; | ||||
| 398 | 24934 | 39.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 | ||
| 399 | 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 | ||||
| 403 | 14613 | 11.8ms | my $g = shift; | ||
| 404 | my $V = $g->[ _V ]; | ||||
| 405 | 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 | ||||
| 410 | 228 | 18.5ms | my $g = shift; | ||
| 411 | 76 | 16.2ms | my @v = $g->[ _V ]->paths( @_ ); # spent 16.2ms making 76 calls to Graph::AdjacencyMap::Light::paths, avg 213µs/call | ||
| 412 | 76 | 95µ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 | ||||
| 421 | 190 | 3.76ms | my $g = shift; | ||
| 422 | 38 | 16.4ms | my @v = $g->vertices05; # spent 16.4ms making 38 calls to Graph::vertices05, avg 432µs/call | ||
| 423 | 38 | 136µ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 { | ||||
| 426 | 76 | 332µ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 { | ||||
| 441 | return @v; | ||||
| 442 | } | ||||
| 443 | } | ||||
| 444 | } | ||||
| 445 | |||||
| 446 | 1 | 9µ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 | ||||
| 449 | 8 | 1.19ms | my $g = shift; | ||
| 450 | 2 | 10.9ms | my @v = $g->vertices05; # spent 10.9ms making 2 calls to Graph::vertices05, avg 5.44ms/call | ||
| 451 | 2 | 15µ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 { | ||||
| 454 | return @v; | ||||
| 455 | } | ||||
| 456 | } | ||||
| 457 | |||||
| 458 | sub 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 | ||||
| 464 | 299350 | 197ms | my $g = shift; | ||
| 465 | my $V = $g->[ _V ]; | ||||
| 466 | my @e; | ||||
| 467 | if (($V->[ _f ]) & _LIGHT) { | ||||
| 468 | for my $v ( @_ ) { | ||||
| 469 | 24934 | 491ms | $g->add_vertex( $v ) unless exists $V->[ _s ]->{ $v }; # spent 491ms making 24934 calls to Graph::add_vertex, avg 20µs/call | ||
| 470 | 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 | } | ||||
| 480 | return @e; | ||||
| 481 | } | ||||
| 482 | |||||
| 483 | sub _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 | ||||
| 489 | 239480 | 215ms | my $g = shift; | ||
| 490 | 29935 | 99.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 | } | ||||
| 497 | unless (@_ == 2) { | ||||
| 498 | unless ($g->is_hyperedged) { | ||||
| 499 | require Carp; | ||||
| 500 | Carp::croak("Graph::add_edge: graph is not hyperedged"); | ||||
| 501 | } | ||||
| 502 | } | ||||
| 503 | 29935 | 721ms | my @e = $g->_add_edge( @_ ); # spent 721ms making 29935 calls to Graph::_add_edge, avg 24µs/call | ||
| 504 | 29935 | 697ms | $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 | ||
| 505 | $g->[ _G ]++; | ||||
| 506 | 29935 | 48.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 | ||
| 507 | return $g; | ||||
| 508 | } | ||||
| 509 | |||||
| 510 | sub _vertex_ids { | ||||
| 511 | 249650 | 140ms | my $g = shift; | ||
| 512 | my $V = $g->[ _V ]; | ||||
| 513 | my @e; | ||||
| 514 | if (($V->[ _f ] & _LIGHT)) { | ||||
| 515 | for my $v ( @_ ) { | ||||
| 516 | return () unless exists $V->[ _s ]->{ $v }; | ||||
| 517 | 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 | } | ||||
| 527 | 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 | ||||
| 531 | 341163 | 268ms | my $g = shift; | ||
| 532 | my $E = $g->[ _E ]; | ||||
| 533 | my $V = $g->[ _V ]; | ||||
| 534 | my @i; | ||||
| 535 | if (($V->[ _f ] & _LIGHT) && @_ == 2) { | ||||
| 536 | return 0 unless | ||||
| 537 | exists $V->[ _s ]->{ $_[0] } && | ||||
| 538 | exists $V->[ _s ]->{ $_[1] }; | ||||
| 539 | @i = @{ $V->[ _s ] }{ @_[ 0, 1 ] }; | ||||
| 540 | } else { | ||||
| 541 | @i = $g->_vertex_ids( @_ ); | ||||
| 542 | return 0 if @i == 0 && @_; | ||||
| 543 | } | ||||
| 544 | my $f = $E->[ _f ]; | ||||
| 545 | if ($E->[ _a ] == 2 && @i == 2 && !($f & (_HYPER|_REF|_UNIQ))) { # Fast path. | ||||
| 546 | 26277 | 22.7ms | @i = sort @i if ($f & _UNORD); # spent 22.7ms making 26277 calls to Graph::CORE:sort, avg 865ns/call | ||
| 547 | 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 | ||||
| 555 | 1072 | 1.47ms | my $g = shift; | ||
| 556 | my $V = $g->[ _V ]; | ||||
| 557 | 134 | 709µs | my @e = $g->[ _E ]->paths( @_ ); # spent 709µs making 134 calls to Graph::AdjacencyMap::Light::paths, avg 5µs/call | ||
| 558 | wantarray ? | ||||
| 559 | 201 | 607µ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 | ||
| 560 | @v == 1 ? $v[0] : [ @v ] } | ||||
| 561 | @$_ ] } | ||||
| 562 | @e : @e; | ||||
| 563 | } | ||||
| 564 | |||||
| 565 | sub 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 | |||||
| 586 | sub 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 | ||||
| 592 | 536 | 1.04ms | my $g = shift; | ||
| 593 | 134 | 222µ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 { | ||||
| 596 | 268 | 1.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 { | ||||
| 611 | 134 | 3.24ms | return $g->edges05; # spent 3.24ms making 134 calls to Graph::edges05, avg 24µs/call | ||
| 612 | } | ||||
| 613 | } | ||||
| 614 | } | ||||
| 615 | |||||
| 616 | sub has_edges { | ||||
| 617 | my $g = shift; | ||||
| 618 | scalar $g->[ _E ]->has_paths( @_ ); | ||||
| 619 | } | ||||
| 620 | |||||
| 621 | ### | ||||
| 622 | # by_id | ||||
| 623 | # | ||||
| 624 | |||||
| 625 | sub 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 | |||||
| 634 | sub 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 | |||||
| 643 | sub has_vertex_by_id { | ||||
| 644 | my $g = shift; | ||||
| 645 | $g->expect_multivertexed; | ||||
| 646 | $g->[ _V ]->has_path_by_multi_id( @_ ); | ||||
| 647 | } | ||||
| 648 | |||||
| 649 | sub 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 | |||||
| 662 | sub get_multivertex_ids { | ||||
| 663 | my $g = shift; | ||||
| 664 | $g->expect_multivertexed; | ||||
| 665 | $g->[ _V ]->get_multi_ids( @_ ); | ||||
| 666 | } | ||||
| 667 | |||||
| 668 | sub 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 | |||||
| 679 | sub 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 | |||||
| 689 | sub 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 | |||||
| 698 | sub 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 | |||||
| 711 | sub 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 | |||||
| 723 | sub 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 | |||||
| 754 | sub _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 | ||||
| 783 | 647660 | 505ms | my $g = shift; | ||
| 784 | my $n = pop; | ||||
| 785 | my $i = $n == _S ? 0 : -1; # _edges_from() or _edges_to() | ||||
| 786 | my $V = $g->[ _V ]; | ||||
| 787 | my $E = $g->[ _E ]; | ||||
| 788 | my $N = $g->[ $n ]; | ||||
| 789 | my $h = $V->[ _f ] & _HYPER; | ||||
| 790 | unless (defined $N && $N->[ 0 ] == $g->[ _G ]) { | ||||
| 791 | $g->[ $n ]->[ 1 ] = { }; | ||||
| 792 | $N = $g->[ $n ]; | ||||
| 793 | my $u = $E->[ _f ] & _UNORD; | ||||
| 794 | 67 | 168µs | my $Ei = $E->_ids; # spent 168µs making 67 calls to Graph::AdjacencyMap::_ids, avg 3µs/call | ||
| 795 | while (my ($ei, $ev) = each %{ $Ei }) { | ||||
| 796 | next unless @$ev; | ||||
| 797 | my $e = [ $ei, $ev ]; | ||||
| 798 | if ($u) { | ||||
| 799 | push @{ $N->[ 1 ]->{ $ev->[ 0] } }, $e; | ||||
| 800 | push @{ $N->[ 1 ]->{ $ev->[-1] } }, $e; | ||||
| 801 | } else { | ||||
| 802 | my $e = [ $ei, $ev ]; | ||||
| 803 | push @{ $N->[ 1 ]->{ $ev->[$i] } }, $e; | ||||
| 804 | } | ||||
| 805 | } | ||||
| 806 | $N->[ 0 ] = $g->[ _G ]; | ||||
| 807 | } | ||||
| 808 | my @e; | ||||
| 809 | my @at = $h ? $g->vertices_at( @_ ) : @_; | ||||
| 810 | my %at; @at{@at} = (); | ||||
| 811 | for my $v ( @at ) { | ||||
| 812 | 24876 | 75.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 | ||
| 813 | next unless defined $vi && exists $N->[ 1 ]->{ $vi }; | ||||
| 814 | push @e, @{ $N->[ 1 ]->{ $vi } }; | ||||
| 815 | } | ||||
| 816 | 24876 | 102ms | if (wantarray && $g->is_undirected) { # spent 102ms making 24876 calls to Graph::omniedged, avg 4µs/call | ||
| 817 | 24876 | 64.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 | ||
| 818 | for my $e ( @e ) { | ||||
| 819 | unless ( $e->[ 1 ]->[ $i ] == $i[ $i ] ) { | ||||
| 820 | $e = [ $e->[ 0 ], [ reverse @{ $e->[ 1 ] } ] ]; | ||||
| 821 | } | ||||
| 822 | } | ||||
| 823 | } | ||||
| 824 | 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 | ||||
| 828 | 49752 | 83.1ms | push @_, _S; | ||
| 829 | 24876 | 858ms | goto &_edges; # spent 858ms making 24876 calls to Graph::_edges, avg 35µs/call | ||
| 830 | } | ||||
| 831 | |||||
| 832 | sub _edges_to { | ||||
| 833 | push @_, _P; | ||||
| 834 | goto &_edges; | ||||
| 835 | } | ||||
| 836 | |||||
| 837 | sub _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 | |||||
| 845 | sub edges_at { | ||||
| 846 | my $g = shift; | ||||
| 847 | map { $g->_edges_id_path($_ ) } $g->_edges_at( @_ ); | ||||
| 848 | } | ||||
| 849 | |||||
| 850 | sub edges_from { | ||||
| 851 | my $g = shift; | ||||
| 852 | map { $g->_edges_id_path($_ ) } $g->_edges_from( @_ ); | ||||
| 853 | } | ||||
| 854 | |||||
| 855 | sub 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 | ||||
| 861 | 74628 | 70.6ms | my $g = shift; | ||
| 862 | my $E = $g->[ _E ]; | ||||
| 863 | 24876 | 1.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 | |||||
| 868 | sub 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 | |||||
| 876 | sub _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 | |||||
| 900 | sub all_successors { | ||||
| 901 | my $g = shift; | ||||
| 902 | $g->expect_directed; | ||||
| 903 | return $g->_all_successors(@_); | ||||
| 904 | } | ||||
| 905 | |||||
| 906 | sub _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 | |||||
| 930 | sub all_predecessors { | ||||
| 931 | my $g = shift; | ||||
| 932 | $g->expect_directed; | ||||
| 933 | return $g->_all_predecessors(@_); | ||||
| 934 | } | ||||
| 935 | |||||
| 936 | sub 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 | |||||
| 947 | 1 | 2µs | *neighbors = \&neighbours; | ||
| 948 | |||||
| 949 | sub 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 | |||||
| 970 | 1 | 2µs | *all_neighbors = \&all_neighbours; | ||
| 971 | |||||
| 972 | sub all_reachable { | ||||
| 973 | my $g = shift; | ||||
| 974 | $g->directed ? $g->all_successors(@_) : $g->all_neighbors(@_); | ||||
| 975 | } | ||||
| 976 | |||||
| 977 | sub 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 | |||||
| 989 | sub 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 | |||||
| 1003 | sub get_vertex_count { | ||||
| 1004 | my $g = shift; | ||||
| 1005 | $g->[ _V ]->_get_path_count( @_ ) || 0; | ||||
| 1006 | } | ||||
| 1007 | |||||
| 1008 | sub 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 | |||||
| 1015 | sub 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 | |||||
| 1025 | sub 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 | |||||
| 1039 | sub _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 | |||||
| 1047 | sub in_degree { | ||||
| 1048 | my $g = shift; | ||||
| 1049 | $g->_in_degree( @_ ); | ||||
| 1050 | } | ||||
| 1051 | |||||
| 1052 | sub _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 | |||||
| 1060 | sub out_degree { | ||||
| 1061 | my $g = shift; | ||||
| 1062 | $g->_out_degree( @_ ); | ||||
| 1063 | } | ||||
| 1064 | |||||
| 1065 | sub _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 | |||||
| 1073 | sub 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 | |||||
| 1086 | 1 | 2µs | *vertex_degree = \°ree; | ||
| 1087 | |||||
| 1088 | sub is_sink_vertex { | ||||
| 1089 | my $g = shift; | ||||
| 1090 | return 0 unless @_; | ||||
| 1091 | $g->successors( @_ ) == 0 && $g->predecessors( @_ ) > 0; | ||||
| 1092 | } | ||||
| 1093 | |||||
| 1094 | sub is_source_vertex { | ||||
| 1095 | my $g = shift; | ||||
| 1096 | return 0 unless @_; | ||||
| 1097 | $g->predecessors( @_ ) == 0 && $g->successors( @_ ) > 0; | ||||
| 1098 | } | ||||
| 1099 | |||||
| 1100 | sub is_successorless_vertex { | ||||
| 1101 | my $g = shift; | ||||
| 1102 | return 0 unless @_; | ||||
| 1103 | $g->successors( @_ ) == 0; | ||||
| 1104 | } | ||||
| 1105 | |||||
| 1106 | sub is_predecessorless_vertex { | ||||
| 1107 | my $g = shift; | ||||
| 1108 | return 0 unless @_; | ||||
| 1109 | $g->predecessors( @_ ) == 0; | ||||
| 1110 | } | ||||
| 1111 | |||||
| 1112 | sub is_successorful_vertex { | ||||
| 1113 | my $g = shift; | ||||
| 1114 | return 0 unless @_; | ||||
| 1115 | $g->successors( @_ ) > 0; | ||||
| 1116 | } | ||||
| 1117 | |||||
| 1118 | sub is_predecessorful_vertex { | ||||
| 1119 | my $g = shift; | ||||
| 1120 | return 0 unless @_; | ||||
| 1121 | $g->predecessors( @_ ) > 0; | ||||
| 1122 | } | ||||
| 1123 | |||||
| 1124 | sub is_isolated_vertex { | ||||
| 1125 | my $g = shift; | ||||
| 1126 | return 0 unless @_; | ||||
| 1127 | $g->predecessors( @_ ) == 0 && $g->successors( @_ ) == 0; | ||||
| 1128 | } | ||||
| 1129 | |||||
| 1130 | sub 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 | |||||
| 1142 | sub is_exterior_vertex { | ||||
| 1143 | my $g = shift; | ||||
| 1144 | return 0 unless @_; | ||||
| 1145 | $g->predecessors( @_ ) == 0 || $g->successors( @_ ) == 0; | ||||
| 1146 | } | ||||
| 1147 | |||||
| 1148 | sub 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 | |||||
| 1157 | sub sink_vertices { | ||||
| 1158 | my $g = shift; | ||||
| 1159 | grep { $g->is_sink_vertex($_) } $g->vertices05; | ||||
| 1160 | } | ||||
| 1161 | |||||
| 1162 | sub source_vertices { | ||||
| 1163 | my $g = shift; | ||||
| 1164 | grep { $g->is_source_vertex($_) } $g->vertices05; | ||||
| 1165 | } | ||||
| 1166 | |||||
| 1167 | sub successorless_vertices { | ||||
| 1168 | my $g = shift; | ||||
| 1169 | grep { $g->is_successorless_vertex($_) } $g->vertices05; | ||||
| 1170 | } | ||||
| 1171 | |||||
| 1172 | sub predecessorless_vertices { | ||||
| 1173 | my $g = shift; | ||||
| 1174 | grep { $g->is_predecessorless_vertex($_) } $g->vertices05; | ||||
| 1175 | } | ||||
| 1176 | |||||
| 1177 | sub successorful_vertices { | ||||
| 1178 | my $g = shift; | ||||
| 1179 | grep { $g->is_successorful_vertex($_) } $g->vertices05; | ||||
| 1180 | } | ||||
| 1181 | |||||
| 1182 | sub predecessorful_vertices { | ||||
| 1183 | my $g = shift; | ||||
| 1184 | grep { $g->is_predecessorful_vertex($_) } $g->vertices05; | ||||
| 1185 | } | ||||
| 1186 | |||||
| 1187 | sub isolated_vertices { | ||||
| 1188 | my $g = shift; | ||||
| 1189 | grep { $g->is_isolated_vertex($_) } $g->vertices05; | ||||
| 1190 | } | ||||
| 1191 | |||||
| 1192 | sub interior_vertices { | ||||
| 1193 | my $g = shift; | ||||
| 1194 | grep { $g->is_interior_vertex($_) } $g->vertices05; | ||||
| 1195 | } | ||||
| 1196 | |||||
| 1197 | sub exterior_vertices { | ||||
| 1198 | my $g = shift; | ||||
| 1199 | grep { $g->is_exterior_vertex($_) } $g->vertices05; | ||||
| 1200 | } | ||||
| 1201 | |||||
| 1202 | sub 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 | |||||
| 1211 | sub 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 | |||||
| 1222 | sub 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 | |||||
| 1234 | sub 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 | |||||
| 1245 | sub add_cycle { | ||||
| 1246 | my $g = shift; | ||||
| 1247 | $g->add_path(@_, $_[0]); | ||||
| 1248 | } | ||||
| 1249 | |||||
| 1250 | sub delete_cycle { | ||||
| 1251 | my $g = shift; | ||||
| 1252 | $g->expect_non_unionfind; | ||||
| 1253 | $g->delete_path(@_, $_[0]); | ||||
| 1254 | } | ||||
| 1255 | |||||
| 1256 | sub has_cycle { | ||||
| 1257 | my $g = shift; | ||||
| 1258 | @_ ? ($g->has_path(@_, $_[0]) ? 1 : 0) : 0; | ||||
| 1259 | } | ||||
| 1260 | |||||
| 1261 | sub 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 | |||||
| 1272 | sub 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 | |||||
| 1288 | sub 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 | |||||
| 1297 | sub 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 | |||||
| 1306 | sub 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 | |||||
| 1314 | sub 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 | |||||
| 1322 | sub 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 | |||||
| 1329 | sub 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 | |||||
| 1336 | sub 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 | |||||
| 1344 | sub 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 | |||||
| 1352 | sub 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 | |||||
| 1360 | sub 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 | |||||
| 1367 | sub 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 | |||||
| 1375 | sub 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 | |||||
| 1383 | sub 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 | |||||
| 1390 | sub 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 | |||||
| 1397 | sub 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 | |||||
| 1404 | sub 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 | |||||
| 1411 | sub 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 | |||||
| 1418 | sub 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 | |||||
| 1425 | sub 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 | |||||
| 1433 | sub 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 | |||||
| 1443 | sub _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 | sub set_edge_attribute { | ||||
| 1463 | 139706 | 148ms | my $g = shift; | ||
| 1464 | 19958 | 124ms | $g->expect_non_multiedged; # spent 124ms making 19958 calls to Graph::expect_non_multiedged, avg 6µs/call | ||
| 1465 | my $value = pop; | ||||
| 1466 | my $attr = pop; | ||||
| 1467 | my $E = $g->[ _E ]; | ||||
| 1468 | 24913 | 530ms | $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 | ||
| 1469 | 39916 | 628ms | $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 | |||||
| 1472 | sub 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 | |||||
| 1482 | sub 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 | |||||
| 1490 | sub 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 | |||||
| 1499 | sub 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 | |||||
| 1506 | sub 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 | |||||
| 1514 | sub 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 | |||||
| 1522 | sub 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 | |||||
| 1531 | sub 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 | |||||
| 1539 | sub 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 | |||||
| 1547 | sub _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 | ||||
| 1564 | 40056 | 41.7ms | my $g = shift; | ||
| 1565 | 5007 | 33.6ms | $g->expect_non_multiedged; # spent 33.6ms making 5007 calls to Graph::expect_non_multiedged, avg 7µs/call | ||
| 1566 | my $attr = pop; | ||||
| 1567 | 5007 | 53.5ms | return undef unless $g->has_edge( @_ ); # spent 53.5ms making 5007 calls to Graph::has_edge, avg 11µs/call | ||
| 1568 | 5007 | 29.0ms | my @i = $g->_vertex_ids( @_ ); # spent 29.0ms making 5007 calls to Graph::_vertex_ids, avg 6µs/call | ||
| 1569 | return undef if @i == 0 && @_; | ||||
| 1570 | my $E = $g->[ _E ]; | ||||
| 1571 | 5007 | 146ms | $E->_get_path_attr( @i, $attr ); # spent 146ms making 5007 calls to Graph::AdjacencyMap::_get_path_attr, avg 29µs/call | ||
| 1572 | } | ||||
| 1573 | |||||
| 1574 | sub 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 | |||||
| 1583 | sub 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 | |||||
| 1590 | sub 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 | |||||
| 1598 | sub 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 | |||||
| 1605 | sub 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 | |||||
| 1613 | sub 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 | |||||
| 1620 | sub 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 | |||||
| 1628 | sub 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 | |||||
| 1636 | sub 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 | |||||
| 1649 | sub vertex { | ||||
| 1650 | my $g = shift; | ||||
| 1651 | $g->has_vertex( @_ ) ? @_ : undef; | ||||
| 1652 | } | ||||
| 1653 | |||||
| 1654 | sub 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 | |||||
| 1661 | sub 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 | |||||
| 1668 | sub 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 | ||||
| 1675 | 335 | 407µs | my $g = shift; | ||
| 1676 | while (@_) { | ||||
| 1677 | my $u = shift @_; | ||||
| 1678 | 67 | 5.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 | } | ||||
| 1690 | return $g; | ||||
| 1691 | } | ||||
| 1692 | |||||
| 1693 | ### | ||||
| 1694 | # More constructors. | ||||
| 1695 | # | ||||
| 1696 | |||||
| 1697 | sub 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 | |||||
| 1720 | 1 | 2µs | *copy_graph = \© | ||
| 1721 | |||||
| 1722 | sub _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 | |||||
| 1730 | sub _deep_copy_DataDumper { | ||||
| 1731 | my $g = shift; | ||||
| 1732 | my $d = Data::Dumper->new([$g]); | ||||
| 1733 | 2 | 1.88ms | 2 | 98µ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 # 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 | |||||
| 1739 | sub deep_copy { | ||||
| 1740 | if (_can_deep_copy_Storable()) { | ||||
| 1741 | return _deep_copy_Storable(@_); | ||||
| 1742 | } else { | ||||
| 1743 | return _deep_copy_DataDumper(@_); | ||||
| 1744 | } | ||||
| 1745 | } | ||||
| 1746 | |||||
| 1747 | 1 | 2µs | *deep_copy_graph = \&deep_copy; | ||
| 1748 | |||||
| 1749 | sub 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 | |||||
| 1763 | sub 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 | |||||
| 1774 | 1 | 2µs | *transpose = \&transpose_graph; | ||
| 1775 | |||||
| 1776 | sub 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 | |||||
| 1794 | 1 | 2µs | *complement = \&complement_graph; | ||
| 1795 | |||||
| 1796 | sub 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 | |||||
| 1817 | 1 | 2µs | *complete = \&complete_graph; | ||
| 1818 | |||||
| 1819 | ### | ||||
| 1820 | # Transitivity. | ||||
| 1821 | # | ||||
| 1822 | |||||
| 1823 | sub is_transitive { | ||||
| 1824 | my $g = shift; | ||||
| 1825 | Graph::TransitiveClosure::is_transitive($g); | ||||
| 1826 | } | ||||
| 1827 | |||||
| 1828 | ### | ||||
| 1829 | # Weighted vertices. | ||||
| 1830 | # | ||||
| 1831 | |||||
| 1832 | 1 | 800ns | my $defattr = 'weight'; | ||
| 1833 | |||||
| 1834 | sub _defattr { | ||||
| 1835 | return $defattr; | ||||
| 1836 | } | ||||
| 1837 | |||||
| 1838 | sub 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 | |||||
| 1846 | sub 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 | |||||
| 1856 | sub get_vertex_weight { | ||||
| 1857 | my $g = shift; | ||||
| 1858 | $g->expect_non_multivertexed; | ||||
| 1859 | $g->get_vertex_attribute(@_, $defattr); | ||||
| 1860 | } | ||||
| 1861 | |||||
| 1862 | sub has_vertex_weight { | ||||
| 1863 | my $g = shift; | ||||
| 1864 | $g->expect_non_multivertexed; | ||||
| 1865 | $g->has_vertex_attribute(@_, $defattr); | ||||
| 1866 | } | ||||
| 1867 | |||||
| 1868 | sub 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 | |||||
| 1875 | sub delete_vertex_weight { | ||||
| 1876 | my $g = shift; | ||||
| 1877 | $g->expect_non_multivertexed; | ||||
| 1878 | $g->delete_vertex_attribute(@_, $defattr); | ||||
| 1879 | } | ||||
| 1880 | |||||
| 1881 | sub 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 | |||||
| 1889 | sub 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 | |||||
| 1900 | sub get_vertex_weight_by_id { | ||||
| 1901 | my $g = shift; | ||||
| 1902 | $g->expect_multivertexed; | ||||
| 1903 | $g->get_vertex_attribute_by_id(@_, $defattr); | ||||
| 1904 | } | ||||
| 1905 | |||||
| 1906 | sub has_vertex_weight_by_id { | ||||
| 1907 | my $g = shift; | ||||
| 1908 | $g->expect_multivertexed; | ||||
| 1909 | $g->has_vertex_attribute_by_id(@_, $defattr); | ||||
| 1910 | } | ||||
| 1911 | |||||
| 1912 | sub 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 | |||||
| 1919 | sub 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 | ||||
| 1930 | 90018 | 95.5ms | my $g = shift; | ||
| 1931 | 15003 | 92.4ms | $g->expect_non_multiedged; # spent 92.4ms making 15003 calls to Graph::expect_non_multiedged, avg 6µs/call | ||
| 1932 | 15003 | 23.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 { | ||||
| 1937 | my $w = pop; | ||||
| 1938 | 15003 | 972ms | $g->add_edge(@_); # spent 972ms making 15003 calls to Graph::add_edge, avg 65µs/call | ||
| 1939 | 15003 | 843ms | $g->set_edge_attribute(@_, $defattr, $w); # spent 843ms making 15003 calls to Graph::set_edge_attribute, avg 56µs/call | ||
| 1940 | } | ||||
| 1941 | } | ||||
| 1942 | |||||
| 1943 | sub 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 | |||||
| 1961 | sub 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 | |||||
| 1972 | sub 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 | |||||
| 1984 | sub get_edge_weight { | ||||
| 1985 | my $g = shift; | ||||
| 1986 | $g->expect_non_multiedged; | ||||
| 1987 | $g->get_edge_attribute(@_, $defattr); | ||||
| 1988 | } | ||||
| 1989 | |||||
| 1990 | sub has_edge_weight { | ||||
| 1991 | my $g = shift; | ||||
| 1992 | $g->expect_non_multiedged; | ||||
| 1993 | $g->has_edge_attribute(@_, $defattr); | ||||
| 1994 | } | ||||
| 1995 | |||||
| 1996 | sub 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 | |||||
| 2003 | sub delete_edge_weight { | ||||
| 2004 | my $g = shift; | ||||
| 2005 | $g->expect_non_multiedged; | ||||
| 2006 | $g->delete_edge_attribute(@_, $defattr); | ||||
| 2007 | } | ||||
| 2008 | |||||
| 2009 | sub 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 | |||||
| 2023 | sub 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 | |||||
| 2036 | sub get_edge_weight_by_id { | ||||
| 2037 | my $g = shift; | ||||
| 2038 | $g->expect_multiedged; | ||||
| 2039 | $g->get_edge_attribute_by_id(@_, $defattr); | ||||
| 2040 | } | ||||
| 2041 | |||||
| 2042 | sub has_edge_weight_by_id { | ||||
| 2043 | my $g = shift; | ||||
| 2044 | $g->expect_multiedged; | ||||
| 2045 | $g->has_edge_attribute_by_id(@_, $defattr); | ||||
| 2046 | } | ||||
| 2047 | |||||
| 2048 | sub 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 | |||||
| 2055 | sub 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 | |||||
| 2065 | 1 | 200ns | my %expected; | ||
| 2066 | 1 | 4µs | @expected{qw(directed undirected acyclic)} = qw(undirected directed cyclic); | ||
| 2067 | |||||
| 2068 | sub _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 | sub expect_undirected { | ||||
| 2081 | 76 | 187µs | my $g = shift; | ||
| 2082 | 38 | 289µs | _expected('undirected') unless $g->is_undirected; # spent 289µs making 38 calls to Graph::omniedged, avg 8µs/call | ||
| 2083 | } | ||||
| 2084 | |||||
| 2085 | sub expect_directed { | ||||
| 2086 | my $g = shift; | ||||
| 2087 | _expected('directed') unless $g->is_directed; | ||||
| 2088 | } | ||||
| 2089 | |||||
| 2090 | sub expect_acyclic { | ||||
| 2091 | my $g = shift; | ||||
| 2092 | _expected('acyclic') unless $g->is_acyclic; | ||||
| 2093 | } | ||||
| 2094 | |||||
| 2095 | sub 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 | |||||
| 2103 | sub expect_multivertexed { | ||||
| 2104 | my $g = shift; | ||||
| 2105 | _expected('multivertexed') unless $g->is_multivertexed; | ||||
| 2106 | } | ||||
| 2107 | |||||
| 2108 | sub 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 | ||||
| 2114 | 79936 | 83.1ms | my $g = shift; | ||
| 2115 | 39968 | 151ms | _expected('non-multiedged') if $g->is_multiedged; # spent 151ms making 39968 calls to Graph::multiedged, avg 4µs/call | ||
| 2116 | } | ||||
| 2117 | |||||
| 2118 | sub expect_multiedged { | ||||
| 2119 | my $g = shift; | ||||
| 2120 | _expected('multiedged') unless $g->is_multiedged; | ||||
| 2121 | } | ||||
| 2122 | |||||
| 2123 | sub expect_non_unionfind { | ||||
| 2124 | my $g = shift; | ||||
| 2125 | _expected('non-unionfind') if $g->has_union_find; | ||||
| 2126 | } | ||||
| 2127 | |||||
| 2128 | sub _get_options { | ||||
| 2129 | 740 | 2.08ms | my @caller = caller(1); | ||
| 2130 | 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 | } | ||||
| 2133 | my @opt = @{ $_[0] }; | ||||
| 2134 | 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 | } | ||||
| 2137 | return @opt; | ||||
| 2138 | } | ||||
| 2139 | |||||
| 2140 | ### | ||||
| 2141 | # Random constructors and accessors. | ||||
| 2142 | # | ||||
| 2143 | |||||
| 2144 | sub __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 | ||||
| 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. | ||||
| 2164 | 1 | 11µs | *_shuffle = $^P && $] < 5.009003 ? | ||
| 2165 | \&__fisher_yates_shuffle : \&List::Util::shuffle; | ||||
| 2166 | 1 | 8.76ms | 1 | 10µs | } # spent 10µs making 1 call to Graph::BEGIN@2155 |
| 2167 | |||||
| 2168 | sub 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 | |||||
| 2241 | sub random_vertex { | ||||
| 2242 | my $g = shift; | ||||
| 2243 | my @V = $g->vertices05; | ||||
| 2244 | @V[rand @V]; | ||||
| 2245 | } | ||||
| 2246 | |||||
| 2247 | sub random_edge { | ||||
| 2248 | my $g = shift; | ||||
| 2249 | my @E = $g->edges05; | ||||
| 2250 | @E[rand @E]; | ||||
| 2251 | } | ||||
| 2252 | |||||
| 2253 | sub random_successor { | ||||
| 2254 | my ($g, $v) = @_; | ||||
| 2255 | my @S = $g->successors($v); | ||||
| 2256 | @S[rand @S]; | ||||
| 2257 | } | ||||
| 2258 | |||||
| 2259 | sub random_predecessor { | ||||
| 2260 | my ($g, $v) = @_; | ||||
| 2261 | my @P = $g->predecessors($v); | ||||
| 2262 | @P[rand @P]; | ||||
| 2263 | } | ||||
| 2264 | |||||
| 2265 | ### | ||||
| 2266 | # Algorithms. | ||||
| 2267 | # | ||||
| 2268 | |||||
| 2269 | 1 | 3µs | my $MST_comparator = sub { ($_[0] || 0) <=> ($_[1] || 0) }; | ||
| 2270 | |||||
| 2271 | sub _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 | |||||
| 2282 | sub _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 | |||||
| 2291 | sub 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 | sub _MST_add { | ||||
| 2315 | 14989 | 53.9ms | my ($g, $h, $HF, $r, $attr, $unseen) = @_; | ||
| 2316 | 4991 | 332ms | for my $s ( grep { exists $unseen->{ $_ } } $g->successors( $r ) ) { # spent 332ms making 4991 calls to Graph::successors, avg 67µs/call | ||
| 2317 | 15021 | 460ms | $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 | |||||
| 2321 | sub _next_alphabetic { shift; (sort keys %{ $_[0] })[0] } | ||||
| 2322 | sub _next_numeric { shift; (sort { $a <=> $b } keys %{ $_[0] })[0] } | ||||
| 2323 | 20022 | 30.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 | ||
| 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 | ||||
| 2326 | 540 | 5.78ms | my $g = shift; | ||
| 2327 | 36 | 305µs | my %opt = @_ == 1 ? ( first_root => $_[0] ) : _get_options( \@_ ); # spent 305µs making 36 calls to Graph::_get_options, avg 8µs/call | ||
| 2328 | my %unseen; | ||||
| 2329 | 36 | 7.43ms | my @unseen = $g->vertices05; # spent 7.43ms making 36 calls to Graph::vertices05, avg 206µs/call | ||
| 2330 | @unseen{ @unseen } = @unseen; | ||||
| 2331 | 36 | 187µs | @unseen = _shuffle @unseen; # spent 187µs making 36 calls to List::Util::shuffle, avg 5µs/call | ||
| 2332 | my $r; | ||||
| 2333 | if (exists $opt{ start }) { | ||||
| 2334 | $opt{ first_root } = $opt{ start }; | ||||
| 2335 | $opt{ next_root } = undef; | ||||
| 2336 | } | ||||
| 2337 | if (exists $opt{ get_next_root }) { | ||||
| 2338 | $opt{ next_root } = $opt{ get_next_root }; # Graph 0.201 compat. | ||||
| 2339 | } | ||||
| 2340 | 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 { | ||||
| 2347 | $r = shift @unseen; | ||||
| 2348 | } | ||||
| 2349 | my $next = | ||||
| 2350 | exists $opt{ next_root } ? | ||||
| 2351 | $opt{ next_root } : | ||||
| 2352 | $opt{ next_alphabetic } ? | ||||
| 2353 | \&_next_alphabetic : | ||||
| 2354 | $opt{ next_numeric } ? \&_next_numeric : | ||||
| 2355 | \&_next_random; | ||||
| 2356 | my $code = ref $next eq 'CODE'; | ||||
| 2357 | my $attr = exists $opt{ attribute } ? $opt{ attribute } : $defattr; | ||||
| 2358 | 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 | ||||
| 2362 | 35253 | 57.3ms | my ($g, $h, $add, $etc) = splice @_, 0, 4; # Leave %opt in @_. | ||
| 2363 | |||||
| 2364 | 36 | 13.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 | ||
| 2365 | 36 | 189µs | my $HF = Heap071::Fibonacci->new; # spent 189µs making 36 calls to Heap071::Fibonacci::new, avg 5µs/call | ||
| 2366 | |||||
| 2367 | while (defined $r) { | ||||
| 2368 | # print "r = $r\n"; | ||||
| 2369 | 36 | 34.2ms | $add->($g, $h, $HF, $r, $attr, $unseenh, $etc); # spent 34.2ms making 36 calls to Graph::_MST_add, avg 950µs/call | ||
| 2370 | delete $unseenh->{ $r }; | ||||
| 2371 | 36 | 100µs | while (defined $HF->top) { # spent 100µs making 36 calls to Heap071::Fibonacci::top, avg 3µs/call | ||
| 2372 | 5007 | 154ms | 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); | ||||
| 2374 | 1 | 2µs | 5008 | 8.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 |
| 2375 | 5007 | 9.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"; | ||||
| 2377 | if (exists $unseenh->{ $v }) { | ||||
| 2378 | 4955 | 661ms | $h->set_edge_attribute($u, $v, $attr, $w); # spent 661ms making 4955 calls to Graph::set_edge_attribute, avg 133µs/call | ||
| 2379 | delete $unseenh->{ $v }; | ||||
| 2380 | 4955 | 827ms | $add->($g, $h, $HF, $v, $attr, $unseenh, $etc); # spent 827ms making 4955 calls to Graph::_MST_add, avg 167µs/call | ||
| 2381 | } | ||||
| 2382 | } | ||||
| 2383 | } | ||||
| 2384 | return $h unless defined $next; | ||||
| 2385 | 36 | 280µs | $r = $code ? $next->( $g, $unseenh ) : shift @$unseena; # spent 280µs making 36 calls to Graph::_next_random, avg 8µs/call | ||
| 2386 | } | ||||
| 2387 | |||||
| 2388 | 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 | ||||
| 2392 | 108 | 603µs | my $g = shift; | ||
| 2393 | 36 | 443µs | $g->expect_undirected; # spent 443µs making 36 calls to Graph::expect_undirected, avg 12µs/call | ||
| 2394 | 1 | 1.55ms | 108 | 1.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 | |||||
| 2397 | 1 | 2µs | *MST_Dijkstra = \&MST_Prim; | ||
| 2398 | |||||
| 2399 | 1 | 1µs | *minimum_spanning_tree = \&MST_Prim; | ||
| 2400 | |||||
| 2401 | ### | ||||
| 2402 | # Cycle detection. | ||||
| 2403 | # | ||||
| 2404 | |||||
| 2405 | 1 | 2µs | *is_cyclic = \&has_a_cycle; | ||
| 2406 | |||||
| 2407 | sub is_acyclic { | ||||
| 2408 | my $g = shift; | ||||
| 2409 | return !$g->is_cyclic; | ||||
| 2410 | } | ||||
| 2411 | |||||
| 2412 | sub is_dag { | ||||
| 2413 | my $g = shift; | ||||
| 2414 | return $g->is_directed && $g->is_acyclic ? 1 : 0; | ||||
| 2415 | } | ||||
| 2416 | |||||
| 2417 | 1 | 2µs | *is_directed_acyclic_graph = \&is_dag; | ||
| 2418 | |||||
| 2419 | ### | ||||
| 2420 | # Backward compat. | ||||
| 2421 | # | ||||
| 2422 | |||||
| 2423 | sub average_degree { | ||||
| 2424 | my $g = shift; | ||||
| 2425 | my $V = $g->vertices05; | ||||
| 2426 | |||||
| 2427 | return $V ? $g->degree / $V : 0; | ||||
| 2428 | } | ||||
| 2429 | |||||
| 2430 | sub 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 | |||||
| 2441 | sub 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 | |||||
| 2452 | sub _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 | |||||
| 2466 | sub _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 | |||||
| 2480 | sub _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 | |||||
| 2494 | sub 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 | |||||
| 2504 | sub 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 | |||||
| 2515 | sub 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 | |||||
| 2525 | sub 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 | |||||
| 2535 | sub 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 | |||||
| 2546 | sub 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 | |||||
| 2556 | sub 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 | |||||
| 2566 | sub 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 | |||||
| 2580 | sub 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 | |||||
| 2596 | 1 | 2µs | *toposort = \&topological_sort; | ||
| 2597 | |||||
| 2598 | sub _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 | |||||
| 2610 | sub undirected_copy { | ||||
| 2611 | my $g = shift; | ||||
| 2612 | $g->expect_directed; | ||||
| 2613 | return _check_cache($g, 'undirected', \&_undirected_copy_compute); | ||||
| 2614 | } | ||||
| 2615 | |||||
| 2616 | 1 | 2µs | *undirected_copy_graph = \&undirected_copy; | ||
| 2617 | |||||
| 2618 | sub 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 | |||||
| 2633 | 1 | 2µs | *directed_copy_graph = \&directed_copy; | ||
| 2634 | |||||
| 2635 | ### | ||||
| 2636 | # Cache or not. | ||||
| 2637 | # | ||||
| 2638 | |||||
| 2639 | 1 | 6µs | my %_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 | ||||
| 2650 | 18 | 73µs | my ($g, $type, $code) = splice @_, 0, 3; | ||
| 2651 | my $c = $_cache_type{$type}; | ||||
| 2652 | if (defined $c) { | ||||
| 2653 | 2 | 52µs | my $a = $g->get_graph_attribute($c); # spent 52µs making 2 calls to Graph::Attribute::get_attribute, avg 26µs/call | ||
| 2654 | unless (defined $a && $a->[ 0 ] == $g->[ _G ]) { | ||||
| 2655 | $a->[ 0 ] = $g->[ _G ]; | ||||
| 2656 | 2 | 1.40s | $a->[ 1 ] = $code->( $g, @_ ); # spent 1.40s making 2 calls to Graph::_connected_components_compute, avg 701ms/call | ||
| 2657 | 2 | 63µs | $g->set_graph_attribute($c, $a); # spent 63µs making 2 calls to Graph::Attribute::set_attribute, avg 32µs/call | ||
| 2658 | } | ||||
| 2659 | return $a->[ 1 ]; | ||||
| 2660 | } else { | ||||
| 2661 | Carp::croak("Graph: unknown cache type '$type'"); | ||||
| 2662 | } | ||||
| 2663 | } | ||||
| 2664 | |||||
| 2665 | sub _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 | |||||
| 2675 | sub connectivity_clear_cache { | ||||
| 2676 | my $g = shift; | ||||
| 2677 | _clear_cache($g, 'connectivity'); | ||||
| 2678 | } | ||||
| 2679 | |||||
| 2680 | sub strong_connectivity_clear_cache { | ||||
| 2681 | my $g = shift; | ||||
| 2682 | _clear_cache($g, 'strong_connectivity'); | ||||
| 2683 | } | ||||
| 2684 | |||||
| 2685 | sub biconnectivity_clear_cache { | ||||
| 2686 | my $g = shift; | ||||
| 2687 | _clear_cache($g, 'biconnectivity'); | ||||
| 2688 | } | ||||
| 2689 | |||||
| 2690 | sub 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 | |||||
| 2696 | sub SPT_Bellman_Ford_clear_cache { | ||||
| 2697 | my $g = shift; | ||||
| 2698 | _clear_cache($g, 'SPT_Bellman_Ford'); | ||||
| 2699 | } | ||||
| 2700 | |||||
| 2701 | sub 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 | ||||
| 2711 | 26 | 25.5ms | my $g = shift; | ||
| 2712 | my %cce; | ||||
| 2713 | my %cci; | ||||
| 2714 | my $cc = 0; | ||||
| 2715 | 2 | 7µ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 { | ||||
| 2737 | 2 | 12.1ms | my @u = $g->unique_vertices; # spent 12.1ms making 2 calls to Graph::unique_vertices, avg 6.05ms/call | ||
| 2738 | 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 | ||||
| 2740 | 2 | 19µs | (each %r)[1]; | ||
| 2741 | }; | ||||
| 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 | ||||
| 2743 | 72 | 216µs | $cc++ if keys %r; | ||
| 2744 | (each %r)[1]; | ||||
| 2745 | }; | ||||
| 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 | ||||
| 2750 | 19964 | 20.6ms | my ($v, $t) = @_; | ||
| 2751 | $cce{ $v } = $cc; | ||||
| 2752 | push @{ $cci{ $cc } }, $v; | ||||
| 2753 | delete $r{ $v }; | ||||
| 2754 | }, | ||||
| 2755 | 2 | 18.6ms | @_); # spent 18.6ms making 2 calls to Graph::Traversal::new, avg 9.32ms/call | ||
| 2756 | 2 | 1.35s | $t->dfs; # spent 1.35s making 2 calls to Graph::Traversal::postorder, avg 673ms/call | ||
| 2757 | } | ||||
| 2758 | 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 | ||||
| 2762 | 6 | 30µs | my $g = shift; | ||
| 2763 | 2 | 1.40s | my $ccc = _check_cache($g, 'connectivity', # spent 1.40s making 2 calls to Graph::_check_cache, avg 701ms/call | ||
| 2764 | \&_connected_components_compute, @_); | ||||
| 2765 | return @{ $ccc }; | ||||
| 2766 | } | ||||
| 2767 | |||||
| 2768 | sub 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 | |||||
| 2775 | sub 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 | ||||
| 2783 | 8 | 50µs | my $g = shift; | ||
| 2784 | 2 | 46µs | $g->expect_undirected; # spent 46µs making 2 calls to Graph::expect_undirected, avg 23µs/call | ||
| 2785 | 2 | 1.40s | my ($CCE, $CCI) = $g->_connected_components(); # spent 1.40s making 2 calls to Graph::_connected_components, avg 701ms/call | ||
| 2786 | return values %{ $CCI }; | ||||
| 2787 | } | ||||
| 2788 | |||||
| 2789 | sub 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 | |||||
| 2817 | 1 | 2µs | my $super_component = sub { join("+", sort @_) }; | ||
| 2818 | |||||
| 2819 | sub 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 | |||||
| 2839 | sub is_connected { | ||||
| 2840 | my $g = shift; | ||||
| 2841 | $g->expect_undirected; | ||||
| 2842 | my ($CCE, $CCI) = $g->_connected_components(); | ||||
| 2843 | return keys %{ $CCI } == 1; | ||||
| 2844 | } | ||||
| 2845 | |||||
| 2846 | sub is_weakly_connected { | ||||
| 2847 | my $g = shift; | ||||
| 2848 | $g->expect_directed; | ||||
| 2849 | $g->undirected_copy->is_connected(@_); | ||||
| 2850 | } | ||||
| 2851 | |||||
| 2852 | 1 | 2µs | *weakly_connected = \&is_weakly_connected; | ||
| 2853 | |||||
| 2854 | sub weakly_connected_components { | ||||
| 2855 | my $g = shift; | ||||
| 2856 | $g->expect_directed; | ||||
| 2857 | $g->undirected_copy->connected_components(@_); | ||||
| 2858 | } | ||||
| 2859 | |||||
| 2860 | sub weakly_connected_component_by_vertex { | ||||
| 2861 | my $g = shift; | ||||
| 2862 | $g->expect_directed; | ||||
| 2863 | $g->undirected_copy->connected_component_by_vertex(@_); | ||||
| 2864 | } | ||||
| 2865 | |||||
| 2866 | sub weakly_connected_component_by_index { | ||||
| 2867 | my $g = shift; | ||||
| 2868 | $g->expect_directed; | ||||
| 2869 | $g->undirected_copy->connected_component_by_index(@_); | ||||
| 2870 | } | ||||
| 2871 | |||||
| 2872 | sub same_weakly_connected_components { | ||||
| 2873 | my $g = shift; | ||||
| 2874 | $g->expect_directed; | ||||
| 2875 | $g->undirected_copy->same_connected_components(@_); | ||||
| 2876 | } | ||||
| 2877 | |||||
| 2878 | sub weakly_connected_graph { | ||||
| 2879 | my $g = shift; | ||||
| 2880 | $g->expect_directed; | ||||
| 2881 | $g->undirected_copy->connected_graph(@_); | ||||
| 2882 | } | ||||
| 2883 | |||||
| 2884 | sub _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 | |||||
| 2914 | sub _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 | |||||
| 2922 | sub strongly_connected_components { | ||||
| 2923 | my $g = shift; | ||||
| 2924 | $g->expect_directed; | ||||
| 2925 | $g->_strongly_connected_components(@_); | ||||
| 2926 | } | ||||
| 2927 | |||||
| 2928 | sub 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 | |||||
| 2941 | sub 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 | |||||
| 2949 | sub 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 | |||||
| 2968 | sub 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 | |||||
| 3004 | 1 | 2µs | *strongly_connected = \&is_strongly_connected; | ||
| 3005 | |||||
| 3006 | sub 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 | |||||
| 3094 | sub _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 | |||||
| 3109 | sub _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 | |||||
| 3136 | sub _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 | |||||
| 3211 | sub 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 | |||||
| 3219 | sub is_biconnected { | ||||
| 3220 | my $g = shift; | ||||
| 3221 | my ($ap) = ($g->biconnectivity(@_))[0]; | ||||
| 3222 | return $g->edges >= 2 ? @$ap == 0 : undef ; | ||||
| 3223 | } | ||||
| 3224 | |||||
| 3225 | sub is_edge_connected { | ||||
| 3226 | my $g = shift; | ||||
| 3227 | my ($br) = ($g->biconnectivity(@_))[2]; | ||||
| 3228 | return $g->edges >= 2 ? @$br == 0 : undef; | ||||
| 3229 | } | ||||
| 3230 | |||||
| 3231 | sub is_edge_separable { | ||||
| 3232 | my $g = shift; | ||||
| 3233 | my ($br) = ($g->biconnectivity(@_))[2]; | ||||
| 3234 | return $g->edges >= 2 ? @$br > 0 : undef; | ||||
| 3235 | } | ||||
| 3236 | |||||
| 3237 | sub articulation_points { | ||||
| 3238 | my $g = shift; | ||||
| 3239 | my ($ap) = ($g->biconnectivity(@_))[0]; | ||||
| 3240 | return @$ap; | ||||
| 3241 | } | ||||
| 3242 | |||||
| 3243 | 1 | 2µs | *cut_vertices = \&articulation_points; | ||
| 3244 | |||||
| 3245 | sub biconnected_components { | ||||
| 3246 | my $g = shift; | ||||
| 3247 | my ($bc) = ($g->biconnectivity(@_))[1]; | ||||
| 3248 | return @$bc; | ||||
| 3249 | } | ||||
| 3250 | |||||
| 3251 | sub biconnected_component_by_index { | ||||
| 3252 | my $g = shift; | ||||
| 3253 | my $i = shift; | ||||
| 3254 | my ($bc) = ($g->biconnectivity(@_))[1]; | ||||
| 3255 | return $bc->[ $i ]; | ||||
| 3256 | } | ||||
| 3257 | |||||
| 3258 | sub 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 | |||||
| 3265 | sub 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 | |||||
| 3289 | sub 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 | |||||
| 3323 | sub bridges { | ||||
| 3324 | my $g = shift; | ||||
| 3325 | my ($br) = ($g->biconnectivity(@_))[2]; | ||||
| 3326 | return defined $br ? @$br : (); | ||||
| 3327 | } | ||||
| 3328 | |||||
| 3329 | ### | ||||
| 3330 | # SPT. | ||||
| 3331 | # | ||||
| 3332 | |||||
| 3333 | sub _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 | |||||
| 3354 | sub _SPT_Dijkstra_compute { | ||||
| 3355 | } | ||||
| 3356 | |||||
| 3357 | sub 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 | |||||
| 3379 | 1 | 2µs | *SSSP_Dijkstra = \&SPT_Dijkstra; | ||
| 3380 | |||||
| 3381 | 1 | 1µs | *single_source_shortest_paths = \&SPT_Dijkstra; | ||
| 3382 | |||||
| 3383 | sub 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 | |||||
| 3401 | sub __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 | |||||
| 3424 | sub _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 | |||||
| 3459 | sub _SPT_Bellman_Ford_compute { | ||||
| 3460 | } | ||||
| 3461 | |||||
| 3462 | sub 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 | |||||
| 3498 | 1 | 2µs | *SSSP_Bellman_Ford = \&SPT_Bellman_Ford; | ||
| 3499 | |||||
| 3500 | sub 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 | |||||
| 3522 | sub 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 | |||||
| 3529 | 1 | 2µs | *transitive_closure = \&TransitiveClosure_Floyd_Warshall; | ||
| 3530 | |||||
| 3531 | sub 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 | |||||
| 3538 | 1 | 2µs | *all_pairs_shortest_paths = \&APSP_Floyd_Warshall; | ||
| 3539 | |||||
| 3540 | sub _transitive_closure_matrix_compute { | ||||
| 3541 | } | ||||
| 3542 | |||||
| 3543 | sub 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 | |||||
| 3564 | sub path_length { | ||||
| 3565 | my $g = shift; | ||||
| 3566 | my $tcm = $g->transitive_closure_matrix; | ||||
| 3567 | $tcm->path_length(@_); | ||||
| 3568 | } | ||||
| 3569 | |||||
| 3570 | sub path_predecessor { | ||||
| 3571 | my $g = shift; | ||||
| 3572 | my $tcm = $g->transitive_closure_matrix; | ||||
| 3573 | $tcm->path_predecessor(@_); | ||||
| 3574 | } | ||||
| 3575 | |||||
| 3576 | sub path_vertices { | ||||
| 3577 | my $g = shift; | ||||
| 3578 | my $tcm = $g->transitive_closure_matrix; | ||||
| 3579 | $tcm->path_vertices(@_); | ||||
| 3580 | } | ||||
| 3581 | |||||
| 3582 | sub is_reachable { | ||||
| 3583 | my $g = shift; | ||||
| 3584 | my $tcm = $g->transitive_closure_matrix; | ||||
| 3585 | $tcm->is_reachable(@_); | ||||
| 3586 | } | ||||
| 3587 | |||||
| 3588 | sub 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 | |||||
| 3604 | sub _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 | |||||
| 3627 | sub diameter { | ||||
| 3628 | my $g = shift; | ||||
| 3629 | my ($min, $max, $minp, $maxp) = $g->_minmax_path(@_); | ||||
| 3630 | return defined $maxp ? (wantarray ? @$maxp : $max) : undef; | ||||
| 3631 | } | ||||
| 3632 | |||||
| 3633 | 1 | 2µs | *graph_diameter = \&diameter; | ||
| 3634 | |||||
| 3635 | sub 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 | |||||
| 3675 | sub 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 | |||||
| 3693 | sub 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 | |||||
| 3734 | sub 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 | |||||
| 3745 | sub 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 | |||||
| 3762 | 1 | 2µs | *centre_vertices = \¢er_vertices; | ||
| 3763 | |||||
| 3764 | sub 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 | |||||
| 3793 | sub 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 | |||||
| 3807 | sub 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 | |||||
| 3816 | sub 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 | |||||
| 3833 | 1 | 3µs | my %_factorial = (0 => 1, 1 => 1); | ||
| 3834 | |||||
| 3835 | sub __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 | |||||
| 3844 | sub _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 | |||||
| 3854 | sub 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 | |||||
| 3896 | sub 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 | |||||
| 3924 | sub 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 | |||||
| 3956 | sub 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 | |||||
| 4020 | sub _dump { | ||||
| 4021 | require Data::Dumper; | ||||
| 4022 | my $d = Data::Dumper->new([$_[0]],[ref $_[0]]); | ||||
| 4023 | defined wantarray ? $d->Dump : print $d->Dump; | ||||
| 4024 | } | ||||
| 4025 | |||||
| 4026 | 1 | 94µs | 1; | ||
# 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 |