From 182b2c7598c946ffdc82c81c244d43e1b4dac661 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Wed, 30 Apr 2003 01:29:46 +0000 Subject: [PATCH] This commit was generated by cvs2svn to compensate for changes in r5, which included commits to RCS files with non-trunk default branches. --- wheel.pl | 631 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 631 insertions(+) create mode 100755 wheel.pl diff --git a/wheel.pl b/wheel.pl new file mode 100755 index 0000000..61655cf --- /dev/null +++ b/wheel.pl @@ -0,0 +1,631 @@ +#! /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="0.10 p06 12/14/2001 DLA"; + +# 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, + charged=>1, + fill=>[187,187,255], + border=>[187,187,255], + shape=>'triangle', + }, + 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)); +} + -- 2.39.2