G::Seq

Usage

Methods description

Methods code

    my $gb = shift;
    my $type = shift;
    my $filename = shift;

    return if($gb->{"label$type"});

    if($filename){
	open(FILE,">>$filename");
	print FILE "\n\nID,";
	foreach(sort keys %{$gb->{All}->{$type}}){
	    print FILE "$_,";
	}
	print FILE ",total,key richness,\n,";

	foreach(sort keys %{$gb->{All}->{$type}}){
	    printf FILE ("%s,", substr($_, 0, 1)) if(length($_) == 4);
	}
	print FILE "\n,";
	foreach(sort keys %{$gb->{All}->{$type}}){
	    printf FILE ("%s,", substr($_, 1, 3)) if(length($_) == 4);
	}
	print FILE "\n";
	
	close(FILE);
    }

    else{
	msg_send("\n\nID:\t");
	foreach(sort keys %{$gb->{All}->{$type}}){
	    msg_send("$_\t");
	}
	msg_send("| total\t# key richness");
    }

    $gb->{"label$type"} = 1;

    my $gb = shift;
    my $id = shift;
    my $type = shift;
    my $ref = shift;
    my $filename = shift;
    my $nkey;
    my $total;

    if($filename){
	open(FILE,">>$filename");
	if($id){ printf FILE "\n$id,"; }
	else{ print FILE "\nAll genes,"; }
	foreach(sort keys %{$gb->{All}->{$type}}){
	    $nkey ++ if($ref->{$_});
	    $total += $ref->{$_};
	    printf FILE (int($ref->{$_}) - $ref->{$_}) ? "%.3f," : "%d,", $ref->{$_};
	}
	print FILE ",$total,$nkey";
	close(FILE);
    }
    
    else{
	if($id){ $id =~ s/FEATURE|CDS//; msg_send("\n\n$id:\t"); }
	else{ msg_send("\n\nAll:\t"); }
	foreach(sort keys %{$gb->{All}->{$type}}){
	    $nkey ++ if($ref->{$_});
	    $total += $ref->{$_};
	    $ref->{$_} =  sprintf((int($ref->{$_}) - $ref->{$_}) ? "%.3f" : "%d", $ref->{$_});
	    msg_send("$ref->{$_}\t"); 
##printf((int($ref->{$_}) - $ref->{$_}) ? "%.3f\t" : "%d\t", $ref->{$_});
	}
	msg_send("| $total\t# $nkey");
    }

    &opt_default(output=>'stdout', filename=>'usage.csv', 
		 id=>'', type=>'C2', delkey=>'[\^\/BJOUXZbdefhijklmnopqrsuvwxyz]');
    my @args = opt_get(@_);
    my $gb = opt_as_gb(shift @args);
    my $output = opt_val("output");
    my $filename = opt_val("filename");
    my $id = opt_val("id");
    my $type = opt_val("type");
    my $delkey = opt_val("delkey");
        
    my $seq;
    my @tmp;
    my $i;
    my $amino;
    my $codon;
    my %count;
    
    if($id =~ /CDS|FEATURE/){ ## for a single gene
	$seq = $gb->get_geneseq($id);
	my $num = $gb->{$id}->{feature};
	@tmp = split(//, $gb->{"FEATURE$num"}->{translation});
	$i = $gb->{"FEATURE$num"}->{codon_start} - 1;
	for(; $i < length($seq); $i += 3){
	    $amino = shift @tmp;
	    $amino = '^' if($i == 0);      ## start codon
	    $amino = '/' if($amino eq ''); ## stop codon
	    $count{$amino} ++ if($type =~ /A/ && $amino !~ /[\^\/]/);
	    next if($type !~ /C/);
	    $codon = substr($seq, $i, 3);
	    $count{$amino.$codon}++;
	}
    }
    else{ ## for a group of genes ('All')
	foreach my $cds ($gb->cds()){
	    next if($gb->{$cds}->{gene} eq "CT875");	    
	    ##next if(exists $gb->{$cds}->{partial});
	    next if($id ne 'All' && $gb->{$cds}->{$id} == 0);
	    $seq = $gb->get_geneseq($cds);
	    @tmp = split(//, $gb->{$cds}->{translation});
	    $i = $gb->{$cds}->{codon_start} - 1;
	    for(; $i < length($seq); $i += 3){
		$amino = shift @tmp;
		$amino = '^' if($i == 0);      ## start codon
		$amino = '/' if($amino eq ''); ## stop codon
		$count{$amino} ++ if($type =~ /A/ && $amino !~ /[\^\/]/);
		next if($type !~ /C/);
		$codon = substr($seq, $i, 3);
		$count{$amino.$codon}++; 
	    }
	}
    }

    ### count to frequency (normalization of aa codon usage)
    my %usage; ## aa codon usage
    my $tnc;   ## total number of codons
    my $tna;   ## total number of aa
    my %sum;   ## ex. $sum{'F'} indicates number of aa 'F'
    my %box;   ## codon box number

    foreach (keys %count){
	delete $count{$_} if($delkey && $_ =~ /$delkey/); #####################
	if(length($_) == 1){ ## ex. $_ = 'F'
	   $tna += $count{$_};
	}
	if(length($_) == 4){ ## ex. $_ = 'Fuuc'
	    $sum{substr($_, 0, 1)} += $count{$_};
	    $tnc += $count{$_};
	}
    }

    if($type =~ /A0/ && $type =~ /C0/){ %usage = %count; }
    else{
	foreach (keys %count){
	    if(length($_) == 1){
		if($type =~ /A0/){ $usage{$_} = $count{$_}; }
		if($type =~ /A1/){ $usage{$_} = $count{$_} / $tna; }
	    }
	    if(length($_) == 4){
		if($type =~ /C0/){ $usage{$_} = $count{$_}; }
		if($type =~ /C1/){ $usage{$_} = $count{$_} / $tnc; }
		if($type =~ /C2|C3/){ $usage{$_} = $count{$_} / $sum{substr($_, 0, 1)}; }
	    }
	}
	if($type =~ /C3/){
	    if($id eq 'All'){ 
		$gb->{All}->{$type} = \%count;
	    }else{
		&aa_codon_compiler($gb, -output=>'n', -filename=>$filename, 
				   -id=>'All', -type=>$type, -delkey=>$delkey) unless($gb->{All}->{$type});
	    }
	    foreach (keys %{$gb->{All}->{$type}}){
		$box{substr($_, 0, 1)} ++  if(length($_) == 4);
	    }
	    foreach (keys %usage){ $usage{$_} *= $box{substr($_, 0, 1)} if(length($_) == 4); }
	}
    }

    $gb->{$id}->{$type} =\% usage;
    &aa_codon_compiler($gb, -output=>'n', -filename=>$filename, 
		       -id=>'All', -type=>$type, -delkey=>$delkey) unless($gb->{All}->{$type});
    
    if($output eq "f"){
	_key_printer($gb, $type, $filename);
	_value_printer($gb, $id, $type,\% usage, $filename);
    }
    if($output !~ /[fn]/){
	_key_printer($gb, $type);
	_value_printer($gb, $id, $type,\% usage);
    }

    return\% usage;
}


## aa_codon_usage ver.20010329-01
## scripting by Haruo Suzuki (haruo@g-language.org)
## This program characterizes various types of amino acid and codon usage in ORF.
## Options::
##  -output   output option (default: stdout)
##  -filename output filename (default: 'usage.csv')
##  -id       ID of a group of genes or a single gene (default:'')
##  -type     normalization type (default:'C2')
##  -delkey   regular expression to delete keys of aa and codon from the analysis
##            (default:'[\^\/BJOUXZbdefhijklmnopqrsuvwxyz]',
##             where '^' and '/' indicates start and stop codons, respectively)
## Usage: (reference HASH) = &aa_codon_usage(pointer G instance);

sub aa_codon_usage{
    &opt_default(output=>'stdout', filename=>'usage.csv', 
		 id=>'', type=>'C2', delkey=>'[\^\/BJOUXZbdefhijklmnopqrsuvwxyz]');
    my @args = opt_get(@_);
    my $gb = opt_as_gb(shift @args);
    my $output = opt_val("output");
    my $filename = opt_val("filename");
    my $id = opt_val("id");
    my $type = opt_val("type");
    my $delkey = opt_val("delkey");
    my $usage;

    if($id){
	$usage = &aa_codon_compiler($gb, -output=>$output, -filename=>$filename, 
			   -id=>$id, -type=>$type, -delkey=>$delkey);
    }
    else{
	foreach my $cds ($gb->cds()){
	    $usage = &aa_codon_compiler($gb, -output=>$output, -filename=>$filename, 
			       -id=>$cds, -type=>$type, -delkey=>$delkey);
	}
    }
    return $usage;
}


## rscu ver.20010329-01
## scripting by Haruo Suzuki (haruo@g-language.org)
## This program calculates relative synonymous codon usage (RSCU) in ORF.
## Options:
##  -output   output option (default: stdout)
##  -filename output filename (default: 'usage.csv')
##  -id       ID of a group of genes or a single gene (default:'')
##  -delkey   regular expression to delete keys of aa and codon from the analysis
##            (default:'[\^\/BJOUXZbdefhijklmnopqrsuvwxyz]',
##             where '^' and '/' indicates start and stop codons, respectively)
## Usage: (reference HASH) = &rscu(pointer G instance);

sub rscu{
    &opt_default(output=>'stdout', filename=>'usage.csv', 
		 id=>'', delkey=>'[\^\/BJOUXZbdefhijklmnopqrsuvwxyz]');
    my @args = opt_get(@_);
    my $gb = opt_as_gb(shift @args);
    my $output = opt_val("output");
    my $filename = opt_val("filename");
    my $id = opt_val("id");
    my $delkey = opt_val("delkey");

    &aa_codon_compiler($gb, -output=>$output, -filename=>$filename, 
		       -id=>$id, -type=>'C3', -delkey=>$delkey);
}


## usage_dist ver.20020630
## Author: Haruo Suzuki
## Usage: (scalar) = &usage_dist(pointer G instance);
## Options:
##  -type     normalization type of aa_codon_usage data (default:'C2')
##  -metric   r, euclidean, manhattan, KARLIN (default:'manhattan') 
##  -id       ID of one group of genes or a single gene (default:'')
##  -id2      ID of a second group of genes (default:'')
##  -usage2   aa_codon_usage of a second group of genes (default:'')
## Description:
##  Measures distance (aa_codon_usage difference), and inputs in the G instance.
##  i.e. Distance will be accessible at $gb->{"$type:$metric($id|$id2)"}
## References:
##  Karlin and Mrazek (2000) J. Bacteriol. 182:18,p5238-5250
## Requirements:
##   aa_codon_compiler();

sub usage_dist {
    &opt_default(type=>'C2', metric=>'manhattan', id=>'', id2=>'', usage2=>'');
    my @args = opt_get(@_);
    my $gb = opt_as_gb(shift @args);
    my $type = opt_val("type");
    my $metric = opt_val("metric");
    my $id = opt_val("id");
    my $id2 = opt_val("id2");
    my $usage1;
    my $usage2 = opt_val("usage2");
    my %key;
    my $dist;
    
    unless($usage2){
	unless($id2){
	    $id2 = 'RP';
	    unless($gb->{RP}->{$type}){
		foreach($gb->cds()){
		    $gb->{$_}->{RP} = ( ($gb->{$_}->{product} =~ /ribosomal.+protein/i && 
					 $gb->{$_}->{product} !~ /putative|ase|[cl]ation/i) ? 1 : 0 );
		}
	    }
	}
	$usage2 = ($gb->{$id2}->{$type}) ? 
	    $gb->{$id2}->{$type} : &aa_codon_compiler($gb, -id=>$id2, -type=>$type, -output=>'n');
    }
    
    $type = "A1C2" if($metric eq 'KARLIN');
    $id = 'All' unless($id);
    $usage1 = ($gb->{$id}->{$type}) ? 
	$gb->{$id}->{$type} : &aa_codon_compiler($gb, -id=>$id, -type=>$type, -output=>'n');
    
    foreach (keys %{$usage1}){ $key{$_} ++; }
    foreach (keys %{$usage2}){ $key{$_} ++; }

    if($metric eq 'r'){
	my ($N, $M1, $M2, $S11, $S22, $S12);
	foreach (keys %key){ $N ++; $M1 += $usage1->{$_}; }
	$M1 /= $N;
	foreach (keys %key){ $M2 += $usage2->{$_}; }
	$M2 /= $N;
	foreach (keys %key){ $S11 += ($usage1->{$_} - $M1)**2; }
	foreach (keys %key){ $S22 += ($usage2->{$_} - $M2)**2; }
	foreach (keys %key){ $S12 += ($usage1->{$_} - $M1) * ($usage2->{$_} - $M2); }
	$dist = $S12 / sqrt($S11 * $S22);
    }

    if($metric eq 'euclidean'){
	foreach (keys %key){
	    $dist += ($usage1->{$_} - $usage2->{$_})**2;
       	}
	$dist = sqrt($dist);
    }
    
    if($metric eq 'manhattan'){
	foreach (keys %key){
	    $dist += abs($usage1->{$_} - $usage2->{$_});
       	}
    }

    if($metric eq 'KARLIN'){
	my %eachaa;
	foreach (keys %key){ ## sigma|f(x,y,z) - g(x,y,z)| for each amino acid
	    $eachaa{substr($_, 0, 1)} += abs($usage1->{$_} - $usage2->{$_}) if(length($_) == 4);
	}
	foreach (keys %eachaa){ ## sigma{ Pa(F) * sigma|f(x,y,z) - g(x,y,z)| }
	    $dist += $usage1->{$_} * $eachaa{$_};
	}
    }

    $type = "C2" if($metric eq 'KARLIN');
    $gb->{"$type:$metric($id|$id2)"} = sprintf "%.4f", $dist;
}


## equitability ver.20020630
## Author: Haruo Suzuki
## Description:
##   Calculates the equitability of amino acid and codon usage
## Usage: (scalar or hash) = &equitability(pointer G instance);
## Options:
##   -usage  reference to a hash of amino acid and codon usage (default:"")
##   -id     ID of a group of genes or a single gene (default:"")
##   -type   type of usage (default:"C1")
##   -cei    1 when calculating the codon equitability index (default: 0)
## Requirements:
##   aa_codon_compiler();

sub equitability {
    &opt_default(id=>"", type=>"C1", usage=>"", cei=>'0');
    my @args = opt_get(@_);
    my $gb = opt_as_gb(shift @args);
    my $usage = opt_val("usage");
    my $id = opt_val("id");
    my $type = opt_val("type");
    my $cei = opt_val("cei");

    $type =~ s/[03]/1/g;
    $type = 'A1C2' if($cei);
    $usage = ($gb->{$id}->{$type}) ? 
	$gb->{$id}->{$type} : &aa_codon_compiler($gb, -id=>$id, -type=>$type, -output=>'n') unless($usage);
    
    if($type =~ /C2/){
	my $amino;
	my %box;   ## codon box number
	my %H;     ## shannon index for each amino acid
	my %E;     ## equitability for each amino acid
	
	foreach (keys %{$gb->{All}->{$type}}){
	    if(length($_) == 4){
		$amino = substr($_, 0, 1);
		$box{$amino} ++;
		next if($usage->{$_} == 0);
		$H{$amino} += - $usage->{$_} * log($usage->{$_}) / log(2);
	    }
	}
	foreach (sort keys %{$usage}){
	    if(length($_) == 4){
		$amino = substr($_, 0, 1);
		if($box{$amino} < 2){ $E{$amino} = 1; next; };
		$E{$amino} = $H{$amino} / (log($box{$amino})/log(2));
	    }
	}
	
	if($cei == 0){ return\% E; }
	else{
	    $cei = 0;
	    foreach (keys %E){ $cei += $usage->{$_} * $E{$_}; }
	    $gb->{$id}->{cei} = sprintf "%.4f", $cei;
	}
    }
    
    else {
	my ($S, $H, $E);
	foreach (keys %{$usage}){
	    $S ++;
	    $H += - $usage->{$_} * log($usage->{$_}) / log(2);
	}
	$E = sprintf "%.4f", $H / (log($S)/log(2));
    }
}


## cei ver.20020520
## Author: Haruo Suzuki
## Description:
##   Calculates the codon equitability index (CEI), and inputs in the G instance.
##   i.e. CEI values will be accessible at $gb->{"ID"}->{cei}
##   global variable $gb->{All}->{A0C0} is used.
## Usage: (scalar) = &cei(pointer G instance);
## Options:
##   -id        ID of a group of genes or a single gene (default:"")
## Requirements:
##   equitability();

sub cei {
    &opt_default(id=>"");
    my @args = opt_get(@_);
    my $gb = opt_as_gb(shift @args);
    my $id = opt_val("id");
    
    equitability($gb, -id=>$id, -cei=>'1');
}











sub _codon_table{
    &opt_default(output=>"show",filename=>"codon_table.png");
    my @args=opt_get(@_);
    
    my $result=shift @args;
    my $filename=opt_val("filename");
    my $output=opt_val("output");
    my $x;
    my $y;
    my %amino;
    my %data;
    my %per;
    my $amino_total;
    my $codon;
    my $amino;
    my $v;
    my $h;
    my %exception;
    my $CoDoN;
    my %color;

    my $im = new GD::Image(500,550);
    my $white = $im->colorAllocate(255,255,255);
    my $black = $im->colorAllocate(0,0,0);
    my $red = $im->colorAllocate(255,0,0);
    my $yellow = $im->colorAllocate(200,200,0);
    my $green = $im->colorAllocate(0,150,0);
    my $blue = $im->colorAllocate(0,0,255);

    $color{D}=$yellow;
    $color{E}=$yellow;
    $color{R}=$red;
    $color{K}=$red;
    $color{H}=$red;
    $color{N}=$blue;
    $color{Q}=$blue;
    $color{S}=$blue;
    $color{T}=$blue;
    $color{Y}=$blue;
    $color{A}=$green;
    $color{G}=$green;
    $color{V}=$green;
    $color{L}=$green;
    $color{I}=$green;
    $color{P}=$green;
    $color{F}=$green;
    $color{M}=$green;
    $color{W}=$green;
    $color{C}=$green;
    $color{'/'}=$black;

    foreach((10,50,450,490)){
	$x=$_;
	for($y=10;$y<450;$y++){
	    $im->setPixel($x,$y,$black);
	} 
    }
    foreach((150,250,350)){
	$x=$_;
	for($y=30;$y<450;$y++){
	    $im->setPixel($x,$y,$black);
	} 
    }
    $y=30;
    for($x=50;$x<450;$x++){
	$im->setPixel($x,$y,$black);
    }
    foreach((10,50,150,250,350,450)){
	$y=$_;
	for($x=10;$x<490;$x++){
	    $im->setPixel($x,$y,$black);
	} 
    }

    $im->string(gdSmallFont,15,25,"first",$red);
    $im->string(gdSmallFont,233,15,"second",$green);
    $im->string(gdSmallFont,455,25,"third",$blue);
    $im->string(gdSmallFont,30,95,"T",$red);
    $im->string(gdSmallFont,30,195,"C",$red);
    $im->string(gdSmallFont,30,295,"A",$red);
    $im->string(gdSmallFont,30,395,"G",$red);
    $im->string(gdSmallFont,100,35,"T",$green);
    $im->string(gdSmallFont,200,35,"C",$green);
    $im->string(gdSmallFont,300,35,"A",$green);
    $im->string(gdSmallFont,400,35,"G",$green);
    $im->string(gdSmallFont,470,65,"T",$blue);
    $im->string(gdSmallFont,470,85,"C",$blue);
    $im->string(gdSmallFont,470,105,"A",$blue);
    $im->string(gdSmallFont,470,125,"G",$blue);
    $im->string(gdSmallFont,470,165,"T",$blue);
    $im->string(gdSmallFont,470,185,"C",$blue);
    $im->string(gdSmallFont,470,205,"A",$blue);
    $im->string(gdSmallFont,470,225,"G",$blue);
    $im->string(gdSmallFont,470,265,"T",$blue);
    $im->string(gdSmallFont,470,285,"C",$blue);
    $im->string(gdSmallFont,470,305,"A",$blue);
    $im->string(gdSmallFont,470,325,"G",$blue);
    $im->string(gdSmallFont,470,365,"T",$blue);
    $im->string(gdSmallFont,470,385,"C",$blue);
    $im->string(gdSmallFont,470,405,"A",$blue);
    $im->string(gdSmallFont,470,425,"G",$blue);

    foreach $amino (keys(%{$result})){
	$amino_total=0;
	foreach $codon (keys(%{$$result{$amino}})){
	    $amino_total+=$$result{$amino}{$codon};
	}
	foreach $codon (keys(%{$$result{$amino}})){
	    if($$result{$amino}{$codon} > $data{$codon}){
		if($data{$codon}!=""){
		    $exception{$codon}{amino}=$amino{$codon};
		    $exception{$codon}{per}=$per{$codon};
		}
		$data{$codon}=$$result{$amino}{$codon};
		$amino{$codon}=$amino;
		$per{$codon}=sprintf("%.3f",$$result{$amino}{$codon}/$amino_total);
	    }
	    else{
		$exception{$codon}{amino}=$amino;
		$exception{$codon}{per}=sprintf("%.3f",$$result{$amino}{$codon}/$amino_total);
	    }
	}
    }

    $im->string(gdSmallFont,60,65,"TTT  $amino{ttt}  $per{ttt}",$color{$amino{ttt}});
    $im->string(gdSmallFont,60,85,"TTC  $amino{ttc}  $per{ttc}",$color{$amino{ttc}});
    $im->string(gdSmallFont,60,105,"TTA  $amino{tta}  $per{tta}",$color{$amino{tta}});
    $im->string(gdSmallFont,60,125,"TTG  $amino{ttg}  $per{ttg}",$color{$amino{ttg}});
    $im->string(gdSmallFont,60,165,"CTT  $amino{ctt}  $per{ctt}",$color{$amino{ctt}});
    $im->string(gdSmallFont,60,185,"CTC  $amino{ctc}  $per{ctc}",$color{$amino{ctc}});
    $im->string(gdSmallFont,60,205,"CTA  $amino{cta}  $per{cta}",$color{$amino{cta}});
    $im->string(gdSmallFont,60,225,"CTG  $amino{ctg}  $per{ctg}",$color{$amino{ctg}});
    $im->string(gdSmallFont,60,265,"ATT  $amino{att}  $per{att}",$color{$amino{att}});
    $im->string(gdSmallFont,60,285,"ATC  $amino{atc}  $per{atc}",$color{$amino{atc}});
    $im->string(gdSmallFont,60,305,"ATA  $amino{ata}  $per{ata}",$color{$amino{ata}});
    $im->string(gdSmallFont,60,325,"ATG  $amino{atg}  $per{atg}",$color{$amino{atg}});
    $im->string(gdSmallFont,60,365,"GTT  $amino{gtt}  $per{gtt}",$color{$amino{gtt}});
    $im->string(gdSmallFont,60,385,"GTC  $amino{gtc}  $per{gtc}",$color{$amino{gtc}});
    $im->string(gdSmallFont,60,405,"GTA  $amino{gta}  $per{gta}",$color{$amino{gta}});
    $im->string(gdSmallFont,60,425,"GTG  $amino{gtg}  $per{gtg}",$color{$amino{gtg}});

    $im->string(gdSmallFont,160,65,"TCT  $amino{tct}  $per{tct}",$color{$amino{tct}});
    $im->string(gdSmallFont,160,85,"TCC  $amino{tcc}  $per{tcc}",$color{$amino{tcc}});
    $im->string(gdSmallFont,160,105,"TCA  $amino{tca}  $per{tca}",$color{$amino{tca}});
    $im->string(gdSmallFont,160,125,"TCG  $amino{tcg}  $per{tcg}",$color{$amino{tcg}});
    $im->string(gdSmallFont,160,165,"CCT  $amino{cct}  $per{cct}",$color{$amino{cct}});
    $im->string(gdSmallFont,160,185,"CCC  $amino{ccc}  $per{ccc}",$color{$amino{ccc}});
    $im->string(gdSmallFont,160,205,"CCA  $amino{cca}  $per{cca}",$color{$amino{cca}});
    $im->string(gdSmallFont,160,225,"CCG  $amino{ccg}  $per{ccg}",$color{$amino{ccg}});
    $im->string(gdSmallFont,160,265,"ACT  $amino{act}  $per{act}",$color{$amino{act}});
    $im->string(gdSmallFont,160,285,"ACC  $amino{acc}  $per{acc}",$color{$amino{acc}});
    $im->string(gdSmallFont,160,305,"ACA  $amino{aca}  $per{aca}",$color{$amino{aca}});
    $im->string(gdSmallFont,160,325,"ACG  $amino{acg}  $per{acg}",$color{$amino{acg}});
    $im->string(gdSmallFont,160,365,"GCT  $amino{gct}  $per{gct}",$color{$amino{gct}});
    $im->string(gdSmallFont,160,385,"GCC  $amino{gcc}  $per{gcc}",$color{$amino{gcc}});
    $im->string(gdSmallFont,160,405,"GCA  $amino{gca}  $per{gca}",$color{$amino{gca}});
    $im->string(gdSmallFont,160,425,"GCG  $amino{gcg}  $per{gcg}",$color{$amino{gcg}});

    $im->string(gdSmallFont,260,65,"TAT  $amino{tat}  $per{tat}",$color{$amino{tat}});
    $im->string(gdSmallFont,260,85,"TAC  $amino{tac}  $per{tac}",$color{$amino{tac}});
    $im->string(gdSmallFont,260,105,"TAA  $amino{taa}  $per{taa}",$color{$amino{taa}});
    $im->string(gdSmallFont,260,125,"TAG  $amino{tag}  $per{tag}",$color{$amino{tag}});
    $im->string(gdSmallFont,260,165,"CAT  $amino{cat}  $per{cat}",$color{$amino{cat}});
    $im->string(gdSmallFont,260,185,"CAC  $amino{cac}  $per{cac}",$color{$amino{cac}});
    $im->string(gdSmallFont,260,205,"CAA  $amino{caa}  $per{caa}",$color{$amino{caa}});
    $im->string(gdSmallFont,260,225,"CAG  $amino{cag}  $per{cag}",$color{$amino{cag}});
    $im->string(gdSmallFont,260,265,"AAT  $amino{aat}  $per{aat}",$color{$amino{aat}});
    $im->string(gdSmallFont,260,285,"AAC  $amino{aac}  $per{aac}",$color{$amino{aac}});
    $im->string(gdSmallFont,260,305,"AAA  $amino{aaa}  $per{aaa}",$color{$amino{aaa}});
    $im->string(gdSmallFont,260,325,"AAG  $amino{aag}  $per{aag}",$color{$amino{aag}});
    $im->string(gdSmallFont,260,365,"GAT  $amino{gat}  $per{gat}",$color{$amino{gat}});
    $im->string(gdSmallFont,260,385,"GAC  $amino{gac}  $per{gac}",$color{$amino{gac}});
    $im->string(gdSmallFont,260,405,"GAA  $amino{gaa}  $per{gaa}",$color{$amino{gaa}});
    $im->string(gdSmallFont,260,425,"GAG  $amino{gag}  $per{gag}",$color{$amino{gag}});

    $im->string(gdSmallFont,360,65,"TGT  $amino{tgt}  $per{tgt}",$color{$amino{tgt}});
    $im->string(gdSmallFont,360,85,"TGC  $amino{tgc}  $per{tgc}",$color{$amino{tgc}});
    $im->string(gdSmallFont,360,105,"TGA  $amino{tga}  $per{tga}",$color{$amino{tga}});
    $im->string(gdSmallFont,360,125,"TGG  $amino{tgg}  $per{tgg}",$color{$amino{tgg}});
    $im->string(gdSmallFont,360,165,"CGT  $amino{cgt}  $per{cgt}",$color{$amino{cgt}});
    $im->string(gdSmallFont,360,185,"CGC  $amino{cgc}  $per{cgc}",$color{$amino{cgc}});
    $im->string(gdSmallFont,360,205,"CGA  $amino{cga}  $per{cga}",$color{$amino{cga}});
    $im->string(gdSmallFont,360,225,"CGG  $amino{cgg}  $per{cgg}",$color{$amino{cgg}});
    $im->string(gdSmallFont,360,265,"AGT  $amino{agt}  $per{agt}",$color{$amino{agt}});
    $im->string(gdSmallFont,360,285,"AGC  $amino{agc}  $per{agc}",$color{$amino{agc}});
    $im->string(gdSmallFont,360,305,"AGA  $amino{aga}  $per{aga}",$color{$amino{aga}});
    $im->string(gdSmallFont,360,325,"AGG  $amino{agg}  $per{agg}",$color{$amino{agg}});
    $im->string(gdSmallFont,360,365,"GGT  $amino{ggt}  $per{ggt}",$color{$amino{ggt}});
    $im->string(gdSmallFont,360,385,"GGC  $amino{ggc}  $per{ggc}",$color{$amino{ggc}});
    $im->string(gdSmallFont,360,405,"GGA  $amino{gga}  $per{gga}",$color{$amino{gga}});
    $im->string(gdSmallFont,360,425,"GGG  $amino{ggg}  $per{ggg}",$color{$amino{ggg}});

    $im->string(gdSmallFont,15,465,"yellow  minus charge",$yellow);
    $im->string(gdSmallFont,165,465,"red  plus charge",$red);
    $im->string(gdSmallFont,285,465,"blue  noncharge",$blue);
    $im->string(gdSmallFont,400,465,"green  nonpolar",$green);

    $im->string(gdSmallFont,20,485,"exception",$black);
    $v=485;
    $h=100;
    foreach(sort keys(%exception)){
	$color{$exception{$_}{amino}}=$black if($color{$exception{$_}{amino}}=="");	
	$CoDoN=uc $_;
	$im->string(gdSmallFont,$h,$v,"$CoDoN  $exception{$_}{amino}  $exception{$_}{per}",$color{$exception{$_}{amino}});
	$v+=20;
	if($v == 545){
	    $v=485;
	    $h+=100;
	}
    }

    mkdir ("graph",0777);
    open(OUT,'>graph/'."$filename");
    binmode OUT;
    print OUT $im->png;
    close(OUT);
    
    msg_gimv("graph/$filename") if($output eq "show");
}




sub DESTROY {
    my $self = shift;
}

1;
__END__
## Below is the stub of documentation for your module. You better edit it!

=head1 NAME

G::Seq::Codon - Perl extension for blah blah blah

=head1 SYNOPSIS

  use G::Seq::Codon;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for G::Seq::Codon was created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.

Blah blah blah.

=head1 AUTHOR

A. U. Thor, a.u.thor@a.galaxy.far.far.away

=head1 SEE ALSO

perl(1).

=cut

    my $pkg = shift;
    my $filename = shift;
    my $option = shift;
    my $this;

    return $this;

General documentation