InSilicoSpectro
view release on metacpan or search on metacpan
lib/InSilicoSpectro/InSilico/MSMSOutput.pm view on Meta::CPAN
parameter fname and the file handle will be set in binmode.
=item format
The graphic file format. If not specified, the function will return the
image object for further processing (see GD documentation). The supported
file formats are the ones of GD.
=item fontChoice
The size of the graphics is controlled via the choice of the font. The
fontChoics parameter is a string 'class:size', where class selects
the type of font and size its size.
The GD native fonts are selected by setting class equal to 'default'. The
size the 'default' class must be one of 'Tiny', 'Small', 'MediumBold',
'Large', or 'Giant'. Default font is 'default:Large'.
Alternatively, it is possible give the name of a file containing the
definition of a TrueType font for the class (absolute path) and size
is the point size.
=item inCellBorder
Number of pixels between lines and text, default 1.
=item style
Two styles are supported for the match graphics: 'circle' and 'square'.
Default is 'circle' except when modifLvl was 2 in tabSpectrum, where it
is 'square'.
=item plotIntern
If this parameter is set to any value, and at least one internal fragment
mass exists, the internal fragments are represented in the graphics.
=item nColIntern
Number of column to display internal fragments, default is 2.
=item colorScale
This parameter is used for defining a list of intensities thresholds and
corresponding colors used when highlighting the table cells to indicate
fragment matches. Thresholds must be in increasing order of intensities.
colorScale is a reference to a vector of values, each threshold is associated
with 8 values in the following order:
=over 4
=item threshold value
=item red intensity (cell color)
=item green intensity (cell color)
=item blue intensity (cell color)
=item legend text
=item red intensity (legend text color)
=item green intensity (legend text color)
=item blue intensity (legend text color)
=back
These eight data are repeated for each threshold and the number of threshold
is not limited. The threshold values must be adapted to intensity normalization
(see function tabSpectrum).
By default, plotSpectrumMatch generates a color scale that adapts to the
normalization and contains 5 bins: blue (less intense), red, orange, yellow,
green (most intense).
=item legend
When this parameter is set to 'right', a legend is added at the right of the
graphics. When it is set to 'bottom', a legend is added under the graphics.
The legend is made of the color scale and a count number of matched peaks versus
number of experimental peaks in each intensity bin. This count informs on the
quality of the match. It is important to note that it is not uncommon for an
experimental peak to match several theoretical masses and therefore the count,
which considers each mass once, may be slightly different from what is read
from the graphics. The present two different point of views: theoretical and
experimental masses point of views.
=item changeColModifAA
Except when tabSpectrum was called with modifLvl equal to 2, plotSpectrumMatch
displays one character per amino acid only, i.e. the asterisk indicating the
presence of a modification is suppressed. When changeColModifAA is set to any
value, plotSpectrumMatch display the modified amino acids in another color.
If not set, the modified amino acids are over-lined.
=item modifAAColor
A reference to a vector of three values (R, G, B) used to defined the color for
modified amino acids, default blue.
=item bgColor
A reference to a vector of three values (R, G, B) used to defined the graphics
background color, default white.
=item textColor
A reference to a vector of three values (R, G, B) used to defined the text
color, default black.
=item lineColor
A reference to a vector of three values (R, G, B) used to defined the line
color, default black.
=back
Example:
my $msms = new InSilicoSpectro::InSilico::MSMSOutput(spectrum=>\%spectrum, prec=>2, modifLvl=>1,
expSpectrum=>\@peaks, intSel=>'order', tol=>$tol, minTol=>$minTol);
$msms->plotSpectrumMatch(fname=>$peptide, format=>'png', fontChoice=>'default:Large',
changeColModifAA=>1, legend=>'bottom');
=cut
sub plotSpectrumMatch
{
croak "cannot call graphic method when GD module coul not be loaded" unless $okGD;
unless (defined $tmpim){
$tmpim = new GD::Image(1000, 200);
$tmpWhite = $tmpim->colorAllocate(255,255,255);
}
my $table = shift;
my (%h) = @_;
my ($fname, $fhandle, $fontChoice, $colorScale, $format, $inCellBorder, $bgColor, $textColor, $lineColor, $modifAAColor, $changeColModifAA, $style, $legend, $nColIntern, $plotIntern) = ($h{fname}, $h{fhandle}, $h{fontChoice}, $h{colorScale}, $h{for...
if (defined($format)){
if (($format ne 'png') && ($format ne 'xbm') && ($format ne 'gif') && ($format ne 'gdf') && ($format ne 'bmp') && ($format ne 'sgi') && ($format ne 'pcx') && ($format ne 'jpeg') && ($format ne 'tiff')){
croak("Wrong file format [$format]");
}
}
$fontChoice = $fontChoice || 'default:Large';
$inCellBorder = $inCellBorder || 1;
$nColIntern = $nColIntern || 2;
$style = $style || 'circle';
if (($style eq 'circle') && ($table->{modifLvl} == 2)){
# Would be too ugly
$style = 'square';
}
$plotIntern = undef if (!defined($table->{mass}{intern}));
# Determines font size
my ($fontWidth, $fontHeight, $font, $fontName, $fontPoint, $ttHShift, $ttVShift);
my ($class, $size) = split(/:/, $fontChoice);
if ($class eq 'default'){
if ($size eq 'Tiny'){
$fontWidth = gdTinyFont->width;
$fontHeight = gdTinyFont->height;
eval '$font = gdTinyFont';
}
elsif ($size eq 'Small'){
$fontWidth = gdSmallFont->width;
$fontHeight = gdSmallFont->height;
eval '$font = gdSmallFont';
}
elsif ($size eq 'MediumBold'){
$fontWidth = gdMediumBoldFont->width;
$fontHeight = gdMediumBoldFont->height;
eval '$font = gdMediumBoldFont';
}
elsif ($size eq 'Large'){
$fontWidth = gdLargeFont->width;
$fontHeight = gdLargeFont->height;
eval '$font = gdLargeFont';
}
elsif ($size eq 'Giant'){
$fontWidth = gdGiantFont->width;
$fontHeight = gdGiantFont->height;
eval '$font = gdGiantFont';
}
else{
croak("Unknown size [$size] for font class [$class]");
}
}
else{
if (-e $class){
$fontName = $class;
$fontPoint = $size;
my @coord;
foreach (split(//, 'ACDEFGHIKLMNPQRSTVWYabcbxyz*#°')){
@coord = $tmpim->stringFT($tmpWhite, $fontName, $fontPoint, 0, 10, 180, $_);
if ($fontWidth < $coord[2]-$coord[0]){
$fontWidth = $coord[2]-$coord[0];
}
lib/InSilicoSpectro/InSilico/MSMSOutput.pm view on Meta::CPAN
# Computes image size and line positions -----------------------------
# Terminal fragments
my $cellHeight = $fontHeight+2*$inCellBorder+1;
$ttVShift += $cellHeight;
if (($style eq 'circle') && ($cellHeight % 2 == 1)){
# Must be even to center circles
$cellHeight++;
}
my ($fragLength, $nFrag, @fragNames);
for (my $i = 0; $i < @{$table->{mass}{term}}; $i++){
$nFrag++;
push(@fragNames, $table->{mass}{term}[$i][0]);
if (length($fragNames[-1]) > $fragLength){
$fragLength = length($fragNames[-1]);
}
}
my $fragWidth = $fragLength*$fontWidth+2*$inCellBorder+1;
my @vLines = (0, $fragWidth);
my (@aa, @modified);
my $nativeFontWidth = $fontWidth;
if (($style eq 'circle') && ($fontWidth % 2 == 0)){
# Must be odd to center circles
$fontWidth++;
}
for (my $i = 0; $i < @{$table->{splitPept}}; $i++){
if ($table->{modifLvl} == 2){
# Leaves the amino acids as they are (with modification names explicitely included)
push(@aa, $table->{splitPept}[$i]);
push(@modified, 0);
push(@vLines, $vLines[-1]+length($aa[-1])*$fontWidth+2*$inCellBorder+1);
}
else{
# Maintain a 1-character size
my $aa = $table->{splitPept}[$i];
if (index($aa, '*') != -1){
# modified
$aa =~ s/\*//g;
push(@aa, $aa);
if (defined($changeColModifAA)){
push(@modified, 1);
}
else{
push(@modified, 2);
}
}
else{
# Not modified
push(@aa, $aa);
push(@modified, 0);
}
push(@vLines, $vLines[-1]+$fontWidth+2*$inCellBorder+1);
}
}
my @hLines = (0);
for (my $i = 0; $i <= $nFrag; $i++){
push(@hLines, $hLines[-1]+$cellHeight);
}
# Legend box
my ($legendHeight, $legendWidth, @legend, @intThres, @countPeaks, @countMatched);
my ($maxCountLen, @countLegend, $countStartPos, $maxLegLen);
if (defined($legend)){
# Prepares legend text
if (defined($colorScale)){
# User defined scale
for (my $i = 0; $i < @$colorScale; $i += 8){
push(@intThres, $colorScale->[$i]);
push(@legend, $colorScale->[$i+4]);
}
}
elsif ($table->{intSel} eq 'order'){
@intThres = (0, 0.3, 0.5, 0.7, 0.9);
@legend = ('0 %', '30 %', '50 %', '70 %', '90 %');
}
elsif ($table->{intSel} eq 'relative'){
@intThres = (0, 0.1, 0.2, 0.3, 0.5);
@legend = ('0 %', '10 %', '20 %', '30 %', '50 %');
}
elsif ($table->{intSel} eq 'log'){
@intThres = (0, 4.6, 6.2, 7.6, 9.2);
@legend = ('1', '100', '500', '2000', '10000');
}
elsif ($table->{intSel} eq 'original'){
@intThres = (0, 100, 500, 2000, 10000);
@legend = ('0', '100', '500', '2000', '10000');
}
else{
croak("Unknown intSel value [$table->{intSel}]");
}
# Counts peaks
foreach my $intens (values(%{$table->{normInt}})){
$countPeaks[selectColor(\@intThres, $intens)]++;
}
# Counts matched peaks (once)
my %already;
for (my $i = 0; $i < @{$table->{mass}{term}}; $i++){
for (my $j = 1; $j < @{$table->{mass}{term}[$i]}; $j++){
if (defined((my $expMass = $table->{match}{term}[$i][$j]))){
if (!$already{$expMass}){
$countMatched[selectColor(\@intThres, $table->{intens}{term}[$i][$j])]++;
}
$already{$expMass} = 1;
}
}
}
if (defined($plotIntern)){
# Internal fragments
for (my $i = 0; $i < @{$table->{mass}{intern}}; $i++){
for (my $j = 1; $j < @{$table->{mass}{intern}[$i]}; $j+=2){
if (defined((my $expMass = $table->{match}{intern}[$i][$j+1]))){
if (!$already{$expMass}){
$countMatched[selectColor(\@intThres, $table->{intens}{intern}[$i][$j+1])]++;
}
$already{$expMass} = 1;
}
}
}
}
for (my $i = 0; $i < @intThres; $i++){
push(@countLegend, ($countMatched[$i]+0).'/'.($countPeaks[$i]+0));
$maxCountLen = length($countLegend[-1]) if (length($countLegend[-1]) > $maxCountLen);
}
$legendHeight = scalar(@legend)*$cellHeight+1;
if (defined($font)){
foreach (@legend){
$maxLegLen = length($_) if (length($_) > $maxLegLen);
}
$legendWidth = ($maxLegLen+$maxCountLen)*$nativeFontWidth+4*$inCellBorder+3;
$countStartPos = $maxLegLen*$nativeFontWidth+2*$inCellBorder+1;
}
else{
my (@coord, $lWidth, $countWidth);
foreach (@legend){
@coord = $tmpim->stringFT($tmpWhite, $fontName, $fontPoint, 0, 10, 180, $_);
if ($lWidth < $coord[2]-$coord[0]){
$lWidth = $coord[2]-$coord[0];
}
}
foreach (@countLegend){
@coord = $tmpim->stringFT($tmpWhite, $fontName, $fontPoint, 0, 10, 180, $_);
if ($countWidth < $coord[2]-$coord[0]){
$countWidth = $coord[2]-$coord[0];
}
}
$legendWidth = $lWidth+$countWidth+4*$inCellBorder+3;
$countStartPos = $lWidth+2*$inCellBorder+1;
}
}
my ($internWidth, $internHeight, @internHPos, @internVPos, @internList);
if (defined($plotIntern)){
# Internal fragments
for (my $i = 0; $i < @{$table->{mass}{intern}}; $i++){
for (my $j = 1; $j < @{$table->{mass}{intern}[$i]}; $j+=2){
push(@internList, [$table->{mass}{intern}[$i][0], $table->{mass}{intern}[$i][$j], defined($table->{match}{intern}[$i][$j+1]) ? $table->{intens}{intern}[$i][$j+1] : undef]);
}
}
my ($maxFrag, $maxAA);
for (my $i = 0; $i < @internList; $i++){
$maxFrag = length($internList[$i][0]) if (length($internList[$i][0]) > $maxFrag);
$maxAA = length($internList[$i][1]) if (length($internList[$i][1]) > $maxAA);
}
@internHPos = (0);
for (my $i = 0; $i < $nColIntern; $i++){
push(@internHPos, $internHPos[-1]+$maxFrag*$fontWidth+2*$inCellBorder+1);
push(@internHPos, $internHPos[-1]+$maxAA*$fontWidth+2*$inCellBorder+1);
}
@internVPos = ($hLines[-1]+2*$inCellBorder);
for (my $i = 0; $i < int(scalar(@internList)/$nColIntern); $i++){
push(@internVPos, $internVPos[-1]+$cellHeight);
}
push(@internVPos, $internVPos[-1]+$cellHeight) unless (scalar(@internList) % $nColIntern == 0);
}
# Determines size
my $imageWidth = $vLines[-1]+1;
my $imageHeight = $hLines[-1]+1;
if ($legend eq 'right'){
$imageWidth += $legendWidth+2*$inCellBorder;
if (defined($plotIntern)){
$imageHeight = $internVPos[-1]+1;
$imageWidth = $internHPos[-1]+1 if ($internHPos[-1]+1 > $imageWidth);
}
}
elsif ($legend eq 'bottom'){
if (defined($plotIntern)){
if ($internHPos[-1]+2*$inCellBorder+$legendWidth+1 > $imageWidth){
# Enlarge image because of overlap
$imageWidth = $internHPos[-1]+2*$inCellBorder+$legendWidth+1;
}
$imageHeight = max($imageHeight+$legendHeight+2*$inCellBorder-1, $internVPos[-1]+1);
}
else{
$imageHeight += $legendHeight+2*$inCellBorder-1;
}
}
elsif (defined($plotIntern)){
$imageHeight = $internVPos[-1]+1;
}
# Creates the graphic image and allocates colors
my $im = new GD::Image($imageWidth, $imageHeight);
my $white = $im->colorAllocate(255,255,255);
my $black = $im->colorAllocate(0,0,0);
my $blue= $im->colorAllocate(0,72,223);
my $red = $im->colorAllocate(255,16,0);
my $green = $im->colorAllocate(19,232,0);
my $yellow = $im->colorAllocate(255,255,80);
my $orange = $im->colorAllocate(255,180,0);
$bgColor = defined($bgColor) ? $im->colorAllocate(@$bgColor) : $white;
$lineColor = defined($lineColor) ? $im->colorAllocate(@$lineColor) : $black;
$textColor = defined($textColor) ? $im->colorAllocate(@$textColor) : $black;
$modifAAColor = defined($modifAAColor) ? $im->colorAllocate(@$modifAAColor) : $blue;
# Prepares the color scale
my (@color, @legendColor);
if (defined($colorScale)){
# User defined scale
for (my $i = 0; $i < @$colorScale; $i += 8){
push(@color, $im->colorAllocate($colorScale->[$i+1], $colorScale->[$i+2], $colorScale->[$i+3]));
push(@legendColor, $im->colorAllocate($colorScale->[$i+5], $colorScale->[$i+6], $colorScale->[$i+7]));
}
}
elsif ($table->{intSel} eq 'order'){
@color = ($blue, $red, $orange, $yellow, $green);
@legendColor = ($white, $white, $black, $black, $black);
}
elsif ($table->{intSel} eq 'relative'){
@color = ($blue, $red, $orange, $yellow, $green);
@legendColor = ($white, $white, $black, $black, $black);
}
elsif ($table->{intSel} eq 'log'){
@color = ($blue, $red, $orange, $yellow, $green);
@legendColor = ($white, $white, $black, $black, $black);
}
elsif ($table->{intSel} eq 'original'){
@color = ($blue, $red, $orange, $yellow, $green);
@legendColor = ($white, $white, $black, $black, $black);
}
else{
croak("Unknown intSel value [$table->{intSel}]");
}
# Plots the horizontal lines and fragment names
$im->filledRectangle(0, 0, $imageWidth-1, $imageHeight-1, $bgColor);
for (my $i = 0; $i < @hLines; $i++){
$im->line(0, $hLines[$i], $vLines[-1], $hLines[$i], $lineColor);
}
for (my $i = 0; $i < @fragNames; $i++){
if (defined($font)){
$im->string($font, $inCellBorder+1, $hLines[$i+1]+$inCellBorder+1, $fragNames[$i], $textColor);
}
else{
$im->stringFT($textColor, $fontName, $fontPoint, 0, $inCellBorder+1+$ttHShift, $hLines[$i+1]+$inCellBorder+1+$ttVShift, $fragNames[$i]);
}
}
# Plots the peptide sequence
for (my $i = 0; $i < @aa; $i++){
if ($modified[$i] == 0){
# Plots as is
if (defined($font)){
$im->string($font, $vLines[$i+1]+$inCellBorder+1, $inCellBorder+1, $aa[$i], $textColor);
}
else{
$im->stringFT($textColor, $fontName, $fontPoint, 0, $vLines[$i+1]+$inCellBorder+1+$ttHShift, $inCellBorder+1+$ttVShift, $aa[$i]);
}
}
elsif ($modified[$i] == 1){
# Change color
if (defined($font)){
$im->string($font, $vLines[$i+1]+$inCellBorder+1, $inCellBorder+1, $aa[$i], $modifAAColor);
}
else{
$im->stringFT($modifAAColor, $fontName, $fontPoint, 0, $vLines[$i+1]+$inCellBorder+1+$ttHShift, $inCellBorder+1+$ttVShift, $aa[$i]);
}
}
else{
# Overlines
if (defined($font)){
$im->string($font, $vLines[$i+1]+$inCellBorder+1, $inCellBorder+1, $aa[$i], $textColor);
}
else{
$im->stringFT($textColor, $fontName, $fontPoint, 0, $vLines[$i+1]+$inCellBorder+1+$ttHShift, $inCellBorder+1+$ttVShift, $aa[$i]);
}
$im->line($vLines[$i+1]+$inCellBorder+1, 2, $vLines[$i+2]-$inCellBorder-1, 2, $textColor);
$im->line($vLines[$i+1]+$inCellBorder+1, 3, $vLines[$i+2]-$inCellBorder-1, 3, $textColor);
}
}
my $height = $cellHeight;
my $vRadius = 0.5*$height;
my $width = $vLines[2]-$vLines[1]-2*$inCellBorder;
if ($width > $hLines[2]-$hLines[1]-2*$inCellBorder){
$width = $hLines[2]-$hLines[1]-2*$inCellBorder;
}
my $hRadius = 0.5*$width;
if ($style eq 'circle'){
$im->line($vLines[1], $hLines[1], $vLines[1], $hLines[-1], $lineColor);
$im->line($vLines[0], 0, $vLines[0], $hLines[-1], $lineColor);
$im->line($vLines[-1], 0, $vLines[-1], $hLines[-1], $lineColor);
for (my $i = 0; $i < @{$table->{mass}{term}}; $i++){
for (my $j = 1; $j < @{$table->{mass}{term}[$i]}; $j++){
if (defined($table->{mass}{term}[$i][$j])){
# Draw circle
if (defined($table->{intens}{term}[$i][$j])){
# Match, coloured circle
$im->filledEllipse($vLines[$j]+$hRadius, $hLines[$i+1]+$vRadius, $width, $width, $color[selectColor(\@intThres, $table->{intens}{term}[$i][$j])]);
$im->ellipse($vLines[$j]+$hRadius, $hLines[$i+1]+$vRadius, $width, $width, $lineColor);
}
else{
# No match, empty circle
$im->ellipse($vLines[$j]+$hRadius, $hLines[$i+1]+$vRadius, $width, $width, $lineColor);
}
}
else{
# Impossible mass, draw a point
$im->rectangle($vLines[$j]+$hRadius, $hLines[$i+1]+$vRadius, $vLines[$j]+$hRadius+1, $hLines[$i+1]+$vRadius+1, $lineColor);
}
}
}
}
elsif ($style eq 'square'){
for (my $i = 1; $i < @vLines-1; $i++){
$im->line($vLines[$i], $hLines[1], $vLines[$i], $hLines[-1], $lineColor);
}
$im->line($vLines[0], 0, $vLines[0], $hLines[-1], $lineColor);
$im->line($vLines[-1], 0, $vLines[-1], $hLines[-1], $lineColor);
for (my $i = 0; $i < @{$table->{mass}{term}}; $i++){
for (my $j = 1; $j < @{$table->{mass}{term}[$i]}; $j++){
if (defined($table->{mass}{term}[$i][$j])){
# Existing mass
if (defined($table->{intens}{term}[$i][$j])){
# Match, fill the cell with color
$im->filledRectangle($vLines[$j]+1, $hLines[$i+1]+1, $vLines[$j+1]-1, $hLines[$i+2]-1, $color[selectColor(\@intThres, $table->{intens}{term}[$i][$j])]);
}
}
else{
# Impossible mass, draw a little slash
$im->line($vLines[$j]+$hRadius-2, $hLines[$i+1]+$vRadius-2, $vLines[$j]+$hRadius+3, $hLines[$i+1]+$vRadius+3, $lineColor);
}
}
}
}
else{
croak("Unknown style [$style]");
}
if (defined($legend)){
my ($legLeft, $legTop) = ($legend eq 'right') ? ($vLines[-1]+2*$inCellBorder, $hLines[-1]-$legendHeight+1) : ($imageWidth-1-$legendWidth, $hLines[-1]+2*$inCellBorder);
my $countRight = $legLeft+$legendWidth-$inCellBorder;
my $legRight = $legLeft+$countStartPos-$inCellBorder;
$im->rectangle($legLeft, $legTop, $legLeft+$legendWidth, $legTop+$legendHeight-1, $lineColor);
for (my $i = 1; $i < @legend; $i++){
$im->line($legLeft, $legTop+$i*$cellHeight, $legLeft+$legendWidth, $legTop+$i*$cellHeight, $lineColor);
}
my $n = scalar(@legend)-1;
my @coord;
for (my $i = 0; $i < @legend; $i++){
$im->filledRectangle($legLeft+1, $legTop+$i*$cellHeight+1, $legLeft+$countStartPos, $legTop+($i+1)*$cellHeight-1, $color[$n-$i]);
if(defined($font)){
$im->string($font, $legRight-length($legend[$n-$i])*$nativeFontWidth, $legTop+$i*$cellHeight+$inCellBorder+1, $legend[$n-$i], $legendColor[$n-$i]);
$im->string($font, $countRight-length($countLegend[$n-$i])*$nativeFontWidth, $legTop+$i*$cellHeight+$inCellBorder+1, $countLegend[$n-$i], $textColor);
}
else{
@coord = $tmpim->stringFT($tmpWhite, $fontName, $fontPoint, 0, $inCellBorder+1+$ttHShift, $inCellBorder+1+$ttVShift, $legend[$n-$i]);
my $length = $coord[2]-$coord[0];
$im->stringFT($legendColor[$n-$i], $fontName, $fontPoint, 0, $legRight-$length, $legTop+$i*$cellHeight+$inCellBorder+1+$ttVShift, $legend[$n-$i]);
@coord = $tmpim->stringFT($tmpWhite, $fontName, $fontPoint, 0, $inCellBorder+1+$ttHShift, $inCellBorder+1+$ttVShift, $countLegend[$n-$i]);
$length = $coord[2]-$coord[0];
$im->stringFT($textColor, $fontName, $fontPoint, 0, $countRight-$length, $legTop+$i*$cellHeight+$inCellBorder+1+$ttVShift, $countLegend[$n-$i]);
}
}
$im->line($legLeft+$countStartPos, $legTop, $legLeft+$countStartPos, $legTop+$legendHeight-1, $lineColor);
}
if (defined($plotIntern)){
# Draws lines
for (my $i = 0; $i < @internVPos; $i++){
$im->line(0, $internVPos[$i], $internHPos[-1], $internVPos[$i], $lineColor);
}
for (my $i = 0; $i < @internHPos; $i++){
$im->line($internHPos[$i], $internVPos[0], $internHPos[$i], $internVPos[-1], $lineColor);
}
# Adds text and color
my $line = 0;
for (my $i = 0; $i < @internList; $i += $nColIntern, $line++){
my $col = 0;
for (my $j = 0; ($i+$j < @internList) && ($j < $nColIntern); $j++, $col += 2){
if (defined($font)){
$im->string($font, $internHPos[$col]+$inCellBorder+1, $internVPos[$line]+$inCellBorder+1, $internList[$i+$j][0], $textColor);
}
else{
$im->stringFT($textColor, $fontName, $fontPoint, 0, $internHPos[$col]+$inCellBorder+1+$ttHShift, $internVPos[$line]+$inCellBorder+1+$ttVShift, $internList[$i+$j][0]);
}
if (defined($internList[$i+$j][2])){
my $index = selectColor(\@intThres, $internList[$i+$j][2]);
$im->filledRectangle($internHPos[$col+1]+1, $internVPos[$line]+1, $internHPos[$col+2]-1, $internVPos[$line+1]-1, $color[$index]);
if (defined($font)){
$im->string($font, $internHPos[$col+1]+$inCellBorder+1, $internVPos[$line]+$inCellBorder+1, $internList[$i+$j][1], $legendColor[$index]);
}
else{
$im->stringFT($legendColor[$index], $fontName, $fontPoint, 0, $internHPos[$col+1]+$inCellBorder+1+$ttHShift, $internVPos[$line]+$inCellBorder+1+$ttVShift, $internList[$i+$j][1]);
}
}
else{
if (defined($font)){
$im->string($font, $internHPos[$col+1]+$inCellBorder+1, $internVPos[$line]+$inCellBorder+1, $internList[$i+$j][1], $textColor);
}
else{
$im->stringFT($textColor, $fontName, $fontPoint, 0, $internHPos[$col+1]+$inCellBorder+1+$ttHShift, $internVPos[$line]+$inCellBorder+1+$ttVShift, $internList[$i+$j][1]);
}
}
}
}
}
if (defined($format)){
# Creates file
if ($fhandle){
binmode $fhandle;
print $fhandle $im->$format;
}
else{
$fname =~ s/\.$format$//;
open(FGD, ">$fname.$format") || croak("Cannot open file [$fname.$format]: $!");
binmode FGD;
print FGD $im->$format;
close(FGD);
}
}
else{
# Returns the image for further processing
return $im;
}
} # plotSpectrumMatch
=head1 FUNCTIONS
=head2 cmpFragTypes
This function can be used in a sort of fragment type names. Fragment
type names are assumed to follow the rule:
=over 4
=item internal fragments
They are named after their generic name, only immonium ions
are supported so far and they are named 'immo'.
=item N-/C-terminal fragments
They must comply with the pattern
ion&charge - loss1 -loss2 - ...
For instance, singly charged b ions are simply named 'b' and
their doubly and triply counterparts are names 'b++' and
'b+++'. This is the ion&charge part of the pattern above.
The losses may occur once or several times, multiple losses
lib/InSilicoSpectro/InSilico/MSMSOutput.pm view on Meta::CPAN
$ionB =~ s/\+//g;
if (($ionA cmp $ionB) || ($chargeA <=> $chargeB)){
$change = 1;
}
elsif (@partA <=> @partB){
# Different number of losses
$change = 1;
}
else{
# Prepares the losses for comparison
my @lossA;
foreach my $loss (@partA){
$loss =~ s/\*//g;
if ($loss =~ /(\d+)\((\w+)\)/){
# Multiple losses
push(@lossA, [$2, $1]);
}
else{
# Single loss
push(@lossA, [$loss, 1]);
}
}
@lossA = sort {$a->[0] cmp $b->[0]} @lossA;
my @lossB;
foreach my $loss (@partB){
$loss =~ s/\*//g;
if ($loss =~ /(\d+)\((\w+)\)/){
# Multiple losses
push(@lossB, [$2, $1]);
}
else{
# Single loss
push(@lossB, [$loss, 1]);
}
}
@lossB = sort {$a->[0] cmp $b->[0]} @lossB;
# Compares the losses by ignoring multiplicity (we parse it just in case)
for (my $i = 0; $i < @lossA; $i++){
if ($lossA[$i][0] cmp $lossB[$i][0]){
$change = 1;
last;
}
}
}
}
if ($change){
my $tmp = $$current;
$$current = $$old;
$$old = $tmp;
}
} # chooseColorFrag
=head2 plotLegendOnly(%h)
This function plots the color scale only and should be used
if you don not want to display it for each match plot. Note
that the legend generated by PlotSpectrumMatch contains extra
information that is specific to the match, i.e. the count of
matched peaks per intensity bin. This information is not
reported if you decide to save space and only display the
color scale once.
The named parameters are (see plotSpectrumMatch for detailed
explanations):
=over 4
=item fname
The file name of the generated image.
=item fhandle
An open file handle for writing the generated image. It has priority over
parameter fname and the file handle will be set in binmode.
=item format
The graphic file format.
=item fontChoice
The size of the graphics is controlled via the choice of the font.
=item inCellBorder
Number of pixels between lines and text, default 1.
=item colorScale
This parameter is used for defining a list of intensities thresholds and
corresponding colors used when highlighting the table cells to indicate
fragment matches.
=item lineColor
A reference to a vector of three values (R, G, B) used to defined the line
color, default black.
=item intSel
In case no user-defined color scale is provided, a default color
scale is used instead. To properly adjust this scale to the intensity
normalization method it is important to indicate via parameter intSel
which is this normalization. Possible values are listed in function
normalizeIntensities.
=back
=cut
sub plotLegendOnly
{
my (%h) = @_;
my ($fname, $fhandle, $fontChoice, $intSel, $colorScale, $format, $inCellBorder, $lineColor) = ($h{fname}, $h{fhandle}, $h{fontChoice}, $h{intSel}, $h{colorScale}, $h{format}, $h{inCellBorder}, $h{lineColor});
if (defined($format)){
if (($format ne 'png') && ($format ne 'xbm') && ($format ne 'gif') && ($format ne 'gdf') && ($format ne 'bmp') && ($format ne 'sgi') && ($format ne 'pcx') && ($format ne 'jpeg') && ($format ne 'tiff')){
croak("Wrong file format [$format]");
}
}
$fontChoice = $fontChoice || 'default:Large';
$inCellBorder = $inCellBorder || 1;
# Determines font size
my ($fontWidth, $fontHeight, $font, $fontName, $fontPoint, $ttHShift, $ttVShift);
my ($class, $size) = split(/:/, $fontChoice);
if ($class eq 'default'){
if ($size eq 'Tiny'){
$fontWidth = gdTinyFont->width;
$fontHeight = gdTinyFont->height;
eval '$font = gdTinyFont';
}
elsif ($size eq 'Small'){
$fontWidth = gdSmallFont->width;
$fontHeight = gdSmallFont->height;
eval '$font = gdSmallFont';
}
elsif ($size eq 'MediumBold'){
$fontWidth = gdMediumBoldFont->width;
$fontHeight = gdMediumBoldFont->height;
eval '$font = gdMediumBoldFont';
}
elsif ($size eq 'Large'){
$fontWidth = gdLargeFont->width;
$fontHeight = gdLargeFont->height;
eval '$font = gdLargeFont';
}
elsif ($size eq 'Giant'){
$fontWidth = gdGiantFont->width;
$fontHeight = gdGiantFont->height;
eval '$font = gdGiantFont';
}
else{
croak("Unknown size [$size] for font class [$class]");
}
}
else{
if (-e $class){
$fontName = $class;
$fontPoint = $size;
my @coord = $tmpim->stringFT($tmpWhite, $fontName, $fontPoint, 0, 10, 180, 'AFGHKMPQRSWYbyz*#°');
$fontHeight = $coord[1]-$coord[7];
$ttHShift = 10-$coord[0];
$ttVShift = 180-$coord[1];
}
else{
croak("Unknown font class [$class]");
}
}
# Computes image size
my $cellHeight = $fontHeight+2*$inCellBorder+1;
$ttVShift += $cellHeight;
my ($legendHeight, $legendWidth, @legend, @intThres);
if (defined($colorScale)){
# User defined scale
for (my $i = 0; $i < @$colorScale; $i += 8){
push(@intThres, $colorScale->[$i]);
push(@legend, $colorScale->[$i+4]);
}
}
elsif ($intSel eq 'order'){
@intThres = (0, 0.3, 0.5, 0.7, 0.9);
@legend = ('0 %', '30 %', '50 %', '70 %', '90 %');
}
elsif ($intSel eq 'relative'){
@intThres = (0, 0.1, 0.2, 0.3, 0.5);
@legend = ('0 %', '10 %', '20 %', '30 %', '50 %');
}
elsif ($intSel eq 'log'){
@intThres = (0, 4.6, 6.2, 7.6, 9.2);
@legend = ('1', '100', '500', '2000', '10000');
}
elsif ($intSel eq 'original'){
@intThres = (0, 100, 500, 2000, 10000);
@legend = ('0', '100', '500', '2000', '10000');
}
else{
croak("Unknown intSel value [$intSel]");
}
$legendHeight = scalar(@legend)*$cellHeight+1;
if (defined($font)){
my $maxLen;
foreach (@legend){
$maxLen = length($_) if (length($_) > $maxLen);
}
$legendWidth = $maxLen*$fontWidth+2*$inCellBorder+2;
}
else{
my @coord;
foreach (@legend){
@coord = $tmpim->stringFT($tmpWhite, $fontName, $fontPoint, 0, 10, 180, $_);
if ($legendWidth < $coord[2]-$coord[0]){
$legendWidth = $coord[2]-$coord[0];
}
}
$legendWidth += 2*$inCellBorder+2;
}
# Creates the graphic image and allocates colors
my $im = new GD::Image($legendWidth, $legendHeight);
my $white = $im->colorAllocate(255,255,255);
my $black = $im->colorAllocate(0,0,0);
my $blue= $im->colorAllocate(0,72,223);
my $red = $im->colorAllocate(255,16,0);
my $green = $im->colorAllocate(19,232,0);
my $yellow = $im->colorAllocate(255,255,80);
my $orange = $im->colorAllocate(255,180,0);
$lineColor = defined($lineColor) ? $im->colorAllocate(@$lineColor) : $black;
# Prepares the color scale
my (@color, @legendColor);
if (defined($colorScale)){
# User defined scale
for (my $i = 0; $i < @$colorScale; $i += 8){
push(@color, $im->colorAllocate($colorScale->[$i+1], $colorScale->[$i+2], $colorScale->[$i+3]));
push(@legendColor, $im->colorAllocate($colorScale->[$i+5], $colorScale->[$i+6], $colorScale->[$i+7]));
}
}
elsif ($intSel eq 'order'){
@color = ($blue, $red, $orange, $yellow, $green);
@legendColor = ($white, $white, $black, $black, $black);
}
elsif ($intSel eq 'relative'){
@color = ($blue, $red, $orange, $yellow, $green);
@legendColor = ($white, $white, $black, $black, $black);
}
elsif ($intSel eq 'log'){
@color = ($blue, $red, $orange, $yellow, $green);
@legendColor = ($white, $white, $black, $black, $black);
}
elsif ($intSel eq 'original'){
@color = ($blue, $red, $orange, $yellow, $green);
@legendColor = ($white, $white, $black, $black, $black);
}
else{
croak("Unknown intSel value [$intSel]");
}
$im->rectangle(0, 0, $legendWidth-1, $legendHeight-1, $lineColor);
for (my $i = 1; $i < @legend; $i++){
$im->line(0, $i*$cellHeight, $legendWidth-1, $i*$cellHeight, $lineColor);
}
my $n = scalar(@legend)-1;
my @coord;
for (my $i = 0; $i < @legend; $i++){
$im->filledRectangle(1, $i*$cellHeight+1, $legendWidth-2, ($i+1)*$cellHeight-1, $color[$n-$i]);
if (defined($font)){
$im->string($font, $legendWidth-$inCellBorder-1-length($legend[$n-$i])*$fontWidth, $i*$cellHeight+$inCellBorder+1, $legend[$n-$i], $legendColor[$n-$i]);
}
else{
@coord = $tmpim->stringFT($tmpWhite, $fontName, $fontPoint, 0, $inCellBorder+1+$ttHShift, $inCellBorder+1+$ttVShift, $legend[$n-$i]);
my $length = $coord[2]-$coord[0];
$im->stringFT($legendColor[$n-$i], $fontName, $fontPoint, 0, $legendWidth-$inCellBorder-2-$length+$ttHShift, $i*$cellHeight+$inCellBorder+1+$ttVShift, $legend[$n-$i]);
}
}
if (defined($format)){
# Creates file
if ($fhandle){
binmode $fhandle;
print $fhandle $im->$format;
}
else{
$fname =~ s/\.$format$//;
open(FGD, ">$fname.$format")|| croak("Cannot open file [$fname.$format]: $!");
binmode FGD;
print FGD $im->$format;
close(FGD);
}
}
else{
# Returns the image for further processing
return $im;
}
} # plotLegendOnly
=head1 EXAMPLES
See programs starting with testMSMSOut in folder InSilicoSpectro/InSilico/test/.
=head1 AUTHORS
Jacques Colinge, Upper Austria University of Applied Science at Hagenberg
=cut
( run in 0.849 second using v1.01-cache-2.11-cpan-39bf76dae61 )