Perl Monk, Perl Meditation PerlMonks

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

 on Oct 04, 2012 at 01:10 UTC ( #997155=note: print w/replies, xml ) Need Help??

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"

Replies are listed 'Best First'.
Re^3: Finding subgraphs induced by a set of given vertices.
by Anonymous Monk on Oct 04, 2012 at 02:48 UTC

You say you want to return instead of print?

Hmm, how to 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.

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 ( #~ )

Create A New User
Node Status?
node history
Node Type: note [id://997155]
help
Chatterbox?
 [ambrus]: 1nickt: the tea didn't have sugar or honey or lemon or milk. or even caffeine in a significant quantity. it's really "colored water", warm water with some fruit smell to make it more pleasant than ordinary warm water. [ambrus]: 1nickt: in theory, it shouldn't hurt the electronics, but also could temporarily cause problems until it dries, and the inside of the keyboard doesn't dry quickly, because it's closed. [ambrus]: 1nickt: that's the theory. the theory is also that it should have dried by Sunday morning, but it didn't. so I dunno. [ambrus]: I'll try today evening if it works now.

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (9)
As of 2017-11-21 14:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
In order to be able to say "I know Perl", you must have:

Results (302 votes). Check out past polls.

Notices?