#!/usr/bin/perl
use strict; # https://perlmonks.org/?node_id=11109069
use warnings;
use List::Util qw( uniq );
my $edges = <<END;
[1,2], [1,3], [1,4], [1,5],
[2,3], [2,4],
[3,4],
[5,6], [5,7], [5,9],
[6,9],
[7,8],
[8,9],
END
$edges =~ s/(?<=\[)[\w,]+(?=\])/ join ',', sort split ',', $& /ge; #
+fix order
#print "$edges\n";
my %alldirect;
my %seen;
find( uniq sort $edges =~ /\w+/g ); # start with e
+very node
sub find
{
$seen{ "@_" }++ and return;
if( my @out = "@_:$edges" =~ /\b(\w+)\b.+\b(\w+)\b.*:(?!.*?\[\1,\2\]
+)/s )
{
for my $node ( @out ) # pair of unconnected nodes, try without
+ each one
{
find( grep $_ ne $node, @_ );
}
}
else
{
$alldirect{ "@_" }++; # it is fully
+connected
}
}
my @seq = sort keys %alldirect;
my %subset; # remove subsets of
+supersets
for my $sub ( @seq )
{
for my $super ( @seq )
{
if( length $sub < length $super and !$subset{$super} and
"$sub\n$super" !~ /\b(\w+)\b.*\n(?!.*\b\1\b)/ ) # sub node
+not found
{
$subset{$sub}++;
last;
}
}
}
my @directlyconnected = grep !$subset{$_}, @seq;
print "$_\n" for @directlyconnected;;
Outputs :
1 2 3 4
1 5
5 6 9
5 7
7 8
8 9
Note: I think your expected output is wrong. 1 2 3 4 are all strongly connected and belong in the same subset.
Quick explanation:
Top down approach. Start with set of all nodes.
Try to find unconnected pair of nodes, if so, try with two subsets, each with one of those nodes.
If no unconnected pair, have a directly connected subset!
Second half eliminates valid subsets of larger valid subsets.
| 