legend results from the CPAN

BioPerl

#Author: William McCaig
#Date: 06/16/2006
#Purpose:  To print visual images of alignments
#
#Requires:  An alignment file
#
#Produces:  An image file
#
#Revision History: 
#09/01/2006 - WDM - Introduction of "wrap" flag, allowing alignment to be
#                   wrapped at a set base and stacked vertically
#                   Addition of internal members y_num and y_size for tracking
#                   of number of vertical panels and size of panels,
#                   respectively
#
#09/06/2006 - WDM - Introduction of "p_legend" flag, for printing of an optional
#                   colored legend when protein coloring is selected
#
#09/24/2008 - WDM - Test file created for the module
#
#03/01/2009 - YH -  Introduction of "show_nonsynonymous" flag which enables
#                   highlighting of nonsynonymous mutations in nucleotide
#                   alignments. Addition of internal members codon_table and
#                   missense_pos for translating codons -> amino acids and for
#                   keeping track of missense mutation positions respectively.
#
#03/05/2009 - YH  - Swapped names of subroutines x_label and y_label to match
#                   both documentation and intuition. Finalized implementation
#                   of show_nonsynonymous functionality.

# docs after the code!

package Bio::Align::Graphics;

use vars qw( @PRINT_PARAMS %OK_FIELD);

use 5.008003;
use strict;
use warnings;

use GD;
use GD::Simple;
use Bio::AlignIO;
use Data::Dumper;
use POSIX qw(ceil floor);

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use PrintAlignment ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( );

# Preloaded methods go here.
our %FONT_TABLE = (1 => gdTinyFont, 2 => gdSmallFont, 3 => gdMediumBoldFont, 4 => gdLargeFont, 5 => gdGiantFont );
our %PROTEIN_COLORS = ('Q' => [255, 0, 204], 'E' => [255, 0, 102], 'D' =>  [255, 0, 0] , 'S' => [255, 51, 0] , 'T' => [255, 102, 0 ], 
			'G' => [255, 153, 0] , 'P' => [255, 204, 0] , 'C' => [255, 255, 0] , 'A' => [204, 255, 0] , 'V' => [153, 255, 0],
			'I' => [102, 255, 0] , 'L' => [51 , 255, 0] , 'M' => [0, 255, 0] , 'F' => [0 , 255, 102] , 'Y' => [0 , 255, 204],
			'W' => [0, 204, 255] , 'H' => [0, 102, 255] , 'R' => [0, 0, 255] , 'K' => [102, 0, 255] , 'N' => [204, 0, 255] );
