in reply to Re^2: Sub set where all are connected
in thread Sub set where all are connected
#!/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.
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^4: Sub set where all are connected
by LanX (Saint) on Nov 23, 2019 at 17:38 UTC | |
|
Re^4: Sub set where all are connected
by LanX (Saint) on Nov 23, 2019 at 18:09 UTC | |
by tybalt89 (Monsignor) on Nov 23, 2019 at 20:53 UTC | |
by LanX (Saint) on Nov 23, 2019 at 21:07 UTC | |
by tybalt89 (Monsignor) on Nov 23, 2019 at 21:24 UTC | |
by bliako (Abbot) on Nov 23, 2019 at 20:43 UTC | |
by LanX (Saint) on Nov 23, 2019 at 21:16 UTC | |
by Your Mother (Archbishop) on Nov 24, 2019 at 00:35 UTC | |
by LanX (Saint) on Nov 24, 2019 at 00:47 UTC | |
| |
by bliako (Abbot) on Nov 24, 2019 at 09:41 UTC | |
by LanX (Saint) on Nov 24, 2019 at 14:27 UTC | |
|