← Back to branch summary

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

« back to all changes in this revision

Viewing changes to Bio/Graphics/Pictogram.pm

  • 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:
Bio/Graphics/Pictogram.pm
10
10
 
11
11
=head1 NAME
12
12
 
13
 
Bio::Graphics::Pictogram 
 
13
Bio::Graphics::Pictogram - generate SVG output of Pictogram display for consensus motifs
14
14
 
15
15
=head1 SYNOPSIS
16
16
 
78
78
position scaled by the background frequencies of each nucleotide.
79
79
 
80
80
It requires the SVG-2.26 or later module by Ronan Oger available at
81
 
http://www.cpan.org.
 
81
http://www.cpan.org
82
82
 
83
83
Recommended viewing of the SVG is the plugin available at Adobe:
84
84
http://www.adobe.com/svg
85
85
 
86
 
An example of this module may be found at:
87
 
 
88
 
http://scooby.fugu-sg.org:9001/pictogram/index.html
89
 
 
90
86
=head1 FEEDBACK
91
87
 
92
88
 
96
92
Bioperl modules. Send your comments and suggestions preferably to one
97
93
of the Bioperl mailing lists. Your participation is much appreciated.
98
94
 
99
 
  bioperl-l@bioperl.org              - General discussion
100
 
  http://bio.perl.org/MailList.html  - About the mailing lists
 
95
  bioperl-l@bioperl.org                  - General discussion
 
96
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
101
97
 
102
98
=head2 Reporting Bugs
103
99
 
104
100
Report bugs to the Bioperl bug tracking system to help us keep track
105
 
the bugs and their resolution.  Bug reports can be submitted via email
106
 
or the web:
 
101
the bugs and their resolution.  Bug reports can be submitted via the
 
102
web:
107
103
 
108
 
  bioperl-bugs@bioperl.org
109
 
  http://bugzilla.bioperl.org/
 
104
  http://bugzilla.open-bio.org/
110
105
 
111
106
=head1 AUTHOR - Shawn Hoon
112
107
 
124
119
package Bio::Graphics::Pictogram;
125
120
use strict;
126
121
use SVG 2.26;
127
 
use Bio::Root::Root;
128
 
use vars qw(@ISA);
129
 
@ISA = qw(Bio::Root::Root);
 
122
use Bio::SeqIO;
 
123
use base qw(Bio::Root::Root);
130
124
 
131
125
use constant MAXBITS => 2;
132
126
 
167
161
  $self->background($background);
168
162
  $self->plot_bits($bit) if $bit;
169
163
  $self->normalize($normalize) if $normalize;
170
 
  
 
164
 
171
165
  return $self;
172
166
}
173
167
 
175
169
 
176
170
 Title   : make_svg
177
171
 Usage   : $picto->make_svg();
178
 
 Function: make the SVG object 
179
 
 Returns : L<SVG> 
 
172
 Function: make the SVG object
 
173
 Returns : L<SVG>
180
174
 Arguments: A fasta file or array ref of L<Bio::Seq> objects or a L<Bio::Matrix::PSM::SiteMatrixI>
181
175
 
182
176
=cut
186
180
  my $fontsize = $self->fontsize;
187
181
  my $size = $fontsize * 0.75;
188
182
  my $width= $size;
189
 
  my $height= $size+40; 
 
183
  my $height= $size+40;
190
184
  my $color = $self->color;
191
185
 
192
186
  #starting x coordinate for pictogram
197
191
 
198
192
  my $bp = 1;
199
193
 
200
 
  #input can be file or array ref of sequences 
 
194
  #input can be file or array ref of sequences
201
195
  if(ref($input) eq 'ARRAY'){
202
196
    @pwm = @{$self->_make_pwm($input)};
203
 
  }  
 
197
  }
204
198
  elsif(ref($input) && $input->isa("Bio::Matrix::PSM::SiteMatrixI")){
205
199
    @pwm = $self->_make_pwm_from_site_matrix($input);
206
 
  }  
 
200
  }
207
201
  else {
208
202
    my $sio = Bio::SeqIO->new(-file=>$input,-format=>"fasta");
209
203
    my @seq;
213
207
    @pwm = @{$self->_make_pwm(\@seq)};
214
208
  }
215
209
 
216
 
  
 
210
 
217
211
  my $svg = $self->svg_obj;
218
 
  my $seq_length = scalar(@pwm + 1) * $width + $x + $x; 
 
212
  my $seq_length = scalar(@pwm + 1) * $width + $x + $x;
219
213
  my $seq_grp;
220
214
 
221
215
  #scale the svg if length greater than svg width
222
216
  if($seq_length > $svg->{-document}->{'width'}){
223
217
    my $ratio = $svg->{-document}->{'width'}/($seq_length);
224
 
    $seq_grp = $svg->group(transform=>"scale($ratio,1)"); 
 
218
    $seq_grp = $svg->group(transform=>"scale($ratio,1)");
225
219
  }
