Your skill will accomplishwhat the force of many cannot PerlMonks

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

by LanX (Bishop)
 on Oct 03, 2012 at 17:02 UTC ( #997101=note: print w/replies, xml ) Need Help??

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.

checking for subgraphs is in general far more complicated

Cheers Rolf

• Comment on Re: Finding subgraphs induced by a set of given vertices.

Replies are listed 'Best First'.
Re^2: Finding subgraphs induced by a set of given vertices.
by zing (Beadle) on Oct 03, 2012 at 21:10 UTC
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};"
Re^2: Finding subgraphs induced by a set of given vertices.
by zing (Beadle) on Oct 04, 2012 at 01:10 UTC
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?

Hmm, how to 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"]] })

Naturally I zoned out going from QT to T :) I should have not used @S, I should have called it @Triplets, and I also glossed over the output (one match was missing, doh). In main loop should be

```  for my \$one (@T) {
my @matches = induced( \@S, \$one );
```#~ sub DEBUG(){}  # disable debugging

Also note that  sub DEBUG(){} won't work to disable the  DEBUG() print function because of the empty argument list prototype (unless there's some magic associated with the  #~ thingie). Plain old  DEBUG {} would work, though.

Create A New User
Node Status?
node history
Node Type: note [id://997101]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2018-04-19 22:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My travels bear the most uncanny semblance to ...

Results (75 votes). Check out past polls.

Notices?