[Bio] / FigKernelPackages / proml.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/proml.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6, Wed Jan 31 01:06:51 2007 UTC revision 1.8, Sun Feb 11 18:35:46 2007 UTC
# Line 94  Line 94 
94  #  Rate values (n of them)  #  Rate values (n of them)
95    
96    
97    use Data::Dumper;
98    
99  use strict;  use strict;
100  use gjonewicklib qw( gjonewick_to_overbeek  use gjonewicklib qw( gjonewick_to_overbeek
101                       newick_is_unrooted                       newick_is_unrooted
# Line 243  Line 245 
245          }          }
246          elsif ( ref( $user_trees->[0] ) ne 'ARRAY' )  # First element not tree          elsif ( ref( $user_trees->[0] ) ne 'ARRAY' )  # First element not tree
247          {          {
248              print STDERR "proml::proml usertree or rearrange option value must be reference to list of trees\n";              print STDERR "proml::proml user_trees or rearrange option value must be reference to list of trees\n";
249              return ();              return ();
250          }          }
251      }      }
# Line 296  Line 298 
298      #                            ]      #                            ]
299      #  Root node of gjonewick always has a descendent list.  If the first      #  Root node of gjonewick always has a descendent list.  If the first
300      #  field of the first tree is not an array reference, they are overbeek      #  field of the first tree is not an array reference, they are overbeek
301      #  trees.  Also relabel tree tips to local ids.      #  trees.
302    
303      my @user_trees = ();      my @user_trees = ();
304      if ( $user_trees )      if ( @$user_trees )
305      {      {
306          if ( @user_trees && ( ref( $user_trees[0]->[0] ) ne 'ARRAY' ) )  # overbeek trees          if ( ref( @$user_trees[0]->[0] ) ne 'ARRAY' )  # overbeek trees
307          {          {
308              @user_trees = map { gjonewicklib::newick_relabel_nodes( $_, \%local_id ) }              @user_trees = map { gjonewicklib::overbeek_to_gjonewick( $_ ) }
                           map { gjonewicklib::overbeek_to_gjonewick( $_ ) }  
309                            @$user_trees;                            @$user_trees;
310          }          }
311          else          else
312          {          {
313              @user_trees = map { gjonewicklib::newick_relabel_nodes( $_, \%local_id ) }              @user_trees = map { gjonewicklib::copy_newick_tree( $_ ) }
314                            @$user_trees;                            @$user_trees;
315          }          }
316    
317          # Make sure trees are unrooted:          # Relabel and make sure trees are unrooted:
318    
319          @user_trees = map { gjonewicklib::newick_is_unrooted( $_ ) ? $_          @user_trees = map { gjonewicklib::newick_is_unrooted( $_ ) ? $_
320                                                                     : gjonewicklib::uproot_newick( $_ )                                                                     : gjonewicklib::uproot_newick( $_ )
321                            }                            }
322                          map { gjonewicklib::newick_relabel_nodes( $_, \%local_id ); $_ }
323                        @user_trees;                        @user_trees;
324      }      }
325    
# Line 368  Line 370 
370      print PROML "P\n"    if $model =~ m/PMB/i;      print PROML "P\n"    if $model =~ m/PMB/i;
371      print PROML "P\nP\n" if $model =~ m/PAM/i;      print PROML "P\nP\n" if $model =~ m/PAM/i;
372    
     print PROML "S\n" if $slow;  
   
373      if ( @user_trees )      if ( @user_trees )
374      {      {
375          &write_intree( @user_trees ) or print STDERR "proml::proml: Could not write intree\n"          &write_intree( @user_trees ) or print STDERR "proml::proml: Could not write intree\n"
# Line 379  Line 379 
379          print PROML "V\n" if $rearrange || $global;          print PROML "V\n" if $rearrange || $global;
380          print PROML "L\n" if $user_lengths && ! $rearrange && ! $global;          print PROML "L\n" if $user_lengths && ! $rearrange && ! $global;
381      }      }
382        elsif ( $slow )  # Slow and user trees are mutually exclusive
383        {
384            print PROML "S\n";
385        }
386    
387      if ( $weights )      if ( $weights )
388      {      {
# Line 388  Line 392 
392          print PROML "W\n";          print PROML "W\n";
393      }      }
394    
395      #  All the options are written, try to lauch the run:      #  All the options are written, try to launch the run:
396    
397      print PROML "Y\n";      print PROML "Y\n";
398    
# Line 406  Line 410 
410          print PROML "$gamma_bins\n";          print PROML "$gamma_bins\n";
411          print PROML "$invar_frac\n" if $invar_frac;          print PROML "$invar_frac\n" if $invar_frac;
412      }      }
413      elsif ( $user_trees )  
414        if ( $user_trees )
415      {      {
416          print PROML "13\n";     #  Random number seed of unknown use          print PROML "13\n";     #  Random number seed of unknown use
417      }      }
# Line 418  Line 423 
423      my @likelihoods = &read_outfile();      my @likelihoods = &read_outfile();
424    
425      my @trees = gjonewicklib::read_newick_trees( 'outtree' );      my @trees = gjonewicklib::read_newick_trees( 'outtree' );
426      @trees or print STDERR "proml::proml: Could read proml outtree file\n"      @trees or print STDERR "proml::proml: Could not read proml outtree file\n"
427                and chdir $cwd                and chdir $cwd
428                and return ();                and return ();
429    

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.8

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3