Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re^2: supertree construction in perl

by zing (Beadle)
on Oct 08, 2012 at 08:34 UTC ( #997769=note: print w/ replies, xml ) Need Help??


in reply to Re: supertree construction in perl
in thread supertree construction in perl

Hi Thomas, Yes you are very true. So I have edited the code properly this time and introduces proper variable names and indentation.

#This program read the triplets from file named "data" and returns the #supertree. # ___DATA(triplets)____ #b c a #a c d #d e b #### NOTE ::: SuperTree part hasnt been incorporated yet. use strict; use warnings; use Data::Dumper; use Graph; use Data::Dump qw/ pp /; ####READ IN THE INPUT DATA ######## my @triplets; # Get all the triplets while (<>) { push @triplets, [ split ]; } #Make a deep copy of @triplets my @triplet_deep_copy = map { [@$_] } @triplets; #####AUXILIARY GRAPH G(L) ####### # In order to generate the G(L) first of all extract first two column +s of @triplets into another matrix my @auxiliary_edges=@triplets; splice(@$_, 2, 1) foreach @auxiliary_edges; print "----EDGE LIST TO BUILD AUXILIARY GRAPH-----\n"; print Dumper \@auxiliary_edges; ##### CONNECTED COMPONENTS ########## my $auxiliary_graph = Graph->new( undirected => 1 ); my @from; my @to; for (my $p = 0; $p <= 2; $p++) { $from[$p]=$triplets[$p][0]; } for (my $q = 0; $q <= 2; $q++) { $to[$q]=$triplets[$q][1]; } for (my $r = 0; $r <= 2; $r++) { $auxiliary_graph->add_edge($from[$r], $to[$r]); } my @subgraphs = $auxiliary_graph->connected_components; # Subgraphs my $V = $auxiliary_graph->vertices; # Number of taxa my $connected_components=scalar @subgraphs; #Get the number of connect +ed components ###### FINDING THE TRIPLETS WHICH ARE SUBSET(OR INDUCED BY) OF EACH OF + THE CONNECTED COMPONENTS###### Main(@auxiliary_edges); exit(0); sub induced { my $trip = shift; my @matches; for my $QT ( @_ ) { for my $triplet ( @$trip ) { my %seen; # my %Pie; undef @seen{@$QT}; delete @seen{@$triplet}; if ( keys( %seen ) <= ( @$QT - @$triplet ) ) { push @matches, $triplet; } } ## end for my $triplet ( @$trip ) } ## end for my $QT ( @_ ) return @matches; }## end sub induced sub Main { my $tree = Graph->new( undirected => 1 ); my $dad='u'; $tree->add_vertex($dad); for my $one (@subgraphs) { my @matches = induced( \@triplet_deep_copy, $one ); print "\nTriplet induced by subgraph ", pp( $one => { MATCHES => + \@matches } ), "\n\n"; } }


Comment on Re^2: supertree construction in perl
Download Code

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (8)
As of 2015-07-02 23:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (47 votes), past polls