226
220
  else {
227
221
    $seq_grp= $svg->group();
283
277
    $bp++;
284
278
    $x+=$width;
285
279
  }
286
 
  
 
280
 
287
281
  #plot the tags
288
282
  $seq_grp->text(x=>int($width/2),y=>$bit_y,style=>{"font-size"=>'10','text-anchor'=>'middle','font-family'=>'Verdana','fill'=>'black'})->cdata("Bits:") if $self->plot_bits;
289
 
  
 
283
 
290
284
 $seq_grp->text(x=>int($width/2),y=>$pos_y,style=>{"font-size"=>'10','text-anchor'=>'middle','font-family'=>'Verdana','fill'=>'black'})->cdata("Position:");
291
285
 
292
286
  #plot the base positions
295
289
    $seq_grp->text(x=>$x+int($width/2),y=>$pos_y,style=>{"font-size"=>'10','text-anchor'=>'left','font-family'=>'Verdana','fill'=>'black'})->cdata($nbr);
296
290
    $x+=$width;
297
291
  }
298
 
    
 
292
 
299
293
 
300
294
#  $seq_grp->transform("scale(2,2)");
301
295
 
309
303
  my $consensus = $matrix->consensus;
310
304
  foreach my $i(1..length($consensus)){
311
305
    my %base = $matrix->next_pos;
312
 
    my $bits; 
 
306
    my $bits;
313
307
    $bits+=($base{pA} * log2($base{pA}/$bgd->{'A'}));
314
308
    $bits+=($base{pC} * log2($base{pC}/$bgd->{'C'}));
315
309
    $bits+=($base{pG} * log2($base{pG}/$bgd->{'G'}));
318
312
  }
319
313
  return @pwm;
320
314
}
321
 
  
 
315
 
322
316
sub _make_pwm {
323
317
  my ($self,$input) = @_;
324
318
  my $count = 1;
353
347
    # relative entropy (RelEnt) or Kullback-Liebler distance
354
348
    # relent = sum fk * log2(fk/gk) where fk is frequency of nucleotide k and
355
349
    # gk the background frequency of nucleotide k
356
 
    
 
350
 
357
351
    my $bits;
358
352
    $bits+=(($hash{$pos}{'A'}||0) / $count) * log2((($hash{$pos}{'A'}||0)/$count) / ($bgd->{'A'}));
359
353
    $bits+=(($hash{$pos}{'C'}||0) / $count) * log2((($hash{$pos}{'C'}||0)/$count) / ($bgd->{'C'}));
364
358
    push @pwm,\@array;
365
359
  }
366
360
  return $self->pwm(\@pwm);
367
 
}  
 
361
}
368
362
 
369
363
 
370
364
###various get/sets
373
367
 
374
368
 Title   : fontsize
375
369
 Usage   : $picto->fontsize();
376
 
 Function: get/set for fontsize 
 
370
 Function: get/set for fontsize
377
371
 Returns : int
378
 
 Arguments: int 
 
372
 Arguments: int
379
373
 
380
374
=cut
381
375
 
391
385
 
392
386
 Title   : color
393
387
 Usage   : $picto->color();
394
 
 Function: get/set for color 
 
388
 Function: get/set for color
395
389
 Returns : a hash reference
396
390
 Arguments: a hash  reference
397
391
 
409
403
 
410
404
 Title   : svg_obj
411
405
 Usage   : $picto->svg_obj();
412
 
 Function: get/set for svg_obj 
 
406
 Function: get/set for svg_obj
413
407
 Returns : L<SVG>
414
 
 Arguments: L<SVG> 
 
408
 Arguments: L<SVG>
415
409
 
416
410
=cut
417
411
 
429
423
 Usage   : $picto->plot_bits();
430
424
 Function: get/set for plot_bits to indicate whether to plot
431
425
           information content at each base position
432
 
 Returns :1/0 
 
426
 Returns :1/0
433
427
 Arguments: 1/0
434
428
 
435
429
=cut
466
460
 
467
461
 Title   : background
468
462
 Usage   : $picto->background();
469
 
 Function: get/set for hash reference of nucleodtide bgd frequencies 
470
 
 Returns : hash reference 
 
463
 Function: get/set for hash reference of nucleodtide bgd frequencies
 
464
 Returns : hash reference
471
465
 Arguments: hash reference
472
466
 
473
467
=cut
484
478
 
485
479
 Title   : pwm
486
480
 Usage   : $picto->pwm();
487
 
 Function: get/set for pwm 
 
481
 Function: get/set for pwm
488
482
 Returns : int
489
 
 Arguments: int 
 
483
 Arguments: int
490
484
 
491
485
=cut
492
486
 
504
498
    return 0 if $val==0;
505
499
    return log($val)/log(2);
506
500
}
507
 
  
 
501
 
508
502
 
509
503
1;