wheel.cgi
#! /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.4 2009-10-20 21:23:36 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;
use HTML::Entities qw(encode_entities);
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:'.encode_entities($q->param('sequence')));
print $q->img({-src=>$q->self_url.'&draw=yes'});
print <<OUT
<table width="400"><tr><td>By default the output presents the
hydrophilic residues as circles, hydrophobic residues as diamonds,
potentially negatively charged as triangles, and potentially
positively charged as pentagons. Hydrophobicity is color coded as
well: the most hydrophobic residue is green, and the amount of green
is decreasing proportionally to the hydrophobicity, with zero
hydrophobicity coded as yellow. Hydrophilic residues are coded red
with pure red being the most hydrophilic (uncharged) residue, and the
amount of red decreasing proportionally to the hydrophilicity. The
potentially charged residues are light blue. (The color will not apply
if you turn off color.)</td></tr></table>
OUT
}
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));
}