[Bioperl-guts-l]
bioperl-run/Bio/Tools/Run/Phylo/Phylip Base.pm, 1.7,
1.8 DrawGram.pm, 1.9, 1.10 DrawTree.pm, 1.7, 1.8 PhylipConf.pm,
1.10, 1.11
Jason Stajich
jason at pub.open-bio.org
Sat Oct 8 17:42:48 EDT 2005
Update of /home/repository/bioperl/bioperl-run/Bio/Tools/Run/Phylo/Phylip
In directory pub.open-bio.org:/tmp/cvs-serv17303/Bio/Tools/Run/Phylo/Phylip
Modified Files:
Base.pm DrawGram.pm DrawTree.pm PhylipConf.pm
Log Message:
DrawTree Basically works
Index: Base.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-run/Bio/Tools/Run/Phylo/Phylip/Base.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Base.pm 30 Sep 2005 01:09:30 -0000 1.7
--- Base.pm 8 Oct 2005 21:42:46 -0000 1.8
***************
*** 45,63 ****
Report bugs to the Bioperl bug tracking system to help us keep track
! of the bugs and their resolution. Bug reports can be submitted via
! email or the web:
! bioperl-bugs at bioperl.org
! http://bugzilla.bioperl.org/bioperl-bugs/
=head1 AUTHOR - Jason Stajich
! Email jason at bioperl.org
!
! Describe contact details here
!
! =head1 CONTRIBUTORS
!
! Additional contributors names and emails here
=head1 APPENDIX
--- 45,56 ----
Report bugs to the Bioperl bug tracking system to help us keep track
! of the bugs and their resolution. Bug reports can be submitted via the
! web:
! http://bugzilla.bioperl.org/
=head1 AUTHOR - Jason Stajich
! Email jason-at-bioperl.org
=head1 APPENDIX
***************
*** 90,94 ****
BEGIN {
%DEFAULT = (
! 'VERSION' => $ENV{'PHYLIPVERSION'} || '3.6',
);
%FILENAME = %Bio::Tools::Run::Phylo::Phylip::PhylipConf::FileName;
--- 83,87 ----
BEGIN {
%DEFAULT = (
! 'VERSION' => $ENV{'PHYLIPVERSION'} || '3.6',
);
%FILENAME = %Bio::Tools::Run::Phylo::Phylip::PhylipConf::FileName;
Index: PhylipConf.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-run/Bio/Tools/Run/Phylo/Phylip/PhylipConf.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** PhylipConf.pm 4 Oct 2005 17:04:58 -0000 1.10
--- PhylipConf.pm 8 Oct 2005 21:42:46 -0000 1.11
***************
*** 38,44 ****
Report bugs to the Bioperl bug tracking system to help us keep track
the bugs and their resolution. Bug reports can be submitted via
! email or the web:
- bioperl-bugs at bio.perl.org
http://bugzilla.bioperl.org/
--- 38,43 ----
Report bugs to the Bioperl bug tracking system to help us keep track
the bugs and their resolution. Bug reports can be submitted via
! the web:
http://bugzilla.bioperl.org/
***************
*** 63,72 ****
use strict;
!
! use vars qw(%Menu %FileName $RESOLUTIONX $RESOLUTIONY);
$RESOLUTIONX = 300;
$RESOLUTIONY = 300;
%FileName = (
"3.5"=>{'OUTFILE'=>'outfile',
--- 62,74 ----
use strict;
! use Exporter;
! use vars qw(@ISA %Menu %FileName $RESOLUTIONX $RESOLUTIONY @EXPORT_OK);
! use base 'Exporter';
$RESOLUTIONX = 300;
$RESOLUTIONY = 300;
+ @EXPORT_OK = qw(%FileName %Menu);
+
%FileName = (
"3.5"=>{'OUTFILE'=>'outfile',
***************
*** 187,198 ****
'DRAWGRAM' => {
'SCALE' => "R\n",
! 'HORIZONTALMARGINS' => "M\n",
! 'VERTICALMARGINS' => "M\n",
!
'SCREEN' => {
'Y|YES|1' => "V\nX\n",
'N|NO|0' => "V\nN\n",
},
!
'PLOTTER' => {
'P|POSTSCRIPT' => "P\nL\n",
--- 189,204 ----
'DRAWGRAM' => {
'SCALE' => "R\n",
! 'HORIZMARGINS' => "M\n%.2f\n%.2f\n",
! 'VERTICALMARGINS' => "M\n%.2f\n%.2f",
'SCREEN' => {
'Y|YES|1' => "V\nX\n",
'N|NO|0' => "V\nN\n",
},
! 'FONT' => "F\n%s\n",
! 'PAGES' => {
! 'L|PAGES|SIZE' => "#\nL\n%d\n%d\nM\n",
! 'P|PHYSICAL' => "#\nP\n%.4f\n%.4f\nM\n",
! 'O|OVERLAP' => "#\nO\n%.4f\n%.4f\nM\n",
! },
'PLOTTER' => {
'P|POSTSCRIPT' => "P\nL\n",
***************
*** 205,209 ****
"PCX" => "P\nP\n3\n",
},
! 'ANCESTRAL' => {
'I|INTER|INTERMEDIETE' => "A\nI\n",
'W|WEIGHTED' => "A\nW\n",
--- 211,215 ----
"PCX" => "P\nP\n3\n",
},
! 'ANCESTRALNODES' => {
'I|INTER|INTERMEDIETE' => "A\nI\n",
'W|WEIGHTED' => "A\nW\n",
***************
*** 212,223 ****
'V' => "A\nV\n",
},
! 'STYLE' => {
! 'CLAD|CLADOGRAM' => "S\nC\n",
! 'PHEN|PHENOGRAM' => "S\nP\n",
'V|CURV|CURVOGRAM' => "S\nV\n",
'E|EURO|EUROGRAM' => "S\nE\n",
'S|SWOOP|SWOOPOGRAM' => "S\nS\n",
! 'C|CIRC|O|CIRCULAR' => "S\nO\n",
! }
},
'SEQBOOT'=>{
--- 218,274 ----
'V' => "A\nV\n",
},
! 'TREESTYLE' => {
! 'C|CLAD|CLADOGRAM' => "S\nC\n",
! 'P|PHEN|PHENOGRAM' => "S\nP\n",
'V|CURV|CURVOGRAM' => "S\nV\n",
'E|EURO|EUROGRAM' => "S\nE\n",
'S|SWOOP|SWOOPOGRAM' => "S\nS\n",
! 'O|CIRC|CIRCULAR' => "S\nO\n",
! },
! 'TIPSPACE' => "C\n%.4f\n",
! 'STEMLEN' => "T\n%.4f\n",
! 'TREEDEPTH' => "D\n%.4f\n",
! 'LABEL_ANGLE' => "L\n%.4f\n",
! 'USEBRANCHLENS' => {
! '1|Y|YES' => "",
! '0|N|NO' => "B\n",
! },
! },
! 'DRAWTREE' => {
! 'SCREEN' => {
! 'Y|YES|1' => "V\nX\n",
! 'N|NO|0' => "V\nN\n",
! },
! 'PLOTTER' => {
! 'L|P|POSTSCRIPT' => "P\nL\n",
! 'PICT' => "P\nM\n",
! "HP|PCL|LaserJect" => "P\nJ\n",
! "BMP" => "P\nW\n$RESOLUTIONX\n$RESOLUTIONY",
! "FIG" => "P\nF\n",
! "IDRAW" => "P\nA\n",
! "VRML" => "P\nZ\n",
! "PCX" => "P\nP\n3\n",
! },
! 'LABEL_ANGLE' => {
! 'F|FIXED' => "L\nF\n%d\n",
! 'R|RADIAL' => "L\nR\n",
! 'A|ALONG' => "L\nA\n",
! 'M|MIDDLE' => "L\nM\n",
! },
! 'ROTATION' => "R\n%d\n",
! 'ITERATE' => {
! 'E|EQUAL|DAYLIGHT' => "",
! 'N|NBODY|N-BODY' => "I\n",
! 'NO|FALSE' => "I\nI\n",
! },
! 'TREEARC' => "I\nI\nA\n%d\n",
! 'SCALE' => "S\n%.2f\n",
! 'PAGES' => {
! 'L|PAGES|SIZE' => "#\nL\n%d\n%d\nM\n",
! 'P|PHYSICAL' => "#\nP\n%.4f\n%.4f\nM\n",
! 'O|OVERLAP' => "#\nO\n%.4f\n%.4f\nM\n",
! },
! 'HORIZMARGINS' => "M\n%.2f\n%.2f\n",
! 'VERTICALMARGINS' => "M\n%.2f\n%.2f",
},
'SEQBOOT'=>{
Index: DrawGram.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-run/Bio/Tools/Run/Phylo/Phylip/DrawGram.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** DrawGram.pm 4 Oct 2005 17:04:58 -0000 1.9
--- DrawGram.pm 8 Oct 2005 21:42:46 -0000 1.10
***************
*** 66,74 ****
%OK_FIELD %DEFAULT);
use strict;
-
use Bio::Tools::Run::Phylo::Phylip::Base;
use Cwd;
- @ISA = qw( Bio::Tools::Run::Phylo::Phylip::Base );
-
# inherit from Phylip::Base which has some methods for dealing with
# Phylip specifics
--- 66,72 ----
%OK_FIELD %DEFAULT);
use strict;
use Bio::Tools::Run::Phylo::Phylip::Base;
+ use Bio::Tools::Run::Phylo::Phylip::PhylipConf qw(%Menu);
use Cwd;
# inherit from Phylip::Base which has some methods for dealing with
# Phylip specifics
***************
*** 90,98 ****
BEGIN {
! %DEFAULT = ('PLOTTER' => 'L',
'SCREEN' => 'N');
! $DEFAULT{'FONTFILE'} = Bio::Root::IO->catfile($ENV{'PHYLIPDIR'},"font1") if $ENV{'PHYLIPDIR'};
! @DRAW_PARAMS = qw(PLOTTER SCREEN TREEDIR TREESTYLE USEBRANCHLENS
LABEL_ANGLE HORIZMARGINS VERTICALMARGINS
SCALE TREEDEPTH STEMLEN TIPSPACE ANCESTRALNODES
--- 88,97 ----
BEGIN {
! %DEFAULT = ('PLOTTER' => 'P',
'SCREEN' => 'N');
! $DEFAULT{'FONTFILE'} = Bio::Root::IO->catfile($ENV{'PHYLIPDIR'},"font1") if $ENV{'PHYLIPDIR'};
! $PROGRAMNAME = 'drawgram';
! @DRAW_PARAMS = qw(PLOTTER SCREEN TREESTYLE USEBRANCHLENS
LABEL_ANGLE HORIZMARGINS VERTICALMARGINS
SCALE TREEDEPTH STEMLEN TIPSPACE ANCESTRALNODES
***************
*** 115,119 ****
sub program_name {
! return 'drawgram';
}
--- 114,118 ----
sub program_name {
! return $PROGRAMNAME;
}
***************
*** 300,304 ****
my $tfh;
($tfh,$treefile) = $self->io->tempfile(-dir=>$self->tempdir);
! my $treeIO = Bio::TreeIO->new(-fh => $tfh,
-format=>'newick');
$treeIO->write_tree($input);
--- 299,303 ----
my $tfh;
($tfh,$treefile) = $self->io->tempfile(-dir=>$self->tempdir);
! my $treeIO = Bio::TreeIO->new(-fh => $tfh,
-format=>'newick');
$treeIO->write_tree($input);
***************
*** 329,351 ****
my $cat = 0;
my ($hmargin,$vmargin);
!
! my %menu = %{$Bio::Tools::Run::Phylo::Phylip::PhylipConf::Menu{$self->version}->{'DRAWGRAM'}};
!
foreach my $attr ( @DRAW_PARAMS) {
$value = $self->$attr();
$attr = uc($attr);
if( ! exists $menu{$attr} ) {
! $self->warn("unknown parameter $attr, known params are ",
! join(",",keys %menu), "\n");
! }
! if( ! ref ($menu{$attr}) =~ /HASH/i ) {
! $param_string .= $menu{$attr} . $value . "\n";
}
- next unless (defined $value);
my $seen = 0;
! for my $stype ( keys %{$menu{$attr}} ) {
!
! if( $value =~ /$stype/i ) {
! $param_string .= $menu{$attr}->{$stype};
$seen = 1;
last;
--- 328,356 ----
my $cat = 0;
my ($hmargin,$vmargin);
! my %menu = %{$Menu{$self->version}->{'DRAWGRAM'}};
foreach my $attr ( @DRAW_PARAMS) {
$value = $self->$attr();
+ next unless defined $value;
+ my @vals;
+ if( ref($value) ) {
+ ($value, at vals) = @$value;
+ }
$attr = uc($attr);
if( ! exists $menu{$attr} ) {
! $self->warn("unknown parameter $attr, known params are ".
! join(",",keys %menu). "\n");
! }
! if( ref ($menu{$attr}) !~ /HASH/i ) {
! unless( @vals ) {
! $param_string .= $menu{$attr};
! } else {
! $param_string .= sprintf($menu{$attr},$value, at vals);
! }
! next;
}
my $seen = 0;
! for my $stype ( keys %{$menu{$attr}} ) {
! if( $value =~ /$stype/i ) {
! $param_string .= sprintf($menu{$attr}->{$stype}, at vals);
$seen = 1;
last;
Index: DrawTree.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-run/Bio/Tools/Run/Phylo/Phylip/DrawTree.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** DrawTree.pm 30 Sep 2005 00:55:45 -0000 1.7
--- DrawTree.pm 8 Oct 2005 21:42:46 -0000 1.8
***************
*** 27,30 ****
--- 27,37 ----
Felsenstein's Phylip suite.
+ To set parameters with option you need to pass in an array reference.
+ For example to change the margines
+ $drawfact->HORIZMARGINS('
+
+ This can be a brittle module as the menus change in PHYLIP. It should
+ support phylip 3.6 but no guarantees.
+
=head1 FEEDBACK
***************
*** 32,37 ****
User feedback is an integral part of the evolution of this and other
! Bioperl modules. Send your comments and suggestions preferably to
! the Bioperl mailing list. Your participation is much appreciated.
bioperl-l at bioperl.org - General discussion
--- 39,44 ----
User feedback is an integral part of the evolution of this and other
! Bioperl modules. Send your comments and suggestions preferably to the
! Bioperl mailing list. Your participation is much appreciated.
bioperl-l at bioperl.org - General discussion
***************
*** 41,59 ****
Report bugs to the Bioperl bug tracking system to help us keep track
! of the bugs and their resolution. Bug reports can be submitted via
! email or the web:
- bioperl-bugs at bioperl.org
http://bugzilla.bioperl.org/
=head1 AUTHOR - Jason Stajich
! Email jason at bioperl.org
!
! Describe contact details here
!
! =head1 CONTRIBUTORS
!
! Additional contributors names and emails here
=head1 APPENDIX
--- 48,59 ----
Report bugs to the Bioperl bug tracking system to help us keep track
! of the bugs and their resolution. Bug reports can be submitted via the
! web:
http://bugzilla.bioperl.org/
=head1 AUTHOR - Jason Stajich
! Email jason-at-bioperl.org
=head1 APPENDIX
***************
*** 76,84 ****
use Bio::Tools::Run::Phylo::Phylip::Base;
use Cwd;
- @ISA = qw( Bio::Tools::Run::Phylo::Phylip::Base );
-
# inherit from Phylip::Base which has some methods for dealing with
# Phylip specifics
! @ISA = qw(Bio::Tools::Run::Phylo::Phylip::Base);
# You will need to enable the neighbor program. This
--- 76,85 ----
use Bio::Tools::Run::Phylo::Phylip::Base;
use Cwd;
# inherit from Phylip::Base which has some methods for dealing with
# Phylip specifics
!
! @ISA = qw( Bio::Tools::Run::Phylo::Phylip::Base );
!
! use Bio::Tools::Run::Phylo::Phylip::PhylipConf qw(%Menu);
# You will need to enable the neighbor program. This
***************
*** 97,103 ****
BEGIN {
! %DEFAULT = ('PLOTTER' => 'L',
'SCREEN' => 'N');
!
$PROGRAMNAME="drawtree";
if (defined $ENV{'PHYLIPDIR'}) {
--- 98,105 ----
BEGIN {
! %DEFAULT = ('PLOTTER' => 'P',
'SCREEN' => 'N');
! $DEFAULT{'FONTFILE'} = Bio::Root::IO->catfile($ENV{'PHYLIPDIR'},"font1") if $ENV{'PHYLIPDIR'};
!
$PROGRAMNAME="drawtree";
if (defined $ENV{'PHYLIPDIR'}) {
***************
*** 114,119 ****
ITERATE SCALE
HORIZMARGINS VERTICALMARGINS
- CHARHEIGHT
- ENTHUSIASM
FONT
);
--- 116,119 ----
***************
*** 127,131 ****
Title : program_name
! Usage : >program_name()
Function: holds the program name
Returns: string
--- 127,131 ----
Title : program_name
! Usage : $obj->program_name()
Function: holds the program name
Returns: string
***************
*** 135,139 ****
sub program_name {
! return 'drawtree';
}
--- 135,139 ----
sub program_name {
! return $PROGRAMNAME;
}
***************
*** 342,345 ****
--- 342,347 ----
=cut
+
+
sub _setparams {
my ($attr, $value, $self);
***************
*** 350,454 ****
my $cat = 0;
my ($hmargin,$vmargin);
foreach my $attr ( @DRAW_PARAMS) {
$value = $self->$attr();
!
$attr = uc($attr);
! next unless (defined $value);
! if ($attr eq 'PLOTTER' ||
! $attr eq 'SCREEN' ) {
! # take first char of the input
! $param_string .= uc(substr($value,0,1))."\n";
! next;
! } elsif( $attr eq 'USEBRANCHLENS' ) {
! if( uc(substr($value,0,1)) eq 'Y' ||
! uc(substr($value,0,1)) eq '1'
! ) {
! $self->warn("Expected a number in $attr\n");
! next;
! }
! $param_string .= "1\n$1";
! } elsif( $attr eq 'LABEL_ANGLE' ) {
! if( $value !~ /([FRA])/i ) {
! $self->warn("($attr)Expected value of one of F,R,A");
! next;
! }
! my $a = $1;
! $param_string .= "2\n$a\n";
! if( $a eq 'F' ) {
! my $angle = 0;
! if( $value =~ /(\-?\d+(\.\d+)?)/ ) {
! $angle = $1;
! if( $angle >= 90 || $angle < -90 ) {
! $self->warn("provided an angle which is too large ($angle) expected -90 <= $angle <= 90, setting it to 0");
! $angle = 0;
! }
! }
! $param_string .= "$angle\n";
! }
! } elsif( $attr eq 'ROTATION' ) {
! if( $value !~ /(\-?\d+(\.\d+)?)/ ||
! $1 < -360 || $1 > 360 ) {
! $self->warn("($attr)Expected a number between -360 and 360 $attr\n");
! next;
! }
! $param_string = "3\n$1\n";
! } elsif( $attr eq 'TREEARC' ) {
! if( $value !~ /(\-?\d+(\.\d+)?)/ ||
! $1 <= 0 || $1 > 360 ) {
! $self->warn("($attr)Expected a number between -360 and 360 $attr\n");
! next;
! }
! $param_string = "4\n$1\n";
! } elsif( $attr eq 'ITERATE' ) {
! if( uc(substr($value,0,1)) eq 'N' ||
! substr($value,0,1) eq '0' ) {
! $param_string .= "5\n";
! }
! } elsif( $attr eq 'SCALE' ) {
! if( $value !~ /(\d+(\.\d+)?)/ ) {
! $self->warn("($attr)Expected a number in $attr\n");
! next;
! }
! $param_string .= "6\n$1\n";
! } elsif( $attr eq 'HORIZMARGINS' ) {
! if( $value !~ /(\d+(\.\d+)?)/ ) {
! $self->warn("($attr)Expected a number in $attr\n");
! next;
! }
! $hmargin = $1;
! } elsif( $attr eq 'VERTICALMARGINS' ) {
! if( $value !~ /(\d+(\.\d+)?)/ ) {
! $self->warn("Expected a number in $attr\n");
! next;
! }
! $vmargin = $1;
! } elsif( $attr eq 'CHARHEIGHT' ) {
! if( $value !~ /(\d+(\.\d+)?)/ ) {
! $self->warn("Expected a number in $attr\n");
! next;
! }
! $param_string .= "8\n$1";
! } elsif( $attr eq 'ENTHUSIASM' ) {
! if( $value !~ /(\d+(\.\d+)?)/ ) {
! $self->warn("Expected a number from in $attr\n");
! next;
}
! $param_string .= "9\n$1\n";
!
! } elsif( $attr eq 'FONT' ) {
! $value =~ s/([\w\d]+)\s+/$1/g;
! $param_string .= "10\n$value\n";
}
}
- if( $hmargin || $vmargin ) {
- $hmargin ||= '.';
- $vmargin ||= '.';
- $param_string .= "5\n$hmargin\n$vmargin\n";
- }
-
$param_string .="Y\n";
return $param_string;
}
-
--- 352,391 ----
my $cat = 0;
my ($hmargin,$vmargin);
+ my %menu = %{$Menu{$self->version}->{'DRAWGRAM'}};
foreach my $attr ( @DRAW_PARAMS) {
$value = $self->$attr();
! next unless defined $value;
! my @vals;
! if( ref($value) ) {
! ($value, at vals) = @$value;
! }
$attr = uc($attr);
! if( ! exists $menu{$attr} ) {
! $self->warn("unknown parameter $attr, known params are ".
! join(",",keys %menu). "\n");
! }
! if( ref ($menu{$attr}) !~ /HASH/i ) {
! unless( @vals ) {
! $param_string .= $menu{$attr};
! } else {
! $param_string .= sprintf($menu{$attr},$value, at vals);
}
! next;
! }
! my $seen = 0;
! for my $stype ( keys %{$menu{$attr}} ) {
! if( $value =~ /$stype/i ) {
! $param_string .= sprintf($menu{$attr}->{$stype}, at vals);
! $seen = 1;
! last;
! }
! }
! unless( $seen ) {
! $self->warn("Unknown requested attribute $attr, $value is not known\n");
}
}
$param_string .="Y\n";
return $param_string;
}
More information about the Bioperl-guts-l
mailing list