《代码之美》（十二）－－在BioPerl里培育漂亮代码

Lincoln Stein

BioPerl是一个Perl的开发包，处理大多数常见的生物信息学问题,包括DNA蛋白质分析,进化树构建和分析,遗传数据的解读,还有基因组序列分 析. 其中有一个名为Bio::Graphics的基因组绘制模块,用来把基因信息用一种直观的可视化的方法显示出来,类似于金融分析中的股市走势图.

Bio::Graphics要满足的需求包括:

问题的解决方案是开放的: 需要图形化的信息有很多而且还在继续增加,而且不同的生物信息学家也想用不同的方式表示同一功能的注释信息. 所以需要有加入新的视觉表示方法和扩展已有的视觉表示方法的功能.

特性密度: 有些基因组的特性更加紧密(相邻基因之间的变化很迅速), 而其它的则相对稀疏. 甚至不同的特性可以在同一个基因上重叠,这时你可以想让重叠的部分彼此模糊,有时你希望控制碰撞,把重叠的特性分开显示. 因为如果有上千重叠的特性需要展示,碰撞控制可能会对性能造成大副影响,所以要能依据上下文来激活或关闭碰撞控制.

处理尺度:要既能展现基因组中包含500碱基对的高清细节的图片,又能画出跨度为一亿五千万核苷酸的基因全貌.

对交互web应用有用: 用户可以点击特性的图片来打开下拉菜单,链接到其他网页,查看工具等等.

独立于图形格式: 处理布局的部分和生成图像的部分应该分开,这样更容易生成各种不同格式的图片.

独立于数据库模式: 基因的特性的数据可以存在一个简单的文本文件里,也能存入一个复杂的关系数据库里.

需求确定后便可以进行设计了. 首先通过编写一段伪代码来搞明白Bio::Graphics应用的流程:

use Bio::Graphics::Panel;

@first_set_of_features = get_features_somehow();
@second_set_of_features = get_more_features_somehow();

$panel_object = Bio::Graphics::Panel->new(panel_options...)
$panel_object->add_track(\@first_set_of_features, track_options...);
$panel_object->add_track(\@second_set_of_features, track_options...);

print $panel_object->png;

panel是用来显示图形的主界面. get_features可以从数据库中提取特性. add_track可以在panel里加入一条显示特性集的一条轨道. 最后png方法可以生成一个png图片.

上面的代码包含了典型的应用流程. 但API中有一些缺陷.
最大的问题是它强迫程序员在开始构造图像前把所有特性载入内存.
另一个问题是调用add_track后,就不能再改动该轨道的配置设置.
最后,add_track迫使程序员按固定顺序加入轨道,不能在任意位置插入轨道.

为此,需要改进代码（伪代码）:

use Bio::Graphics::Panel;

$panel_object = Bio::Graphics::Panel->new(panel_options...)
$track1 = $panel_object->add_track(bump_true, other_track_options...);
$track2 = $panel_object->add_track(bump_true, other_track_options...);

$collection = Bio::SeqFeature::CollectionI->new(@args);
$iterator = $collection->get_seq_stream(@query_parameters);

$genes = 0; $variations = 0;
while ($feature = $iterator->next_seq) {
    if ($feature->method eq 'gene') {
        $track1->add_feature($feature);
        $genes++;
    } elsif ($feature->method eq 'variation') {
        $track2->add_feature($feature);
        $variations++;
    }
}

$track1->configure(bump_false) if $genes > 100;
$track2->configure(bump_false) if $variations > 100;

print $panel_object->png;

上面的代码在panel上创建了两条轨道。初始时它们是碰撞测试的（bump_true）。

Bio::SeqFeature::Collection可以 从数据库中一次读取一条特性，这样就避免了一次性载入所有的特性。之后根据特性的信息，改变两条轨道的显示：第一条显示基因（genes）的特性，第二条 显示变种（variations）的特性。最后根据特性数量的多少来改变轨道的配置，决定轨道是否进行碰撞测试。

在前面的代码里涉及到设定选项（panel_options），这里把它定义成如下的方式：

