Bio/Tools/Run/Phylo/Phylip/DrawTree.pm

   1 # $Id $
   2 #
   3 # BioPerl module for Bio::Tools::Run::Phylo::Phylip::DrawTree
   4 #
   5 # Cared for by Jason Stajich <jason@bioperl.org>
   6 #
   7 # Copyright Jason Stajich
   8 #
   9 # You may distribute this module under the same terms as perl itself
  10
  11 # POD documentation - main docs before the code
  12
  13 =head1 NAME
  14
  15 Bio::Tools::Run::Phylo::Phylip::DrawTree - use Phylip DrawTree program to draw trees
  16
  17 =head1 SYNOPSIS
  18
  19   use Bio::Tools::Run::Phylo::Phylip::DrawTree;
  20
  21   my $drawfact = new Bio::Tools::Run::Phylo::Phylip::DrawTree();
  22   my $treeimagefile = $drawfact->run($tree);
  23
  24 =head1 DESCRIPTION
  25
  26 This is a module for automating drawing of trees through Joe
  27 Felsenstein's Phylip suite.
  28
  29 =head1 FEEDBACK
  30
  31 =head2 Mailing Lists
  32
  33 User feedback is an integral part of the evolution of this and other
  34 Bioperl modules. Send your comments and suggestions preferably to
  35 the Bioperl mailing list.  Your participation is much appreciated.
  36
  37   bioperl-l@bioperl.org              - General discussion
  38   http://bioperl.org/MailList.shtml  - About the mailing lists
  39
  40 =head2 Reporting Bugs
  41
  42 Report bugs to the Bioperl bug tracking system to help us keep track
  43 of the bugs and their resolution. Bug reports can be submitted via
  44 email or the web:
  45
  46   bioperl-bugs@bioperl.org
  47   http://bugzilla.bioperl.org/
  48
  49 =head1 AUTHOR - Jason Stajich
  50
  51 Email jason@bioperl.org
  52
  53 Describe contact details here
  54
  55 =head1 CONTRIBUTORS
  56
  57 Additional contributors names and emails here
  58
  59 =head1 APPENDIX
  60
  61 The rest of the documentation details each of the object methods.
  62 Internal methods are usually preceded with a _
  63
  64 =cut
  65
  66
  67 # Let the code begin...
  68
  69
  70 package Bio::Tools::Run::Phylo::Phylip::DrawTree;
  71 use vars qw($AUTOLOAD @ISA $PROGRAM $PROGRAMDIR $PROGRAMNAME
  72             $FONTFILE @DRAW_PARAMS @OTHER_SWITCHES
  73             %OK_FIELD %DEFAULT);
  74 use strict;
  75
  76 use Bio::Tools::Run::Phylo::Phylip::Base;
  77 use Cwd;
  78 @ISA = qw( Bio::Tools::Run::Phylo::Phylip::Base );
  79
  80 # inherit from Phylip::Base which has some methods for dealing with
  81 # Phylip specifics
  82 @ISA = qw(Bio::Tools::Run::Phylo::Phylip::Base);
  83
  84 # You will need to enable the neighbor program. This
  85 # can be done in (at least) 3 ways:
  86 #
  87 # 1. define an environmental variable PHYLIPDIR:
  88 # export PHYLIPDIR=/home/shawnh/PHYLIP/bin
  89 #
  90 # 2. include a definition of an environmental variable PHYLIPDIR in
  91 # every script that will use DrawTree.pm.
  92 # $ENV{PHYLIPDIR} = '/home/shawnh/PHYLIP/bin';
  93 #
  94 # 3. You can set the path to the program through doing:
  95 # my @params('program'=>'/usr/local/bin/drawgram');
  96 # my $neighbor_factory = Bio::Tools::Run::Phylo::Phylip::DrawTree->new(@params)
  97
  98 BEGIN {
  99     %DEFAULT = ('PLOTTER' => 'L',
 100                 'SCREEN'  => 'N');
 101
 102     $PROGRAMNAME="drawtree";
 103     if (defined $ENV{'PHYLIPDIR'}) {
 104         $PROGRAMDIR = $ENV{'PHYLIPDIR'} || '';
 105         $PROGRAM = Bio::Root::IO->catfile($PROGRAMDIR,
 106                                           $PROGRAMNAME.($^O =~ /mswin/i ?'.exe':''));
 107         $DEFAULT{'FONTFILE'} = Bio::Root::IO->catfile($ENV{'PHYLIPDIR'},"font1");
 108     }
 109     else {
 110         $PROGRAM = $PROGRAMNAME;
 111     }
 112
 113     @DRAW_PARAMS = qw(PLOTTER SCREEN LABEL_ANGLE ROTATION TREEARC
 114                       ITERATE SCALE
 115                       HORIZMARGINS VERTICALMARGINS
 116                       CHARHEIGHT
 117                       ENTHUSIASM
 118                       FONT
 119                       );
 120     @OTHER_SWITCHES = qw(QUIET);
 121     foreach my $attr(@DRAW_PARAMS,@OTHER_SWITCHES) {
 122         $OK_FIELD{$attr}++;
 123     }
 124 }
 125
 126 =head2 program_name
 127
 128  Title   : program_name
 129  Usage   : >program_name()
 130  Function: holds the program name
 131  Returns:  string
 132  Args    : None
 133
 134 =cut
 135
 136 sub program_name {
 137   return 'drawtree';
 138 }
 139
 140 =head2 program_dir
 141
 142  Title   : program_dir
 143  Usage   : ->program_dir()
 144  Function: returns the program directory, obtiained from ENV variable.
 145  Returns:  string
 146  Args    :
 147
 148 =cut
 149
 150 sub program_dir {
 151   return Bio::Root::IO->catfile($ENV{PHYLIPDIR}) if $ENV{PHYLIPDIR};
 152 }
 153
 154 =head2 new
 155
 156  Title   : new
 157  Usage   : my $obj = new Bio::Tools::Run::Phylo::Phylip::DrawTree();
 158  Function: Builds a new Bio::Tools::Run::Phylo::Phylip::DrawTree object
 159  Returns : an instance of Bio::Tools::Run::Phylo::Phylip::DrawTree
 160  Args    : The available DrawGram parameters
 161
 162
 163 =cut
 164
 165 sub new {
 166   my($class,@args) = @_;
 167
 168   my $self = $class->SUPER::new(@args);
 169
 170   my ($attr, $value);
 171
 172   while (@args)  {
 173       $attr =   shift @args;
 174       $value =  shift @args;
 175       next if( $attr =~ /^-/ ); # don't want named parameters
 176       if ($attr =~/PROGRAM/i) {
 177           $self->executable($value);
 178           next;
 179       }
 180       $self->$attr($value);
 181   }
 182   $self->plotter($DEFAULT{'PLOTTER'}) unless $self->plotter;
 183   $self->screen($DEFAULT{'SCREEN'}) unless $self->screen;
 184   $self->fontfile($DEFAULT{'FONTFILE'}) unless $self->fontfile;
 185   return $self;
 186 }
 187
 188
 189 sub AUTOLOAD {
 190     my $self = shift;
 191     my $attr = $AUTOLOAD;
 192     $attr =~ s/.*:://;
 193     $attr = uc $attr;
 194     $self->throw("Unallowed parameter: $attr !") unless $OK_FIELD{$attr};
 195     $self->{$attr} = shift if @_;
 196     return $self->{$attr};
 197 }
 198
 199 =head2 run
 200
 201  Title   : run
 202  Usage   : my $file = $app->run($treefile);
 203  Function: Draw a tree
 204  Returns : File containing the rendered tree
 205  Args    : either a Bio::Tree::TreeI
 206             OR
 207            filename of a tree in newick format
 208
 209 =cut
 210
 211 sub run{
 212    my ($self,$input) = @_;
 213
 214    # Create input file pointer
 215    my ($infilename) = $self->_setinput($input);
 216     if (!$infilename) {
 217         $self->throw("Problems setting up for drawgram. Probably bad input data in $input !");
 218     }
 219
 220     # Create parameter string to pass to neighbor program
 221     my $param_string = $self->_setparams();
 222
 223     # run drawgram
 224     my $plotfile = $self->_run($infilename,$param_string);
 225     return $plotfile;
 226 }
 227
 228 =head2 draw_tree
 229
 230  Title   : draw_tree
 231  Usage   : my $file = $app->draw_tree($treefile);
 232  Function: This method is deprecated. Please use run method.
 233  Returns : File containing the rendered tree
 234  Args    : either a Bio::Tree::TreeI
 235             OR
 236            filename of a tree in newick format
 237
 238 =cut
 239
 240 sub draw_tree{
 241   return shift->run(@_);
 242 }
 243
 244 =head2  _run
 245
 246  Title   :  _run
 247  Usage   :  Internal function, not to be called directly
 248  Function:  makes actual system call to drawgram program
 249  Example :
 250  Returns : Bio::Tree object
 251  Args    : Name of a file the tree to draw in newick format
 252            and a parameter string to be passed to drawgram
 253
 254
 255 =cut
 256
 257 sub _run {
 258     my ($self,$infile,$param_string) = @_;
 259     my $instring;
 260     my $curpath = cwd;
 261
 262     unless( File::Spec->file_name_is_absolute($infile) ) {
 263         $infile = $self->io->catfile($curpath,$infile);
 264     }
 265     $instring = $infile . "\n";
 266     if( ! defined $self->fontfile ) {
 267         $self->throw("You must have defined a fontfile");
 268     }
 269
 270     if( -e $self->io->catfile($curpath,'fontfile') ) {
 271         $instring .= $self->io->catfile($curpath,'fontfile')."\n";
 272     } elsif( File::Spec->file_name_is_absolute($self->fontfile) ) {
 273         #$instring .= $self->io->catfile($self->tempdir,$self->fontfile)."\n";
 274         $instring .= $self->io->catfile($self->fontfile)."\n";
 275     } else {
 276         $instring .= $self->io->catfile($curpath,$self->fontfile)."\n";
 277     }
 278     chdir($self->tempdir);
 279     $instring .= $param_string;
 280     $self->debug( "Program ".$self->executable." $param_string\n");
 281     # open a pipe to run drawgram to bypass interactive menus
 282     if ($self->quiet() || $self->verbose() < 0) {
 283         open(DRAW,"|".$self->executable.">/dev/null");
 284     }
 285     else {
 286         open(DRAW,"|".$self->executable);
 287     }
 288     print DRAW $instring;
 289     close(DRAW);
 290     chdir($curpath);
 291     #get the results
 292     my $plotfile = $self->io->catfile($self->tempdir,$self->plotfile);
 293
 294     $self->throw("drawgram did not create plotfile correctly ($plotfile)")
 295         unless (-e $plotfile);
 296     return $plotfile;
 297 }
 298
 299 =head2  _setinput()
 300
 301  Title   :  _setinput
 302  Usage   :  Internal function, not to be called directly
 303  Function:  Create input file for drawing program
 304  Example :
 305  Returns : filename containing tree in newick format
 306  Args    : Bio::Tree::TreeI object
 307
 308
 309 =cut
 310
 311 sub _setinput {
 312     my ($self, $input) = @_;
 313     my $treefile;
 314     unless (ref $input) {
 315         # check that file exists or throw
 316         $treefile = $input;
 317         unless (-e $input) {return 0;}
 318
 319     } elsif ($input->isa("Bio::Tree::TreeI")) {
 320         #  Open temporary file for both reading & writing of BioSeq array
 321         my $tfh;
 322         ($tfh,$treefile) = $self->io->tempfile(-dir=>$self->tempdir);
 323         my $treeIO = Bio::TreeIO->new(-fh => $tfh,
 324                                       -format=>'newick');
 325         $treeIO->write_tree($input);
 326         $treeIO->close();
 327         close($tfh);
 328         undef $tfh;
 329     }
 330     return $treefile;
 331 }
 332
 333 =head2  _setparams()
 334
 335  Title   :  _setparams
 336  Usage   :  Internal function, not to be called directly
 337  Function:   Create parameter inputs for drawgram program
 338  Example :
 339  Returns : parameter string to be passed to drawgram
 340  Args    : name of calling object
 341
 342 =cut
 343
 344 sub _setparams {
 345     my ($attr, $value, $self);
 346
 347     #do nothing for now
 348     $self = shift;
 349     my $param_string = "";
 350     my $cat = 0;
 351     my ($hmargin,$vmargin);
 352     foreach  my $attr ( @DRAW_PARAMS) {
 353         $value = $self->$attr();
 354
 355         $attr = uc($attr);
 356         next unless (defined $value);
 357         if ($attr eq 'PLOTTER' ||
 358             $attr eq 'SCREEN' ) {
 359             # take first char of the input
 360             $param_string .= uc(substr($value,0,1))."\n";
 361             next;
 362         } elsif( $attr eq 'USEBRANCHLENS' ) {
 363             if( uc(substr($value,0,1)) eq 'Y' ||
 364                 uc(substr($value,0,1)) eq '1'
 365                 ) {
 366                 $self->warn("Expected a number in $attr\n");
 367                 next;
 368             }
 369             $param_string .= "1\n$1";
 370         } elsif( $attr eq 'LABEL_ANGLE' ) {
 371             if( $value !~ /([FRA])/i ) {
 372                 $self->warn("($attr)Expected value of one of F,R,A");
 373                 next;
 374             }
 375             my $a = $1;
 376             $param_string .= "2\n$a\n";
 377             if( $a eq 'F' ) {
 378                 my $angle = 0;
 379                 if( $value =~ /(\-?\d+(\.\d+)?)/ ) {
 380                     $angle = $1;
 381                     if( $angle >= 90 || $angle < -90 ) {
 382                         $self->warn("provided an angle which is too large ($angle) expected -90 <= $angle <= 90, setting it to 0");
 383                         $angle = 0;
 384                     }
 385                 }
 386                 $param_string .= "$angle\n";
 387             }
 388         } elsif( $attr eq 'ROTATION' ) {
 389             if( $value !~ /(\-?\d+(\.\d+)?)/ ||
 390                 $1 < -360 || $1 > 360 ) {
 391                 $self->warn("($attr)Expected a number between -360 and 360 $attr\n");
 392                 next;
 393             }
 394             $param_string = "3\n$1\n";
 395         } elsif( $attr eq 'TREEARC' ) {
 396             if( $value !~ /(\-?\d+(\.\d+)?)/ ||
 397                 $1 <= 0 || $1 > 360 ) {
 398                 $self->warn("($attr)Expected a number between -360 and 360 $attr\n");
 399                 next;
 400             }
 401             $param_string = "4\n$1\n";
 402         } elsif( $attr eq 'ITERATE' ) {
 403             if( uc(substr($value,0,1)) eq 'N' ||
 404                 substr($value,0,1) eq '0' ) {
 405                 $param_string .= "5\n";
 406             }
 407         } elsif( $attr eq 'SCALE' ) {
 408             if( $value !~ /(\d+(\.\d+)?)/ ) {
 409                 $self->warn("($attr)Expected a number in $attr\n");
 410                 next;
 411             }
 412             $param_string .= "6\n$1\n";
 413         } elsif( $attr eq 'HORIZMARGINS' ) {
 414             if( $value !~ /(\d+(\.\d+)?)/ ) {
 415                 $self->warn("($attr)Expected a number in $attr\n");
 416                 next;
 417             }
 418             $hmargin = $1;
 419         } elsif( $attr eq 'VERTICALMARGINS' ) {
 420             if( $value !~ /(\d+(\.\d+)?)/ ) {
 421                 $self->warn("Expected a number in $attr\n");
 422                 next;
 423             }
 424             $vmargin = $1;
 425         } elsif( $attr eq 'CHARHEIGHT' ) {
 426             if( $value !~ /(\d+(\.\d+)?)/ ) {
 427                 $self->warn("Expected a number in $attr\n");
 428                 next;
 429             }
 430             $param_string .= "8\n$1";
 431         } elsif( $attr eq 'ENTHUSIASM' ) {
 432             if( $value !~ /(\d+(\.\d+)?)/ ) {
 433                 $self->warn("Expected a number from in $attr\n");
 434                 next;
 435             }
 436             $param_string .= "9\n$1\n";
 437
 438         } elsif( $attr eq 'FONT' ) {
 439             $value =~ s/([\w\d]+)\s+/$1/g;
 440             $param_string .= "10\n$value\n";
 441         }
 442     }
 443     if( $hmargin || $vmargin ) {
 444         $hmargin ||= '.';
 445         $vmargin ||= '.';
 446         $param_string .= "5\n$hmargin\n$vmargin\n";
 447     }
 448
 449     $param_string .="Y\n";
 450     return $param_string;
 451 }
 452
 453
 454
 455 =head1 Bio::Tools::Run::Wrapper methods
 456
 457 =cut
 458
 459 =head2 no_param_checks
 460
 461  Title   : no_param_checks
 462  Usage   : $obj->no_param_checks($newval)
 463  Function: Boolean flag as to whether or not we should
 464            trust the sanity checks for parameter values
 465  Returns : value of no_param_checks
 466  Args    : newvalue (optional)
 467
 468
 469 =cut
 470
 471 =head2 save_tempfiles
 472
 473  Title   : save_tempfiles
 474  Usage   : $obj->save_tempfiles($newval)
 475  Function:
 476  Returns : value of save_tempfiles
 477  Args    : newvalue (optional)
 478
 479
 480 =cut
 481
 482 =head2 outfile_name
 483
 484  Title   : outfile_name
 485  Usage   : my $outfile = $dragram->outfile_name();
 486  Function: Get/Set the name of the output file for this run
 487            (if you wanted to do something special)
 488  Returns : string
 489  Args    : [optional] string to set value to
 490
 491
 492 =cut
 493
 494
 495 =head2 tempdir
 496
 497  Title   : tempdir
 498  Usage   : my $tmpdir = $self->tempdir();
 499  Function: Retrieve a temporary directory name (which is created)
 500  Returns : string which is the name of the temporary directory
 501  Args    : none
 502
 503
 504 =cut
 505
 506 =head2 cleanup
 507
 508  Title   : cleanup
 509  Usage   : $codeml->cleanup();
 510  Function: Will cleanup the tempdir directory after a DrawTree run
 511  Returns : none
 512  Args    : none
 513
 514
 515 =cut
 516
 517 =head2 io
 518
 519  Title   : io
 520  Usage   : $obj->io($newval)
 521  Function:  Gets a L<Bio::Root::IO> object
 522  Returns : L<Bio::Root::IO>
 523  Args    : none
 524
 525
 526 =cut
 527
 528 1; # Needed to keep compiler happy