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

Problem printing return value from a subroutine

by zing (Beadle)
on Oct 04, 2012 at 02:17 UTC ( #997160=perlquestion: print w/replies, xml ) Need Help??
zing has asked for the wisdom of the Perl Monks concerning the following question:

Hi all, I have this code
#This program read the triplets from file named "data" into #an array of array. use strict; use warnings; use Data::Dumper; use Graph; use Graph::Subgraph; my @S; while (<>) { push @S, [ split ]; } print "-----TRIPLETS-------\n"; print Dumper \@S; #Make a copy of @S my @trip = map { [@$_] } @S; # Find the number of vertices my @L; for my $i ( 0 .. $#S ) { for my $j ( 0 .. $#{ $S[$i] } ) { push (@L,$S[$i][$j]); } } my %seen; @L = grep { ! $seen{ $_ }++ } @L; print " ----VERTICES------\n"; print Dumper \@L; # Now lets generate the G(L) # In order to generate the G(L) we'll extract first two columns of S i +nto another matrix my @GL=@S; splice(@$_, 2, 1) foreach @GL; print "----EDGE LIST TO BUILD G(L)-----\n"; print Dumper \@GL; #my %h = map { $_->[0] => $_->[1] } @S; #print Dumper(\%h); ##### CONNECTED COMPONENTS ########## my $g = Graph->new( undirected => 1 ); my @a; my @b; for (my $p = 0; $p <= 2; $p++) { $a[$p]=$S[$p][0]; } for (my $q = 0; $q <= 2; $q++) { $b[$q]=$S[$q][1]; } for (my $r = 0; $r <= 2; $r++) { $g->add_edge($a[$r], $b[$r]); } my @subgraphs = $g->connected_components; my @allgraphs; my $V = $g->vertices; print "Number of taxa=$V\n"; my $q=scalar @subgraphs; print "Number of connected components ", $q , "\n"; print "First connected component: ", @{ $subgraphs[0] }, "\n"; print "First connected component element: ", $subgraphs[0][1], "\n\n"; 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=induced(@{ $subgraphs[$d-1] }); print "induced=$qw\n"; }
It takes in the data from data file ,the content of which is
b c a a c d d e b
----TRIPLETS------- $VAR1 = [ [ 'b', 'c', 'a' ], [ 'a', 'c', 'd' ], [ 'd', 'e', 'b' ] ]; ----VERTICES------ $VAR1 = [ 'b', 'c', 'a', 'd', 'e' ]; ----EDGE LIST TO BUILD G(L)----- $VAR1 = [ [ 'b', 'c' ], [ 'a', 'c' ], [ 'd', 'e' ] ]; Number of taxa=5 Number of connected components 2 First connected component: cba First connected component element: b component 2 = e d induced=3 component 1 = c b a b c a induced=3
Problem is with the last 5 lines of the output ,it should have been this
component 2 = e d component 1 = c b a induced=b c a
I know the problem is there in the way the subroutine return value is saved. Please suggest me why is this happening and how to fix it.

Replies are listed 'Best First'.
Re: Problem printing return value from a subroutine
by chromatic (Archbishop) on Oct 04, 2012 at 03:58 UTC

    induced() returns a list flattened from an array. my $qw=induced(@{ $subgraphs[$d-1] }); evaluates that return value in scalar context. If you want to return a scalar, you should join the elements of the array. If you want to return a list, you need to capture it as an array or something which provides list context.

    Improve your skills with Modern Perl: the free book.

      But the problem chromatic is this :-
      component 2 = e d induced=3 component 1 = c b a b c a induced=3
      For component 2 (e d),, there shouldn't be any return value,as there is no line in data which has these vertices. Whereas for component 1(c b a), the first line of data file (b c a) should be returned.
Re: Problem printing return value from a subroutine
by AnomalousMonk (Canon) on Oct 04, 2012 at 04:07 UTC

    Further to chromatic's reply: In scalar context, an array evaluates to the number of elements of the array. This may be where you are getting your 3 from.

      Ok so I changed the last lines of the code
      my (@qw)=induced(@{ $subgraphs[$d-1] }); print Dumper @qw; }
      But still incorrect output
      component 2 = e d $VAR1 = 'b'; $VAR2 = 'c'; $VAR3 = 'a'; component 1 = c a b b c a $VAR1 = 'b'; $VAR2 = 'c'; $VAR3 = 'a';

        I must admit I haven't the foggiest notion what your code is trying to accomplish. However, I have never felt that mere ignorance should deter one from offering advice, so...

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

        The quoted subroutine has two odd, nested for-loops. The outer loop

        for my $QT (\@z ){ ... undef @Pie{@$QT}; ... print "@$triplet\n" if keys(%Pie) <= ( @$QT - @$triplet ) ; ... }

        uses the expression  \@z to create a single item loop list consisting of a reference to the  @z array. The loop will iterate once over this single reference, aliasing (or 'topicalizing', which I believe is the more apt term) its value to the  $QT scalar. The  $QT reference is used a couple of times, in each case being de-referenced to an array prior to use. So, what's the point? Why not just use the  @z array directly and forget about all the indirection and one-pass looping?

        The inner for-loop

        for my $triplet ( @trip ){ my %Pie; undef @Pie{@$QT}; delete @Pie{ @$triplet }; print "@$triplet\n" if keys(%Pie) <= ( @$QT - @$triplet ) ; return (@$triplet); }

        iterates over the global, spooky-action-at-a-distance-prone  @trip array, which seems as if it may have multiple elements. However, since the statement body of the loop ends with the
            return (@$triplet);
        statement, and assuming the  @trip array is not empty to begin with, the loop can only iterate once, another one-shot for-loop. Why not just something like
            my $triplet = $trip[0];
        with the rest of the loop body retained (except for using the  @z array directly rather than via a  $QT array reference de-reference)?

        So we end up with something like (again, I have no idea what this is supposed to do):

        sub induced { my (@z) = @_; my $triplet = $trip[0]; my %Pie; undef @Pie{ @z }; delete @Pie{ @$triplet }; print "@$triplet\n" if keys(%Pie) <= (@z - @$triplet); return @$triplet; }

        Minimizing the cruft and wasted motion may allow you to see more clearly the root causes of your problems. Anyway, that's my USD0.02. I hope it helps.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://997160]
Approved by GrandFather
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (9)
As of 2017-03-29 17:10 GMT
Find Nodes?
    Voting Booth?
    Should Pluto Get Its Planethood Back?

    Results (352 votes). Check out past polls.