$track1 = $panel_object->add_track(\@featurs,
    -height => 10,
    -bgcolor => 'blue',
    -bump => 1;

确定模块中的类：
Bio::Graphics::Panel：代表整个图表，负责确定画图区内每条轨道的位置，并负责把特性坐标（用碱基对表达）转换为图像轮廓坐标。

Bio::Graphics::Track：组成面板的轨道，主要负责确定图像轮廓的位置并画出它们。

Bio::Graphics::Glyph：图符的通用类，用来定义特性的绘制方法。比如是一个简单矩形还是椭圆形。

当Track绘制方法大致为：

sub draw {
    @glyphs = $self->get_list_of_glyphs();
    for $glyph (@plyphs) {
        $glyph->draw;
    }

    # draw other stuff in the track, for example, its label
}

glyph类的各个子类都应该知道绘制自己的方法，同时如果特性还包含子特性的话，glyph也需要管理对应的subglyph。下面是glyph的new方法：

sub new {
    $self = shift;
    $feature = shift;
    for $subfeature ($feature->get_SeqFeatures) {
        $subglyph = Bio::Graphics::Glyph->new(-feature=>$subfeature);
        $self->add_subpart($subglyph);
    }
}

glyph的绘制代码需要管理自己内部子图符的绘制：

sub draw {
    @subglyphs = $self->get_subparts();

    for $subglyph (@subglyphs) {
        $subglyph->draw;
    }

    # draw ourself somehow
}

因为track其实也图符有的共通点，所以可以把它作为Bio::Graphics::Glyph的子类。这样面板增加轨道的方法类似于:

sub add_track {
    my $self = shift;
    my $features = shift;
    my @options = @_;
    my $top_level_feature = Bio::Graphics::Feature->new(-type=>'track');
    my $track_glyph = Bio::Graphics::Glyph::track->new(\@options);

    if ($feature) {
        $track_glyph->add_feature($_) foreach @$features;
    }
    $self->do_add_track($track_glyph);
    return $track_glyph;
}

add_feature用于创建包含在轨道内的子图符:

sub add_feature {
    my $self = shift;
    my $feature = shift;
    my $subglyph = Bio::Graphics::Glyph->new(-feature=>$feature);
    $self->add_subpart($subglyph);
}

在add_feature里,会创建一个子图符的对象,但是之前我们希望调用者可以通过传入选项来指定使用哪种图符,比如$panel->add_track(-glyph=>'arrow')可以创建一个箭头. 为此,解决方法是利用工厂:

package Bio::Graphics::Glyph::Factory;

use strict;

my %GENERIC_OPTIONS = (
    bgcolor => 'turquoise';
    fgcolor => 'black';
    fontcolor => 'black';
    font2color => 'turquoise';
    height => 8,
    font => 'gdSmallFont',
    glyph => 'generic';
);

sub new {
    my $class = shift;
    my %args = @_;
    my $options = $args{-options};
    my $panel = $args{-panel};
    return bless {
        options => $options,
        panel => $panel,
    }, $class;
}

sub option {
    my $self = shift;
    my $option_name = shift;
    $option_name = lc $option_name;
    if (exits $self->{options}{$option_name}) {
        return $self->{options}{$option_name};
    } else {
        return $GENERIC_OPTIONS{$option_name};
}

sub make_glyph {
    my $self = shift;
    my @result;

    my $glyph_type = $self->option('glyph');
    my $glyph_class = 'Bio::Graphics::Glyph::' . $glyph_type;
    eval ("require $glyph_class"!) unless $glyph_class->can('new');

    for my $feature (@_) {
        my $glyph = $glyph_class->new(-feature=>$f, -factory=>$self);

        push @result, $glyph;
    }
    return @result;
}

1;

在make_glyph里当glyph_class的new函数没有载入进来时,再在eval里引入对应的图符模块,可以避免不必要的编译.上面可以看到 factory本身作为一个参数选项传入了glyph_class的构造函数里.下面是glyph相关于factory的两个方法:

sub factory {
    my $self = shift;
    return $self->{factory};
}

sub option {
    my $self = shift;
    my ($option_name) = @_;
    return $self->factory->option($option_name);
}

下面把所有的东西联系起来,简单展示Bio::Graphics的实际用法:

#!use/bin/perl

use strict;

use Bio::Graphcis;
use Bio::SeqFeature::Generic;
my $bsg = 'Bio::SeqFeature::Generic';

my $span = $bsg->new(-start=>1,-end=>1000);

my $test1_feat = $bsg->new(-start=>300,-end=>700,-display_name=>'测试用特性',-source_tag=>'测试而已');

my $test2_feat = $bsg->new(-start=>650,-end=>800,-display_name=>'测试特性2');

my $panel = Bio::Graphics::Panel->new(-width=>600, -length=>$span->length, -pad_left=>12, -pad_right=>12);

$panel->add_track($span, -glyph=>'arrow', -double=>1, -tick=>2);

$panel->add_track([$test1_feat, $test2_feat],
    -glyph=>'box',
    -bgcolor=>'orange',
    -font2color=>'red',
    -height => 20,
    -label => 1,
    -description => 1,
);

print $panel->png;

程序员可能希望选项参数是动态的,比如-bgcolor可以根据特性的不同而显示不同的颜色. 可以使用callback的方法:

$panel->add_track(\@features,
    -glyph=>'box';
    -bgcolor=>sub{
        my $feature = shift;
        my $score = $feature->score;
        return 'white' if $score < 0.25;
        return 'pink' if $score < 0.75;
        return 'red';
    }
);

碰撞控制也可以是动态的:

-bump=>sub {
    my ($feature, $option_name, $glyph) = @_;
    return $glyph->panel->length < 50_000;
}

为了支持动态选项,factory需要作些修改:

sub option {
    my $self = shift;
    my ($glyph, $option_name) = @_;
    $option_name = lc $option_name;
    my $value;
    if (exits $self->{options}{$option_name}) {
        $value = $self->{options}{$option_name};
    } else {
        $value = $GENERIC_OPTIONS{$option_name};
    }

    return $value unless ref $value eq 'CODE';

    my $feature = $glyph->feature;
    my $eval = eval {$value->($feature, $option_name, $glyph)};
    warn "Error while evaluating "$option_name' option for glyph $glyph, feature $feature: ", $@, "\n" if $@;

    return defined $eval && $eval eq '*default*

如果value的类型是CODE的话,就会调用这段子程序并返回子程序执行结果.

相应地,glyph也要作出修改:

sub option {
    my $self = shift;
    my ($option_name) = @_;
    return $self->factory->option($self, $option_name);
}

接下来是web交互的支持,如点击某图符可以显示下拉菜单之类的:

$panel = Bio::Graphics::Panel->new(@args);
$panel->add_track(@args);
$panel->add_track(@args);
...
($url, $map, $mapname) = $panel->image_and_map(
    -root => '/var/www/html',
    -url => '/images',
    -link => sub {
        my $feature = shift;
        my $name = $feature->display_name;
        return "";
    }
);
print "我的基因组";
print "";
print $map;

通过image_and_map方法，把图片转化为html的片段，之后只需把有效的html文本打印出来，就可以生成可用于web交互的图像。

为了支持多种图形格式，Bio::Graphics用Perl的GD库来执行底层图形调用。GD库基于Tom Boutell的libgd（），可以生成多种格式的位图图像，包括PNG、JPEG和GIF。下面是 Bio::Graphics::Panel的png方法：

sub png {
    my $self = shift;
    my $gd = $self->gd;
    return $gd->png;
}

但是GD只支持位图，Todd Harris写的Perl的GD::SVG模块（）解决了这个问题。下面的代码可以生成SVG图像：

$panel = Bio::Graphics::Panel->new(-length=>1000, -width=>600, -image_class=>'GD::SVG';);
$panel->add_track... etc...
print $panel->gd->svg;

Bio::Graphics被设计为可扩展的，所以很容易添加新图符，下面的代码添加一个沙漏图符：

package Bio::Graphics::Glyph::hourglass;

use strict;
use base 'Bio::Graphics::Glyph::box';

sub draw_component {
    my $self = shift;
    my ($gd,$dx,$dy) = @_;
    my ($left,$top,$right,$bottom) = $self->bounds($dx,$dy);

    # 绘制多边形代表沙漏
    my $poly = GD::Polygon->new;
    $poly->addPt($left,$top);
    $poly->addPt($right, $bottom);
    $poly->addPt($right, $top);
    $poly->addPt($left, $bottom);
    $poly->addPt($left, $top);
    $gd->filledPolygon($poly, $self->bgcolor);
    $gd->polygon($poly, $self->fgcolor);
}

1;

Lincoln Stein认为Bio::Graphics适用于所有层次的程序员：新手可以立刻上手，中等水平的程序员可以写回调来修改类库的输出，而最有经验的可以定制图符扩展类库。

：在麻省理工大学Whitehead基因研究所工作，开发用于老鼠和人类的基因图谱数据库。代表作有《Network Programming in Perl》。