Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Finding subgraphs induced by a set of given vertices.

by zing (Beadle)
on Oct 03, 2012 at 16:07 UTC ( #997085=perlquestion: print w/ replies, xml ) 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).

Comment on Finding subgraphs induced by a set of given vertices.
Select or Download Code
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
      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

      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.

Re: Finding subgraphs induced by a set of given vertices.
by LanX (Canon) 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 (Abbot) 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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://997085]
Approved by davido
Front-paged by davido
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (10)
As of 2014-11-24 23:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (147 votes), past polls