I have the following collection of nodes and edges. What I want to do is to find all the distinct graph from it.
my %connections=(36=>[31],10=>[3,4],31=>[30,22],30=>[20],22=>[20,8],20=>[1],8=>[5],5=>[2],2=>[1,20], 3=>[7]);
In this example it will yield:
my %all_graph = {
graph1 => {36=>[31],31=>[30,22],30=>[20],22=>[20,8],20=>[1],8=>[5],5=>[2],2=>[1,20]}.
graph2 => {10=>[3,4], 3=>[7]}
};
Is there any existing algorithms that does that?
Use the Graph module:
#!/usr/bin/perl
use strict; use warnings;
use Graph;
my %connections = (
36 => [ 31 ],
10 => [ 3, 4],
31 => [ 30, 22],
30 => [ 20 ],
22 => [ 20, 8],
20 => [ 1 ],
8 => [ 5 ],
5 => [ 2 ],
2 => [ 1, 20 ],
3 => [ 7 ]
);
my $g = Graph->new( undirected => 1 );
for my $src ( keys %connections ) {
for my $tgt ( @{ $connections{$src} } ) {
$g->add_edge($src, $tgt);
}
}
my @subgraphs = $g->connected_components;
my @allgraphs;
for my $subgraph ( @subgraphs ) {
push @allgraphs, {};
for my $node ( @$subgraph ) {
if ( exists $connections{ $node } ) {
$allgraphs[-1]{$node} = [ @{ $connections{$node} } ];
}
}
}
use YAML; print Dump \@allgraphs;
[sinan@archardy SO]$ ./g --- - 2: - 1 - 20 20: - 1 22: - 20 - 8 30: - 20 31: - 30 - 22 36: - 31 5: - 2 8: - 5 - 10: - 3 - 4 3: - 7
To find the connected components of an undirected graph you just do a BFS or DFS (Breadth/Depth first search).
Here some sample BFS code
my %connections=(36=>[31],10=>[3,4],31=>[30,22],30=>[20],22=>[20,8]
,20=>[1],8=>[5],5=>[2],2=>[1,20], 3=>[7]);
my $full_connections = {}; # Build a REAL graph with full 2-way edge lists
foreach my $node (keys %connections) {
foreach my $node2 (@{ $connections{$node} }) {
print "$node, $node2\n";
$full_connections->{$node}->{$node2} = 1;
$full_connections->{$node2}->{$node} = 1;
}
}
my %all_graph = ();
my $current_graph = 0;
my %visited = ();
my @to_visit = ();
foreach my $node (keys %$full_connections) {
next if exists $visited{$node};
# start the next segment
$current_graph++;
@to_visit=($node);
while (@to_visit) {
$node_to_visit = shift @to_visit;
#next if $visited{$node_to_visit};
$visited{$node_to_visit} = $current_graph;
push @to_visit, grep { !exists $visited{$_} }
keys %{ $full_connections->{$node_to_visit} };
}
}
# Now reconstruct %all_graph from %visited - left as exercise for the reader
print Data::Dumper->Dump([\%visited]);
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With