### Finding subgraphs induced by a set of given vertices.

 on Oct 03, 2012 at 16:07 UTC Need Help??
zing has asked for the wisdom of the Perl Monks concerning the following question:

Hi guys, I have this code which takes in input in the form of triplets of vertices(see DATA)
```use strict;
use warnings;
use Data::Dumper;

my @S;
while (<DATA>) {
push @S, [split];
}
print "-----TRIPLETS-------\n";
print Dumper \@S;

__DATA__
b c a
a c d
d e b
What Im stuck with is this :: Suppose I have these points=(a,b,c,d); Then I want to find the set of triplets induced by these 4 vertices. For example for above four points the induced triplets should be:
```b c a
a c d
Whereas for vertices=(d,e,a) there isn't any triplet in the data.

Similarly for vertices=(b,e,d) there is a triplet (d e b) in the data(the last one).

Replies are listed 'Best First'.
Re: Finding subgraphs induced by a set of given vertices.
by Anonymous Monk on Oct 03, 2012 at 16:29 UTC

induced? You mean included

```#!/usr/bin/perl --
use strict; use warnings; use Data::Dump;

my @S = do {
open my(\$data), '<', \q{b c a
a c d
d e b};
map { [ split ] } readline \$data;
};

dd \@S;

for my \$QT ( [qw[ a b c d ]], [qw[ b e d ]] ){
dd \$QT;
for my \$triplet ( @S ){
my %Pie;
undef @Pie{@\$QT};
delete @Pie{ @\$triplet };
#~         warn scalar keys %Pie ;
#~         warn scalar @\$QT;
print "@\$triplet\n" if keys(%Pie) <= ( @\$QT - @\$triplet ) ;
}
}
__END__
[["b", "c", "a"], ["a", "c", "d"], ["d", "e", "b"]]
["a" .. "d"]
b c a
a c d
["b", "e", "d"]
d e b

I just wanted to use Graph module.

```#!/usr/bin/perl
use strict; use warnings;
use Graph;

