Как я могу найти связанные компоненты графа в Perl?

Question

У меня есть следующая коллекция узлов и ребер.То, что я хочу сделать, это найти из него весь отчетливый график.

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 %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]} 
};

Существуют ли алгоритмы, которые это делают?

Answer 1

Используйте модуль График :

#!/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

Answer 2

Чтобы найти подключенные компоненты неориентированного графа, просто выполните BFS или DFS (поиск в ширину / глубину).

Вот пример кода BFS

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]);

Answer 3

Я бы предложил следующий алгоритм:

1.) Переместить все узлы в рабочий набор N.

2.) Начиная с произвольного узла, выполните поиск в графе ( в глубину или в ширину ). Добавьте все посещенные узлы и ребра в первый подграф, удалите посещенные узлы из N

3.) Если N не пусто, выберите следующий начальный узел и перейдите к шагу 2.) для следующего подграфа.