#!/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.
In reply to Re^3: Sub set where all are connected
by tybalt89
in thread Sub set where all are connected
by Sanjay
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |