[Bioperl-guts-l] [14791] bioperl-live/trunk/Bio/Tools/Phylo/PAML.pm: adding parsing support for the Standard Errors (SE line) -- this goes into tags doing the clever mapping as in the branch mode -- only tested with Baseml executions

[Albert Vilella]

Revision: 14791
Author:   avilella
Date:     2008-08-07 11:28:02 -0400 (Thu, 07 Aug 2008)

Log Message:
-----------
adding parsing support for the Standard Errors (SE line) -- this goes into tags doing the clever mapping as in the branch mode -- only tested with Baseml executions

Modified Paths:
--------------
    bioperl-live/trunk/Bio/Tools/Phylo/PAML.pm

Modified: bioperl-live/trunk/Bio/Tools/Phylo/PAML.pm
===================================================================
--- bioperl-live/trunk/Bio/Tools/Phylo/PAML.pm	2008-08-06 20:25:03 UTC (rev 14790)
+++ bioperl-live/trunk/Bio/Tools/Phylo/PAML.pm	2008-08-07 15:28:02 UTC (rev 14791)
@@ -921,12 +921,34 @@
 			    }
 			}
 		    }
+                    # Associate SEs to nodes using tags
+                    if (defined($self->{_SEs})) {
+                        my @SEs = split(" ",$self->{_SEs});
+                        my $i = 0;
+                        foreach my $parent_id ( map {/\d+\.\.(\d+)/} split(" ",$self->{_branch_ids}) ) {
+                            my @nodes;
+                            my @node_ids = @{$match{$parent_id}};
+                            my @nodes_L = map { $tree->find_node(-id => $_) } @node_ids;
+                            my $n = @nodes_L < 2 ? shift(@nodes_L) : $tree->get_lca(@nodes_L);
+                            if( ! $n ) {
+                                $self->warn("no node could be found for node in SE assignation (no lca?)");
+                            }
+                            $n->add_tag_value('SE',$SEs[$i]);
+                            $i++;
+                        }
+                    }
 		    push @trees, $tree;
 		}
 	    }
 	    $okay++;
+	} elsif( /^SEs for parameters/ ) {
+          my $se_line = $self->_readline;
+          $se_line =~ s/\n//;
+          $self->{_SEs} = $se_line;
 	} elsif( /^\s*\d+\.\.\d+/ ) {
-	    push @branches, map { [split(/\.\./,$_)] } split;
+          push @branches, map { [split(/\.\./,$_)] } split;
+          my $ids = $_; $ids =~ s/\n//;
+          $self->{_branch_ids} = $ids;
 	}
     }
     return \@trees,\%match;