G::Seq
COMGA
G::Seq::COMGA - Perl extension for blah blah blah
|
| Globals (from use vars definitions) |
| @EXPORT |
| $VERSION |
| @EXPORT_OK |
use G::Seq::COMGA;
blah blah blah
|
Stub documentation for G::Seq::COMGA 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 |
| COMGA_correlation | No description | Code |
| COMGA_table_maker | No description | Code |
| DESTROY | No description | Code |
| new | No description | Code |
Methods description
Methods code
BEGIN
{ eval "use GD;";
if($@){ warn "$@" };
eval "use SVG;";
if($@){ warn "$@" };}
| COMGA_correlation | description | top | prev | next |
sub COMGA_correlation
{ &opt_default(output =>"STDOUT");
my @args = opt_get(@_);
my $number = 0;
my @gbks=();
my $output = opt_val("output");
if ($output eq "f"){
&opt_default(filename=>"COMGA_correlation.txt");
}if($output eq "show" || $output eq "g"){
&opt_default(filename=>"COMGA_correlation.svg");
}
my $filename =opt_val("filename");
my ($items, $itemt)=(0,0);
my @array=();
my @name=@{$args[0]};
for(my $items=1;$items<@args;$items++){
@{$array[$items-1]}=@{$args[$items]};
}
my @back=();
for(my $items=0;$items<@args-1;$items++){
for(my $itemt=0;$itemt<@args-1;$itemt++){
if($items !=$itemt){
my @dataA=@{$array[$items]};
my @dataB=@{$array[$itemt]};
my ($ganmaA, $ganmaB, $n, $sumA, $sumB, $sumsA, $sumsB)=(0,0,0,0,0,0,0);
my ($averageA, $averageB, $SA, $SB)=(0,0,0,0);
my @A=();
my @B=();
for(my $i=0;$i<@dataA;$i++){
$sumA += $dataA[$i];
$sumB += $dataB[$i];
}
$n=$##dataA+1;
my $averageA = $sumA / $n;
my $averageB = $sumB / $n;
for(my $i=0;$i<@dataA;$i++){
$A[$i]=($dataA[$i]-$averageA)*($dataA[$i]-$averageA);
$B[$i]=($dataB[$i]-$averageB)*($dataB[$i]-$averageB);
$sumsA += $A[$i];
$sumsB += $B[$i];
}
$SA=$sumsA/$n;
$SB=$sumsB/$n;
$ganmaA=sqrt($SA);
$ganmaB=sqrt($SB);
my ($childA, $childB, $motherA, $motherB, $value, $valuei)=(0,0,0,0,0,0);
for(my $i=0;$i<@dataA;$i++){
$childA = $dataA[$i] - $averageA;
$motherA = $childA / $ganmaA;
$childB = $dataB[$i] - $averageB;
$motherB = $childB / $ganmaB;
$valuei = $motherA * $motherB;
$value += $valuei;
}
$value = $value / $n;
$back[$items][$itemt]=$value;
}else{
$back[$items][$itemt]=1;
}
}
}
if($output eq "f"){
open (FILE,">$filename");
for(my $i=0;$i<@name;$i++){
print FILE "=====$name[$i]=====\n";
for(my $t=0;$t<@name;$t++){
if($i !=$t){
print FILE "<=>$name[$t]:$back[$i][$t]\n";
}
}
}
close FILE;
}elsif($output eq "STDOUT"){
for(my $i=0;$i<@name;$i++){
print "=====$name[$i]=====\n";
for(my $t=0;$t<@name;$t++){
if($i !=$t){
print "<=>$name[$t]:$back[$i][$t]\n";
}
}
}
}elsif($output eq "show" || $output eq "g"){
COMGA_table_maker(\@name,\@ back, -filename=>"$filename",
-title=>"Correlation_Table", -version=>"2");
}
return @back;}
sub COMGA_table_maker
{ &opt_default(filename=>"COMGA_table.svg",application=>"gimv",
title=>"COMGA_Table",version=>"2");
my @args = opt_get(@_);
my $number = 0;
my @gbks=();
my @name = @{$args[0]};
my @back = @{$args[1]};
my $title=opt_val("title");
my $application = opt_val("application");
my $version = opt_val("version");
if ($version eq "1"){
&opt_default(filename=>"COMGA_table.png");
}
my $filename =opt_val("filename");
my $items=0;
my $itemt=0;
my @array=();
my @name=@{$args[0]};
for(my $items=1;$items<@args;$items++){
@{$array[$items-1]}=@{$args[$items]};
}
mkdir ("graph", 0777);
if($version eq "1"){
my $max=70;
my $width=20;
my $length=0;
my $height=30;
for(my $i=0;$i<=@name;$i++){
$length=length($name[$i])*7;
if ($max<$length){
$max=$length;
}
$width += $max;
$height += 20;
}
$width = $width+20;
$height= $height+30;
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);
my $yellow = $im->colorAllocate(255,255,0);
my $green = $im->colorAllocate(0,150,0);
my $blue = $im->colorAllocate(0,0,255);
my $aqua = $im->colorAllocate(120,160,255);
my $peachpuff = $im->colorAllocate(255,218,185);
my @x=(20);
my @y=(30);
my $pixx=20;
my $pixy=30;
$im -> string(gdLargeFont,5,5,$title,$black);
$im -> string(gdSmallFont, $width - 110, $height-15,"G-language Project", $black);
for(my $i=0;$i<=@name;$i++){
$x[$i]=$pixx+$max*$i;
$y[$i]=$pixy+20*$i;
}
$im->line($x[0],$y[1],$width-20,$y[1],$blue);
$im->line($x[1],$y[0],$x[1],$height-30,$blue);
$im->line($x[0],$y[0],$width-20,$height-30,$green);
for(my $i=2;$i<=@name;$i++){
$im->line($x[$i],$y[0],$x[$i],$height-30,$gray);
$im->line($x[0],$y[$i],$width-20,$y[$i],$gray);
}
$im->rectangle(20,30,$width-20,$height-30,$black);
for(my $i=0;$i<@name;$i++){
$im->string(gdSmallFont,$x[$i+1]+3,$y[0]+3,$name[$i],$black);
$im->string(gdSmallFont,$x[0]+3,$y[$i+1]+3,$name[$i],$black);
}
for(my $i=0;$i<@name;$i++){
for(my $t=0;$t<@name;$t++){
if($i != $t){
my $datai = sprintf("%.3f",$back[$i][$t]);
$im->string(gdLargeFont,$x[$i+1]+3,$y[$t+1]+3,$datai,$black);
}
}
}
open (OUT, ">graph/$filename");
binmode OUT;
print OUT $im->png;
close(OUT);
msg_gimv("graph/".opt_val("filename"));
}elsif($version eq "2"){
mkdir ("graph", 0777);
my $max=80;
my $width=30;
my $length=0;
my $height=45;
for(my $i=0;$i<=@name;$i++){
$length=length($name[$i])*7;
if ($max<$length){
$max=$length;
}
$width += $max;
$height += 30;
}
$width = $width+30;
$height= $height+45;
my $svg = SVG->new(width=>$width, height=>$height,
onload=>"init(evt)");
my @x=(30);
my @y=(45);
my $pixx=30;
my $pixy=45;
$svg->text(
id=>"title",
x=>40,y=>30, fill=>"navy",
stroke=>"ligntslategrey",
"stroke-width"=>1,
'font-size'=>16
)->cdata("$title");
my $gp1=$svg->group(id=>"group1");
my $last =$width-180;
for(my $i=0;$i<=@name;$i++){
$x[$i]=$pixx+$max*$i;
$y[$i]=$pixy+30*$i;
}
my $glang = $gp1->anchor(-href=>"http://www.g-language.org",
-target=>"_blank")
->text(
id=>"glang",
x=>$last,y=>$height-20,
stroke=>"lightsteelblue",fill=>"navy",
'font-size'=>14,
)->cdata("G-language Project");
$glang->animate(
attributeName=>"x",
begin=>"2s",from=>"-200",to=>"$last",dur=>"4s");
$svg->rect(id=>"around",
x=>30,y=>45,
width=>$width-60,height=>$height-90,
style=>{
fill=>"none",
stroke=>"black",
"stroke-width"=>3
});
$svg->rect(id=>"labelcolor",
x=>30,y=>75,width=>$max,height=>30*$##name+30,
style=>{
fill=>"mediumturquoise",
"fill-opacity"=>0.2
});
$svg->rect(id=>"labelcolor",
x=>30+$max,y=>45,width=>$max*$##args,height=>30,
style=>{
fill=>"mediumturquoise",
"fill-opacity"=>0.2
});
$svg->rect(id=>"labelcolor",
x=>30+$max,y=>75,width=>$max*$##args,height=>30*$#args+30,
style=>{
fill=>"mintcream",
"fill-opacity"=>0.8
});
$svg->line(id=>"line",
x1=>$x[0],y1=>$y[1],x2=>$width-30,y2=>$y[1],
style=>{
stroke=>"blue",
"stroke-width"=>3});
$svg->line(id=>"line",
x1=>$x[1],y1=>$y[0],x2=>$x[1],y2=>$height-45,
style=>{
stroke=>"blue",
"stroke-width"=>3
});
$svg->line(id=>"line",
x1=>$x[0],y1=>$y[0],x2=>$width-30,y2=>$height-45,
style=>{
stroke=>"greenyellow"});
for(my $i=2;$i<=@name;$i++){
$svg->line(id=>"line",
x1=>$x[$i],y1=>$y[0],x2=>$x[$i],y2=>$height-45,
style=>{
stroke=>"black",
"stroke-width"=>2
});
$svg->line(id=>"line",
x1=>$x[0],y1=>$y[$i],x2=>$width-30,y2=>$y[$i],
style=>{
stroke=>"black",
"stroke-width"=>2
});
}
for(my $i=0;$i<@name;$i++){
$svg->text(
id=>"label",
x=>$x[$i+1]+6,y=>$y[0]+20,
stroke=>"black",fill=>"black",
'font-size'=>12,
)->cdata("$name[$i]");
$svg->text(
id=>"label",
x=>$x[0]+6,y=>$y[$i+1]+20,
stroke=>"black",fill=>"black",
'font-size'=>12,
)->cdata("$name[$i]");
}
for(my $i=0;$i<@name;$i++){
for(my $t=0;$t<@name;$t++){
if($i != $t){
my $datai = sprintf("%.3f",$back[$i][$t]);
$svg->text(
id=>"label",
x=>$x[$i+1]+6,y=>$y[$t+1]+20,
fill=>"black",stroke=>"black",
'font-size'=>14,
)->cdata("$datai");
}
}
}
open(OUT, ">graph/$filename") || msg_error($!);
print OUT $svg->xmlify;
close(OUT);
msg_gimv("graph/$filename");
return 1;
}}
sub DESTROY
{ my $self = shift;
}
sub new
{ my $pkg = shift;
my $filename = shift;
my $option = shift;
my $this;
return $this;}
General documentation