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

[LanX]

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

[zing]

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};"

[zing]

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"

[Anonymous Monk]

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"]] })

[Anonymous Monk]

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 );

[AnomalousMonk]

#~ 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.