scripts/biographics/bp_embl2picture.PLS

   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 =head1 NAME
  13
  14 bp_embl2picture.pl - Render a Genbank/EMBL sequence file graphically as a png image
  15
  16 =head1 SYNOPSIS
  17
  18   % bp_embl2picture.pl factor7.embl | display -
  19
  20 =head1 DESCRIPTION
  21
  22 Render a GenBank/EMBL entry into drawable form.  Return as a GIF or
  23 PNG image on standard output.
  24
  25 The file must be in embl, genbank, or another SeqIO- recognized format.
  26 Only the first entry will be rendered.
  27
  28 =head1 SEE ALSO
  29
  30 L<Bio::Graphics>, the BioGraphics HOWTO.
  31
  32 =head1 AUTHOR
  33
  34 Lincoln Stein, lstein@cshl.edu
  35
  36 Copyright (c) 2004 Cold Spring Harbor Laboratory
  37
  38 This library is free software; you can redistribute it and/or modify
  39 it under the same terms as Perl itself.  See DISCLAIMER.txt for
  40 disclaimers of warranty.
  41
  42 =cut
  43
  44 use constant USAGE =><<END;
  45 Usage: $0 <file>
  46    Render a GenBank/EMBL entry into drawable form.
  47    Return as a GIF or PNG image on standard output.
  48
  49    File must be in embl, genbank, or another SeqIO-
  50    recognized format.  Only the first entry will be
  51    rendered.
  52
  53 Example to try:
  54    embl2picture.pl factor7.embl | display -
  55
  56 END
  57
  58 my $file = shift                       or die USAGE;
  59 my $io = Bio::SeqIO->new(-file=>$file) or die USAGE;
  60 my $seq = $io->next_seq                or die USAGE;
  61 my $wholeseq = Bio::SeqFeature::Generic->new(-start=>1,-end=>$seq->length,
  62                                              -display_name=>$seq->display_name);
  63
  64 my @features = $seq->all_SeqFeatures;
  65
  66 # sort features by their primary tags
  67 my %sorted_features;
  68 for my $f (@features) {
  69   my $tag = $f->primary_tag;
  70   push @{$sorted_features{$tag}},$f;
  71 }
  72
  73 my $panel = Bio::Graphics::Panel->new(
  74                                       -length    => $seq->length,
  75                                       -key_style => 'between',
  76                                       -width     => 800,
  77                                       -pad_left  => 10,
  78                                       -pad_right => 10,
  79                                       );
  80 $panel->add_track($wholeseq,
  81                   -glyph => 'arrow',
  82                   -bump => 0,
  83                   -double=>1,
  84                   -tick => 2);
  85
  86 $panel->add_track($wholeseq,
  87                   -glyph  => 'generic',
  88                   -bgcolor => 'blue',
  89                   -label  => 1,
  90                  );
  91
  92 # special cases
  93 if ($sorted_features{CDS}) {
  94   $panel->add_track($sorted_features{CDS},
  95                     -glyph      => 'transcript2',
  96                     -bgcolor    => 'orange',
  97                     -fgcolor    => 'black',
  98                     -font2color => 'red',
  99                     -key        => 'CDS',
 100                     -bump       =>  +1,
 101                     -height     =>  12,
 102                     -label      => \&gene_label,
 103                     -description=> \&gene_description,
 104                    );
 105   delete $sorted_features{'CDS'};
 106 }
 107
 108 if ($sorted_features{tRNA}) {
 109   $panel->add_track($sorted_features{tRNA},
 110                     -glyph     =>  'transcript2',
 111                     -bgcolor   =>  'red',
 112                     -fgcolor   =>  'black',
 113                     -font2color => 'red',
 114                     -key       => 'tRNAs',
 115                     -bump      =>  +1,
 116                     -height    =>  12,
 117                     -label     => \&gene_label,
 118                    );
 119   delete $sorted_features{tRNA};
 120 }
 121
 122 # general case
 123 my @colors = qw(cyan orange blue purple green chartreuse magenta yellow aqua);
 124 my $idx    = 0;
 125 for my $tag (sort keys %sorted_features) {
 126   my $features = $sorted_features{$tag};
 127   $panel->add_track($features,
 128                     -glyph    =>  'generic',
 129                     -bgcolor  =>  $colors[$idx++ % @colors],
 130                     -fgcolor  => 'black',
 131                     -font2color => 'red',
 132                     -key      => "${tag}s",
 133                     -bump     => +1,
 134                     -height   => 8,
 135                     -description => \&generic_description
 136                    );
 137 }
 138
 139 print $panel->png;
 140 exit 0;
 141
 142 sub gene_label {
 143   my $feature = shift;
 144   my @notes;
 145   foreach (qw(product gene)) {
 146     next unless $feature->has_tag($_);
 147     @notes = $feature->each_tag_value($_);
 148     last;
 149   }
 150   $notes[0];
 151 }
 152
 153 sub gene_description {
 154   my $feature = shift;
 155   my @notes;
 156   foreach (qw(note)) {
 157     next unless $feature->has_tag($_);
 158     @notes = $feature->each_tag_value($_);
 159     last;
 160   }
 161   return unless @notes;
 162   substr($notes[0],30) = '...' if length $notes[0] > 30;
 163   $notes[0];
 164 }
 165
 166 sub generic_description {
 167   my $feature = shift;
 168   my $description;
 169   foreach ($feature->all_tags) {
 170     my @values = $feature->each_tag_value($_);
 171     $description .= $_ eq 'note' ? "@values" : "$_=@values; ";
 172   }
 173   $description =~ s/; $//; # get rid of last
 174   $description;
 175 }