?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
empty directory
[bioperl-live.git] / examples / biographics / all_glyphs.pl
blob42a8d82ec64252edb3a4cf61b9738a7a8101becb
1 #!/usr/bin/perl -w
2 # Generate a simple display of all glyphs for comparison testing
3 # T. Harris (harris@cshl.org)
4
5 # Usage:
6 # ./all_glyphs GD > all.png
7 # ./all_glyphs GD 0 1000 > all.png # output in png with a wide view
8 # ./all_glyphs GD::SVG 100 150 > all.svg # output in SVG, zoomed
9
10 use lib '.','../..','./blib/lib','../../blib/lib','../..';
11 use strict;
12 use Bio::Seq;
13 use Bio::Graphics::Panel;
14 use Bio::Graphics::Feature;
15
16 chomp (my $CLASS = shift);
17 $CLASS or die "\nUsage: lots_of_glyphs IMAGE_CLASS
18 \t- where IMAGE_CLASS is one of GD or GD::SVG
19 \t- GD generate png output; GD::SVG generates SVG.\n";
20
21 chomp (my $start = shift);
22 chomp (my $end = shift);
23
24 $start ||= -100;
25 $end ||= 1000;
26
27 my $ftr = 'Bio::Graphics::Feature';
28 my $segment = $ftr->new(-start=>$start,-end=>$end,-name=>'ZK154',-type=>'clone');
29 my $panel = Bio::Graphics::Panel->new(
30 -grid => [50,100,150,200,250,300,310,320,330],
31 -gridcolor => 'lightcyan',
32 -grid => 1,
33 -segment => $segment,
34 # -offset => 300,
35 # -length => 1000,
36 -spacing => 15,
37 -width => 600,
38 -pad_top => 20,
39 -pad_bottom => 20,
40 -pad_left => 20,
41 -pad_right=> 20,
42 # -bgcolor => 'teal',
43 # -key_style => 'between',
44 -key_style => 'bottom',
45 -image_class => $CLASS,
46 );
47
48 my $zk154_1 = $ftr->new(-start=>-50,-end=>800,-name=>'ZK154.1',-type=>'gene',-source=>'predicted');
49 my $zk154_2 = $ftr->new(-start=>380,-end=>500,-name=>'ZK154.2',-type=>'gene',-source=>'predicted');
50 my $zk154_3 = $ftr->new(-start=>900,-end=>1200,-name=>'ZK154.3',-type=>'gene',-source=>'confirmed');
51 my $xyz4 = $ftr->new(-segments=>[[40,80],[100,120],[200,280],[300,320]],
52 -name =>'xyz4',
53 -source =>'mysterious',
54 -subtype=>'predicted',
55 -type =>'alignment');
56
57 # alignment
58 add_scores($xyz4);
59 $panel->add_track([$zk154_1,[$zk154_2,$xyz4]],
60 -glyph => 'alignment',
61 -label => 'alignment',
62 -key => 'alignment',
63 -height => 10,
64 -font => 'gdSmallFont',
65 -bump => 1,
66 -bgcolor => sub { shift->primary_tag eq 'predicted' ? 'green' : 'blue'},
67 -connector => sub { my $primary_tag = shift->primary_tag;
68 $primary_tag eq 'transcript' ? 'hat'
69 : $primary_tag eq 'alignment' ? 'solid'
70 : undef},
71 -connector_color => 'black',
72 );
73
74 # anchored_arrow
75 my $short_segment = $ftr->new(-start=>200,-end=>1000);
76 $panel->add_track($short_segment,
77 -glyph => 'anchored_arrow',
78 -label => 'anchored_arrow',
79 -key => 'anchored_arrow',
80 -double => 1,
81 -bump => 0,
82 -height => 10,
83 -linewidth =>1,
84 -arrowstyle=>'regular',
85 -tick =>1,
86 );
87
88 # arrow
89 $panel->add_track($segment,
90 -glyph => 'arrow',
91 -label => 'arrow-minor ticks',
92 -key => 'arrow',
93 -double => 1,
94 -fgcolor=> 'red',
95 -bump => 0,
96 -height => 10,
97 -arrowstyle=>'regular',
98 -tick =>1,
99 -linewidth =>1,
100 );
101
102 $panel->add_track($segment,
103 -glyph => 'arrow',
104 -label => 'arrow-major ticks',
105 -double => 1,
106 -bump => 0,
107 -height => 10,
108 -linewidth =>1,
109 -arrowstyle=>'filled',
110 -tick=>2,
111 );
112
113 # box
114 my $box = $ftr->new(-start=>100,-end=>600,-name=>'JC8',-type=>'clone');
115 $panel->add_track($box,
116 -glyph => 'box',
117 -label => 'box',
118 -key => 'box',
119 -bump => 0,
120 -height => 10,
121 -font => 'gdLargeFont',
122 -linewidth =>1,
123 -bgcolor => 'turquoise',
124 -fgcolor => 'black',
125 );
126
127
128 # cds
129 my $cds = $ftr->new(-segments=>[[1,50],[100,150],[222,280],[380,400],[520,599],[801,900]],
130 -name=>'cds',
131 -type=>'gene',
132 -strand=>'+1',
133 -subtype=>'predicted',
134 );
135
136 my $cds2 = $ftr->new(-segments =>[[23,90],[157,201],[256,375],[439,502],[600,725]],
137 -name =>'cds',
138 -strand => '-1',
139 -subtype =>'predicted',
140 -type =>'gene');
141
142 $panel->add_track([$cds],
143 -glyph => 'cds',
144 -label => 'cds',
145 -key => 'cds',
146 -bump => 0,
147 -height =>30,
148 -linewidth=>1,
149 -frame0f => 'blue',
150 -frame1f => 'green',
151 -frame2f => 'yellow',
152 -frame0r => 'red',
153 -frame1r => 'black',
154 -frame2r => 'purple',
155 # -sixframe => 1,
156 -require_subparts=>1,
157 );
158
159
160 # crossbox
161 my $crossbox = $ftr->new(-start=>200,-end=>600);
162 $panel->add_track($crossbox,
163 -glyph => 'crossbox',
164 -label => 'crossbox',
165 -key => 'crossbox',
166 -bump => 0,
167 -height => 20,
168 # -font => 'gdMediumBold',
169 -linewidth =>1,
170 -bgcolor => 'red',
171 -fgcolor => 'black',
172 );
173
174 # diamond
175 my $diamonds = $ftr->new(-segments=>[[10,11],[100,101],[201,202],[214,215],[237,238],
176 [300,301],[350,351],[400,550],[601,602],[775,776]],
177 -name=>'SNPs');
178 $panel->add_track([$diamonds],
179 -glyph => 'diamond',
180 -label => 'diamond',
181 -key => 'diamond',
182 -height => 10,
183 -bgcolor => 'aqua',
184 );
185
186
187
188 # dna
189 my $string =
190 'tcgtcaaatgtctattgggtcgaaaagaaggtgaacgagtgctcggtgatgcgttcaaaactcaacacaaatcttcacatttcgctccactagtcgactttatcgattttgattatcatgctcaaatgaagatttccaaagaggcaattgtgcagttgaaaaagaaaatgagcccacatatgacaaagcatggatttttctattcaatgggaaaagaaatagtgaaacgacaaactggagtaattcgaacaaattgtctagattgtctggataggacgaatgccgtacaaacagccatcggacttcaaatgtcacatgatcaagttgcatttctgaatttaaacgcgggaaaagtgaatgtagagcaacgagttgaagagattcttcgtgatttgtggcagaaaaatggagatcagtgtagtacgatctacgcgggaactggagctcttgacggaaagagcaagttgaaagacgcgtcgagatcgcttgcaagaactattcagaataatttgatggatggtgcaaagcaggaatcatttgatttatttttgactggagccgcatatgatccgaggcttttcgatagagcatgtaatatattgccacctagtttgatacaagaatacgctgacgccgtatcgcagcttgtcgagcgaagtcccgaaatcgccgaacctcaatccattaaaatattcgttggaacttggaatgtgaatggaggaaagaatattcataatgtggcattccgtaatgaatcgagtctctcccactggatatttgccaattcaatgacacgtctcgtatctgtagaagatgagcaactagctgatattgtagcaattggagttgaagaacttgttgatttgaatgcaagtaatatggttaaagcaagtaccacaaatcaacgaatgtggtgtgaaagtattcgaaaaactctttctgaaaaagctccatttgtgctcattggctccgagcagctcgtcggtgtttgtctattcctcttcgcaagaccacgtgtctcaccatacctgaaagactttgcagtggcttctgtaaagactggaatgggtggagcaactggaaataagggatccgttgccttccgaatcgtcgtattctccacttctatttgttttatttgttctcactttgcagccgggcaaaacgagattcgagacagaaatgaggattttgcgacgacgttgaaaaagattcgattcccgttgggcagagaaattgactcgcatgacgtcatattttggttgggagatttcaactatcgaattaatttgtcgggggatgaagttaagaatgctgttagaaatggagactatgcgaaattagtcgaaaatgatcaattgacacagcagaaagctcttggacagacatttgttggcttcaacgaaggacagctcacgttcgcaccaacatacaaatacgacacattcagtgatgactatgatacgagtgaaaagtgtcgtgcacccgcatggactgatcgaattctttggaaagatcagagaaagaagggaaaaacgcaacttctcagctatgatagatcagaattaaaaacttctgatcatcgacctgttggagctgttttcaaagtggaaacttttaaagttggcggcagaaaatgtgtggagctcatcgaggatgttgtagaatctatgggtccaccggacggaacaatcattgtcagtattgccggaaaacctcgattcccgccgcaaatgtttccgccgattcatgagaagttgaaggaactcggtgctcaagttcagctgagcaaattcgacgatggcgatctatggattgtactgaatagtggagaaatggcattagccgcattaagtatggatgggctgaagatcggaggaacagatcagattaatgtgaagttgaagtcaccggattgggcttatgctttgaagccacatctttcagattttgatttggaatcgtttgaagtgacggcagaggaagaggcattacttggtggtactgatggtgccgtttttgaatttgcagacgaagacgaggacgcaatcagtgtgtctagtctgacgcttactggttcggctcccgatcgacctcgtccaccatcagcaagaagtgaagcgatcagtgtagccaaacttgaatggccaacagaacaaccaaacgtcctctccacatcaatgccaacacgagcttcatcagcttctcttgccaatagttcttggtatgagcatgtaccaccacttgctccacctcaatcaaacaataataaaagccctccacaagcttgtctattcaatccattcactcaatctgcaccatccccggctccaccaccatccacgattcctcttccaccgactcgtggagcatcagttggaccaggtcctccagcggttcccgtcaggaaggcacccccaccgccacctcggcctgtcattccacctagaccaaaaaatatgtag';
191
192 my $fragment = Bio::Seq->new(-seq=>$string);
193 my $dna = $ftr->new(-seq=>$fragment,
194 -start=>$start,-end=>$end);
195 $panel->add_track($dna,
196 -glyph => 'dna',
197 -label => 'dna',
198 -key => 'dna',
199 -height => 50,
200 -linewidth=> 1,
201 -axis_color=>'red',
202 -gc_bins => 10,
203 -strand => 'both',
204 );
205
206
207 # dot
208 my $dots = $ftr->new(-segments=>[[10,11],[100,150],[201,232],[214,215],[237,270],
209 [280,281],[300,321],[400,550],[601,602],[775,776]]);
210 $panel->add_track([$dots],
211 -glyph => 'dot',
212 -label => 'dot',
213 -key => 'dot',
214 -height => 10,
215 -bgcolor => 'red',
216 -point => 5,
217 );
218
219 # ellipse
220 my $ellipses = $ftr->new(-segments=>[[100,150],[201,232],[237,270],[300,321],[400,550],[730,776]]);
221 $panel->add_track([$ellipses],
222 -glyph => 'ellipse',
223 -label => 'ellipse',
224 -key => 'ellipse',
225 -height => 10,
226 -bgcolor => 'orange',
227 );
228
229 # ex
230 my $ex = $ftr->new(-start=>100,-end=>400);
231 $panel->add_track($ex,
232 -glyph => 'ex',
233 -label => 'ex',
234 -key => 'ex',
235 -bump => 0,
236 -height => 20,
237 # -font => 'gdMediumBold',
238 -linewidth =>1,
239 -bgcolor => 'red',
240 -fgcolor => 'black',
241 );
242
243 # graded_segments
244 my $partial_gene = $ftr->new(-segments=>[[1,50],[100,150],[220,300],
245 [380,400],[520,600],[800,900]],
246 -name =>'partial_gene',
247 -strand => '+1',
248 -type =>'exon',
249 -source =>'confirmed');
250
251 add_scores($partial_gene);
252 $panel->add_track($partial_gene,
253 -glyph => 'graded_segments',
254 -key => 'graded_segments',
255 -label => 'graded_segments - quill connector',,
256 -bgcolor => 'blue',
257 -connector => 'quill',
258 );
259
260 $panel->add_track($partial_gene,
261 -glyph => 'graded_segments',
262 -label => 'graded_segments - hat connector',
263 -key => 'graded_segments',
264 -bgcolor => 'green',
265 -connector => 'hat',
266 );
267
268 $panel->add_track($partial_gene,
269 -glyph => 'graded_segments',
270 -label => 'graded_segments - solid connector',
271 -key => 'graded_segments',
272 -bgcolor => 'yellow',
273 -connector => 'solid',
274 );
275
276 $panel->add_track($partial_gene,
277 -glyph => 'graded_segments',
278 -label => 'graded_segments - dashed connector',
279 -key => 'graded_segments',
280 -bgcolor => 'red',
281 -connector => 'dashed',
282 );
283
284 # heterogenous_segments
285 $panel->add_track([[$zk154_2,$zk154_3],[$zk154_2,$xyz4]],
286 -glyph => 'heterogeneous_segments',
287 -label => 'heterogeneous_segments',
288 -key => 'heterogeneous_segments',
289 -height => 10,
290 -bump => 1,
291 -predicted_color=>'orange',
292 -confirmed_color=>'purple',
293 -mysterious_color=>'red',
294 -connector_color => 'black',
295 );
296
297 # line
298 $panel->add_track($short_segment,
299 -glyph => 'line',
300 -label => 'line',
301 -key => 'line',
302 -bump => 0,
303 -height => 20,
304 # -font => 'gdMediumBold',
305 -linewidth =>1,
306 -bgcolor => 'green',
307 -fgcolor => 'black',
308 );
309
310 # pinsertion
311 my $pinsertion = $ftr->new(-segments=>[[10,10],[100,100],[200,200],[300,300],[400,400],
312 [550,600],[650,650]]);
313 $panel->add_track([$pinsertion],
314 -glyph => 'pinsertion',
315 -label => 'pinsertion',
316 -key => 'pinsertion',
317 -height => 10,
318 -bgcolor => 'yellow',
319 );
320
321 # primers
322 my $p = $ftr->new(-start=>200,-end=>600);
323 $panel->add_track($p,
324 -glyph => 'primers',
325 -label => 'primers',
326 -key => 'primers',
327 -height => 10,
328 -linewidth =>1,
329 );
330
331 # processed_transcript
332 my $trans1 = $ftr->new(-start=>50,-end=>10,-name=>'ZK154.1',-type=>"3'-UTR");
333 my $trans2 = $ftr->new(-start=>100,-end=>50,-name=>'ZK154.2',-type=>'CDS');
334 my $trans3 = $ftr->new(-start=>350,-end=>225,-name=>'ZK154.3',-type=>'CDS');
335 my $trans4 = $ftr->new(-start=>650,-end=>500,-name=>'ZK154.3',-type=>'CDS');
336 my $trans5 = $ftr->new(-start=>700,-end=>650,-name=>'ZK154.3',-type=>"5'-UTR");
337 my $trans = $ftr->new(-segments=>[$trans1,$trans2,$trans3,$trans4,$trans5]);
338 $panel->add_track($trans,
339 -glyph => 'processed_transcript',
340 -key => 'processed_transcript',
341 -label => 'processed_transcript',
342 -bgcolor => 'aqua',
343 # -height => 5,
344 );
345
346 $panel->add_track($trans,
347 -glyph => 'processed_transcript',
348 -key => 'processed_transcript',
349 -label => 'processed_transcript',
350 -bgcolor => 'green',
351 # -height => 10,
352 -thin_utr => 1);
353
354
355 # redgreen_box
356 $panel->add_track($partial_gene,
357 -glyph => 'redgreen_box',
358 -label => 'redgreen_box',
359 -key => 'redgreen_box',
360 );
361
362 # redgreen_segments
363 $panel->add_track($partial_gene,
364 -glyph => 'redgreen_segment',
365 -label => 'redgreen_segment',
366 -key => 'redgreen_segment',
367 );
368
369 # rndrect
370 $panel->add_track($partial_gene,
371 -glyph => 'rndrect',
372 -label => 'rndrect',
373 -key => 'rndrect',
374 );
375
376 # ruler_arrow
377 $panel->add_track($partial_gene,
378 -glyph => 'ruler_arrow',
379 -label => 1,
380 -key => 'ruler_arrow',
381 -base => 1,
382 );
383
384 $panel->add_track($partial_gene,
385 -glyph => 'ruler_arrow',
386 -label => 1,
387 -key => 'ruler_arrow',
388 -base => 1,
389 -parallel => 0,
390 );
391
392 # segments
393 $panel->add_track([$zk154_1,[$zk154_2,$xyz4]],
394 -glyph => 'segments',
395 -label => 'segments',
396 -key => 'segments',
397 -height => 10,
398 -bump => 1,
399 -bgcolor => sub { shift->primary_tag eq 'predicted' ? 'green' : 'blue'},
400 -connector => sub { my $primary_tag = shift->primary_tag;
401 $primary_tag eq 'transcript' ? 'hat'
402 : $primary_tag eq 'alignment' ? 'solid'
403 : undef},
404 -connector_color => 'black',
405 # -draw_dna => 1,
406 );
407
408 # span
409 my $big_span = $ftr->new(-start=>-400,-end=>3000);
410 my $small_span = $ftr->new(-start=>290,-end=>600);
411 $panel->add_track([$big_span,$small_span],
412 -glyph => 'span',
413 -label => 'span',
414 -key => 'span',
415 );
416
417 # splice_site
418 $panel->add_track($partial_gene,
419 -glyph => 'splice_site',
420 -label => 'splice_site',
421 -key => 'splice_site',
422 -direction => 'right',
423 );
424
425 # transcript
426 $panel->add_track($trans,
427 -glyph => 'transcript',
428 -label => 'transcript',
429 -key => 'transcript',
430 -bgcolor =>'yellow',
431 -arrow_length=>10,
432 );
433
434 # transcript2
435 $panel->add_track($trans,
436 -glyph => 'transcript2',
437 -label => 'transcript2',
438 -key => 'transcript2',
439 -bgcolor => 'purple',
440 -arrow_length=>10,
441 );
442
443 # translation
444 $panel->add_track($dna,
445 -glyph => 'translation',
446 -label => 'translation',
447 -key => 'translation',
448 -translation => '3frame',
449 -frame0 => 'red',
450 -frame1 => 'blue',
451 -frame2 => 'green',
452 -arrow_length => 10,
453 -start_codons => 1,
454 -show_sequence=> 1,
455 );
456
457
458 # triangle
459 $panel->add_track([$pinsertion],
460 -glyph => 'triangle',
461 -label => 'triangle',
462 -key => 'triangle',
463 -bgcolor => 'yellow',
464 -point => 1,
465 -orient => 'E',
466 );
467
468
469 # xyplot
470 $panel->add_track($partial_gene,
471 -glyph => 'xyplot',
472 -key => 'xyplot',
473 -label => 'xyplot',
474 -graph_type => 'boxes');
475
476
477 my $gd = $panel->gd;
478 my $type = ($CLASS eq 'GD') ? 'png' : 'svg';
479 print $gd->$type;
480
481
482
483
484
485
486 sub add_scores {
487 my $ftr = shift;
488 my $score = 10;
489 my @segs = $ftr->segments;
490 foreach (@segs) {
491 $_->score($score);
492 $score += 10;
493 }
494 }
495
496
BioPerl core