Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

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

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


in reply to Finding subgraphs induced by a set of given vertices.

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


Comment on Re: Finding subgraphs induced by a set of given vertices.
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?

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

        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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://997101]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2014-07-26 12:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (176 votes), past polls