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

[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]

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

[Anonymous Monk]

You're hilarious :) When you're done debugging the thing, done learning how it works, switch one debug sub for the other one, the disabling one, in my editor, its select both lines, and hit Ctrl+Q , it toggles comments ( #~ )

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