#################################################################
#New
sub new {
my $class = shift;
my %options = @_;

my $self  = {
	
	#####OPTIONS#####
	#Display Defaults
	font => defined($options{font}) ? $FONT_TABLE{$options{font}} : $FONT_TABLE{2},
	x_label => defined($options{x_label}) ? $options{x_label} : 1,
	y_label => defined($options{y_label}) ? $options{y_label} : 1,
	
	#Colors
	bg_color => $options{bg_color} || 'white',
	fg_color => $options{font_color} || 'black',
	x_label_color => $options{x_label_color} || 'blue',
	y_label_color => $options{y_label_color} || 'red',
	p_color => $options{p_color} || undef,
	p_legend => $options{p_legend} || undef,
	p_color_table => undef,
			
	#Sequence Defaults
	reference => $options{reference} || undef,
	reference_id => $options{reference_id} || undef,
	match_char => $options{match_char} || ".",
	block_size => defined($options{block_size}) ? $options{block_size} : 10,
	block_space => defined ($options{block_space}) ? ($options{block_space} * ($options{font} ? $FONT_TABLE{$options{font}}->width : $FONT_TABLE{2}->width)) : ( ($options{font} ? ($FONT_TABLE{$options{font}}->width * 2 ) : ($FONT_TABLE{2}->width * 2)) )...
	wrap => $options{wrap} || 80,
	show_nonsynonymous => $options{show_nonsynonymous} || undef, # If turned on, will highlight nonsynonymous (missense) mutations. Valid only for nucleotide alignments
	
	#Padding
	pad_left => $options{pad_left} || 5, 		#space between x label and border
	pad_right => $options{pad_right} || 5,		#space between end of sequences and border
	pad_top => $options{pad_top} || 5,		#space between y label and border
	pad_bottom => $options{pad_bottom} || 5,	#space between bottom of sequences and border
	x_label_space => $options{x_label_space} || 1, #space between x label and sequences
	y_label_space => $options{y_label_space} || 1, #space between y label and sequences
	
	#Labels
	labels => $options{labels} || undef,
	dm_labels => $options{dm_labels} || undef,
	dm_label_start => $options{dml_start} || undef,
	dm_label_end => $options{dml_end} || undef,
	dm_label_color => $options{dml_color} || undef,
	domain_start => $options{dm_start} || undef,
	domain_end => $options{dm_end} || undef,
	domain_color => $options{dm_color} || undef,
	
	#File Defaults
	align => $options{align} || undef,
	output => $options{output} || undef,
	out_format => $options{out_format} || undef,
			
	####PRIVATE VALUES#####
	
	image => $options{image} || undef,
	seq_format => undef,
	
	#X and Y size of char
	x_char_size => ($options{font} ? $FONT_TABLE{$options{font}}->width : $FONT_TABLE{2}->width),
	y_char_size => ($options{font} ? $FONT_TABLE{$options{font}}->height : $FONT_TABLE{2}->height),
	
	#Image W & H
	width => undef,		#overall width of the image
	height => undef,	#overall height of image
		
	#Sequences 
	sequences => undef,
	seq_ids => undef,
	ref_sequence => undef,
	id_length => 0,
	seq_length => $options{align}->length() || 0,
	no_sequences => $options{align}->num_sequences() || 0,
	seq_start_x => undef,
	seq_start_y => undef,
	start => $options{start} || 1,
	end => $options{end} || $options{align}->length(),
	y_num => undef,
	y_size => undef,
	footer_size => 110,
	footer_start => undef
		
	};

bless ($self, $class);

die "new:Must supply alignment for drawing!\n"
	unless defined ($self->{align});


foreach my $seq ($self->{align}->each_seq) 
{
$self->{id_length} =  ( length($seq->id()) > $self->{id_length} ) ?  length($seq->id()) : $self->{id_length};

		
	
	if( $self->{reference_id} && ($seq->id() eq $self->{reference_id}) )
	{
	 @{$self->{ref_sequence}} = split //, $seq->seq;
	 unshift @{$self->{sequences}}, $seq->seq;
         unshift @{$self->{seq_ids}}, $seq->id();
	 }else
	  {
		push @{$self->{sequences}}, $seq->seq;
		push @{$self->{seq_ids}}, $seq->id();
	  }
	  
	if(!defined($self->{seq_format}))
	{
	 $self->{seq_format} = $seq->alphabet;
	}
}

if(!($self->{reference_id}) )
{
@{$self->{ref_sequence}} = split //, ${$self->{sequences}}[0];
$self->{reference_id} = ${$self->{seq_ids}}[0];
}

$self->{y_num} = ($self->{seq_length} > $self->{wrap}) ? ( sprintf( "%.0f", ( ($self->{seq_length} / $self->{wrap}) + .5) ) ) : 1;
$self->{y_size} = ( ($self->{no_sequences} + $self->{pad_bottom}) * $self->{y_char_size});
$self->{seq_start_x} = ($self->{pad_left} + $self->{id_length} + $self->{x_label_space}) * $self->{x_char_size};

if( defined($self->{show_nonsynonymous}) ) # Extra column changes dimensions
{
	$self->{seq_length_aa} = ($self->{seq_length} / 3) + $self->{seq_length}; # Consider length of sequence plus extra column every 3 nucleotides
	$self->{seq_start_y} = ($self->{pad_top} + length($self->{seq_length_aa}) + $self->{y_label_space}) * $self->{y_char_size};
	$self->{width} = $self->{seq_start_x} + ((( $self->{wrap} / $self->{block_size}) + 1) * $self->{block_space}) + ( ($self->{wrap} + $self->{pad_right}) * ($self->{x_char_size} + 1.2) ) + ( ($self->{seq_length} / 3) * 2); # Needed to add this for widt...
}else
{
	$self->{seq_start_y} = ($self->{pad_top} + length($self->{seq_length}) + $self->{y_label_space}) * $self->{y_char_size};
	$self->{width} = $self->{seq_start_x} + ((( $self->{wrap} / $self->{block_size}) + 1) * $self->{block_space}) + ($self->{wrap} + $self->{pad_right}) * $self->{x_char_size};
}

$self->{footer_start} = $self->{seq_start_y} + $self->{y_size} * $self->{y_num};

if(defined($self->{p_color}) && defined($self->{p_legend}) && $self->{p_legend}){
$self->{height} = $self->{seq_start_y} + $self->{footer_size} + $self->{y_size} * $self->{y_num};
}else{
 $self->{height} = $self->{seq_start_y} + $self->{y_size} * $self->{y_num};
}
$self->{image} = GD::Simple->new($self->{width},$self->{height});
$self->{image}->alphaBlending(1);
$self->{image}->saveAlpha(1);
$self->{image}->bgcolor($self->{bg_color});
$self->{image}->fgcolor($self->{fg_color});
$self->{image}->rectangle(0,0,$self->{width}-1, $self->{height} - 1);
return $self;

} #End new Subroutine#########################################################


