wheel.pl
#! /usr/bin/perl -w
# wheel.pl: Draw alpha helical wheel with hydrophobic moment using
# wif (modifiable to woct) scale.
# Copyright (C) 2001 Don Armstrong and Raphael Zidovetzki
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
my $VERSION=q$Id: wheel.pl,v 1.2 2004/10/19 01:16:18 don Exp $;
# Intial Released Version 0.10
# p01: Fixing displayed angle
# p02: Added arrowhead, fixed lack of return in xy2deg(), added no color option
# p03: Added round function, fixed rounding in angles, changed hm to line, added hm_up option
# p04: Removed bounding box
# p05: Changing user interface to allow simultaneous viewing of options and wheel
# p06: Released to public under GPL
use CGI::Carp qw(fatalsToBrowser);
use strict;
use CGI;
use Math::Trig;
use GD;
use GD::Text::Align;
use POSIX;
sub round($) {
my ($a) = @_;
return (floor $a+0.5);
}
sub min($$){
my ($a,$b)=@_;
if ($a>$b) {
return $b;
}
return $a;
}
sub max($$){
my ($a,$b)=@_;
if ($a<$b) {
return $b;
}
return $a;
}
my $q = new CGI;
sub xy2deg($$) {
my ($x,$y) = @_;
my $angle = rad2deg(atan($x/$y));
if ($y<0) {
$angle+=180;
}
elsif ($angle<0) {
$angle+=360;
}
return $angle;
}
sub calculate_hydrophobic_moment($$){
my ($sequence,$param)=@_;
my $phe=$param->{phe};
my $theta=$param->{theta};
my ($x,$y)=(0,0);
foreach my $amino_acid (split(//,$sequence)) {
$x+=-$param->{aa}->{$amino_acid}->{wif} * sin($phe);
$y+=+$param->{aa}->{$amino_acid}->{wif} * cos($phe);
$phe+=$theta;
}
return ($x,$y);
}
sub draw_wheel($$$){
my ($im,$aasequence,$param)=@_;
my $phe=$param->{phe};
my $aanumber=0;
my $point1;
my @points;
foreach my $aminoacid (split(//,$aasequence)) {
push @points, calculate_geometry($param,$phe);
$phe += $param->{theta};
$aanumber++;
last if ($aanumber>18);
}
for ($aanumber=0;$aanumber<19;$aanumber++) {
my $point = pop @points;
last if (!defined $point);
if ($aanumber>0) {
draw_connection($im,$aanumber,$point1,$point);
}
$point1 = $point;
}
$phe = $param->{phe};
$aanumber = 0;
foreach my $aminoacid (split(//,$aasequence)) {
$point1=calculate_geometry($param,$phe);
draw_aa($im,$aminoacid,
$param->{centerx}+($point1->{bx}-$param->{centerx})*
($param->{d}+2.2*$param->{r}*POSIX::floor($aanumber/18))/
$param->{d},$param->{centery}+($point1->{by}-$param->{centery})*
($param->{d}+2.2*$param->{r}*POSIX::floor($aanumber/18))/
$param->{d},$phe,$param,$aanumber);
$phe+=$param->{theta};
$aanumber++;
}
my ($hydro_x,$hydro_y) = calculate_hydrophobic_moment($aasequence,$param);
draw_hydrophobic_moment($im,$hydro_x,$hydro_y,$param);
}
sub draw_hydrophobic_moment($$$$){
my ($im,$x,$y,$param)=@_;
my $norm=($x*$x+$y*$y)**(0.5);
my $angle = xy2deg($x,-$y);
if ($norm !=0 and $param->{hmscale}!=0) {
$x=$x/$norm*$param->{hmscale};
$y=$y/$norm*$param->{hmscale};
}
# Draw Moment Line (Box, really)
my $poly = GD::Polygon->new;
print STDERR "$angle\n";
$poly->addPt($param->{centerx}-round(($param->{hmscale}/50)*sin(deg2rad($angle+90))),
$param->{centery}+round(($param->{hmscale}/50)*cos(deg2rad($angle+90))));
$poly->addPt($param->{centerx}+round($x*0.85-($param->{hmscale}/50)*sin(deg2rad($angle+90))),
$param->{centery}+round($y*0.85+($param->{hmscale}/50)*cos(deg2rad($angle+90))));
$poly->addPt($param->{centerx}+round($x*0.85-($param->{hmscale}/50)*sin(deg2rad($angle-90))),
$param->{centery}+round($y*0.85+($param->{hmscale}/50)*cos(deg2rad($angle-90))));
$poly->addPt($param->{centerx}-round(($param->{hmscale}/50)*sin(deg2rad($angle-90))),
$param->{centery}+round(($param->{hmscale}/50)*cos(deg2rad($angle-90))));
$im->filledPolygon($poly,$param->{black});
# Draw Arowhead
undef $poly;
$poly = GD::Polygon->new;
$poly->addPt($param->{centerx}+$x,$param->{centery}+$y);
$poly->addPt($param->{centerx}+$x-round(($param->{hmscale}/5)*sin(deg2rad($angle+20))),
$param->{centery}+$y+round(($param->{hmscale}/5)*cos(deg2rad($angle+20))));
$poly->addPt($param->{centerx}+$x-round(($param->{hmscale}/5)*sin(deg2rad($angle-20))),
$param->{centery}+$y+round(($param->{hmscale}/5)*cos(deg2rad($angle-20))));
$im->filledPolygon($poly,$param->{black});
my $text= GD::Text::Align->new($im,
valign => 'center',
halign => 'center',
color=> $param->{black},
);
$text->set_font('/usr/share/fonts/truetype/Florsn01.ttf',$param->{fontsize2});
if ($param->{disp_hm_angle}) {
$text->set_text(POSIX::floor($norm*100+.5)/100 . '@' . POSIX::floor(($angle*10+0.5))/10);
}
else {
$text->set_text(POSIX::floor($norm*100+.5)/100);
}
my $offset=-10-$param->{fontsize2}/2;
if ($y<0) {
$offset=-$offset;
}
$text->draw($param->{centerx},$param->{centery}+$offset);
}
sub draw_connection($$$$) {
my ($im,$aanumber,$point1,$point2) = @_;
my $color=$im->colorAllocate(240*((18-$aanumber)/18),
240*((18-$aanumber)/18),
240*((18-$aanumber)/18)
);
my $poly = GD::Polygon->new;
$poly->addPt($point1->{ex},$point1->{ey});
$poly->addPt($point2->{ex},$point2->{ey});
$poly->addPt($point2->{cx},$point2->{cy});
$poly->addPt($point1->{cx},$point1->{cy});
$im->filledPolygon($poly,$color);
return;
}
sub calculate_geometry($$){
my ($param,$phe)=@_;
return {bx=>($param->{d})*sin($phe)+$param->{centerx},
cx=>($param->{d}-($param->{w}/2)/sin((pi-$param->{theta})/2))*sin($phe)+$param->{centerx},
dx=>($param->{centerx}),
ex=>($param->{d}+($param->{w}/2)/sin((pi-$param->{theta})/2))*sin($phe)+$param->{centerx},
by=>-($param->{d})*cos($phe)+$param->{centery},
cy=>-($param->{d}-($param->{w}/2)/sin((pi-$param->{theta})/2))*cos($phe)+$param->{centery},
dy=>($param->{centery}),
ey=>-($param->{d}+($param->{w}/2)/sin((pi-$param->{theta})/2))*cos($phe)+$param->{centery},
};
}
sub draw_n_gon($$$$){
my ($x,$y,$r,$n)=@_;
my $ngon=GD::Polygon->new;
for (my $v = 0;$v<$n;$v++) {
$ngon->addPt($x+$r*sin((2*pi/$n)*$v),$y-$r*cos((2*pi/$n)*$v));
}
return($ngon);
}
sub draw_aa($$$$$$$){
my ($im,$aasymbol,$bx,$by,$phe,$param,$aanumber)=@_;
my $r=$param->{r};
my $ax=$bx;
my $ay=$by;
$_ = $param->{aa}->{$aasymbol}->{shape};
if (defined && /square/) {
$im->filledRectangle($ax-$r,$ay-$r,$ax+$r,$ay+$r,$param->{aa}->{$aasymbol}->{bcolor});
$im->rectangle($ax-$r,$ay-$r,$ax+$r,$ay+$r,$param->{aa}->{$aasymbol}->{fcolor});
}
elsif (defined && /triangle/) {
$im->filledPolygon(draw_n_gon($ax,$ay,1.25*$r,3),
$param->{aa}->{$aasymbol}->{bcolor});
$im->polygon(draw_n_gon($ax,$ay,1.25*$r,3),
$param->{aa}->{$aasymbol}->{fcolor});
}
elsif (defined && /hexagon/) {
$im->filledPolygon(draw_n_gon($ax,$ay,1.18*$r,6),
$param->{aa}->{$aasymbol}->{bcolor});
$im->polygon(draw_n_gon($ax,$ay,1.18*$r,6),
$param->{aa}->{$aasymbol}->{fcolor});
}
elsif (defined && /diamond/) {
$im->filledPolygon(draw_n_gon($ax,$ay,1.25*$r,4),
$param->{aa}->{$aasymbol}->{bcolor});
$im->polygon(draw_n_gon($ax,$ay,1.25*$r,4),
$param->{aa}->{$aasymbol}->{fcolor});
}
elsif (defined && /pentagon/) {
$im->filledPolygon(draw_n_gon($ax,$ay,1.2*$r,5),
$param->{aa}->{$aasymbol}->{bcolor});
$im->polygon(draw_n_gon($ax,$ay,1.2*$r,5),
$param->{aa}->{$aasymbol}->{fcolor});
}
elsif (defined && /octagon/){
$im->filledPolygon(draw_n_gon($ax,$ay,1.1*$r,8),
$param->{aa}->{$aasymbol}->{bcolor});
$im->polygon(draw_n_gon($ax,$ay,1.1*$r,8),
$param->{aa}->{$aasymbol}->{fcolor});
}
else { #cicle
$im->filledPolygon(draw_n_gon($ax,$ay,$r*0.99,360),
$param->{aa}->{$aasymbol}->{bcolor});
$im->arc($ax,$ay,2*$r,2*$r,0,360,$param->{aa}->{$aasymbol}->{fcolor});
}
$im->fill($ax,$ay,$param->{aa}->{$aasymbol}->{bcolor});
my $text= GD::Text::Align->new($im,
valign => 'center',
halign => 'center',
color=> $param->{black},
);
$text->set_font('/usr/share/fonts/truetype/Florsn01.ttf',$param->{fontsize});
my $label_text=$aasymbol . abs($aanumber+$param->{indexaa});
$text->set_text($label_text);
$text->draw($ax,$ay,0);
}
if (defined $q->param('draw') and $q->param('draw')=~/yes/) {
my $param={
indexaa=>1,
d=>320,
centerx=>500,
centery=>500,
xsize=>1000,
ysize=>1000,
w=>14,
theta=>(100/180)*pi,
phe=>(0/180)*pi,
r=>40,
fontsize=>20,
fontsize2=>20,
hmscale=>50,
wifcolor=>1,
maxwif=>0.5802,
minwif=>-1.8502,
hmdisp=>'',
};
# Merge in query params
# DGwoct[woct] and DGwif[wif] are octanol and interface hydrophobicity values
# as seen on http://blanco.biomol.uci.edu/Whole_residue_HFscales.txt
# and used in MPEx.
# Wimley and White
# Nature Struc. Biol 3:842 (1996) [wif values]
# Wimley, Creamer and White
# Biochemistry 34:5108 (1996) [woct values]
$param->{aa} = {G=>{name=>'Glycine',
abbr=>'gly',
woct=>1.15,
wif=>0.01,
},
A=>{name=>'Alanine',
abbr=>'ala',
woct=>0.50,
wif=>0.17,
},
V=>{name=>'Valine',
abbr=>'val',
woct=>-0.46,
wif=>0.07,
},
L=>{name=>'Leucine',
abbr=>'leu',
woct=>-1.25,
wif=>-0.56,
shape=>'diamond',
},
I=>{name=>'Isoleucine',
abbr=>'ile',
woct=>-1.12,
wif=>-0.31,
shape=>'diamond',
},
M=>{name=>'Methionine',
abbr=>'met',
woct=>-0.67,
wif=>-0.23,
shape=>'diamond',
},
P=>{name=>'Proline',
abbr=>'pro',
woct=>0.14,
wif=>0.45,
},
F=>{name=>'Phenylalanine',
abbr=>'phe',
woct=>-1.71,
wif=>-1.13,
shape=>'diamond',
},
W=>{name=>'Tryptophan',
abbr=>'trp',
woct=>-2.09,
wif=>-1.85,
shape=>'diamond',
},
S=>{name=>'Serine',
abbr=>'ser',
woct=>0.46,
wif=>0.13,
},
T=>{name=>'Threonine',
abbr=>'thr',
woct=>0.25,
wif=>0.14,
},
N=>{name=>'Asparagine',
abbr=>'asn',
woct=>0.85,
wif=>0.42,
},
Q=>{name=>'Glutamine',
abbr=>'gln',
woct=>0.77,
wif=>0.58,
},
Y=>{name=>'Tyrosine',
abbr=>'tyr',
woct=>-0.71,
wif=>-0.94,
shape=>'diamond',
},
C=>{name=>'Cysteine',
abbr=>'cys',
woct=>-0.02,
wif=>-0.24,
shape=>'diamond',
},
K=>{name=>'Lysine',
abbr=>'lys',
woct=>2.80,
wif=>0.99,
shape=>'pentagon',
fill=>[187,187,255],
border=>[187,187,255],
},
R=>{name=>'Arginine',
abbr=>'arg',
woct=>1.81,
wif=>0.81,
shape=>'pentagon',
fill=>[187,187,255],
border=>[187,187,255],
},
H=>{name=>'Histidine',
abbr=>'his',
woct=>2.33,
wif=>0.96,
shape=>'pentagon',
fill=>[187,187,255],
border=>[187,187,255],
},
D=>{name=>'Aspartic Acid',
abbr=>'asp',
woct=>3.64,
wif=>1.23,
shape=>'triangle',
fill=>[187,187,255],
border=>[187,187,255],
},
E=>{name=>'Glutamic Acid',
abbr=>'glu',
woct=>3.63,
wif=>2.02,
shape=>'triangle',
fill=>[187,187,255],
border=>[187,187,255],
},
};
foreach my $param_key ($q->param) {
my $param_value=$q->param($param_key);
if ($param_value=~/^(\-{0,1}\d*\.{0,1}\d+)$/) {
$param->{$param_key}=$q->param($param_key);
if ($param_key=~/^(phe|theta|hmdisp)$/) {
$param->{$param_key}=$param->{$param_key}/180*pi;
}
}
}
if ($q->param('disp_hm_angle') =~ /on/) {
$param->{'disp_hm_angle'}=1;
}
else {
$param->{'disp_hm_angle'}=0;
}
if ($q->param('reverse_helix') =~ /on/) {
$param->{'reverse_helix'}=1;
}
else {
$param->{'reverse_helix'}=0;
}
if ($q->param('wo_color') =~ /on/) {
$param->{'wifcolor'}=0;
}
else {
$param->{'wifcolor'}=1;
}
my $im = new GD::Image($param->{xsize},$param->{ysize});
$param->{white} = $im->colorAllocate(255,255,255);
$param->{black} = $im->colorAllocate(0,0,0);
$param->{red} = $im->colorAllocate(255,0,0);
$param->{blue} = $im->colorAllocate(0,0,255);
foreach my $aminoacid (keys %{$param->{aa}}) {
if ($param->{wifcolor} && $param->{aa}->{$aminoacid}->{wif}<=$param->{maxwif} && !(defined $param->{aa}->{$aminoacid}->{charged} && $param->{aa}->{$aminoacid}->{charged})) {
$param->{aa}->{$aminoacid}->{fcolor} =
$im->colorAllocate(min(($param->{aa}->{$aminoacid}->{wif}-$param->{minwif})/
(0-$param->{minwif})*255,255),
255-max(($param->{aa}->{$aminoacid}->{wif})/
($param->{maxwif}),0)*255,0);
}
elsif ($param->{wifcolor} && defined $param->{aa}->{$aminoacid}->{border}) {
$param->{aa}->{$aminoacid}->{fcolor} = $im->colorAllocate($param->{aa}->{$aminoacid}->{border}[0],
$param->{aa}->{$aminoacid}->{border}[1],
$param->{aa}->{$aminoacid}->{border}[2]);
}
else {
$param->{aa}->{$aminoacid}->{fcolor} = $param->{black};
}
if ($param->{wifcolor} && $param->{aa}->{$aminoacid}->{wif}<=$param->{maxwif} && !(defined $param->{aa}->{$aminoacid}->{charged} && $param->{aa}->{$aminoacid}->{charged})) {
$param->{aa}->{$aminoacid}->{bcolor} =
$im->colorAllocate(min(($param->{aa}->{$aminoacid}->{wif}-$param->{minwif})/
(0-$param->{minwif})*255,255),
255-max(($param->{aa}->{$aminoacid}->{wif})/
($param->{maxwif}),0)*255,0);
}
elsif ($param->{wifcolor} && defined $param->{aa}->{$aminoacid}->{fill}) {
$param->{aa}->{$aminoacid}->{bcolor} = $im->colorAllocate($param->{aa}->{$aminoacid}->{fill}[0],
$param->{aa}->{$aminoacid}->{fill}[1],
$param->{aa}->{$aminoacid}->{fill}[2]);
}
else {
$param->{aa}->{$aminoacid}->{bcolor} = $param->{white};
}
}
# Draw Bounding Box
# $im->rectangle(0,0,$param->{xsize}-1,$param->{ysize}-1,$param->{black});
my $aasequence = $q->param('sequence');
$aasequence =~ s/[^AC-IK-NP-TV-WY]//gs;
if ($param->{reverse_helix}) {
my $aaseq=$aasequence;
$param->{indexaa}*=-1;
my $numberofaa=0;
$aasequence='';
foreach my $aa(split(//,$aaseq)) {
$aasequence = $aa . $aasequence;
$numberofaa++;
}
$param->{indexaa}-=$numberofaa-1;
$param->{theta}*=-1;
}
print STDERR "hmdisp: $param->{hmdisp}\n";
if ($param->{'hmdisp'} =~ /^(\-{0,1}\d*\.{0,1}\d+)$/) {
my ($x,$y) = calculate_hydrophobic_moment($aasequence,$param);
$param->{phe} = - deg2rad(xy2deg($x,-$y)) + $param->{'hmdisp'};
print STDERR $param->{phe};
}
draw_wheel($im,$aasequence,$param);
print $q->header(-type=>'image/png');
print $im->png;
}
else {
print $q->header();
print $q->start_html('Helical Wheel Projections');
if (defined $q->param('submit') and $q->param('submit')=~/Submit/) {
print $q->h1('Wheel:'.$q->param('sequence'));
print $q->img({-src=>$q->self_url.'&draw=yes'});
}
print $q->h1('Helical Wheel Projections'),
$q->start_form(-method=>'GET'),
$q->table($q->Tr([
$q->td({-bgcolor=>'#ddddff'},['Sequence:',
$q->textarea(-name=>'sequence',
-rows=>5,
-columns=>50)
]),
$q->td({-bgcolor=>'#bbbbff'},['Initial AA Number:',
$q->textfield(-name=>'indexaa',
-size=>5,
-maxlength=>5
)
]),
$q->td({-bgcolor=>'#ddddff'},['Initial AA Rotation:',
$q->textfield(-name=>'phe',
-size=>6,
-maxlength=>6)
]),
$q->td({-bgcolor=>'#ddddff'},['Per AA Rotation:',
$q->textfield(-name=>'theta',
-size=>6,
-maxlength=>6)
]),
$q->td({-bgcolor=>'#bbbbff'},['Xsize:',
$q->textfield(-name=>'xsize',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#ddddff'},['Ysize:',
$q->textfield(-name=>'ysize',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#bbbbff'},['CenterX:',
$q->textfield(-name=>'centerx',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#ddddff'},['CenterY:',
$q->textfield(-name=>'centery',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#bbbbff'},['Connection Width:',
$q->textfield(-name=>'w',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#ddddff'},['Symbol Size:',
$q->textfield(-name=>'r',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#bbbbff'},['Font Size:',
$q->textfield(-name=>'fontsize',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#ddddff'},['Graph Radius:',
$q->textfield(-name=>'d',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#bbbbff'},['HM Font Size:',
$q->textfield(-name=>'fontsize2',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#ddddff'},['HM Scale:',
$q->textfield(-name=>'hmscale',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#bbbbff'},['Display HM Angle:',
$q->checkbox(-name=>'disp_hm_angle',
-checked=>'checked',
-label=>'')
]),
$q->td({-bgcolor=>'#ddddff'},['Reverse Helix:',
$q->checkbox(-name=>'reverse_helix',
-label=>'')
]),
$q->td({-bgcolor=>'#bbbbff'},['No Color:',
$q->checkbox(-name=>'wo_color',
-label=>'')
]),
$q->td({-bgcolor=>'#ddddff'},['Hydrophobic Moment Displacement:',
$q->textfield(-name=>'hmdisp',
-size=>5,
-maxlength=>5)
]),
$q->td({-bgcolor=>'#bbbbff',-colspan=>2},
[$q->center($q->submit(-name=>'submit',-value=>'Submit'))
]),
])
),
$q->endform,
$q->hr,$q->i("Created by ".$q->a({-href=>"mailto:don\@donarmstrong.com"},'Don Armstrong')." and Raphael Zidovetzki. Version: ".$q->b($VERSION));
}