[PerlChina] Re: 请教一个bioinformatics问题――质粒作图

这个也很赞！
代码我要学习下，o(∩_∩)o...
谢谢了，这项任务有信心了。

On 11月6日, 上午12时15分, Anthony WU <anthonywu...@gmail.com> wrote:
> GD有個style叫gdEdged，建議看看 libgd 的文檔
> 用法
> $img->filledArc ($cx, $cy, $x , $y, int ($olds / $sum * 360), int
> (($olds + $in) / $sum * 360), $color[$i], gdEdged);
>
>
>
> -------- Original Message --------
> Subject: [PerlChina] Re: 请教一个bioinformatics问题——质粒作图
> From: Fangyuan <chengfangyuan2...@gmail.com>
> To: PerlChina Mongers 讨论组 <perlchina@googlegroups.com>
> Date: 5/11/2009 13:12
> > 恩，非常感谢。
> > 我先试试自己做。
>
> > 谢谢啦！
>
> > On 11月5日, 下午1时02分, "Jester"<jes...@perlchina.org> wrote:
>
> >> 这两天太忙，周末我再仔细找找，可能在我原来的电脑上。
> >> 思路嘛，很简单的，根据基因组大小和每个基因的坐标计算相对位置，
> >> 然后换算成360度的角度位置，用你的平面几何知识算出在图上的坐标，画filledPolygen（好像是这个函数名，好久没用了）
>
> >> Jester，jes...@perlchina.org
> >> 2009-11-05  
>
> >> ----- Original Message -----  
> >> From:   Fangyuan  
> >> To:   PerlChina Mongers 讨论组  
> >> Sent:  2009-11-04, 17:36:57
> >> Subject:  [PerlChina] Re: 请教一个bioinformatics问题----质粒作图
>
> >>> Jester,
>
> >>> 这张图很酷呀，正是我想想的类型。请问这张图是你用GD写的程序得到的结果吗？
>
> >>> 很希望能看到你的源程序，呵呵，这样做起来就容易多了。
>
> >>> 不知你能否提示下具体的思路。
>
> >>> 谢谢你的回复 ！
>
> --
> Best Regards,
>         Anthony WU
>
> [pollgd.txt10K ]#!/usr/bin/perl
> #¥»µ{¦¡¶È¨Ñ´ú¸Õ¤§¥Î
> #¦p¹ï¥»µ{¦¡¦³¥ô¦óºÃ°Ý¤Î´£·N
> #Åwªï´£¥X°Q½×
> #µ{¦¡ ²[¼Æ gb2utf8 ¤Î u2utf8 °Ñ·Ówww.phpx.comªº¦³Ãö PHP ¥N½X¼g¦¨
> #¨ä¾l³¡¤À¬° 100%§¹³Ð§@
> #ª©ÅvÂk LeoHacks¶}µo¹Î¶¤©Ò¦³
> #ÄY¸T¹p¶Æ«IÅv¤H¤h¨Ï¥Î¥»¥N½X
> #
> #µ{¦¡Àô¹Ò­n¨D:
> #GD Modules & FreeType support
> BEGIN
> {
>         foreach my $LBPATH ($0, $ENV{'PATH_TRANSLATED'}, $ENV{'SCRIPT_FILENAME'})
>         {
>                 next if ($LBPATH eq '');
>                 $LBPATH =~ s/\\/\//g;
>                 $LBPATH =~ s/\/[^\/]+$//o;
>                 unshift (@INC, $LBPATH);
>         }
>
> }
>
> use CGI::Carp "fatalsToBrowser";
> use LBCGI;
> $LBCGI::POST_MAX = 200000;
> $LBCGI::DISABLE_UPLOADS = 1;
> $LBCGI::HEADERS_ONCE = 1;
> require 'data/boardinfo.cgi';
> require 'bbs.lib.pl';
> require 'data/styles.cgi';
> $| = 1;
> $thisprog = 'pollgd.cgi';
> use LBCGI::forum::topic::poll::read;
> $sss = new LBCGI::forum::topic::poll::read;
> $query = new LBCGI;
>
> my $inmembername = $query->cookie ('amembernamecookie');
> my $inpassword = $query->cookie ('apasswordcookie');
> $inmembername =~ tr/[\a\f\n\e\0\r\t\`\~\!\@\#\$\%\^\&\*\(\)\+\=\\\{\}\;\'\:\"\,\.\/\<\>\?]//d;
> $inpassword =~ tr/[\a\f\n\e\0\r\t\|\@\;\#\{\}\$]//d;
>
> if ($inmembername eq undef)
> {
>         $inmembername = '³X«È';
>         $userregistered = 'no';} else {
>
>         &main::getmember ($inmembername, 'no');
>         &main::error ("´¶³q¿ù»~&$div_will­û $inmembername ¦b¥»½×¾Â¤¤¤£¦s¦b¡I") if ($userregistered eq 'no');
>         &main::error ('´¶³q¿ù»~&½×¾Â±K½X»P$div_will­û¦WºÙ¤£¬Û²Å¡A½Ð­«·sµn¤J¡I') if ($inpassword ne $password);
>
> }
>
> # add
> eval ('use GD;');
> if ($@)
> {
>         &main::error ('GD¿ù»~&¦øªA¾¹¤£¤ä´©GD¡A¥»¥\\¯à¤£¯à¨Ï¥Î');}
>
> &main::error ('¦r§Î¿ù»~&¨S¦³¦r§Î¡A¥»¥\¯à¤£¯à¨Ï¥Î') if (!-e $lbdir . 'MYGD/font/arialuni.ttf');
> #
>
> my $forumid = $query->param ('forumid');
> my $postid = $query->param ('postid');
> my $errortype = $sss->readfile ($forumid, $postid);
> if ($errortype eq -1 || $errortype eq -2)
> {
>         &main::error ("´¶³q¿ù$div_wrong&¦Ñ¤j¡A½Ð¤£­n§ðÀ»µ{¦¡¡I");} elsif ($errortype eq -3) {
>
>         &main::error ("´¶³q¿ù$div_wrong&§ä¤£¨ì¦³Ãö§ë²¼¡I");}
>
> &main::moderator ($forumid);
> &main::error ('¶i¤J½×¾Â&¤@¯ë$div_will­û¤£¤¹³\¶i¤J¦¹½×¾Â¡I') if (($startnewthreads eq 'cert')&&(($membercode ne 'ad' && $membercode ne 'smo' && $membercode ne 'cmo' && $membercode ne 'mo' && $membercode ne 'amo' && $membercode !~ /^rz/)||($inmembername eq '³X«È'))&&($userincert eq 'no'));
> if ($allowusers ne '')
> {
>         &main::error ('¶i¤J½×¾Â&§A¤£¤¹³\¶i¤J¦¹½×¾Â¡I') if (",$allowusers," !~ /\Q,$inmembername,\E/i && $membercode ne 'ad');}
>
> if ($sss->{poll}->{$forumid}->{$postid}->{hidepoll} && !grep (/^\Q$inmembername\E$/i, keys (%{$sss->{poll}->{$forumid}->{$postid}->{poller}})))
> {
>         &main::error ('´¶³q¿ù»~&¹ï¤£°_¡A§A¥²»Ý¥ý§ë²¼¤~¥i¬Ýµ²ªG¡I');
>
> }
>
> #use GD;
> my $sum = $sss->{poll}->{$forumid}->{$postid}->{pollcount};
> my @list = ();
> my ($imgx, $imgy) = (600, 600);
> my ($x, $y) = (399, 399);
> #my $img = GD::Simple->new ($imgx, $imgy);
> my $img = new GD::Image ($imgx, $imgy);
> my $white = $img->colorAllocate (255, 255, 255);
> my $black = $img->colorAllocate (0, 0, 0);
> $img->transparent ($white);
> $img->interlaced ('true');
> my $i = 0;
>
> my @color = ();
> $color[0] = $img->colorAllocate (218, 165, 32); #goldenrod
> $color[1] = $img->colorAllocate (128, 128, 128); #gray
> $color[2] = $img->colorAllocate (255, 215, 0); #gold
> $color[3] = $img->colorAllocate (250, 235, 215); #antiquewhite
> $color[4] = $img->colorAllocate (0, 255, 255); #aqua
> $color[5] = $img->colorAllocate (127, 255, 212); #aquamarine
> $color[6] = $img->colorAllocate (240, 255, 255); #azure
> $color[7] = $img->colorAllocate (220, 220, 220); #gainsboro
> $color[8] = $img->colorAllocate (178, 34, 34); #firebrick
> $color[9] = $img->colorAllocate (34, 139, 34); #forestgreen
> $color[10] = $img->colorAllocate (0, 0, 255); #blue
> $color[11] = $img->colorAllocate (138, 43, 226); #blueviolet
> $color[12] = $img->colorAllocate (165, 42, 42); #brown
> $color[13] = $img->colorAllocate (222, 184, 135); #burlywood
> $color[14] = $img->colorAllocate (95, 158, 160); #cadetblue
> $color[15] = $img->colorAllocate (127, 255, 0); #chartreuse
> $color[16] = $img->colorAllocate (210, 105, 30); #chocolate
> $color[17] = $img->colorAllocate (255, 127, 80); #coral
> $color[18] = $img->colorAllocate (100, 149, 237); #cornflowerblue
> $color[19] = $img->colorAllocate (255, 248, 220); #cornsilk
> $color[20] = $img->colorAllocate (220, 20, 60); #crimson
> $color[21] = $img->colorAllocate (0, 255, 255); #cyan
> $color[22] = $img->colorAllocate (0, 0, 139); #darkblue
> $color[23] = $img->colorAllocate (0, 139, 139); #darkcyan
> $color[24] = $img->colorAllocate (184, 134, 11); #darkgoldenrod
> $color[25] = $img->colorAllocate (169, 169, 169); #darkgray
> $color[26] = $img->colorAllocate (0, 100, 0); #darkgreen
> $color[27] = $img->colorAllocate (189, 183, 107); #darkkhaki
> $color[28] = $img->colorAllocate (139, 0, 139); #darkmagenta
> $color[29] = $img->colorAllocate (85, 107, 47); #darkolivegreen
> $color[30] = $img->colorAllocate (255, 140, 0); #darkorange
> $color[31] = $img->colorAllocate (153, 50, 204); #darkorchid
> $color[32] = $img->colorAllocate (139, 0, 0); #darkred
> $color[33] = $img->colorAllocate (233, 150, 122); #darksalmon
> $color[34] = $img->colorAllocate (143, 188, 143); #darkseagreen
> $color[35] = $img->colorAllocate (72, 61, 139); #darkslateblue
> $color[36] = $img->colorAllocate (47, 79, 79); #darkslategray
> $color[37] = $img->colorAllocate (0, 206, 209); #darkturquoise
> $color[38] = $img->colorAllocate (148, 0, 211); #darkviolet
> $color[39] = $img->colorAllocate (255, 20, 256); #deeppink
> $color[40] = $img->colorAllocate (0, 191, 255); #deepskyblue
> $color[41] = $img->colorAllocate (105, 105, 105); #dimgray
> $color[42] = $img->colorAllocate (30, 144, 255); #dodgerblue
> $color[43] = $img->colorAllocate (255, 250, 240); #floralwhite
> my $fontname = $lbdir . 'MYGD/font/arialuni.ttf';
> my $fgcolor = $black;
> $img->stringFT ($fgcolor, $fontname, 15, 0, 100, 500, &main::big52utf8 ($sss->{poll}->{$forumid}->{$postid}->{topic}));
> $img->stringFT ($fgcolor, $fontname, 9, 0, 1, 520, "$boardurl/topic.cgi?forum=$forumid&topic=$postid");
> #$img->stringFT ($fgcolor, $fontname, 9, 0, 350, 530, &main::big52utf8 ('µ{¦¡»s§@³Ð·N¡GAnthony@LEOHACKS'));
> foreach (keys %{$sss->{poll}->{$forumid}->{$postid}->{item}})
> {
>         push (@list, $sss->{poll}->{$forumid}->{$postid}->{item}->{$_}->{pollcount});
>         my @topleft  = (410, 50 + $i * 15);
>         my @botright = (425, 50 + ($i + 1) * 15);
>         $img->rectangle (@topleft, @botright, $black);
>         $img->fill (int (($topleft[0] + $botright[0]) / 2), int (($topleft[1] + $botright[1]) / 2), $color[$i]);
>         $img->stringFT ($fgcolor, $fontname, 9, 0, $botright[0] + 3, $botright[1], &main::big52utf8 ($sss->{poll}->{$forumid}->{$postid}->{item}->{$_}->{itemname}));
>         $i++;}
>
> undef ($i);
> my ($cx, $cy) = (int ($x / 2), int ($y / 2));
> my $olds = 0;
> my $i = 0;
> foreach my $in (@list)
> {
>         $img->filledArc ($cx, $cy, $x , $y, int ($olds / $sum * 360), int (($olds + $in) / $sum * 360), $color[$i], gdEdged);
>         $olds += $in;
>         $i++;}
>
> $img->arc ($cx, $cy, $x , $y, 0, 360, $black);
> undef ($i);
> undef ($olds);
> print $query->header (-type => 'image/png');
> binmode (STDOUT);
> print $img->png;
> #$img->clear;
> undef ($img);
> exit;
>
> sub u2utf8
> {
>         my $c = shift;
>         $c = unpack ('H4', $c);
>         $c =~ s/(..)(..)/$2$1/;
>         $c = hex ($c);
>         my $str;
>         if ($c<0x80)
>         {
>                 return pack ('C', $c);
>         } elsif ($c<0x800) {
>                 $str = (0xC0|$c>>6);
>                 $str .= (0x80|$c&0x3F);
>         } elsif ($c<0x10000) {
>                 $str = (0xE0|$c>>12);
>                 $str .= (0x80|$c>>6&0x3F);
>                 $str .= (0x80|$c&0x3F);
>         } elsif ($c<0x200000) {
>                 $str = (0xF0|$c>>18);
>                 $str .= (0x80|$c>>12&0x3F);
>                 $str .= (0x80|$c>>6&0x3F);
>                 $str .= (0x80|$c&0x3F);
>         }
>         return pack ('C3', unpack ('A3A3A3', $str));
>
> }
>
> sub big52utf8
> {
>         my $str = $_[0];
>         my $ref = '';
>         open (FILE, '<', $lbdir . 'MYGD/unicode/big5_unicode.bin');
>         binmode (FILE);
>         for (my $i=0;$i<length ($str);$i++)
>         {
>                 my $tmp = substr ($str, $i, 1);
>                 if (ord ($tmp) > 127)
>                 {
>                         $tmp = substr ($str, $i++, 2);
>                         seek (FILE, hex (unpack ('H4', $tmp)) * 2, 0);
>                         read (FILE, $tmp, 2);
>                         $tmp = &main::u2utf8 ($tmp);
>                 }
>                 $ref .= $tmp;
>         }
>         close (FILE);
>         $ref;
>
> }
--~--~---------~--~----~------------~-------~--~----~
您收到此信息是由于您订阅了 Google 论坛"PerlChina Mongers 讨论组"论坛。
要在此论坛发帖，请发电子邮件到 perlchina@googlegroups.com
要退订此论坛，请发邮件至 perlchina+unsubscribe@googlegroups.com
更多选项，请通过 http://groups.google.com/group/perlchina?hl=zh-CN 访问该论坛
-~----------~----~----~----~------~----~------~--~---