G::Seq
Util
G::Seq::Util - Perl extension for blah blah blah
|
| Globals (from use vars definitions) |
| @EXPORT |
| $VERSION |
| @EXPORT_OK |
| Privates (from my definitions) |
| $genename = $gb->{"FEATURE$feat"}->{gene} |
| $l(2) = int ($k / $window) |
| $dif1(1) = -3 |
| $k;(1) |
| $dif1(2) = -3 |
| $dif3 = -2 - 4 - 9 + (-9 * $flag) |
| $k;(2) |
| $dif2(1) = -2 - 3 |
| $dif2(2) = -2 - 3 |
| %COG_fcode = ( J=>"Translation, ribosomal structure and biogenesis", K=>"Transcription", L=>"DNA replication, recombination and repair", D=>"Cell division and chromosome partitioning", O=>"Posttranslational modification, protein turnover, chaperones", M=>"Cell envelope biogenesis, outer membrane", N=>"Cell motility and secretion", P=>"Inorganic ion transport and metabolism", T=>"Signal transduction mechanisms", C=>"Energy production and conservation", G=>"Carbohydrate transport and metabolism", E=>"Amino acid transport and metabolism", F=>"Nucleotide transport and metabolism", H=>"Coenzyme metabolism", I=>"Lipid metabolism", Q=>"Secondary metabolites biosynthesis, transport and catabolism", R=>"General function prediction only", S=>"Function unknown", '-'=>"Non COG" ) |
| $feat = $gb->{"CDS$cds"}->{feature} |
| %COG_fcolor = ( J=>"plum", K=>"fuchsia", L=>"pink", D=>"lightgreen", O=>"green", M=>"khaki", N=>"greenyellow", P=>"darkkhaki", T=>"cyan", C=>"blue", G=>"mediumturquoise", E=>"lightskyblue", F=>"mediumpurple", H=>"aqua", I=>"blueviolet", Q=>"lightskyblue", R=>"gainsboro", S=>"darkgrey", '-'=>"aliceblue" ) |
| $l(1) = int ($k / $window) |
use G::Seq::Util;
blah blah blah
|
Stub documentation for G::Seq::Util was created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.
Blah blah blah.
|
| BEGIN | | Code |
| DESTROY | No description | Code |
| _complement | No description | Code |
| _oligomer_translation | No description | Code |
| _translate | No description | Code |
| atcgcon | No description | Code |
| cds_echo | No description | Code |
| find_king_of_gene | No description | Code |
| genome_map | No description | Code |
| genome_map2 | No description | Code |
| maskseq | No description | Code |
| molecular_weight | No description | Code |
| new | No description | Code |
| pasteseq | No description | Code |
| plasmid_map | No description | Code |
| print_gene_function_list | No description | Code |
| seq2png | No description | Code |
| seqinfo | No description | Code |
Methods description
Methods code
BEGIN
{
eval "use SVG;";
if($@){ warn "$@" };}
sub DESTROY
{ my $self = shift;
}
sub _complement
{ my $nuc = reverse(shift);
$nuc =~ tr
[acgturymkdhbvwsnACGTURYMKDHBVWSN]
[tgcaayrkmhdvbwsnTGCAAYRKMHDVBWSN];
return $nuc;}
sub _oligomer_translation
{ my @args = opt_get(@_);
my $seq = shift @args;
my $frame = shift @args;
my $len = length($seq);
if ($frame > 3){
$seq = G::Seq::Util::_complement($seq);
$frame -= 3;
}
my %CodonTable = (
'gac', 'D', 'caa', 'Q', 'gca', 'A', 'ctg', 'L',
'gat', 'D', 'cag', 'Q', 'gcc', 'A', 'ctt', 'L',
'gaa', 'E', 'agc', 'S', 'gcg', 'A', 'ata', 'I',
'gag', 'E', 'agt', 'S', 'gct', 'A', 'atc', 'I',
'aga', 'R', 'tca', 'S', 'gga', 'G', 'att', 'I',
'agg', 'R', 'tcc', 'S', 'ggc', 'G', 'cca', 'P',
'cga', 'R', 'tcg', 'S', 'ggg', 'G', 'ccc', 'P',
'cgc', 'R', 'tct', 'S', 'ggt', 'G', 'ccg', 'P',
'cgg', 'R', 'aca', 'T', 'gta', 'V', 'cct', 'P',
'cgt', 'R', 'acc', 'T', 'gtc', 'V', 'atg', 'M',
'aaa', 'K', 'acg', 'T', 'gtg', 'V', 'tgg', 'W',
'aag', 'K', 'act', 'T', 'gtt', 'V', 'tgc', 'C',
'cac', 'H', 'tac', 'Y', 'tta', 'L', 'tgt', 'C',
'cat', 'H', 'tat', 'Y', 'ttg', 'L', 'taa', '/',
'aac', 'N', 'ttc', 'F', 'cta', 'L', 'tag', '/',
'aat', 'N', 'ttt', 'F', 'ctc', 'L', 'tga', '/'
);
my $return = '';
my $i;
for ($i = 0; $i < $len; $i ++){
if ($i < $frame - 1){
$return .= substr($seq, $i, $frame - 1) . '-';
$i += $frame - 2;
} elsif ($i + 3 <= $len){
$return .= $CodonTable{substr($seq, $i, 3)};
$i += 2;
$return .= '-' unless ($i >= $len - 1);
} else {
$return .= substr($seq, $i);
last;
}
}
return $return;}
sub _translate
{ my $seq = lc(shift);
my $amino = '';
my %CodonTable = (
'gac', 'D', 'caa', 'Q', 'gca', 'A', 'ctg', 'L',
'gat', 'D', 'cag', 'Q', 'gcc', 'A', 'ctt', 'L',
'gaa', 'E', 'agc', 'S', 'gcg', 'A', 'ata', 'I',
'gag', 'E', 'agt', 'S', 'gct', 'A', 'atc', 'I',
'aga', 'R', 'tca', 'S', 'gga', 'G', 'att', 'I',
'agg', 'R', 'tcc', 'S', 'ggc', 'G', 'cca', 'P',
'cga', 'R', 'tcg', 'S', 'ggg', 'G', 'ccc', 'P',
'cgc', 'R', 'tct', 'S', 'ggt', 'G', 'ccg', 'P',
'cgg', 'R', 'aca', 'T', 'gta', 'V', 'cct', 'P',
'cgt', 'R', 'acc', 'T', 'gtc', 'V', 'atg', 'M',
'aaa', 'K', 'acg', 'T', 'gtg', 'V', 'tgg', 'W',
'aag', 'K', 'act', 'T', 'gtt', 'V', 'tgc', 'C',
'cac', 'H', 'tac', 'Y', 'tta', 'L', 'tgt', 'C',
'cat', 'H', 'tat', 'Y', 'ttg', 'L', 'taa', '/',
'aac', 'N', 'ttc', 'F', 'cta', 'L', 'tag', '/',
'aat', 'N', 'ttt', 'F', 'ctc', 'L', 'tga', '/'
);
while(3 <= length($seq)){
my $codon = substr($seq, 0, 3);
substr($seq, 0, 3) = '';
if ($codon =~ /[^atgc]/){
$amino .= '?';
}else{
$amino .= $CodonTable{$codon};
}
}
if(length($seq)){
&msg_error("Translation: illegal length.\n");
}
return $amino;}
sub atcgcon
{ &opt_default(output=>"stdout",filename=>"cds_info.csv");
my @args=opt_get(@_);
my $gb=opt_as_gb(shift @args);
my $output=opt_val("output");
my $filename=opt_val("filename");
my $start;
my $end;
my $seq;
my $num=1;
my %hash;
foreach($gb->feature()){
if($gb->{"FEATURE$num"}->{type} eq 'CDS'){
$start=$gb->{"FEATURE$num"}->{start};
$end=$gb->{"FEATURE$num"}->{end};
$seq=$gb->getseq($start-1,$end-1);
$hash{a} += $seq =~tr/a/a/;
$hash{t} += $seq =~tr/t/t/;
$hash{g} += $seq =~tr/g/g/;
$hash{c} += $seq =~tr/c/c/;
$hash{total}+=length($seq);
}
$num++;
}
if($output eq "stdout"){
&msg_send(sprintf("total:\t%10d base\n",$hash{total}));
&msg_send(sprintf("a:\t%10d / %2.2f\%\n", $hash{a}, 100.0*$hash{a}/$hash{total}));
&msg_send(sprintf("t:\t%10d / %2.2f\%\n", $hash{t}, 100.0*$hash{t}/$hash{total}));
&msg_send(sprintf("c:\t%10d / %2.2f\%\n", $hash{c}, 100.0*$hash{c}/$hash{total}));
&msg_send(sprintf("g:\t%10d / %2.2f\%\n", $hash{g}, 100.0*$hash{g}/$hash{total}));
&msg_send(sprintf("GC content:\t%.2f\%\n", 100.0($hash{c} + $hash{g}) / $hash{total}));
}
if($output eq "f"){
open(FILE,">$filename");
printf FILE "total:\t%10d base\n",$hash{total};
printf FILE "a:\t%10d / %2.2f\%\n", $hash{a}, 100.0*$hash{a}/$hash{total};
printf FILE "t:\t%10d / %2.2f\%\n", $hash{t}, 100.0*$hash{t}/$hash{total};
printf FILE "c:\t%10d / %2.2f\%\n", $hash{c}, 100.0*$hash{c}/$hash{total};
printf FILE "g:\t%10d / %2.2f\%\n", $hash{g}, 100.0*$hash{g}/$hash{total};
printf FILE "GC content:\t%.2f\%\n", 100.0($hash{c} + $hash{g}) / $hash{total};
close(FILE);
}
return\% hash;}
sub cds_echo
{ my $gb=opt_as_gb(shift);
my $start;
my $end;
my $i=1;
foreach($gb->feature()){
if($gb->{"FEATURE$i"}->{type} eq 'CDS'){
if($gb->{"FEATURE$i"}->{direction} eq 'direct'){
$start = $gb->{"FEATURE$i"}->{start};
$end = $gb->{"FEATURE$i"}->{end};
&msg_send(sprintf("%d..%d\n",$start,$end));
}
elsif($gb->{"FEATURE$i"}->{direction} eq 'complement'){
$start = $gb->{"FEATURE$i"}->{end};
$end = $gb->{"FEATURE$i"}->{start};
&msg_send(sprintf("%d..%d\n",$start,$end));
}
}
$i++;
}}
sub find_king_of_gene
{ my $nuc=shift;
my $gene='you have just found the king of AFROs.'."\n";
msg_gimv('data/debug.jpg');
return $gene;}
sub genome_map
{ &opt_default(output=>"show", name=>1, window=>50, amp=>1.5);
my @args = opt_get(@_);
my $gb = opt_as_gb(shift @args);
my $acnum = $gb->{LOCUS}->{id};
my $output = opt_val("output");
my $name = opt_val("name");
my $filename;
my $topmargin = 30;
my $sidemargin = 80;
my $hblock = 100;
my $vblock = 10;
my $page = 1;
my $start;
my $width = 800;
my $height = 600;
my $i = 0;
my $cds = 1;
my $window=opt_val("window");
my $amp = opt_val("amp");
mkdir ("graph", 0777);
for ($start = 1; $start <= length($gb->{SEQ}); $start += $window * 700 * 10){
my $end = $start + 10 * $window * 700 - 1;
## GD constant
my $im = new GD::Image($width, $height);
my $white = $im->colorAllocate(255,255,255);
my $black = $im->colorAllocate(0,0,0);
my $gray = $im->colorAllocate(180,180,180);
my $red = $im->colorAllocate(255,0,0); ##A
my $yellow = $im->colorAllocate(255,255,0); ##T
my $green = $im->colorAllocate(0,150,0); ##G
my $blue = $im->colorAllocate(0,0,255); ##C
my $aqua = $im->colorAllocate(120, 160, 255);
my $gred = $im->colorAllocate(255,150,150); ##A for graph
my $gyellow = $im->colorAllocate(255,255,50); ##T for graph
my $ggreen = $im->colorAllocate(150,150,150); ##G for graph
my $gblue = $im->colorAllocate(150,150,255); ##C for graph
## Draw Base Graph
for ($i = $sidemargin; $i <= $sidemargin + $hblock * 7; $i += $hblock){
$im->line($i, $topmargin, $i, $topmargin + 5 * 11 * $vblock,
$gray);
}
for ($i = $topmargin; $i <= $topmargin + $vblock * 5 * 11; $i +=
$vblock){
$im->line($sidemargin, $i, $sidemargin + 7 * $hblock, $i, $gray);
}
for ($i = $topmargin + $vblock * 5;
$i < $topmargin + $vblock * 5 * 11;
$i += $vblock * 5){
$im->line($sidemargin, $i - 1, $sidemargin + 7 * $hblock, $i - 1,
$black);
$im->line($sidemargin, $i + 1, $sidemargin + 7 * $hblock, $i + 1,
$black);
}
$im->string(gdSmallFont, $width - 110, 5,
"G-language Project", $black);
$im->string(gdSmallFont, $width - 110 - 50, 5, "A", $red);
$im->string(gdSmallFont, $width - 110 - 40, 5, "T", $yellow);
$im->string(gdSmallFont, $width - 110 - 30, 5, "G", $green);
$im->string(gdSmallFont, $width - 110 - 20, 5, "C", $blue);
my $j = 0;
for ($i = $topmargin + $vblock * 5;
$i <= $topmargin + $vblock * 5 * 10;
$i += $vblock * 5){
my $num = $start + $j * $window * 700;
$im->string(gdTinyFont, 10, $i, "$num", $black);
$j ++;
}
$im->string(gdSmallFont, 5, 5, "$acnum : from $start to $end",
$black);
my ($pa, $pt, $pg, $pc, $num, $color);
my $locus = 0;
for ($i = $start - 1; $i <= $start + 700 * 10 * $window - 1; $i += $window){
last if ($i + $window >= length($gb->{SEQ}));
my $seq = $gb->getseq($i, $i + $window - 1);
my $a = $seq =~ tr/a/a/;
my $t = $seq =~ tr/t/t/;
my $g = $seq =~ tr/g/g/;
my $c = $seq =~ tr/c/c/;
## Draw DNA
if ($a >= $t && $a >= $g && $a >= $c){
my $num = int($a / $window * 100);
$color = $red;
}elsif ($t >= $a && $t >= $g && $t >= $c){
my $num = int($t / $window * 100);
$color = $yellow;
}elsif ($g >= $a && $g >= $t && $g >= $c){
my $num = int($g / $window * 100);
$color = $green;
}elsif ($c >= $a && $c >= $t && $c >= $g){
my $num = int($c / $window * 100);
$color = $blue;
}
$im->setPixel($sidemargin + 1 + $locus % (700),
$topmargin + (int($locus / 700) + 1) * $vblock * 5,
$color);
my $dist = 7;
if ($locus % $dist == $dist - 1){
## Draw A content graph
$num = int($a / int ($window * $amp) * 100) + 5;
$im->line($sidemargin - $dist + $locus % (700), $pa,
$sidemargin + $locus % (700),
$topmargin - $num
+ (int($locus / 700) + 1) * $vblock * 5,
$gred);
$pa = $topmargin - $num +(int($locus / 700) + 1)
* $vblock * 5;
## Draw T content graph
$num = int($t / int ($window * $amp) * 100) + 5;
$im->line($sidemargin - $dist + $locus % (700), $pt,
$sidemargin + $locus % (700),
$topmargin - $num
+ (int($locus / 700) + 1) * $vblock * 5,
$gyellow);
$pt = $topmargin - $num +(int($locus / 700) + 1)
* $vblock * 5;
## Draw G content graph
$num = int($g / int ($window * $amp) * 100) + 5;
$im->line($sidemargin - $dist + $locus % (700), $pg,
$sidemargin + $locus % (700),
$topmargin - $num
+ (int($locus / 700) + 1) * $vblock * 5,
$ggreen);
$pg = $topmargin - $num +(int($locus / 700) + 1)
* $vblock * 5;
## Draw C content graph
$num = int($c / int ($window * $amp) * 100) + 5;
$im->line($sidemargin - $dist + $locus % (700), $pc,
$sidemargin + $locus % (700),
$topmargin - $num
+ (int($locus / 700) + 1) * $vblock * 5,
$gblue);
$pc = $topmargin - $num +(int($locus / 700) + 1)
* $vblock * 5;
}elsif($locus % 700 == 0){
$num = int($a / int ($window * $amp) * 100) + 5;
$pa = $topmargin - $num +(int($locus / 700) + 1)
* $vblock * 5;
$num = int($t / int ($window * $amp) * 100) + 5;
$pt = $topmargin - $num +(int($locus / 700) + 1)
* $vblock * 5;
$num = int($g / int ($window * $amp) * 100) + 5;
$pg = $topmargin - $num +(int($locus / 700) + 1)
* $vblock * 5;
$num = int($c / int ($window * $amp) * 100) + 5;
$pc = $topmargin - $num +(int($locus / 700) + 1)
* $vblock * 5;
}
$locus ++;
}
## Draw Genes
my $flag = 0;
my $before = -5000;
my $before2 = -10000;
while (defined %{$gb->{"CDS$cds"}}){
my $cdsstart = $gb->{"CDS$cds"}->{start};
my $cdsend = $gb->{"CDS$cds"}->{end};
my $cdsdir = $gb->{"CDS$cds"}->{direction};
my $cdsdiff = $cdsstart - $before;
my $cdsdiff2 = $cdsstart - $before2;
if ($flag == 0){
if (int($cdsdiff / $window) < 20){
$flag = 1;
}
}elsif ($flag == 1){
if (int($cdsdiff / $window) < 20){
if (int($cdsdiff2 / $window) < 20){
$flag = 2;
}else{
$flag = 0;
}
}else{
$flag = 0;
}
}elsif ($flag == 2){
if (int($cdsdiff2 / $window) < 20){
$flag = 1;
}else{
$flag = 0;}
sub genome_map2
{ &opt_default(output=>"show", window=>50, type=>"CDS",
start=>1, end=>100000, filename=>"genome_map.svg", ptt=>'', cgi=>0);
my @args = opt_get(@_);
my $gb = shift @args;
my $acnum = $gb->{LOCUS}->{id};
my $output = opt_val("output");
my $filename = opt_val("filename");
my $topmargin = 60;
my $sidemargin = 80;
my $hblock = 100;
my $vblock = 10;
my $page = 1;
my $i = 0;
my $cds = 1;
my $window=opt_val("window");
my $start = opt_val("start");
my $end = opt_val("end");
my $ptt = opt_val("ptt");
my $cgi = opt_val("cgi");
my @type = split(/ /, opt_val("type"));
my $width = (int(($end - $start) / $hblock / $window) + 1) * $hblock + $sidemargin * 2;
my $height = $hblock/2 + $topmargin * 2 + scalar(@type) * $hblock - $vblock;
eval{
$ptt = set_gpac($gb, -ptt=>$ptt);
};
unless ($cgi){
sdb_save(\$ptt, "ptt");
sdb_save($gb, "gb");
}
my $svg = SVG->new(width=>$width, height=>$height);
## Draw Base Graph
for ($i = $sidemargin; $i <= $width - $sidemargin; $i += $hblock){
$svg->line(id=>"bvline$i", x1=>$i,
y1=>$topmargin, x2=>$i, y2=>($hblock * (scalar(@type) + 1) + $vblock),
style=>{
stroke=>"darkgray", 'stroke-width'=>1,
'stroke-opacity'=>0.2
});
}
for ($i = $sidemargin; $i < $width - $sidemargin; $i += $hblock){
$svg->text(
id=>"num$i",
x=>$i, y=>($topmargin - 5), fill=>"black",
'font-size'=>8,
)->cdata(((($i - $sidemargin) + 1) * $window - 49 + $start - 1) . " bp");
}
for ($i = $topmargin; $i <= $topmargin + $vblock * 5 ; $i += $vblock){
$svg->line(id=>"bhline$i", x1=>$sidemargin,
y1=>$i, x2=>($width - $sidemargin), y2=>$i,
style=>{
stroke=>"darkgray", 'stroke-width'=>1,
'stroke-opacity'=>0.2
});
}
for ($i = $topmargin + $vblock * 5;
$i <= $topmargin + $hblock * (scalar(@type) + 1); $i += $hblock){
$svg->line(id=>"bhlline$i", x1=>$sidemargin,
y1=>$i, x2=>($width - $sidemargin), y2=>$i,
style=>{
stroke=>"darkgray", 'stroke-width'=>1,
'stroke-opacity'=>0.2
});
}
for ($i = $topmargin + $vblock * 5 + $hblock / 2;
$i <= $topmargin + $hblock * scalar(@type); $i += $hblock){
$svg->line(id=>"dnau$i", x1=>$sidemargin,
y1=>($i - 1), x2=>($width - $sidemargin), y2=>($i - 1),
style=>{
stroke=>"black", 'stroke-width'=>1,
'stroke-opacity'=>1
});
$svg->line(id=>"dnad$i", x1=>$sidemargin,
y1=>($i + 1), x2=>($width - $sidemargin), y2=>($i + 1),
style=>{
stroke=>"black", 'stroke-width'=>1,
'stroke-opacity'=>1
});
}
$svg->text(
id=>"A",
x=>20, y=>($topmargin + $vblock * 3), fill=>"red",
'font-size'=>10,
)->cdata("A");
$svg->text(
id=>"T",
x=>30, y=>($topmargin + $vblock * 3), fill=>"gold",
'font-size'=>10,
)->cdata("T");
$svg->text(
id=>"G",
x=>40, y=>($topmargin + $vblock * 3), fill=>"green",
'font-size'=>10,
)->cdata("G");
$svg->text(
id=>"C",
x=>50, y=>($topmargin + $vblock * 3), fill=>"blue",
'font-size'=>10,
)->cdata("C");
my ($pa, $pt, $pg, $pc, $num, $color);
my (@gra, @grt, @grc, @grg);
my $locus = 0;
for ($i = $start - 1; $i <= $end; $i += $window){
my $seq = $gb->getseq($i, $i + $window * 2 - 1);
my $a = $seq =~ tr/a/a/;
my $t = $seq =~ tr/t/t/;
my $g = $seq =~ tr/g/g/;
my $c = $seq =~ tr/c/c/;
my $x = $seq =~ tr/x/x/;
my $n = $seq =~ tr/n/n/;
if ($locus % 2 != 1){
## Draw DNA
if ($a >= $t && $a >= $g && $a >= $c){
my $num = int($a / $window * 100);
$color = 'red';
$color = 'white' if ($a == 0);
}elsif ($t >= $a && $t >= $g && $t >= $c){
my $num = int($t / $window * 100);
$color = 'yellow';
}elsif ($g >= $a && $g >= $t && $g >= $c){
my $num = int($g / $window * 100);
$color = 'green';
}elsif ($c >= $a && $c >= $t && $c >= $g){
my $num = int($c / $window * 100);
$color = 'blue';
}
my $j;
for ($j = $topmargin + $vblock * 5 + $hblock / 2;
$j <= $topmargin + $hblock * scalar(@type); $j += $hblock){
last if ($locus >= int($width - $sidemargin * 2) - 3);
$svg->line(id=>"dnac$j", x1=>($sidemargin + 1 + $locus),
y1=>$j, x2=>($sidemargin + 3 + $locus), y2=>$j,
style=>{
stroke=>$color, 'stroke-width'=>1,
'stroke-opacity'=>1
});
}
}
my $dist = 5;
if ($locus % $dist == $dist -1 || $locus == 0){
last if ($a == 0 && $t == 0 && $c == 0 && $g == 0 && $x == 0 && $n == 0);
push (@gra, sprintf("%d,%d", $sidemargin + $locus,
$topmargin + $vblock * 5 - int($a / 2 / $window * 100 ) + 5));
push (@grt, sprintf("%d,%d", $sidemargin + $locus,
$topmargin + $vblock * 5 - int($t / 2 / $window * 100 ) + 5));
push (@grg, sprintf("%d,%d", $sidemargin + $locus,
$topmargin + $vblock * 5 - int($g / 2 / $window * 100 ) + 5));
push (@grc, sprintf("%d,%d", $sidemargin + $locus,
$topmargin + $vblock * 5 - int($c / 2 / $window * 100 ) + 5));
}
$locus ++;
}
$svg->polyline(id=>"gra", points=>join(" ", @gra),
style=>{
stroke=>'red', 'stroke-width'=>1,
'stroke-opacity'=>0.2, fill=>'none'
});
$svg->polyline(id=>"grt", points=>join(" ", @grt),
style=>{
stroke=>'gold', 'stroke-width'=>1,
'stroke-opacity'=>0.2, fill=>'none'
});
$svg->polyline(id=>"grg", points=>join(" ", @grg),
style=>{
stroke=>'green', 'stroke-width'=>1,
'stroke-opacity'=>0.2, fill=>'none'
});
$svg->polyline(id=>"grc", points=>join(" ", @grc),
style=>{
stroke=>'blue', 'stroke-width'=>1,
'stroke-opacity'=>0.2, fill=>'none'
});
## Draw Genes
my $flag = 0;
my $before = -5000;
my $before2 = -10000;
my @colors = qw(J K L D O M N P T C G E F H I Q R S -);
my $col = 0;
foreach my $pat (@type){
$svg->text(
id=>$pat,
x=>20, y=>($topmargin + $vblock * 5 + $hblock * $col + $hblock/2 + 3),
'font-size'=>10,
)->cdata($pat);
foreach my $cds ($gb->feature()){
next unless($gb->{$cds}->{end} >= $start && $gb->{$cds}->{start} <= $end);
next unless($gb->{$cds}->{type} eq $pat);
my $cdsstart = $gb->{$cds}->{start};
my $cdsend = $gb->{$cds}->{end};
my $cdsdir = $gb->{$cds}->{direction};
my $cdsdiff = $cdsstart - $before;
my $genename = $gb->{$cds}->{gene};
my $code = $gb->{$cds}->{code} || $colors[$col];
my $dif1 = -10;
my $sign = -1;
$dif1 = -25 if ($cdsdiff / $window < 15);
if ($cdsdir eq 'complement'){
$dif1 *= -1;
$sign *= -1;
}
$cdsstart = $start if ($cdsstart < $start);
$cdsend = $end if ($cdsend > $end);
if ($cdsdir eq 'direct'){
$svg->rect(
id=>"liner$cds", x=>($sidemargin + ($cdsstart - $start)/$window),
y=>($topmargin + $dif1 + $vblock * 5 + $hblock / 2 - 3 + $hblock * $col),
height=>(abs($dif1) + 3),
width=>(($cdsend - $cdsstart)/$window),
style=>{
stroke=>"gray", 'stroke-width'=>1,
'stroke-opacity'=>0.2, 'fill'=>'none'
});
}else{
$svg->rect(
id=>"liner$cds", x=>($sidemargin + ($cdsstart - $start)/$window),
y=>($topmargin + $vblock * 5 + $hblock / 2 - 1 + $hblock * $col),
height=>(abs($dif1) + 3),
width=>(($cdsend - $cdsstart)/$window),
style=>{
stroke=>"gray", 'stroke-width'=>1,
'stroke-opacity'=>0.2, 'fill'=>'none'
});
}
$svg->anchor(
-href=>'http://localhost/g-language/genome_view.cgi?pos=' . $cds,
-target=>'_blank'
)->rect(
id=>"line$cds", x=>($sidemargin + ($cdsstart - $start)/$window),
y=>($topmargin + $dif1 + $vblock * 5 + $hblock / 2 - 3 + $hblock * $col),
height=>5,
width=>(($cdsend - $cdsstart)/$window),
style=>{
stroke=>"green", 'stroke-width'=>1,
'stroke-opacity'=>0.2, 'fill'=>$COG_fcolor{$code},
'fill-opacity'=>0.2
});
$svg->text(
id=>"cds$cds",
x=>($sidemargin + ($cdsstart - $start)/$window),
y=>($topmargin + (abs($dif1) + 6) * $sign + $vblock * 5 + $hblock / 2 + 1 + $hblock * $col),
fill=>$COG_fcolor{$code},
'font-size'=>5,
)->cdata($genename);
$before = $cdsstart;
}
$col ++;
}
my $topline = $svg->line(id=>"top", x1=>0, y1=>10, x2=>$width, y2=>10,
style=>{
stroke=>"plum", 'stroke-width'=>3,
'stroke-opacity'=>0.3
});
$topline->animate(
attributeName=>"stroke",
values=>join(';', values(%COG_fcolor)), dur=>"90s",
repeatDur=>'indefinite'
);
my $bottomline = $svg->line(id=>"bottom", x1=>0, y1=>($height-10), x2=>$width, y2=>($height-10),
style=>{
stroke=>"plum", 'stroke-width'=>3,
'stroke-opacity'=>0.3
});
$bottomline->animate(
attributeName=>"stroke",
values=>join(';', values(%COG_fcolor)), dur=>"90s",
repeatDur=>'indefinite'
);
$svg->anchor(
-href=>"http://www.g-language.org/",
-target=>"_blank"
)->text(
id=>"credits",
x=>($width - 300), y=>($height - 15), fill=>"darkgray",
'font-size'=>8, 'font-style'=>'italic',
)->cdata(
"generated by genome_map2, G-language Genome Analysis Environment"
);
$svg->text(
id=>"locus",
x=>30, y=>26, fill=>"navy",
'font-size'=>10,
)->cdata("Accession Number: ", $gb->{LOCUS}->{id});
$svg->text(
id=>"locus",
x=>250, y=>26, fill=>"navy",
'font-size'=>10,
)->cdata("Organism: ", $gb->{FEATURE0}->{organism});
$svg->text(
id=>"locus",
x=>500, y=>26, fill=>"navy",
'font-size'=>10,
)->cdata(length($gb->{SEQ}) . " bp");
my $leftarrow = $svg->anchor(
-href=>'http://localhost/g-language/genome_view.cgi?pos=' . ($start - 50000)
)->polygon(
id=>"larrow",
points=>sprintf("%d,%d %d,%d %d,%d", 50,
$topmargin + $vblock * 5 + $hblock * scalar(@type) - 10,
50,
$topmargin + $vblock * 5 + $hblock * scalar(@type) + 20,
15,
$topmargin + $vblock * 5 + $hblock * scalar(@type) + 5
),
style=>{
fill=>"plum", stroke=>"plum", 'stroke-width'=>5,
'fill-opacity'=>0.1, 'stroke-opacity'=>0.3
}
);
$leftarrow->animate(
attributeName=>"stroke",
values=>join(';', reverse(values(%COG_fcolor))), dur=>"90s",
repeatDur=>'indefinite'
);
$leftarrow->animate(
attributeName=>"fill",
values=>join(';', reverse(values(%COG_fcolor))), dur=>"90s",
repeatDur=>'indefinite'
);
my $rightarrow = $svg->anchor(
-href=>'http://localhost/g-language/genome_view.cgi?pos=' . ($end + 50001)
)->polygon(
id=>"rarrow",
points=>sprintf("%d,%d %d,%d %d,%d", $width - 50,
$topmargin + $vblock * 5 + $hblock * scalar(@type) - 10,
$width - 50,
$topmargin + $vblock * 5 + $hblock * scalar(@type) + 20,
$width - 15,
$topmargin + $vblock * 5 + $hblock * scalar(@type) + 5
),
style=>{
fill=>"plum", stroke=>"plum", 'stroke-width'=>5,
'fill-opacity'=>0.1, 'stroke-opacity'=>0.3
}
);
$rightarrow->animate(
attributeName=>"stroke",
values=>join(';', reverse(values(%COG_fcolor))), dur=>"90s",
repeatDur=>'indefinite'
);
$rightarrow->animate(
attributeName=>"fill",
values=>join(';', reverse(values(%COG_fcolor))), dur=>"90s",
repeatDur=>'indefinite'
);
mkdir ("graph", 0777);
open(OUT, '>graph/' . $filename) || msg_error($!);
print OUT $svg->xmlify;
close(OUT);
msg_gimv('graph/' . $filename) if ($output eq 'show');
return 1;}
sub maskseq
{ &opt_default(pattern=>"",start=>1,end=>"");
my @args=opt_get(@_);
my $gb=opt_as_gb(shift @args);
my $seq=\$gb->{SEQ};
my $start=opt_val("start");
my $end=opt_val("end");
my $pat=opt_val("pattern");
my $masked;
my $null;
$$seq=~tr/ \n[0-9]//d;
$$seq=~tr/A-Z/a-z/;
$end=length($$seq) if($end eq "");
for(my $i=0;$i<length($pat);$i++){
$null.="n";
}
if($pat){
$masked=substr($$seq,$start-1,$end-$start+1);
$masked=~s/$pat/$null/g;
substr($$seq,$start-1,$end-$start+1)=$masked;
}
else{
$masked=substr($$seq,$start-1,$end-$start+1);
$masked=~tr/a-zA-Z/n/;
substr($$seq,$start-1,$end-$start+1)=$masked;
}
return $seq;}
sub molecular_weight
{ opt_default(strand=>"single");
my @args = opt_get(@_);
my $gb = opt_as_gb(shift @args);
my $strand = opt_val("strand");
my %mw = ("a", 313.15, "t", 304.19, "g", 329.19, "c", "289.13", "n", 308.915);
my $i = 0;
my $weight = 0;
while(substr($gb->{SEQ}, $i, 1) ne ''){
if (substr($gb->{SEQ}, $i, 1) =~ /[atgc]/){
$weight += $mw{substr($gb->{SEQ}, $i, 1)};
}else{
$weight += $mw{"n"};
}
$i ++;
}
my $double = $weight * 2;
msg_send(sprintf " Molecular Weight of Nucleotides:\n");
msg_send(sprintf " single strand: %12d\n",$weight);
msg_send(sprintf " double strand: %12d\n\n\n",$double);
$weight *= 2 if ($strand eq "double");
return $weight;}
sub new
{ my $pkg = shift;
my $filename = shift;
my $option = shift;
my $this;
return $this;}
sub pasteseq
{ &opt_default();
my @args=opt_get(@_);
my $gb=opt_as_gb(shift);
my $seq=\$gb->{SEQ};
my $paste=shift @_;
my $pos=shift @_;
$$seq=~tr/ \n[0-9]//d;
$$seq=~tr/A-Z/a-z/;
$$paste=~tr/A-Z/a-z/;
substr($$seq,$pos-1,0)=$$paste;
return $seq;}
sub plasmid_map
{ opt_default(ptt=>'', output=>'show', filename=>"plasmid_map.svg", cgi=>0);
my @args = opt_get(@_);
my $gb = shift;
my $ptt = opt_val("ptt");
my $output = opt_val("output");
my $filename = opt_val("filename");
my $cgi = opt_val("cgi");
eval{
$ptt = set_gpac($gb, -ptt=>$ptt);
};
unless ($cgi){
sdb_save(\$ptt, "ptt");
sdb_save($gb, "gb");
}
my $svg = SVG->new(width=>640, height=>400);
my $pi = atan2(1,1) * 4;
my $seqlen = length $gb->{SEQ};
my $maxlen;
foreach my $cds ($gb->cds()){
my $tmplen = length ($gb->get_geneseq($cds));
$maxlen = $tmplen if ($tmplen > $maxlen);
}
foreach my $cds ($gb->cds()){
my $id = $gb->{$cds}->{gene};
my $gene = $gb->get_geneseq($cds);
my $length = length $gene;
my $gc = int(log($maxlen) / log($length) * 30);
my $rad = 2 * $pi * $gb->{$cds}->{start} / $seqlen * -1 + $pi;
my ($x1, $x2, $y1, $y2);
if ($gb->{$cds}->{direction} eq 'direct'){
$x1 = (100 + 5) * sin($rad) + 200;
$y1 = (100 + 5) * cos($rad) + 200;
$x2 = (100 + $gc) * sin($rad) + 200;
$y2 = (100 + $gc) * cos($rad) + 200;
}else{
$x1 = (100 - $gc) * sin($rad) + 200;
$y1 = (100 - $gc) * cos($rad) + 200;
$x2 = (100 - 5) * sin($rad) + 200;
$y2 = (100 - 5) * cos($rad) + 200;
}
my $stroke = $COG_fcolor{$gb->{$cds}->{code}};
my $cdsstart = $gb->{$cds}->{start};
$svg->anchor(
-href=>'http://localhost/g-language/genome_view.cgi?pos=' . $cdsstart,
-target=>"_blank"
)->line(
id=>$id, x1=>$x1,
y1=>$y1, x2=>$x2, y2=>$y2,
style=>{
stroke=>$stroke, 'stroke-width'=>1,
'stroke-opacity'=>0.3
});
}
$svg->circle(id=>'genome', cx=>200, cy=>200, r=>100,
style=>{
stroke=>'blue', fill=>'none', 'stroke-width'=>5,
'stroke-opacity'=>0.2
});
my $x = 400;
my $y = 123;
my $y2 = 130;
$svg->anchor(
-href=>"http://www.ncbi.nih.gov/cgi-bin/COG/palox?fun=all",
-target=>"_blank"
)->text(
id=>"COG link",
x=>($x - 20), y=>($y2 - 30),
'font-size'=>9
)->cdata(
"Gene Classification based on NCBI COG functional categories"
);
foreach my $category (qw(J K L D O M N P T C G E F H I Q R S -)){
$svg->rect(id=>$category, x=>$x, y=>$y, width=>9, height=>8,
style=>{
stroke=>'none', fill=>$COG_fcolor{$category},
opacity=>0.3
});
my $id = $category . '_text';
$svg->text(id=>$id, x=>($x + 15), y=>$y2, 'font-size'=>7)->cdata($COG_fcode{$category});
$y += 12;
$y2 += 12;
}
my $topline = $svg->line(id=>"top", x1=>0, y1=>10, x2=>640, y2=>10,
style=>{
stroke=>"blue", 'stroke-width'=>3,
'stroke-opacity'=>0.3
});
$topline->animate(
attributeName=>"stroke",
values=>join(';', values(%COG_fcolor)), dur=>"90s",
repeatDur=>'indefinite'
);
my $bottomline = $svg->line(id=>"bottom", x1=>0, y1=>390, x2=>640, y2=>390,
style=>{
stroke=>"blue", 'stroke-width'=>3,
'stroke-opacity'=>0.3
});
$bottomline->animate(
attributeName=>"stroke",
values=>join(';', values(%COG_fcolor)), dur=>"90s",
repeatDur=>'indefinite'
);
$svg->anchor(
-href=>"http://www.g-language.org/",
-target=>"_blank"
)->text(
id=>"credits",
x=>380, y=>385, fill=>"darkgray",
'font-size'=>8, 'font-style'=>'italic',
)->cdata(
"generated by plasmid map, G-language Genome Analysis Environment"
);
$svg->text(
id=>"locus",
x=>30, y=>30, fill=>"navy",
'font-size'=>10,
)->cdata("Accession Number: ", $gb->{LOCUS}->{id});
$svg->text(
id=>"locus",
x=>250, y=>30, fill=>"navy",
'font-size'=>10,
)->cdata("Organism: ", $gb->{FEATURE0}->{organism});
$svg->text(
id=>"locus",
x=>500, y=>30, fill=>"navy",
'font-size'=>10,
)->cdata("$seqlen bp");
mkdir('graph', 0777);
open(OUT, '>graph/' . $filename) || msg_error($!);
print OUT $svg->xmlify;
close(OUT);
msg_gimv('graph/' . $filename) if ($output eq "show");
return 1;}
sub print_gene_function_list
{ my $gb = opt_as_gb(shift);
my $seq = shift;
$seq = 'gctggtgg' unless ($seq);
my $revseq = _complement($seq);
my $i = 1;
my %chi;
my %cds;
my $key;
while(defined(%{$gb->{"CDS$i"}})){
my $id = $gb->{"CDS$i"}->{feature};
my ($function, $tmp) = split(/;/, $gb->{"FEATURE$id"}->{function}, 2);
my $cdsseq = $gb->get_cdsseq("CDS$i");
$cds{$function}++;
my $iStart = -1;
while(0 <= ($iStart = index($cdsseq, $seq, $iStart +1))){
$chi{$function}++;
}
$iStart = -1;
while(0 <= ($iStart = index($cdsseq, $revseq, $iStart +1))){
$chi{$function}++;
}
$i++;
}
&msg_send("=== $seq ===\n");
my $tot = 0;
foreach $key (sort keys %chi){
&msg_send(sprintf("%20s: %8d\n",$key, $chi{$key}));
$tot += $chi{$key};
}
&msg_send("total: $tot\n\n");
&msg_send("=== CDS ===\n");
$tot = 0;
foreach $key (sort keys %cds){
next if ($key !~ /[a-z]/);
&msg_send(sprintf("%20s: %8d\n", $key, $cds{$key}));
$tot += $cds{$key};
}
&msg_send("total: $tot\n");
return 1;}
sub seq2png
{ &opt_default(width=>640, filename=>"seq.png", output=>"show");
my @args = opt_get(@_);
my $gb = opt_as_gb(shift @args);
my $width = opt_val("width");
my $output = opt_val("output");
my $filename = opt_val("filename");
my $height = int((length($gb->{SEQ})+1)/$width)+1;
my $im = new GD::Image($width, $height);
my $white = $im->colorAllocate(255,255,255);
my $red = $im->colorAllocate(255,0,0);
my $yellow = $im->colorAllocate(255,255,0);
my $green = $im->colorAllocate(0,150,0);
my $blue = $im->colorAllocate(0,0,255);
my ($x, $y);
my $count = 0;
for ($y = 0; $y <= $height; $y ++){
for ($x = 0; $x <= $width; $x ++){
my $color=$white;
$color=$red if (substr($gb->{SEQ}, $count, 1) eq 'a');
$color=$yellow if (substr($gb->{SEQ}, $count, 1) eq 'g');
$color=$green if (substr($gb->{SEQ}, $count, 1) eq 't');
$color=$blue if (substr($gb->{SEQ}, $count, 1) eq 'c');
$im->setPixel($x,$y,$color);
last if ($count == length($gb->{SEQ}));
$count ++;
}
}
mkdir ('graph', 0777);
open(OUT, '>graph/' . $filename);
binmode OUT;
print OUT $im->png;
close(OUT);
msg_gimv("graph/$filename") if ($output eq 'show');}
sub seqinfo
{ my @args = opt_get(@_);
my $this = opt_as_gb(shift @args);
my $length = length($this->{SEQ});
my $a = $this->{SEQ} =~ tr/a/a/;
my $t = $this->{SEQ} =~ tr/t/t/;
my $g = $this->{SEQ} =~ tr/g/g/;
my $c = $this->{SEQ} =~ tr/c/c/;
my $others = $length - $a - $t - $g - $c;
my $msg;
$msg .= sprintf "\n Length of Sequence : %9d\n" , $length;
$msg .= sprintf " A Content : %9d (%.2f\%)\n" ,
$a , $a / $length * 100;
$msg .= sprintf " T Content : %9d (%.2f\%)\n" ,
$t , $t / $length * 100;
$msg .= sprintf " G Content : %9d (%.2f\%)\n" ,
$g , $g / $length * 100;
$msg .= sprintf " C Content : %9d (%.2f\%)\n" ,
$c , $c / $length * 100;
$msg .= sprintf " Others : %9d (%.2f\%)\n" ,
$others, $others / $length * 100;
$msg .= sprintf " AT Content : %.2f\%\n",
($a + $t) / $length * 100;
$msg .= sprintf " GC Content : %.2f\%\n\n",
($g + $c) / $length * 100;
&msg_send($msg);
return ($a, $t, $g, $c);}
General documentation