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

   1 # $Id $
   2 #
   3 # BioPerl module for Bio::Tools::Run::Phylo::Phylip::DrawGram
   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::DrawGram - use Phylip DrawTree program to draw phylograms or phenograms
  16
  17 =head1 SYNOPSIS
  18
  19   use Bio::Tools::Run::Phylo::Phylip::DrawGram;
  20
  21   my $drawfact = new Bio::Tools::Run::Phylo::Phylip::DrawGram();
  22   my $treeimage = $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::DrawGram;
  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 DrawGram.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::DrawGram->new(@params)
  97
  98 BEGIN {
  99     %DEFAULT = ('PLOTTER' => 'L',
 100                 'SCREEN'  => 'N');
 101         $DEFAULT{'FONTFILE'} = Bio::Root::IO->catfile($ENV{'PHYLIPDIR'},"font1") if $ENV{'PHYLIPDIR'};
 102
 103     @DRAW_PARAMS = qw(PLOTTER SCREEN TREEDIR TREESTYLE USEBRANCHLENS
 104                       LABEL_ANGLE HORIZMARGINS VERTICALMARGINS
 105                       SCALE TREEDEPTH STEMLEN TIPSPACE ANCESTRALNODES
 106                       FONT);
 107     @OTHER_SWITCHES = qw(QUIET);
 108     foreach my $attr(@DRAW_PARAMS,@OTHER_SWITCHES) {
 109         $OK_FIELD{$attr}++;
 110     }
 111 }
 112
 113 =head2 program_name
 114
 115  Title   : program_name
 116  Usage   : >program_name()
 117  Function: holds the program name
 118  Returns:  string
 119  Args    : None
 120
 121 =cut
 122
 123 sub program_name {
 124   return 'drawgram';
 125 }
 126
 127 =head2 program_dir
 128
 129  Title   : program_dir
 130  Usage   : ->program_dir()
 131  Function: returns the program directory, obtiained from ENV variable.
 132  Returns:  string
 133  Args    :
 134
 135 =cut
 136
 137 sub program_dir {
 138   return Bio::Root::IO->catfile($ENV{PHYLIPDIR}) if $ENV{PHYLIPDIR};
 139 }
 140
 141 =head2 new
 142
 143  Title   : new
 144  Usage   : my $obj = new Bio::Tools::Run::Phylo::Phylip::DrawGram();
 145  Function: Builds a new Bio::Tools::Run::Phylo::Phylip::DrawGram object
 146  Returns : an instance of Bio::Tools::Run::Phylo::Phylip::DrawGram
 147  Args    : The available DrawGram parameters
 148
 149
 150 =cut
 151
 152 sub new {
 153   my($class,@args) = @_;
 154
 155   my $self = $class->SUPER::new(@args);
 156
 157   my ($attr, $value);
 158
 159   while (@args)  {
 160       $attr =   shift @args;
 161       $value =  shift @args;
 162       next if( $attr =~ /^-/ ); # don't want named parameters
 163       if ($attr =~/PROGRAM/i) {
 164           $self->executable($value);
 165           next;
 166       }
 167       $self->$attr($value);
 168   }
 169   $self->plotter($DEFAULT{'PLOTTER'}) unless $self->plotter;
 170   $self->screen($DEFAULT{'SCREEN'}) unless $self->screen;
 171   $self->fontfile($DEFAULT{'FONTFILE'}) unless $self->fontfile;
 172   return $self;
 173 }
 174
 175
 176 sub AUTOLOAD {
 177     my $self = shift;
 178     my $attr = $AUTOLOAD;
 179     $attr =~ s/.*:://;
 180     $attr = uc $attr;
 181     $self->throw("Unallowed parameter: $attr !") unless $OK_FIELD{$attr};
 182     $self->{$attr} = shift if @_;
 183     return $self->{$attr};
 184 }
 185
 186 =head2 run
 187
 188  Title   : run
 189  Usage   : my $file = $app->run($treefile);
 190  Function: Draw a tree
 191  Returns : File containing the rendered tree
 192  Args    : either a Bio::Tree::TreeI
 193             OR
 194            filename of a tree in newick format
 195
 196 =cut
 197
 198 sub run{
 199    my ($self,$input) = @_;
 200
 201    # Create input file pointer
 202    my ($infilename) = $self->_setinput($input);
 203     if (!$infilename) {
 204         $self->throw("Problems setting up for drawgram. Probably bad input data in $input !");
 205     }
 206
 207     # Create parameter string to pass to neighbor program
 208     my $param_string = $self->_setparams();
 209
 210     # run drawgram
 211     my $plotfile = $self->_run($infilename,$param_string);
 212     return $plotfile;
 213 }
 214
 215 =head2 draw_tree
 216
 217  Title   : draw_tree
 218  Usage   : my $file = $app->draw_tree($treefile);
 219  Function: This method is deprecated. Please use run instead.
 220  Returns : File containing the rendered tree
 221  Args    : either a Bio::Tree::TreeI
 222             OR
 223            filename of a tree in newick format
 224
 225 =cut
 226
 227 sub draw_tree{
 228   return shift->run(@_);
 229 }
 230
 231 =head2  _run
 232
 233  Title   :  _run
 234  Usage   :  Internal function, not to be called directly
 235  Function:  makes actual system call to drawgram program
 236  Example :
 237  Returns : Bio::Tree object
 238  Args    : Name of a file the tree to draw in newick format
 239            and a parameter string to be passed to drawgram
 240
 241
 242 =cut
 243
 244 sub _run {
 245     my ($self,$infile,$param_string) = @_;
 246     my $instring;
 247     my $curpath = cwd;
 248     unless( File::Spec->file_name_is_absolute($infile) ) {
 249         $infile = $self->io->catfile($curpath,$infile);
 250     }
 251     $instring = $infile . "\n";
 252     if( ! defined $self->fontfile ) {
 253         $self->throw("You must have defined a fontfile");
 254     }
 255
 256     if( -e $self->io->catfile($curpath,'fontfile') ) {
 257         $instring .= $self->io->catfile($curpath,'fontfile')."\n";
 258     } elsif( File::Spec->file_name_is_absolute($self->fontfile) ) {
 259         $instring .= $self->io->catfile($self->fontfile)."\n";
 260     } else {
 261         $instring .= $self->io->catfile($curpath,$self->fontfile)."\n";
 262     }
 263
 264     chdir($self->tempdir);
 265     $instring .= $param_string;
 266     $self->debug( "Program ".$self->executable." $param_string\n");
 267     # open a pipe to run drawgram to bypass interactive menus
 268     if ($self->quiet() || $self->verbose() < 0) {
 269         open(DRAW,"|".$self->executable.">/dev/null");
 270     }
 271     else {
 272         open(DRAW,"|".$self->executable);
 273     }
 274     print DRAW $instring;
 275     close(DRAW);
 276     chdir($curpath);
 277     #get the results
 278     my $plotfile = $self->io->catfile($self->tempdir,$self->plotfile);
 279
 280     $self->throw("drawgram did not create plotfile correctly ($plotfile)")
 281         unless (-e $plotfile);
 282     return $plotfile;
 283 }
 284
 285 =head2  _setinput()
 286
 287  Title   :  _setinput
 288  Usage   :  Internal function, not to be called directly
 289  Function:  Create input file for drawing program
 290  Example :
 291  Returns : filename containing tree in newick format
 292  Args    : Bio::Tree::TreeI object
 293
 294
 295 =cut
 296
 297 sub _setinput {
 298     my ($self, $input) = @_;
 299     my $treefile;
 300     unless (ref $input) {
 301         # check that file exists or throw
 302         $treefile = $input;
 303         unless (-e $input) {return 0;}
 304
 305     } elsif ($input->isa("Bio::Tree::TreeI")) {
 306         #  Open temporary file for both reading & writing of BioSeq array
 307         my $tfh;
 308         ($tfh,$treefile) = $self->io->tempfile(-dir=>$self->tempdir);
 309         my $treeIO = Bio::TreeIO->new(-fh => $tfh,
 310                                       -format=>'newick');
 311         $treeIO->write_tree($input);
 312         $treeIO->close();
 313         close($tfh);
 314         $tfh = undef;
 315     }
 316     return $treefile;
 317 }
 318
 319 =head2  _setparams()
 320
 321  Title   :  _setparams
 322  Usage   :  Internal function, not to be called directly
 323  Function:   Create parameter inputs for drawgram program
 324  Example :
 325  Returns : parameter string to be passed to drawgram
 326  Args    : name of calling object
 327
 328 =cut
 329
 330 sub _setparams {
 331     my ($attr, $value, $self);
 332
 333     #do nothing for now
 334     $self = shift;
 335     my $param_string = "";
 336     my $cat = 0;
 337     my ($hmargin,$vmargin);
 338     foreach  my $attr ( @DRAW_PARAMS) {
 339         $value = $self->$attr();
 340
 341         $attr = uc($attr);
 342         next unless (defined $value);
 343         if ($attr eq 'PLOTTER' ||
 344             $attr eq 'SCREEN' ) {
 345             # take first char of the input
 346             $param_string .= uc(substr($value,0,1))."\n";
 347             next;
 348         } elsif( $attr eq 'TREEDIR' ) { # tree direction
 349             if( $value =~ /^H/i ) {
 350                 $param_string .= "1\n";
 351             }
 352         } elsif( $attr eq 'TREESTYLE' ) {
 353             my $add = "2\n";
 354             if( $value =~ /clad/i || uc(substr($value,0,1)) eq 'C'  ) {
 355                 $add .= "C\n";
 356             } elsif( $value =~ /phen/i || uc(substr($value,0,1)) eq 'P' ) {
 357                 $add .= "P\n";
 358             } elsif( $value =~ /curv/i || uc(substr($value,0,1)) eq 'V' ) {
 359                 $add .= "V\n";
 360             } elsif( $value =~ /euro/i || uc(substr($value,0,1)) eq 'E' ) {
 361                 $add .= "E\n";
 362             } elsif( $value =~ /swoop/i || uc(substr($value,0,1)) eq 'S' ) {
 363                 $add .= "S\n";
 364             } else {
 365                 $self->warn("Unknown requested tree output format $value\n");
 366                 next;
 367             }
 368             $param_string .= $add;
 369         } elsif( $attr eq 'USEBRANCHLENS' ) {
 370             if( uc(substr($value,0,1)) eq 'N' || $value == 0 ) {
 371                 $param_string = "3\n";
 372             }
 373         } elsif( $attr eq 'LABEL_ANGLE' ) {
 374             if( $value !~ /(\d+(\.\d+)?)/ ||
 375                 $1 < 0 || $1 > 90 ) {
 376                 $self->warn("Expected a number from 0-90 in $attr\n");
 377                 next;
 378             }
 379             $param_string .= "4\n$1\n";
 380         } elsif( $attr eq 'HORIZMARGINS' ) {
 381             if( $value !~ /(\d+(\.\d+)?)/ ) {
 382                 $self->warn("Expected a number in $attr\n");
 383                 next;
 384             }
 385             $hmargin = $1;
 386         } elsif( $attr eq 'VERTICALMARGINS' ) {
 387             if( $value !~ /(\d+(\.\d+)?)/ ) {
 388                 $self->warn("Expected a number in $attr\n");
 389                 next;
 390             }
 391             $vmargin = $1;
 392         } elsif( $attr eq 'SCALE' ) {
 393             if( $value !~ /(\d+(\.\d+)?)/ ) {
 394                 $self->warn("Expected a number in $attr\n");
 395                 next;
 396             }
 397             $param_string .= "6\n$1";
 398         } elsif( $attr eq 'TREEDEPTH' ) {
 399             if( $value !~ /(\d+(\.\d+)?)/ ) {
 400                 $self->warn("Expected a number from in $attr\n");
 401                 next;
 402             }
 403             $param_string .= "7\n$1\n";
 404         } elsif( $attr eq 'STEMLEN' ) {
 405             if( $value !~ /(\d+(\.\d+)?)/ ||
 406                  $1 < 0 || $1 >= 1 ) {
 407                 $self->warn("Expected a number from 0 to < 1 in $attr\n");
 408                 next;
 409             }
 410             $param_string .= "8\n$1\n";
 411          } elsif( $attr eq 'TIPSPACE' ) {
 412              if( $value !~ /(\d+(\.\d+)?)/ ) {
 413                  $self->warn("Expected a number from 0 to < 1 in $attr\n");
 414                  next;
 415             }
 416             $param_string .= "9\n$1\n";
 417          } elsif( $attr eq 'ANCESTRALNODES' ) {
 418              if( $value !~ /^([IWCNV])/i ) {
 419                  $self->warn("Unrecognized value $value for $attr, expected one of [IWCNV]\n");
 420                  next;
 421              }
 422              $param_string .= "10\n$1\n";
 423          } elsif( $attr eq 'FONT' ) {
 424              $value =~ s/([\w\d]+)\s+/$1/g;
 425              $param_string .= "11\n$value\n";
 426          }
 427     }
 428     if( $hmargin || $vmargin ) {
 429         $hmargin ||= '.';
 430         $vmargin ||= '.';
 431         $param_string .= "5\n$hmargin\n$vmargin\n";
 432     }
 433
 434     $param_string .="Y\n";
 435     return $param_string;
 436 }
 437
 438
 439
 440 =head1 Bio::Tools::Run::Wrapper methods
 441
 442 =cut
 443
 444 =head2 no_param_checks
 445
 446  Title   : no_param_checks
 447  Usage   : $obj->no_param_checks($newval)
 448  Function: Boolean flag as to whether or not we should
 449            trust the sanity checks for parameter values
 450  Returns : value of no_param_checks
 451  Args    : newvalue (optional)
 452
 453
 454 =cut
 455
 456 =head2 save_tempfiles
 457
 458  Title   : save_tempfiles
 459  Usage   : $obj->save_tempfiles($newval)
 460  Function:
 461  Returns : value of save_tempfiles
 462  Args    : newvalue (optional)
 463
 464
 465 =cut
 466
 467 =head2 outfile_name
 468
 469  Title   : outfile_name
 470  Usage   : my $outfile = $dragram->outfile_name();
 471  Function: Get/Set the name of the output file for this run
 472            (if you wanted to do something special)
 473  Returns : string
 474  Args    : [optional] string to set value to
 475
 476
 477 =cut
 478
 479
 480 =head2 tempdir
 481
 482  Title   : tempdir
 483  Usage   : my $tmpdir = $self->tempdir();
 484  Function: Retrieve a temporary directory name (which is created)
 485  Returns : string which is the name of the temporary directory
 486  Args    : none
 487
 488
 489 =cut
 490
 491 =head2 cleanup
 492
 493  Title   : cleanup
 494  Usage   : $codeml->cleanup();
 495  Function: Will cleanup the tempdir directory after a DrawGram run
 496  Returns : none
 497  Args    : none
 498
 499
 500 =cut
 501
 502 =head2 io
 503
 504  Title   : io
 505  Usage   : $obj->io($newval)
 506  Function:  Gets a L<Bio::Root::IO> object
 507  Returns : L<Bio::Root::IO>
 508  Args    : none
 509
 510
 511 =cut
 512
 513 1; # Needed to keep compiler happy