linux – 如何在Perl中找到图形的连通组件？

发布时间：2020-12-13 19:14:32 所属栏目：Linux 来源：网络整理

导读：我有以下节点和边的集合.我想要做的是从中找到所有不同的图形. 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],20]}. graph2 = {10=[3

我有以下节点和边的集合.我想要做的是从中找到所有不同的图形.

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],20]}.
   graph2  => {10=>[3,3=>[7]} 
};

有没有现成的算法呢？

解决方法

使用 Graph模块：

#!/usr/bin/perl

use strict; use warnings;

use Graph;

my %connections = (
    36 => [ 31 ],10 => [ 3,31 => [ 30,30 => [ 20 ],22 => [ 20,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

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!