[Bio] / FigKernelPackages / raedraw.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/raedraw.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (view) (download) (as text)

1 : olson 1.11 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : redwards 1.1
19 :     #### END tool_hdr ####
20 :    
21 :     =pod
22 :    
23 :     =head1 raedraw.pm
24 :    
25 :     A bunch of modules written by Rob to draw different things. Most of these are going to draw images
26 :     using SVG that has many advantages over png/gif images.
27 :    
28 :     A lot of this is geared towards drawing the genome browser that I am working on. The idea is not only
29 :     to plot sims but other data in tag/value pairs
30 :    
31 :     =cut
32 :    
33 :    
34 :     package raedraw;
35 :     use strict;
36 :     use FIG;
37 :     use SVG;
38 :     use Data::Dumper;
39 :     my $fig=new FIG;
40 :    
41 :    
42 :     =head1 new
43 :    
44 :     Instantiate the script and figure out what we are looking for. These are the options.
45 :     Remeber, this was originally taken from a standalone script I wrote, and then cgi-iffied.
46 :    
47 :     Returns a pointer to itself
48 :    
49 :     Arguments that can be passed in
50 :     -genome <genome> Number to draw as baseline
51 :     -compare_to <genome1,genome2,genome3> A reference to a list of similar genomes to plot on image
52 :     Note that this will be expanded with stuff, and some good stuff too
53 :    
54 :    
55 :     Image size
56 :     -width <width> Width of the image (default 800)
57 :     -margin <pixels> Left/right margin and gap btwn contigs (default 100)
58 :     -top_marg <pixels> Top margin (default=20)
59 :     -bottom_marg <pixels> Bottom margin (default=20) (note: was -p)
60 :     -box_height <box height> Height of the box to color (default=10)
61 :    
62 :     Display options
63 :     -rows <number> Number of rows to split image into (default=1)
64 :     -box_no_score <boolean> Draw boxes around pegs with no score (was: l)
65 :     -box_score <boolean> Draw boxes around pegs with sims (default=1) (was k)
66 :     -show_function <peg number> Show function every <peg number> pegs in target genome
67 :     -tick_mark_height <pixels> Height of the tick marks to show (default=3)
68 :     -genome_lines <boolean> Draw lines where the genome should be
69 : redwards 1.3 -twostrands <boolean> Put the boxes on two different strands for fwd and reverse (complement)
70 :     -bluescale <boolean> The default is to have darkest be a red color. This will make it a blue color
71 :     -scalefactor ([tag, scale]) An array of tuples on which to scale the numbers in tag/value pairs. Should end up so max no. is 1.
72 : redwards 1.1
73 :     Other things
74 : redwards 1.6 -abbrev <boolean> Use abbreviated names (default=1)
75 : redwards 1.1 -stopshort <peg count> Stop after drawing <peg count> pegs (just for development)
76 :    
77 :    
78 :     At the moment, $self->{'genome'} contains the genome that is drawn along the top, and $self->{'compareto'}
79 :     contains the comparators. We need to extend comparators so we can include homology and whatnot.
80 :    
81 :     EOF
82 :    
83 :     =cut
84 :    
85 :     sub new {
86 :     my ($class,%args) = @_;
87 :     my $self = bless{},$class;
88 :    
89 :     # parse out the arguments that are handed in
90 : redwards 1.3 foreach my $arg (qw[genome width margin top_marg bottom_marg box_height rows show_function stopshort box_no_score tick_mark_height
91 : redwards 1.6 genome_lines maxn maxp bluescale user]) {
92 : redwards 1.1 $args{"-".$arg} && ($self->{$arg}=$args{"-".$arg})
93 :     }
94 : redwards 1.6 foreach my $arg (qw[box_score abbrev twostrands]) {
95 : redwards 1.1 if (defined $args{"-".$arg}) {$self->{$arg}=$args{"-".$arg}} else {$self->{$arg}=$args{"-".$arg}=1}
96 :     }
97 : overbeek 1.12
98 :     return $self unless (defined $args{'-compare_to'});
99 : redwards 1.3
100 :     foreach my $arr ($args{"-scalefactor"}) {
101 :     $self->{'scale'}->{$arr->[0]}=$arr->[1];
102 :     }
103 :    
104 :    
105 : redwards 1.1 $args{'-compare_to'} && $self->compareto($args{'-compare_to'});
106 :    
107 :     # predefined things
108 :     $self->{'width'} =800 unless (defined $self->{'width'});
109 :     $self->{'box_height'} =10 unless (defined $self->{'box_height'});
110 :     $self->{'margin'} =100 unless (defined $self->{'margin'});
111 :     $self->{'top_marg'} =20 unless (defined $self->{'top_marg'});
112 :     $self->{'bot_marg'} =20 unless (defined $self->{'bot_marg'});
113 :     $self->{'rows'} =1 unless (defined $self->{'rows'});
114 :     $self->{'tick_mark_height'} =3 unless (defined $self->{'tick_mark_height'});
115 : redwards 1.3 $self->{'maxn'} =50 unless (defined $self->{'maxn'});
116 :     $self->{'maxp'} =1e-5 unless (defined $self->{'maxp'});
117 : redwards 1.1
118 : redwards 1.5
119 : redwards 1.6 # predefine some color things
120 :     $self->{'brightness'}=100;
121 :     $self->{'saturation'}=100;
122 :     $self->{'maxhue'}=0;
123 :    
124 : redwards 1.1 # each genome gets 3 box heights, and we have 2 top/bottom margins
125 :     # we also need to add room for the target genome track.
126 :     $self->{'height'}=(3 * $self->{'box_height'}* (scalar @{$self->compareto()} +1)) + ($self->{'top_marg'} + $self->{'bot_marg'});
127 :    
128 :     # we have the width of the image, and the effective width from which we calculate scaling of the pegs.
129 :     # the effective width is the width * the number of rows we want
130 :     $self->{'effectivewidth'}=$self->{'width'} * $self->{'rows'};
131 :    
132 : overbeek 1.10 $self->{'svg'}=SVG->new();
133 : redwards 1.1
134 :     return $self;
135 :     }
136 :    
137 :    
138 :     =head2 compareto
139 :    
140 :     Get or set the list of genomes or other things that we will compare this to.
141 :     args: A reference to an array of things to add to the comparisons
142 :     returns: A reference to an array of things that we will compare to
143 :    
144 : redwards 1.3 Things we understand are:
145 :     genome number \d+\.\d+
146 :     tagvalue pairs: must be as a ref to an array, and the first element MUST be 'tagvalue'
147 :     the second element must be the tag, and the optional third and fourth elements
148 :     are cutoff values - anything below the third cutoff and above the fourth cutoff
149 :     will not be shown.
150 :    
151 : redwards 1.1 =cut
152 :    
153 :     sub compareto {
154 :     my ($self, $ct)=@_;
155 : redwards 1.3 push (@{$self->{'compareto'}}, @$ct) if ($ct);
156 : redwards 1.1 return $self->{'compareto'};
157 :     }
158 :    
159 :     =head2 show_function
160 :    
161 :     Set a boolean to show the function
162 :     args: boolean whether to set the function
163 :     returns: whether the function is shown or not
164 :    
165 :     =cut
166 :    
167 :     sub show_function {
168 :     my ($self, $sf)=@_;
169 :     if (defined $sf) {$self->{'show_function'}=$sf}
170 :     return $self->{'show_function'}
171 :     }
172 :    
173 :    
174 :     =head2 write_image
175 :    
176 :     Write out the image to a file
177 :     Args: A file name to write to
178 :     Returns: 1 on success
179 :    
180 :     =cut
181 :    
182 :     sub write_image {
183 :     my ($self, $file)=@_;
184 :    
185 :     #print STDERR &Dumper($self);
186 :    
187 :     # make sure that we have something to compare to
188 :     unless ($self->compareto()) {die "Couldn't find any genomes to compare to"}
189 :    
190 :     # at the moment this is essentially a sequential call, but i think we may mess with this soon....
191 :     $self->_define_tracks unless ($self->{'track'});
192 :     $self->_scale_image unless ($self->{'rowcount'});
193 :     $self->_draw_image unless ($self->{'drawn'});
194 :     $self->_hz_lines if ($self->{'genome_lines'});
195 :    
196 :     open (OUT, ">$file") || die "Can't open $file";
197 :     print OUT $self->{'svg'}->xmlify;
198 :     close OUT;
199 :    
200 : redwards 1.4 my $height=(1 + $self->{'rowcount'}) * (((scalar (keys %{$self->{'trackposn'}})) * $self->{'box_height'}* 3) + $self->{'top_marg'}+ $self->{'box_height'} + $self->{'bot_marg'}) + $self->{'top_marg'}+ $self->{'bot_marg'};
201 : redwards 1.2
202 :     print STDERR "The image should be width: ", $self->{'width'}, " height: $height\n";
203 :    
204 :     print STDERR "Image is in $file\n";
205 : redwards 1.1 print STDERR "Processing took ", time-$^T, " seconds\n";
206 : redwards 1.2 return ($self->{'width'}, $height);
207 : redwards 1.1 }
208 :    
209 :    
210 :     =head2 _define_tracks
211 :    
212 :     Each genome has a track that contains all the information about the genome, including the boxes, names, and drawings. This is an internal method to define those tracks
213 :    
214 :     Args: none
215 :     Returns: nothing
216 :    
217 :     =cut
218 :    
219 :     sub _define_tracks {
220 :     my ($self)=@_;
221 :     {
222 :     my $gp=$self->{'top_marg'}+$self->{'box_height'};
223 :     foreach my $simgen ($self->{'genome'}, @{$self->{'compareto'}}) {
224 : redwards 1.3 # we have to copy this so we don't alter the one in the array
225 :     my $test_gen=$simgen;
226 :     my $an;
227 :     if (ref($test_gen) eq "ARRAY") {
228 :     # it is a reference to an array (hence tag val pairs, so we want the 2nd item
229 :     $test_gen=$test_gen->[1];
230 : redwards 1.6 if ($test_gen eq "pirsf") {$an = "PIR Superfamilies"}
231 :     else {$an=uc($test_gen)}
232 :     }
233 :     elsif ($test_gen eq "subsystems") {
234 :     $an = "FIG Subsystems";
235 : redwards 1.3 }
236 :     $self->{'track'}->{$test_gen}=$self->{'svg'}->group(id=>"${test_gen}_group");
237 :     $self->{'trackposn'}->{$test_gen}=$gp;
238 :    
239 :     # if testgen is a genome (an is not defined) so we need to get the genome name
240 : redwards 1.1
241 : redwards 1.3 if (!$an && $self->{'abbrev'}) {$an=$fig->abbrev($fig->genus_species($test_gen))}
242 :     elsif (!$an) {$an=$fig->genus_species($test_gen)}
243 :     $self->{'label'}->{$test_gen}=$an;
244 : redwards 1.1 $gp+=3*$self->{'box_height'};
245 :     }
246 :     }
247 :     }
248 :    
249 :    
250 :    
251 :     =head1 _scale_image
252 :    
253 :     An internal method to figure out how long the whole genome is and use this as the baseline for the image
254 :    
255 : redwards 1.2 We have somethinglike this for 3 contigs ccc and margins mmm:
256 : redwards 1.1 Row1 mmm ccccccccccc mmm
257 :     Row2 mmm ccc mmm ccc mmm
258 :     Row3 mmm ccccccccccc mmm
259 :     Row4 mmm cc mmm cccc mmm
260 :     The total length is $effectivewidth, but we have to remove 2*rows*margins from this
261 :     then we have to remove # contigs-1 * gap between them
262 :    
263 :     args: none
264 :     returns: none
265 :    
266 :     =cut
267 :    
268 :     sub _scale_image {
269 :     my ($self)=@_;
270 :     my %len; my @xs; $self->{'rowcount'}=0;
271 :     my $absorow;
272 :     {
273 :     my $contigcount;
274 :     foreach my $contig ($fig->all_contigs($self->{'genome'})) {
275 :     $contigcount++;
276 :     $self->{'totallen'}+=$fig->contig_ln($self->{'genome'}, $contig);
277 :     $len{$contig}=$fig->contig_ln($self->{'genome'}, $contig);
278 :     }
279 :    
280 :    
281 :     $contigcount = (($contigcount - 1) * $self->{'margin'}) + (2 * $self->{'rows'}*$self->{'margin'});
282 :     $self->{'xmultiplier'}=$self->{'effectivewidth'}- $contigcount;
283 :     # now we have the total length, the length of each contig, and the amount of free space. For each contig, the scale is
284 :     # the percent of contg/totallen. The space that it takes up is that * free space
285 :     # We also need to know the starts and stops for each row in nt and contigs
286 :     my $offset=0;
287 :     foreach my $contig (sort {$fig->contig_ln($self->{'genome'}, $b) <=> $fig->contig_ln($self->{'genome'}, $a)} keys %len) {
288 :     $self->{'xoffset'}->{$contig}=$self->{'margin'}+$offset;
289 :    
290 : redwards 1.2 #print STDERR "For contig $contig, length is $len{$contig} and start is ", $self->{'xoffset'}->{$contig};
291 :     #print STDERR " and end will be ", $self->{'xoffset'}->{$contig} + $self->{'margin'} + (($len{$contig}/$self->{'totallen'}) * $self->{'xmultiplier'}), "\n";
292 : redwards 1.1
293 :     ### Added rowinfo, but not sure about this
294 :     push (@{$self->{'contigrows'}->{$contig}}, $self->{'rowcount'});
295 :     my $laststart = $self->{'rowinfo'}->{$self->{'rowcount'}}->{$contig}->{'start'}=$self->{'xoffset'}->{$contig};
296 :     my $rowend=$self->{'xoffset'}->{$contig} + (($len{$contig}/$self->{'totallen'}) * $self->{'xmultiplier'});
297 :     while (($rowend-$laststart) > ($self->{'width'} - (2 * $self->{'margin'}))) {
298 :     $laststart=
299 :     $self->{'rowinfo'}->{$self->{'rowcount'}+1}->{$contig}->{'start'}=
300 :     $self->{'rowinfo'}->{$self->{'rowcount'}}->{$contig}->{'end'}=
301 :     $self->{'rowinfo'}->{$self->{'rowcount'}}->{$contig}->{'start'}+($self->{'width'} - (2 * $self->{'margin'}));
302 :     $self->{'rowcount'}++;
303 :     push (@{$self->{'contigrows'}->{$contig}}, $self->{'rowcount'});
304 :     }
305 :     $offset=$self->{'rowinfo'}->{$self->{'rowcount'}}->{$contig}->{'end'}=$rowend;
306 :     #### End added rowinfo section
307 :     }
308 :     }
309 :    
310 :     ##NOTE : ROWINFO HAS MARGINS INCLUDED
311 :    
312 :     # we want to find the absolute starts and stops for each row
313 :     # print out the saved information
314 :     for (my $i=0; $i <= $self->{'rowcount'}; $i++) {
315 :     foreach my $c (keys %{$self->{'rowinfo'}->{$i}}) {
316 :     if (!defined $absorow->{$i}->{'start'} || $absorow->{$i}->{'start'} > $self->{'rowinfo'}->{$i}->{$c}->{'start'})
317 :     {$absorow->{$i}->{'start'} = $self->{'rowinfo'}->{$i}->{$c}->{'start'}}
318 :     if (!defined $absorow->{$i}->{'end'} || $absorow->{$i}->{'end'} < $self->{'rowinfo'}->{$i}->{$c}->{'end'})
319 :     {$absorow->{$i}->{'end'} = $self->{'rowinfo'}->{$i}->{$c}->{'end'}}
320 :     }
321 :     }
322 :    
323 :    
324 :     ### Define the rows
325 :     for (my $row=0; $row <=$self->{'rowcount'}; $row++) {
326 :     my $transform=$row * (((scalar keys %{$self->{'trackposn'}}) * $self->{'box_height'} * 3) + $self->{'top_marg'} + $self->{'bot_marg'});
327 :     my $xtrans=$absorow->{$row}->{'start'} - $self->{'margin'};
328 :     $self->{'rowgroup'}->{$row}=$self->{'svg'}->group(id=>"row_$row", transform=>"translate(-$xtrans, $transform)");
329 : redwards 1.2
330 : redwards 1.1 # add genome labels to the rows
331 :     foreach my $simgen (keys %{$self->{'trackposn'}}) {
332 :     $self->{'rowgroup'}->{$row}->text(id=>"${simgen}_${row}_label", x=>$xtrans, y=>$self->{'trackposn'}->{$simgen}, textLength=>100, lengthAdjust=>"spacingAndGlyphs",
333 :     style=>{'font-family'=>"Helvetica", 'font-size'=>"10", fill=>"black",})->cdata($self->{'label'}->{$simgen});
334 :     }
335 :     }
336 :     } # end _scale_image
337 :    
338 :     =head1 _draw_genome
339 :    
340 :     An internal method to draw the genome that we are comparing to, and to define the locations of the pegs (perhaps)
341 :    
342 :     args: none
343 :     returns: none
344 :    
345 :     =cut
346 :    
347 :     sub _draw_image {
348 :     my ($self)=@_;
349 :     $self->{'drawn'}=1;
350 :     my $defs=$self->{'track'}->{$self->{'genome'}}->defs;
351 :     my $time=time; my $pegcount;
352 :     foreach my $peg ($fig->pegs_of($self->{'genome'})) {
353 :     $pegcount++;
354 :     last if ($self->{'stopshort'} && $self->{'stopshort'} == $pegcount);
355 : redwards 1.6 if ($self->{'user'} eq "master:RobE") {unless ($pegcount % 100) {print STDERR "Pegs done: $pegcount\n"}}
356 : redwards 1.1 # Define the location of the box once per peg
357 :     # also use this to figure out which row to add it to
358 :     my @loc=$fig->feature_location($peg);
359 :     $loc[0] =~ m/^(.*)\_(\d+)\_(\d+)$/;
360 :     my ($contig, $start, $stop)=($1, $2, $3);
361 :     my $len=$stop-$start;
362 :    
363 :     # if the orf is in the same direction want the sim on top, if not want it below
364 :     my $x=$self->{'xoffset'}->{$contig} + (($start/$self->{'totallen'}) * $self->{'xmultiplier'});
365 :     my $boxwidth = (abs($stop-$start)/$self->{'totallen'})*$self->{'xmultiplier'};
366 :    
367 :     # figure out the correct row for the current location. The row is after we have split up the genome
368 :     my $row;
369 :     foreach my $addrow (@{$self->{'contigrows'}->{$contig}}) {
370 :     if ($x >= $self->{'rowinfo'}->{$addrow}->{$contig}->{'start'} && $x < $self->{'rowinfo'}->{$addrow}->{$contig}->{'end'}) {$row=$addrow; last}
371 :     }
372 :     unless (defined $row) {
373 :     print STDERR "Couldn't get a row for $contig looking for a start of $x (real start: $start). These are the starts:\n";
374 :     print STDERR "These are the contigrows: ", join " ", @{$self->{'contigrows'}->{$contig}}, "\n";
375 :     print STDERR map {"$_: " . $self->{'rowinfo'}->{$_}->{$contig}->{'start'} . "\n"} @{$self->{'contigrows'}->{$contig}};
376 :     print STDERR "These are the stops\n";
377 :     print STDERR map {"$_: " . $self->{'rowinfo'}->{$_}->{$contig}->{'end'} . "\n"} @{$self->{'contigrows'}->{$contig}};
378 :     print STDERR "\n";
379 :     exit -1;
380 :     }
381 :    
382 :     # show the function if we are supposed to
383 : redwards 1.4 if ($self->{'show_function'} && !($pegcount % $self->{'show_function'})) {$self->_add_functions($defs, $peg, $x, $boxwidth, $row)}
384 : redwards 1.1
385 :    
386 :     # add a tick mark for the peg
387 :     my $sl=$self->{'trackposn'}->{$self->{'genome'}}-$self->{'tick_mark_height'}; # start line
388 :     my $el=$self->{'trackposn'}->{$self->{'genome'}}+$self->{'tick_mark_height'}; # end line
389 :     $self->{'rowgroup'}->{$row}->line(x1=>$x, x2=>$x, y1=>$sl, y2=>$el);
390 :     $self->{'rowgroup'}->{$row}->line(x1=>$x+$boxwidth, x2=>$x+$boxwidth, y1=>$sl, y2=>$el);
391 :    
392 :    
393 :     #if we want the empty boxes draw them first and then the color thing will overwrite.
394 :     if ($self->{'box_no_score'}) {
395 :     foreach my $simgen (keys %{$self->{'trackposn'}}) {
396 :     my $y=$self->{'trackposn'}->{$simgen};
397 :     if ($start > $stop) {$y-=$self->{'box_height'}}
398 :     $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
399 :     width=>$boxwidth, id=>"${peg}_$y", style => {stroke => "rgb(0,0,0)", fill => "none"});
400 :     }
401 :     }
402 :    
403 :     # now for each peg we need to figure out what we need to add
404 : redwards 1.3 # figure out the strand
405 :     my $comp=0;
406 :     if ($self->{'twostrands'} && $start > $stop) {$comp=1}
407 : redwards 1.1 foreach my $match (@{$self->compareto()}) {
408 : redwards 1.3 next unless ($match);
409 :     if (ref($match) eq "ARRAY" && $match->[0] eq "tagvalue") {
410 :     # deal with tag value pairs
411 : redwards 1.6 $self->_plot_tag_value($peg, $x, $boxwidth, $row, $match);
412 :     }
413 :     elsif ($match eq "subsystems") {
414 :     $self->_plot_subsystems($peg, $x, $boxwidth, $row, $match);
415 : redwards 1.3 }
416 :     elsif ($match =~ /^\d+\.\d+/) {
417 : redwards 1.1 # it is a genome
418 :     $self->_plot_sims($peg, $x, $boxwidth, $row, $match, $comp);
419 :     }
420 :     else {
421 :     print STDERR "No support for matches to $match yet\n";
422 :     }
423 :     }
424 :     }
425 :     }
426 :    
427 :    
428 :     =head2 _add_functions
429 :    
430 :     An internal method to add the functions to the image.
431 :     Args: definitions (defs), peg, position (x) where to add the text, box width, row (y group) to add the text
432 :     Returns: None
433 :    
434 :     I want to make the text at 45 degrees, so we are going to have to make a path and then put the text on the path.
435 :     This is tricky. What we do is define a horizontal path from the point where we want to start to the end of the image
436 :     and we rotate it by 45 degrees. Then we put the text onto that path we have just created. Neato, huh?
437 :    
438 :     =cut
439 :    
440 :     sub _add_functions {
441 :     my ($self, $defs, $peg, $position, $boxwidth, $row)=@_;
442 :     return unless ($self->{'show_function'});
443 :     my $funclocx=$position+($boxwidth/2); # this should be the middle of the box?
444 :     my $funclocy=$self->{'trackposn'}->{$self->{'genome'}}-2;
445 :     my $funcendx=$self->{'effectivewidth'}+$funclocx; # this doesn't matter it just needs to be off the image!
446 :     $defs->path(id=>"${peg}_line", d=>"M $funclocx $funclocy L $funcendx $funclocy", transform=>"rotate(-45, $funclocx $funclocy)");
447 :    
448 :    
449 :     # now just add the text as a textPath
450 :     $self->{'rowgroup'}->{$row}->text(style=>{'font-family'=>"Helvetica, sans-serif", 'font-size'=>"2", fill=>"black",})
451 :     ->textPath(id=>"${peg}_function", '-href'=>"#${peg}_line")
452 :     ->cdata(scalar $fig->function_of($peg));
453 :     }
454 :    
455 :    
456 : redwards 1.6 =head2 _plot_subsystems
457 :    
458 :     An internal method to plot a box if the peg is in a subsystem
459 :     Takes the following as arguments:
460 :     peg, position (x) where to draw the box, width of the box to draw, row (y group)
461 :    
462 :     I am going to try and color the box based on some factor of the subsystems. I will keep saturation and brightness at 50%
463 :     and then vary the hue from 0-360
464 :    
465 :     =cut
466 :    
467 :     sub _plot_subsystems {
468 :     my ($self, $peg, $x, $boxwidth, $row)=@_;
469 :     my $y=$self->{'trackposn'}->{'subsystems'} - (0.5 * $self->{'box_height'});
470 :    
471 :     unless (defined $self->{'maxhue'}) {$self->{'maxhue'}=-5}
472 :     if ($self->{'maxhue'} > 360) {
473 :     $self->{'maxhue'}=-5;
474 :     $self->{'brightness'}-=10;
475 :     if ($self->{'brightness'} < 0) {
476 :     $self->{'brightness'}=100;
477 :     $self->{'saturation'}-=10;
478 :     }
479 :     }
480 :    
481 :     foreach my $ss (sort $fig->subsystems_for_peg($peg))
482 :     {
483 :     next if ($ss->[0] =~ /essential/i);
484 :     next if ($self->{'subsystems'}->{$peg}->{$ss->[0]});
485 :     $self->{'subsystems'}->{$peg}->{$ss->[0]}=1;
486 :     unless ($self->{'hue'}->{$ss->[0]}) {$self->{'hue'}->{$ss->[0]}=$self->{'maxhue'}+5; $self->{'maxhue'}+=5}
487 :     my @color=($self->{'hue'}, $self->{'saturation'}, $self->{'brightness'});
488 :     if ($self->{'bluescale'}) {($color[0], $color[3])=($color[3], $color[0])}
489 :     if ($self->{'box_score'}) {
490 :     $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
491 :     width=>$boxwidth, id=>$ss->[0].".".$peg, style => {stroke => "rgb(0,0,0)", fill => "rgb(@color)"});
492 :     } else {
493 :     $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
494 :     width=>$boxwidth, id=>$ss->[0].$peg, style => {stroke => "none", fill => "rgb(@color)"});
495 :     }
496 :     }
497 :     }
498 :    
499 : redwards 1.3 =head2 _plot_tag_value
500 :    
501 :     An internal method to plot tag value pairs.
502 :     Takes the following as arguments:
503 : redwards 1.6 peg, position (x) where to draw the box, width of the box to draw, row (y group)
504 : redwards 1.3 and then a reference to the tagvalue pairs
505 :    
506 :     The last element must be a reference to an array with the following four items:
507 :     'tagvalue' (ignored - just a boolean for this)
508 :     'tag' -- tag that is used for the plot
509 :     'minimum' -- optional, if supplied minimum cutoff
510 :     'maximum' -- optional, if supplied maximum cutoff
511 :    
512 :     =cut
513 :    
514 :     sub _plot_tag_value {
515 : redwards 1.6 my ($self, $peg, $x, $boxwidth, $row, $tv)=@_;
516 :     my $y=$self->{'trackposn'}->{$tv->[1]} - (0.5 * $self->{'box_height'});
517 :    
518 : redwards 1.3 my $min=$tv->[2] if ($tv->[2]);
519 :     my $max=$tv->[3] if ($tv->[3]);
520 : redwards 1.4
521 : redwards 1.3 my @attr = $fig->feature_attributes($peg);
522 :     if (@attr > 0) {
523 : redwards 1.9 foreach (@attr) {
524 : redwards 1.7 next if ($self->{'addedtv'}->{$tv->[1].$peg}); # specifically avoid dups with tag/value pairs
525 :     $self->{'addedtv'}->{$tv->[1].$peg}=1;
526 : redwards 1.8 my($fid,$tag,$val,$url) = @$_;
527 : redwards 1.7 next unless (lc($tag) eq lc($tv->[1]));
528 :    
529 :     # we are going to test if it is a number. If it is not a number, we don't want to check min/max
530 :     my $number=1;
531 :     eval {
532 :     use warnings; # make sure we warn
533 :     local $SIG{__WARN__} = sub {die $_[0]}; # die if there is a warning
534 :     $val+=0; # generate the warning
535 :     };
536 :     undef $number if ($@);
537 :    
538 :     next if ($number && $min && $val < $min);
539 :     next if ($number && $max && $val > $max);
540 :     # now color the box. We can do this based on the number. We should probably have a scale factor here, but I don't know what it is
541 :     # so we'll let people supply it.
542 :     my @color=(0,1,1); # maybe 1,1,1?
543 :     if ($number) {
544 :     @color=map {int(255 * $_)} my_color($number * $self->{'scale'}->{$tv->[1]});
545 :     }
546 :     if ($self->{'bluescale'}) {($color[0], $color[3])=($color[3], $color[0])}
547 :     if ($self->{'box_score'}) {
548 : redwards 1.3 $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
549 : redwards 1.7 width=>$boxwidth, id=>$tv->[1].$peg, style => {stroke => "rgb(0,0,0)", fill => "rgb(@color)"});
550 :     } else {
551 :     $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
552 :     width=>$boxwidth, id=>$tv->[1].$peg, style => {stroke => "none", fill => "rgb(@color)"});
553 :     }
554 : redwards 1.3 }
555 :     }
556 :     }
557 :    
558 :    
559 :    
560 : redwards 1.1 =head2 _plot_sims
561 :    
562 :     An internal method to add the similarities to the image
563 :     Args: peg, position (x) where to add the text, width of the box to draw, row (y group) to add the text,
564 :     genome to compare to, flag for whether to put below the line (complement essentially)
565 :     Returns: None
566 :    
567 :     =cut
568 :    
569 :    
570 :     sub _plot_sims {
571 :     ##### PLOT SIMS #####
572 :     # find the sims for the genomes that we need
573 :     my ($self, $peg, $x, $boxwidth, $row, $simgen, $comp)=@_;
574 :     my %seensims; # genomes we have seen sims from for this peg. So we only get the best hit
575 : redwards 1.3 foreach my $sim ($fig->sims($peg, $self->{'maxn'}, $self->{'maxp'}, 'fig')) {
576 : redwards 1.1 next unless ($fig->genome_of($$sim[1]) == $simgen && defined $self->{'trackposn'}->{$fig->genome_of($$sim[1])});
577 :     # figure out the y posn
578 :     my $y=$self->{'trackposn'}->{$simgen};
579 :     if ($comp) {$y-=$self->{'box_height'}}
580 :     # now we just need to color based on the sim
581 :     my @color=map {int(255 * $_)} my_color($$sim[2]); # this will adjust it for rgb 0-255
582 :     # color at the moment is on a red based scale, but I'd rather have it on a blue based scale as i am in a blue mood
583 :     # (though not down in the dumps, I just like the color blue)
584 :     # swap r and b, leave g the same
585 : redwards 1.3 if ($self->{'bluescale'}) {($color[0], $color[3])=($color[3], $color[0])}
586 : redwards 1.1
587 :     #now we need to make a box:
588 :     #x from $x length $boxwidth
589 :     #y from $y length $boxheight
590 :     #color is in @{$colorgenome->{$fig->genome_of($$sim[1])}}
591 :     if ($self->{'box_score'}) {
592 :     $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
593 :     width=>$boxwidth, id=>$$sim[1].$peg, style => {stroke => "rgb(0,0,0)", fill => "rgb(@color)"});
594 :     } else {
595 :     $self->{'rowgroup'}->{$row}->rect(x=>$x, y=>$y, height=>$self->{'box_height'},
596 :     width=>$boxwidth, id=>$$sim[1].$peg, style => {stroke => "none", fill => "rgb(@color)"});
597 :     }
598 :     }
599 :     # lastx is used as the translate function x factor. We need to set it to the end position less the margin so we still have some margin (for error)
600 :     }
601 :    
602 :    
603 :    
604 :     =head2 _hz_lines
605 :    
606 :     An internal method to add horizontal lines to an image where the genomes are
607 :     Args: None
608 :     Returns: None
609 :    
610 :     =cut
611 :    
612 :    
613 :     sub _hz_lines {
614 :     my ($self)=@_;
615 :     for (my $row=0; $row <= $self->{'rowcount'}; $row++) {
616 :     foreach my $contig (keys %{$self->{'rowinfo'}->{$row}}) {
617 :     my ($start, $end)=($self->{'rowinfo'}->{$row}->{$contig}->{'start'}, $self->{'rowinfo'}->{$row}->{$contig}->{'end'});
618 :     foreach my $simgen (keys %{$self->{'trackposn'}}) {
619 :     $self->{'rowgroup'}->{$row}->line(id=>"line_${simgen}_${contig}_$row",
620 :     x1=>$start, x2=>$end, y1=>$self->{'trackposn'}->{$simgen}, y2=>$self->{'trackposn'}->{$simgen});
621 :     }
622 :     }
623 :     }
624 :     }
625 :    
626 :    
627 :    
628 :     #### COLORS.
629 :     #
630 :     # This has been stolen from protein.cgi written by Gary because I don't
631 :     # understand enough about colors
632 :    
633 :     sub my_color {
634 :     my $percent=shift;
635 :     return (255,255,255) unless ($percent);
636 :     $percent=1-$percent/100; # we want the more similar ones to be darker
637 :     my $hue = 5/6 * $percent - 1/12;
638 :     my $sat = 1 - 10 * $percent / 9;
639 :     my $br = 1;
640 :     return hsb2rgb( $hue, $sat, $br );
641 :     }
642 :    
643 : overbeek 1.12
644 :     sub heat_map_color {
645 :     my ($self, $fraction, $color)=@_;
646 :     my $hue=$fraction/100;
647 :     my @color=hsb2rgb($hue, 0.6, 1);# saturation and brightness are fixed at 100%
648 :     if ($color eq 'blue') {($color[2], $color[0])=($color[0], $color[2])}
649 :     elsif ($color eq 'green') {($color[1], $color[0])=($color[0], $color[1])}
650 :     return @color;
651 :     }
652 :    
653 :    
654 :    
655 : redwards 1.1 #
656 :     # Convert HSB to RGB. Hue is taken to be in range 0 - 1 (red to red);
657 :     #
658 :    
659 :     sub hsb2rgb {
660 :     my ( $h, $s, $br ) = @_;
661 :     $h = 6 * ($h - floor($h)); # Hue is made cyclic modulo 1
662 :     if ( $s > 1 ) { $s = 1 } elsif ( $s < 0 ) { $s = 0 }
663 :     if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
664 :     my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1, $h, 0 )
665 :     : ( $h <= 2 ) ? ( 2 - $h, 1, 0 )
666 :     : ( 0, 1, $h - 2 )
667 :     )
668 :     : ( ( $h <= 4 ) ? ( 0, 4 - $h, 1 )
669 :     : ( $h <= 5 ) ? ( $h - 4, 0, 1 )
670 :     : ( 1, 0, 6 - $h )
671 :     );
672 :     ( ( $r * $s + 1 - $s ) * $br,
673 :     ( $g * $s + 1 - $s ) * $br,
674 :     ( $b * $s + 1 - $s ) * $br
675 :     )
676 :     }
677 :    
678 :     sub floor {
679 :     my $x = $_[0];
680 :     defined( $x ) || return undef;
681 :     ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x );
682 :     }
683 :    
684 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3