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};" | [reply] [d/l] |
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" | [reply] [d/l] [select] |
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"]] })
| [reply] [d/l] |
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 );
| [reply] [d/l] |