Finding subgraphs induced by a set of given vertices.

[zing]

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

[Anonymous Monk]

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

[remiah]

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);
    $g->add_vertices( @$vertex_set );
    $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.

[zing]

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

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

[AnomalousMonk]

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.

[zing]

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" .

[Anonymous Monk]

Gee, like, you can read Re^4: Finding subgraphs induced by a set of given vertices., and like adjust to whatever you actually want

[zing]

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

[zing]

I hope I was clear explaining my problem. Please let me know if you need any other information. Help me on his