sub draw{
my $self = shift;

die "draw:Must supply alignment for drawing!\n"
	unless defined ($self->{align});

if(defined($self->{x_label}) && $self->{x_label})
{
$self->x_label();
}

if(defined($self->{y_label}) && $self->{y_label})
{
$self->y_label();
}


if(defined($self->{domain_start}) && defined($self->{domain_end}) && not defined($self->{p_color}) )
{
$self->_draw_domain();
}

# 
if( defined($self->{show_nonsynonymous}) && ( $self->{seq_format} eq "protein" ) )
{
die "draw:Option show_nonsynonymous only works with Nucleotide alignments!\n";
}elsif  ( defined($self->{show_nonsynonymous}) )
 {
 	$self->{codon_table} = Bio::Tools::CodonTable->new();
 	$self->{missense_pos} = {};
# 	print STDERR "You are using option show_nonsynonymous. Option works best if wrap value is a multiple of 4.\n"
 }

if(defined($self->{p_color}) && $self->{seq_format} eq "protein")
{
$self->_draw_colored_sequences();
	if(defined($self->{p_legend}) && $self->{p_legend})
	{
	 $self->_draw_legend();
	}
}elsif(defined($self->{p_color}) && ($self->{seq_format} ne "protein"))
 {
  die "draw:Option p_color only works with Protein alignments!\n";
 }else
  {
   $self->_draw_sequences();
  }

if(defined($self->{dm_label_start}))
{
$self->_domain_label();
}


 
if($self->{output})
{
  open my $OUTPUT, '>', $self->{output} or die "Could not read file '$self->{output}': $!\n";
  binmode $OUTPUT;
  
	if(defined($self->{out_format}))
	{
		SWITCH: {
		if($self->{out_format} eq "png")  {print $OUTPUT $self->{image}->png;  last SWITCH;}
		if($self->{out_format} eq "jpeg") {print $OUTPUT $self->{image}->jpeg; last SWITCH;}
		if($self->{out_format} eq "gif")  {print $OUTPUT $self->{image}->gif;  last SWITCH;}
		if($self->{out_format} eq "gd")   {print $OUTPUT $self->{image}->gd;   last SWITCH;}
		}

	}else
	{
	 print $OUTPUT $self->{image}->png;
	}
  
  close $OUTPUT;
}else
 {
	binmode STDOUT;
	
	if(defined($self->{out_format}))
	{
		SWITCH: {
		if($self->{out_format} eq "png")  {print STDOUT $self->{image}->png;  last SWITCH;}
		if($self->{out_format} eq "jpeg") {print STDOUT $self->{image}->jpeg; last SWITCH;}
		if($self->{out_format} eq "gif")  {print STDOUT $self->{image}->gif;  last SWITCH;}
		if($self->{out_format} eq "gd")   {print STDOUT $self->{image}->gd;   last SWITCH;}
		}

	}else
	{
	 print STDOUT $self->{image}->png;
	}
  
  
 }#End Output if/else

Bio/Align/Graphics.pm view on Meta::CPAN


for (my $i=0; $i < $self->{no_sequences}; $i++) 
{
	
	 my @letters = split //, ${$self->{sequences}}[$i];
	

	my $y_num = $self->{y_num}; #sprintf( "%.0f", ( ($self->{seq_length} / $self->{wrap}) + .5) ) - 1;
	my $y_char = $self->{y_size}; #( ($self->{no_sequences} + $self->{pad_bottom}) * $self->{y_char_size});
	 
	for(my $k=0; $k<=$y_num; $k++)
	{
	 my $x_char = $k * $self->{wrap};
	
		for (my $j=$x_char; $j <= ( ($x_char + $self->{wrap}) - 1); $j++) 
		{
		 last unless defined($letters[$j]);
		
		 $print_char = $letters[$j];
				 
		if( ( ($j + 1) % ($self->{block_size})) == 0)
		{
		 $block_num = $self->{block_space};
		}else
		 {
		  $block_num = 0;
		 }
		 
	#print "Chunk Space: $chunk_space\n";
	 $self->{image}->bgcolor($colors{$print_char});
	 $self->{image}->fgcolor($colors{$print_char});
	 $self->{image}->rectangle( $self->{seq_start_x} + ( ($j - $x_char) * $self->{x_char_size} ) + $block_total - 1   ,   $self->{seq_start_y} + ( $i * $self->{y_char_size} ) + ($k * $y_char) - $self->{y_char_size}    ,   $self->{seq_start_x} + (($j - $...
	 $self->{image}->moveTo($self->{seq_start_x} + ( ($j - $x_char) * $self->{x_char_size}) + $block_total, $self->{seq_start_y} + ($k * $y_char) + ($i * $self->{y_char_size}) );
	 $self->{image}->fgcolor($self->{fg_color});
	 $self->{image}->font($self->{font});
	 $self->{image}->string($print_char);
	
	if( defined($self->{labels}) && $i == ($self->{no_sequences} - 1))
	 {
	 
		if(${$self->{labels}}{$j + 1})
		{
		 my $label = ${$self->{labels}}{$j + 1};
		 my $offset = defined($self->{dm_label_start}) ? 3 : 0;
		 $self->{image}->moveTo($self->{seq_start_x} + ( ( ($j - $x_char) + 1.25) * $self->{x_char_size}) + $block_total, $self->{seq_start_y} + (($self->{no_sequences}) * $self->{y_char_size}) + ($k * $y_char) + ( (length($label) + $offset) * ($self->{x_c...
		 $self->{image}->font($self->{font});
		 $self->{image}->angle(-90);
		 $self->{image}->string($label);
		 $self->{image}->angle(0);		
		}
	 }
	 
	 
	 $block_total += $block_num; 
	}
$block_total = 0;
	}
}
}

sub _draw_legend{

my $self = shift;
my $title_font = $FONT_TABLE{3};
my @l_order = ("Negatively Charged", "Positively Charged", "Hydrophobic", "Aromatic", "Found in Loops", "Large Polar Acids");
my %legend = ("Negatively Charged" => ["D" , "E"] , "Positively Charged" => ["K", "R"] , "Hydrophobic" => ["A","F","I","L","M","V","W","Y"] ,
		"Aromatic" => ["F", "H", "W", "Y"] , "Found in Loops" => ["D", "G", "P", "S", "T"] , "Large Polar Acids" => ["H", "K", "N", "Q", "R"]);

my $x1 = 2;
my $x2 = 42;

my $colors = $self->{p_color_table};

my $y_start = $self->{footer_start};
my $label = "Protein Color Legend";
$self->{image}->bgcolor($self->{bg_color});
$self->{image}->fgcolor($self->{fg_color});
$self->{image}->rectangle(1,$y_start, 70 * $self->{x_char_size}, $self->{height} - 2);

$self->{image}->moveTo((35 - (length($label) / 2) ) * $self->{x_char_size} , $y_start + $self->{y_char_size});
$self->{image}->font($title_font);
$self->{image}->string($label);

my $count = 3;

foreach my $c_label (@l_order)
{

if( ($count % 2) == 0)
{

$self->{image}->moveTo( $x2 *  $self->{x_char_size}, $y_start + ( ($count - 1) * $self->{y_char_size}));
$self->{image}->font($self->{font});
$self->{image}->string($c_label);
	my $i = 0;
	foreach my $chars(@{$legend{$c_label}})
	{
	 $self->{image}->bgcolor($$colors{$chars});
	 $self->{image}->fgcolor($$colors{$chars});
	 $self->{image}->rectangle( ($x2 + 20 + $i) * $self->{x_char_size}, $y_start + ( ($count - 2) * $self->{y_char_size}), ($x2 + 20 + $i + 1) * $self->{x_char_size}, $y_start + ( ($count -1) * $self->{y_char_size}));
	 $self->{image}->bgcolor($self->{bg_color});
	 $self->{image}->fgcolor($self->{fg_color});
	 $i++;
	}

}else
 {
  $self->{image}->moveTo($x1 * $self->{x_char_size} , $y_start + ($count * $self->{y_char_size}));
  $self->{image}->font($self->{font});
  $self->{image}->string($c_label);
	my $i = 0;
	foreach my $chars(@{$legend{$c_label}})
	{
	 $self->{image}->bgcolor($$colors{$chars});
	 $self->{image}->fgcolor($$colors{$chars});
	 $self->{image}->rectangle( ($x1 + 20 + $i) * $self->{x_char_size}, $y_start + ( ($count - 1) * $self->{y_char_size}), ($x1 + 20 + $i + 1) * $self->{x_char_size}, $y_start + ( ($count) * $self->{y_char_size}));
	 $self->{image}->bgcolor($self->{bg_color});
	 $self->{image}->fgcolor($self->{fg_color});
	 $i++;
	}
 }

$count += 1;
}

}
########################################
#####ACCESSORS#####
sub width{
my $self = shift;
return $self->{image}->width if exists $self->{image};
}

sub height{
my $self = shift;
return $self->{image}->height if exists $self->{image};
}

sub aln_length{
my $self = shift;
return $self->{seq_length} if exists $self->{seq_length};
}

sub aln_format{
my $self = shift;
return $self->{seq_format} if exists $self->{seq_format};
}

sub no_sequences{
my $self = shift;
return $self->{no_sequences} if exists $self->{no_sequences};
}

1;
__END__

=head1 NAME

Bio::Align::Graphics - Graphic Rendering of Bio::Align::AlignI Objects

=head1 SYNOPSIS

  use Bio::Align::Graphics;

  #Get an AlignI object, usually by using Bio::AlignIO

  my $file=shift @ARGV;
  my $in=new Bio::AlignIO(-file=>$file, -format=>'clustalw');
  my $aln=$in->next_aln();


  #Create a new Graphics object

( run in 0.550 second using v1.01-cache-2.11-cpan-2398b32b56e )