[Bioperl-l] Displaying an alignment using Bio::Graphics

[Fernan Aguero]

+----[ Josh Burdick <jburdick at gradient.cis.upenn.edu> (10.Aug.2004 11:45):
|
| I wrote a Perl module to write out DNA (or an arbitrary string), 
| with HTML tags around some regions.

Hi Josh,

this is a late reply ... I remembered reading this thread
but at that time i was not trying to colorize sequences in
HTML. Now I am :)

|    Don't know if this is useful in your case, since it's only for one 
| string.  If anyone wants to adapt it for use in bioperl, feel free.  
| It's attached at the end of this message.

Yes, it is useful. I'm dealing with alignments too, but will
be colorizing the consensus sequence to mark some features.

[snipped]

| This code is a bit more efficient, since it only adds tags
| at the beginning and end of where things are colored, or
| otherwise tagged.  It has some weird bugs, though, if you
| add non-nested regions.

Yes, I'm seeing some weird things regarding the place where
the tag is added. I guess I've corrected the behaviour, at
least for my particular example. Don't know if it'll work
for other cases. Below is the explanation and fix.

I'm trying to colorize two non-nested regions:

------------xxxxxxxxxxxxxxxxxx---------------

so I want the regions marked with '-' to be colored and the
central region (x) to be in plain black.

The central region is a CDS (ATG...TGA), so it's easy to see
if the ranges are being colorized OK. 

My range objects (-) have start=>1, end=>80, start=>573,end=>623
The first base is a 'G' and after getting the output from
ColoredSeq, it looks like this:

g<tag>------</tag>ATGxxxxxxTGAt<tag>------</tag>

So it seems that it is putting the opening tag _after_ the
position indicated as a 'start'. The closing tags appear to
be OK. Is this the bug you mentioned for non-nested regions?

What I'd like is to have that base also colored. I guessed
that this was because you have: 
$a = $_->start + 1; 
in your add_tag method. Now if I change it to 
$a = $_->start; 
then the opening tag is positioned OK (at least for this
simple example).

Perhaps this change breaks other cases (nested tags)?

| Browsers typically won't complain, but exactly which tag
| will have precedence where is unpredictable.

I guess you are referring to the last tag. This is not being
printed ... in my case it does not matter since there's
nothing in the HTML file after it (the browser will not
complain). Anyway I could just print a closing tag after
calling ColoredSeq ...

Thanks for sharing your code, 

Fernan

[snipped]

|    Josh
| 
| -- 
| Josh Burdick
| jburdick at gradient.cis.upenn.edu
| http://www.cis.upenn.edu/~jburdick

 
| cut here
| --------------
| 
| # Write a sequence, with bits of it colored as HTML.
| 
| package local::Bio::ColoredSeq;
| 
| # Constructor.
| # Args:
| #   Seq object containing the Seq in question
| sub new {
|    my($type, $seq) = @_;
|    my $self = ();
| 
|    $self->{'seq'} = $seq;
|    my %h = ();
|    $self->{'tags'} = \%h;
|    return bless $self, $type;
| }
| 
| # Add a tag around a certain region of the sequence text.
| # Args:
| #   opening_tag, closing_tag - the HTML tags to put around
| #     that chunk of sequence.
| #   loc - ref. to list of things implementing RangeI
| # Note that currently, later tags override earlier tags.
| sub add_tag {
|    my($self, $opening_tag, $closing_tag, $locs) = @_;
| 
|    foreach (@$locs) {
| 	my $a = $_->start + 1;
| 	my $b = $_->end + 1;
| #	print "$a $b $opening_tag $closing_tag\n";
| 	next if ($a == $b);
| 	$self->{'tags'}->{$a} = $self->{'tags'}->{$a} . $opening_tag;
| 	$self->{'tags'}->{$b} = $closing_tag . $self->{'tags'}->{$b};
|    }
| }
| 
| # HTML, showing bits of the sequence in various colors.
| sub as_html {
|    my($self) = @_;
|    my $line_length = 50;
|    my $s = "";
| 
|    my $seq = $self->{'seq'};
|    my %tags = %{$self->{'tags'}};
| 
|    foreach my $i (1..($seq->length)) {
| 	if (defined $tags{$i}) {
| 	    $s = $s . $tags{$i};
| 	}
| 	if ($i % $line_length == 1) {
| 	    $s = $s . "<br>\n";
| 	}
| 	$s = $s . $seq->subseq($i, $i);
|    }
|    
|    return $s;
| }
| 
| 1;
| 
+----]

-- 
Fernan Aguero -  fernan at iib.unsam.edu.ar
Phone: +54 11 4580-7255/7 ext 310, Fax: +54 11 4752-9639
Check http://genoma.unsam.edu.ar/~fernan for more info.