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

[Josh Burdick]

Jason Stajich wrote:

>I think Lincoln wrote something recently - I don't remember where he put
>it though.
>  
>
    I wrote a Perl module to write out DNA (or an arbitrary string), 
with HTML tags around some regions.
    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.

>I do it with HTML - this produces LARGE files though since every base gets
>an html tag.  The number matching is for intron mapping stuff so wouldn't
>be necessary for you.
>  
>

    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.  Browsers 
typically won't complain, but exactly which tag will have precedence 
where is unpredictable.
    I'd guess HTML is still fewer bytes/base than a readable image file, 
though if the image is compressed, that's less certain.
    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;