← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to doc/howto/examples/graphics/embl2picture.pl

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
doc/howto/examples/graphics/embl2picture.pl
1
 
#!/usr/bin/perl
2
 
 
3
 
# file: embl2picture.pl
4
 
# This is code example 6 in the Graphics-HOWTO
5
 
# Author: Lincoln Stein
6
 
 
7
 
use strict;
8
 
use lib "$ENV{HOME}/projects/bioperl-live";
9
 
use Bio::Graphics;
10
 
use Bio::SeqIO;
11
 
 
12
 
use constant USAGE =><<END;
13
 
Usage: $0 <file>
14
 
   Render a GenBank/EMBL entry into drawable form.
15
 
   Return as a GIF or PNG image on standard output.
16
 
 
17
 
   File must be in embl, genbank, or another SeqIO-
18
 
   recognized format.  Only the first entry will be 
19
 
   rendered.
20
 
 
21
 
Example to try:
22
 
   embl2picture.pl factor7.embl | display -
23
 
 
24
 
END
25
 
 
26
 
my $file = shift                       or die USAGE;
27
 
my $io = Bio::SeqIO->new(-file=>$file) or die USAGE;
28
 
my $seq = $io->next_seq                or die USAGE;
29
 
my $wholeseq = Bio::SeqFeature::Generic->new(-start=>1,-end=>$seq->length,
30
 
                                             -display_name=>$seq->display_name);
31
 
 
32
 
my @features = $seq->all_SeqFeatures;
33
 
 
34
 
# sort features by their primary tags
35
 
my %sorted_features;
36
 
for my $f (@features) {
37
 
  my $tag = $f->primary_tag;
38
 
  push @{$sorted_features{$tag}},$f;
39
 
}
40
 
 
41
 
my $panel = Bio::Graphics::Panel->new(
42
 
                                      -length    => $seq->length,
43
 
                                      -key_style => 'between',
44
 
                                      -width     => 800,
45
 
                                      -pad_left  => 10,
46
 
                                      -pad_right => 10,
47
 
                                      );
48
 
$panel->add_track($wholeseq,
49
 
                  -glyph => 'arrow',
50
 
                  -bump => 0,
51
 
                  -double=>1,
52
 
                  -tick => 2);
53
 
 
54
 
$panel->add_track($wholeseq,
55
 
                  -glyph  => 'generic',
56
 
                  -bgcolor => 'blue',
57
 
                  -label  => 1,
58
 
                 );
59
 
 
60
 
# special cases
61
 
if ($sorted_features{CDS}) {
62
 
  $panel->add_track($sorted_features{CDS},
63
 
                    -glyph      => 'transcript2',
64
 
                    -bgcolor    => 'orange',
65
 
                    -fgcolor    => 'black',
66
 
                    -font2color => 'red',
67
 
                    -key        => 'CDS',
68
 
                    -bump       =>  +1,
69
 
                    -height     =>  12,
70
 
                    -label      => \&gene_label,
71
 
                    -description=> \&gene_description,
72
 
                   );
73
 
  delete $sorted_features{'CDS'};
74
 
}
75
 
 
76
 
if ($sorted_features{tRNA}) {
77
 
  $panel->add_track($sorted_features{tRNA},
78
 
                    -glyph     =>  'transcript2',
79
 
                    -bgcolor   =>  'red',
80
 
                    -fgcolor   =>  'black',
81
 
                    -font2color => 'red',
82
 
                    -key       => 'tRNAs',
83
 
                    -bump      =>  +1,
84
 
                    -height    =>  12,
85
 
                    -label     => \&gene_label,
86
 
                   );
87
 
  delete $sorted_features{tRNA};
88
 
}
89
 
 
90
 
# general case
91
 
my @colors = qw(cyan orange blue purple green chartreuse magenta yellow aqua);
92
 
my $idx    = 0;
93
 
for my $tag (sort keys %sorted_features) {
94
 
  my $features = $sorted_features{$tag};
95
 
  $panel->add_track($features,
96
 
                    -glyph    =>  'generic',
97
 
                    -bgcolor  =>  $colors[$idx++ % @colors],
98
 
                    -fgcolor  => 'black',
99
 
                    -font2color => 'red',
100
 
                    -key      => "${tag}s",
101
 
                    -bump     => +1,
102
 
                    -height   => 8,
103
 
                    -description => \&generic_description
104
 
                   );
105
 
}
106
 
 
107
 
print $panel->png;
108
 
exit 0;
109
 
 
110
 
sub gene_label {
111
 
  my $feature = shift;
112
 
  my @notes;
113
 
  foreach (qw(product gene)) {
114
 
    next unless $feature->has_tag($_);
115
 
    @notes = $feature->each_tag_value($_);
116
 
    last;
117
 
  }
118
 
  $notes[0];
119
 
}
120
 
 
121
 
sub gene_description {
122
 
  my $feature = shift;
123
 
  my @notes;
124
 
  foreach (qw(note)) {
125
 
    next unless $feature->has_tag($_);
126
 
    @notes = $feature->each_tag_value($_);
127
 
    last;
128
 
  }
129
 
  return unless @notes;
130
 
  substr($notes[0],30) = '...' if length $notes[0] > 30;
131
 
  $notes[0];
132
 
}
133
 
 
134
 
sub generic_description {
135
 
  my $feature = shift;
136
 
  my $description;
137
 
  foreach ($feature->all_tags) {
138
 
    my @values = $feature->each_tag_value($_);
139
 
    $description .= $_ eq 'note' ? "@values" : "$_=@values; ";
140
 
  }
141
 
  $description =~ s/; $//; # get rid of last
142
 
  $description;
143
 
}