← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to scripts/graphics/contig_draw.PLS

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
scripts/graphics/contig_draw.PLS
1
 
#!/usr/bin/perl -w
2
 
# $Id: contig_draw.PLS,v 1.1 2004/05/20 19:49:28 matsallac Exp $
3
 
 
4
 
=head1 NAME
5
 
 
6
 
search_overview -- Render a SearchIO parser report into a simple overview graphic
7
 
 
8
 
=head1 SYNOPSIS
9
 
 
10
 
search_overview -i filename [-f format] [-o outputfilename] [--labels]
11
 
 
12
 
=head1 DESCRIPTION
13
 
 
14
 
This script will take any Bio::SearchIO parseable report and turn it
15
 
into a simple overview graphic of the report.  For our purposes we are
16
 
assuming BLAST and the BLAST scores when assigning colors.  Output is
17
 
a PNG format file.
18
 
 
19
 
This is not intended to be an overly customized script, rather it
20
 
should probably just be either a quick and dirty look at a report or a
21
 
starting point for more complicated implementations.
22
 
 
23
 
The color is determined by the hit score which is currently pegged to the NCBI 
24
 
scheme which looks like this
25
 
 
26
 
 RED     E<gt>= 200 
27
 
 PURPLE  80-200
28
 
 GREEN   50-80
29
 
 BLUE    40-50
30
 
 BLACK   E<lt>40
31
 
 
32
 
Options:
33
 
 -i/--input        The input filename, otherwise input is assumed from STDIN
34
 
 -o/--output       The output filename, this is optional, if you do not
35
 
                   provide the output filename the script will create a file
36
 
                   using the name of the query sequence and will process
37
 
                   all the sequences in the file.  If an output filename
38
 
                   IS provided the script will only display an image for the 
39
 
                   first one.
40
 
 -f/--format       The SearchIO format parser to use, if not provided
41
 
                   SearchIO will guess based on the file extension.
42
 
 -l/--labels       Display the hit sequence name as a label in the overview.
43
 
                   For lots of sequences this will make the image very long
44
 
                   so by default it is turned off.
45
 
 
46
 
=head1 AUTHOR Jason Stajich
47
 
 
48
 
Jason Stajich, jason[-at-]open-bio[-dot-]org.
49
 
 
50
 
=cut
51
 
 
52
 
use strict;
53
 
 
54
 
use Bio::Graphics::Panel;
55
 
use Bio::Graphics::Feature;
56
 
use Bio::Graphics::FeatureFile;
57
 
use Bio::Assembly::IO;
58
 
use Getopt::Long;
59
 
use Dumpvalue();
60
 
my $dumper = new Dumpvalue();
61
 
 
62
 
use constant WIDTH          => 600;  # default width
63
 
 
64
 
my ($in,$format,$out);
65
 
 
66
 
my $showlabels = 0;
67
 
 
68
 
# This defines the color order
69
 
# For NCBI it is typically defined like this
70
 
# Score
71
 
# RED     >= 200 
72
 
# PURPLE  80-200
73
 
# GREEN   50-80
74
 
# BLUE    40-50
75
 
# BLACK   <40
76
 
my @COLORS = qw(red magenta green blue black);
77
 
my @SCORES = (200,80,50,40,0);
78
 
 
79
 
GetOptions(
80
 
           'i|in|input:s'   => \$in,
81
 
           'f|format:s'     => \$format,
82
 
           'o|output:s'     => \$out,
83
 
           'l|labels'       => \$showlabels
84
 
           );
85
 
 
86
 
if (!$in) {
87
 
     $in = "../../t/data/acefile.ace.1";
88
 
     # $in = "../../t/data/consed_project/edit_dir/test_project.fasta.screen.ace.1";
89
 
}
90
 
if (!$out) {
91
 
     $out = "web/contig.png";
92
 
}
93
 
print("Parsing this file: ($in)\n");
94
 
my $parser = new Bio::Assembly::IO(-file   => $in );
95
 
my $ass = $parser->next_assembly();
96
 
 
97
 
my @contigs = $ass->all_contigs();
98
 
 
99
 
# for demo purposes, just work on the first contig
100
 
my $contig = pop(@contigs);
101
 
 
102
 
     my (@sequences,@features,@configs);
103
 
 
104
 
          # get the consensus sequence
105
 
     my $cs = $contig->get_consensus_sequence();
106
 
     print STDERR "Adding a consensus with start(".$cs->start().") and end(".$cs->end().")\n";
107
 
     $cs->display_name("Consensus sequence(".$cs->start().",".length($cs->seq()).")");
108
 
     my $min = $cs->start();
109
 
     my $max = $cs->end();
110
 
     push @features, $cs;
111
 
     $dumper->dumpValue($cs);
112
 
          # now get the things in this contig
113
 
     foreach my $feat ($contig->each_seq()) {
114
 
          print STDERR "Adding a member with name(".$feat->display_id().") start(".$feat->start().") and end(".$feat->end().")\n";
115
 
          print(ref($feat)."\n");
116
 
          # $dumper->dumpValue($feat) ;
117
 
          # my @fs = $feat->get_all_tags(); 
118
 
          # print("These are the seqfeatures:\n");
119
 
          # $dumper->dumpValue(\@fs);
120
 
          # my @tag_values = $feat->get_tag_values('contig');
121
 
          # my $locatable_seq = $feat->get_tag_values('contig');
122
 
          # print("These are the tagged values:\n");
123
 
          # $dumper->dumpValue(\@tag_values);
124
 
               # help bioperlers! how do i not do this:
125
 
             push @features, $feat;
126
 
          $min = &MIN($min,$feat->start());
127
 
          $max = &MAX($max,$feat->end());
128
 
          $feat->display_name($feat->display_name()."(".$feat->start().",".$feat->end().")");
129
 
     }
130
 
    my $panel = Bio::Graphics::Panel->new(
131
 
                              -length => 2000,
132
 
                              -width    =>   900,
133
 
                                          -bgcolor => 'white',
134
 
                                          -pad_left=> 10,
135
 
                                          -pad_right=> 10);
136
 
    $panel->add_track('arrow' => Bio::Graphics::Feature->new
137
 
                      (-start => 0,
138
 
                       -end   => $max-$min + 100 ),
139
 
                      -bump   => 0,
140
 
                      -double => 1,
141
 
                      -tick   => 2,
142
 
                      );
143
 
     # my $invisible_track = $panel->add_track(-glyph    =>   '');
144
 
     # $invisible_track->add_feature(new Bio::SeqFeature::Generic(-start    =>   $min-500,     -end =>   $max+500));
145
 
    my $track = $panel->add_track(-glyph   =>   'generic',-label    =>   1);
146
 
    foreach my $f ( @features ) {
147
 
          my $newfeat = new Bio::SeqFeature::Generic(-start =>   $f->start()-$min ,
148
 
                                                       -end =>   $f->end()-$min,
149
 
                                                       -display_name  =>   $f->display_name());
150
 
             $track->add_feature($newfeat);
151
 
    }
152
 
    if( $out ) { 
153
 
        open(OUT,">$out") || die("cannot open $out: $!");
154
 
        binmode(OUT);
155
 
        print OUT $panel->png;
156
 
        close(OUT);
157
 
    } else { 
158
 
        open(OUT, ">$out.png") || die("$out: $!");
159
 
        binmode(OUT);
160
 
        print OUT $panel->png;  
161
 
        close(OUT);
162
 
    }
163
 
 
164
 
sub MAX {return $_[0] < $_[1] ? $_[1] : $_[0] }
165
 
sub MIN {return $_[0] > $_[1] ? $_[1] : $_[0] }