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

[Lincoln Stein]

Hi,

Just so that people know, there is a library in gbrowse (http://www.gmod.org/ggb) 
called Bio::Graphics::Browser::Markup that handles nested HTML tags 
correctly (including doing hue addition when two colors overlap).  Here is the synopsis:

  use Bio::Graphics::Browser::Markup;

  my $string = join '','a'..'z','a'..'z','a'..'z';
  my $markup = Bio::Graphics::Browser::Markup->new;

  $markup->add_style(cds=>'UPPERCASE');
  $markup->add_style(exon     =>'Text-decoration: underline');
  $markup->add_style(variation=>'Font-weight: bold');
  $markup->add_style(italic=>'Font-style: oblique');
  $markup->add_style(yellow=>'BGCOLOR blue');
  $markup->add_style(green=>'BGCOLOR red');
  $markup->add_style(orange=>'BGCOLOR orange');
  $markup->add_style(mango=>'FGCOLOR red');
  $markup->add_style(br=>'<br>');
  $markup->markup(\$string,[
                          ['cds',1=>10],
                          ['cds',12=>15],
                          ['variation',20=>41],
                          ['exon',0=>29],
                          ['exon',32=>40], 
                          ['italic',18=>29],
                          ['yellow',5=>40],
                          ['green',20=>50],
                          ['orange',30=>60],
                          ['mango',0=>36],
                          ['br',10=>10],
                          ['br',20=>20],
                          ['br',30=>30],
                          ['br',40=>40],
                          ['br',50=>50],
                          ['br',60=>60],
                          ]);
   print $string,"\n";

Then there is another module called Bio::Graphics::Browser::PadAlignment 
which uses this code to generate colorized multiple alignments that are correctly gapped, 
etc.  An example of this running is here:

	http://www.wormbase.org/db/seq/show_mult_align?name=WP%3ACE31390;class=Protein

Lincoln


On Sunday 05 September 2004 04:00 pm, Fernan Aguero wrote:
> +----[ 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;
>
> +----]

-- 
Lincoln Stein
lstein at cshl.edu
Cold Spring Harbor Laboratory
1 Bungtown Road
Cold Spring Harbor, NY 11724
(516) 367-8380 (voice)
(516) 367-8389 (fax)