my @path_sets = ( [ "b", "c", "a" ], [ "a", "c", "d" ], [ "d", "e", "b
+" ] );
my @vertex_sets = ( [qw[ a b c d ]], [qw[ b e d ]] );

#convert [b,c,d] to "[b-c,c-d]"
sub to_pathstr {
my @path_set =@_;
my \$pre='';my @ret=();
for (@path_set) {
for( @{\$_} ){
push @ret, "\$pre-\$_" if (\$pre);
\$pre=\$_;
}
}
return @ret;
}
#if edges of path[b,c,d] shares 2 edges of complete graph[a,b,c,d]
#this path go through 3 vertices of graph, maybe.
for my \$vertex_set (@vertex_sets){
my(\$g, \$c);
\$g=new Graph(directed=>1);
\$c=\$g->complete; #ex. [a,b,c,d] =>a-b,a-c,a-d,b-a,b-c,b-d,c-a,c-b,
+c-d,d-a,d-b,d-c
print "target vertex=\$g\n";

#convert array [b,c,d] to "b-c,c-d", Graph module's edge represent
+ation
for my \$pathstr( map{ [ to_pathstr(\$_)] } @path_sets ){
my \$regex=join('|', map{"\Q\$_\E"} @{\$pathstr});
my (@matched)= "\$c" =~ /(\$regex)/g; #check how may egdes match
if( @matched >= 2 ){
print "matched path=".join(',',@\$pathstr)."\n";
}
}
print "\n";
}
Your one with hash operation is nicer than mine.

Thanks Anon,

How do i modify this code to take in input from command line i.e. instead of this line

for my \$QT ( [qw[ a b c d ]], [qw[ b e d ]] )

How do i feed it with input vertices from command line

Re: Finding subgraphs induced by a set of given vertices.
by LanX (Bishop) on Oct 03, 2012 at 17:02 UTC
to give you some explanation of Anonymous Monks code:

you are not checking for subgraphs but subsets.

Perl's way to do this is using hashes, because hash-keys are unique sets of strings.

And hashslices are a very efficient way to determine the cut between to hashes.

see also: Using hashes for set operations...

checking for subgraphs is in general far more complicated

Cheers Rolf

Hi LanX, I tried to make the code a little flexible
```my @z;
for (my \$r = 0; \$r <= 2; \$r++)
{\$z[\$r]=\$subgraphs[0][\$r];}

for my \$QT (@z ){
print Dumper \$QT;
for my \$triplet ( @S ){
my %Pie;
undef @Pie{@\$QT};
delete @Pie{ @\$triplet };
print "@\$triplet\n" if keys(%Pie) <= ( @\$QT - @\$triplet ) ;
}
}
But Im getting this error::

Can't use string ("c") as an ARRAY ref while "strict refs" in use at combo.pl line 89

Line 89 being " undef @Pie{@\$QT};"
Hi Lanx, I have two questions:-

1. Could you please explain me this part of the code posted by anonymous

```for my \$triplet ( @S ){
my %Pie;
undef @Pie{@\$QT};
delete @Pie{ @\$triplet };
print "@\$triplet\n" if keys(%Pie) <= ( @\$QT - @\$triplet ) ;

2. If I call this code as a subroutine,how do I save the retun value of this subroutine.

```sub induced {
my (@z)=@_;
for my \$QT (\@z ){
#print Dumper \$QT;
for my \$triplet ( @trip ){
my %Pie;
undef @Pie{@\$QT};
delete @Pie{ @\$triplet };
print "@\$triplet\n" if keys(%Pie) <= ( @\$QT - @\$triplet ) ;
return @\$triplet;
}
}}
my @C;
my \$d;
my \$p=\$#subgraphs+1;
for (\$d=\$p; \$d >=1; \$d--)
{
print "component \$d = @{ \$subgraphs[\$d-1] }\n";
my (\$qw,\$we,\$er)=&induced(@{ \$subgraphs[\$d-1] });

}
----------OUTPUT------------
component 2 = e d
component 1 = c a b
b c a

But I want to save the return value "b c a"

You say you want to return instead of print?

Think about that for a minute, return instead of print

Hmm, how to return instead of print?

Write return instead of print?

Hmm, yes, write return instead of print, replace print with return, yes, I think that is it :)

But there is a problem with returning instead of printing -- there can be more than one matching triplet , so by returning you only get the first matching triplet

```#!/usr/bin/perl --
use strict;
use warnings;
use Data::Dump qw/ pp /;

Main(@ARGV);
exit(0);

#~ sub DEBUG(){}  # disable debugging
sub DEBUG { my ( \$p, \$f, \$l ) = caller; print "\$f:\$l: ", pp(@_), "\n";
+ }

sub induced {
my \$trip = shift;
my @matches;
for my \$QT ( @_ ) {
DEBUG( \$QT );
for my \$triplet ( @\$trip ) {
DEBUG(\$triplet);
my %seen;        # my %Pie;
DEBUG( \%seen ); # DEBUG( \%Pie );
undef @seen{@\$QT};
DEBUG( \%seen );
delete @seen{@\$triplet};
DEBUG( \%seen );
DEBUG(
{
KEYS_LEFT    => \%seen,
QT_SIZE      => scalar(@\$QT),
TRIPLET_SIZE => scalar(@\$triplet),
},
);

if ( keys( %seen ) <= ( @\$QT - @\$triplet ) ) {
DEBUG( \$triplet );
push @matches, \$triplet;
}
} ## end for my \$triplet ( @\$trip )
} ## end for my \$QT ( @_ )
return @matches;
} ## end sub induced

sub Main {
my @S = ( [ "b", "c", "a" ], [ "a", "c", "d" ], [ "d", "e", "b" ] );
my @T = ( [qw[ a b c d ]], [qw[ b e d ]] );
for my \$one (@S) {
my @matches = induced( \@T, \$one );
print "\nGot some? ", pp( \$one => { MATCHES => \@matches } ), "\n\
+n";
}
} ## end sub Main

__END__
qtPie:16: ["b", "c", "a"]
qtPie:18: ["a" .. "d"]
qtPie:20: {}
qtPie:22: { a => undef, b => undef, c => undef }
qtPie:24: {}
qtPie:25: { KEYS_LEFT => {}, QT_SIZE => 3, TRIPLET_SIZE => 4 }
qtPie:18: ["b", "e", "d"]
qtPie:20: {}
qtPie:22: { a => undef, b => undef, c => undef }
qtPie:24: { a => undef, c => undef }
qtPie:25: {
KEYS_LEFT    => { a => undef, c => undef },
QT_SIZE      => 3,
TRIPLET_SIZE => 3,
}

Got some? (["b", "c", "a"], { MATCHES => [] })

qtPie:16: ["a", "c", "d"]
qtPie:18: ["a" .. "d"]
qtPie:20: {}
qtPie:22: { a => undef, c => undef, d => undef }
qtPie:24: {}
qtPie:25: { KEYS_LEFT => {}, QT_SIZE => 3, TRIPLET_SIZE => 4 }
qtPie:18: ["b", "e", "d"]
qtPie:20: {}
qtPie:22: { a => undef, c => undef, d => undef }
qtPie:24: { a => undef, c => undef }
qtPie:25: {
KEYS_LEFT    => { a => undef, c => undef },
QT_SIZE      => 3,
TRIPLET_SIZE => 3,
}

Got some? (["a", "c", "d"], { MATCHES => [] })

qtPie:16: ["d", "e", "b"]
qtPie:18: ["a" .. "d"]
qtPie:20: {}
qtPie:22: { b => undef, d => undef, e => undef }
qtPie:24: { e => undef }
qtPie:25: { KEYS_LEFT => { e => undef }, QT_SIZE => 3, TRIPLET_SIZE =>
+ 4 }
qtPie:18: ["b", "e", "d"]
qtPie:20: {}
qtPie:22: { b => undef, d => undef, e => undef }
qtPie:24: {}
qtPie:25: { KEYS_LEFT => {}, QT_SIZE => 3, TRIPLET_SIZE => 3 }
qtPie:34: ["b", "e", "d"]

Got some? (["d", "e", "b"], { MATCHES => [["b", "e", "d"]] })
Re: Finding subgraphs induced by a set of given vertices.
by AnomalousMonk (Chancellor) on Oct 04, 2012 at 17:00 UTC

zing: If you run Anonymonk's code of node 997164 with the necessary changes of 997168 and 997253, how does it work for you? It seems to me to produce the results you want given the limited dataset examples you have given.

AM its now what I want.Here's the output from the code given by anonymous
```Got some? (["b", "c", "a"], { MATCHES => [] })

Got some? (["a", "c", "d"], { MATCHES => [] })

Got some? (["d", "e", "b"], { MATCHES => [["b", "e", "d"]] })
But for T = a b c d I have induced = "b", "c", "a" , "a", "c", "d" .

Similarly for T = b e d output should be = "d", "e", "b" .

The code fails on this data Code
```---------DATA--------------
b c a
a c d
d e b
e f g
g d f
h i g
And the output is
```component 2 = e d g f
component 1 = c a b
b c a
Which is wrong, because it should have been this
```

component 2 = e d g f
e f g
g d f
component 1 = c a b
b c a
Because with the vertices in component 2, we can have 4th & 5th row of DATA. Please help on this
I hope I was clear explaining my problem. Please let me know if you need any other information. Help me on his

Create A New User
Node Status?
node history
Node Type: perlquestion [id://997085]
Approved by davido
Front-paged by davido
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (4)
As of 2018-05-20 14:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
World peace can best be achieved by:

Results (150 votes). Check out past polls.

Notices?