#!/usr/bin/perl -w 
use Getopt::Std;
#use Statistics::Distributions::GTest;
use vars qw($VERSION $DESC $opt_h $opt_f);
$VERSION = 0.3;
$DESC    = "Generates the taxonomic heatmap browser in HTML,  or input to iTol, for Ardell and Hou (2015).";
$NAME    = $0;
$NAME    =~ s/^.*\///;

# Execute: compute_heatmap.pl tCE-Nov5-2014.3.fas > CCA-HEATMAP-TAX-BROWSER/Ardell_Hou_2015.html
# Execute: compute_heatmap.pl -I tCE-Nov5-2014.3.fas 

# inputfile: tCE-Nov5-2014.3.fas. This file is a research product of Ardell and Hou (2015) derived from tRNAdb-CE v 0.8
# inputfile: prokaryotes_NCBI_102615.txt This file from NCBI Genome Reports downloaded Oct. 26, (2015) provides genome size data
# inputfile: addresses_v4.txt.gz This file is custom generated, recoding NCBI taxonomy using IP-address-like hex codes. v4 includes NCBI Tax IDs for iTol. 
#            This v4 input file was generated from 
#            fastaxsort_index_wTaxID --index -S "\|" -f 3 NCBI_tax_Nov_13_2014/nodes.dmp NCBI_tax_Nov_13_2014/names.dmp tCE-Nov5-2014.p1.fas > tax_address_index_w_taxID.txt &

$genome_report_file = "prokaryotes_NCBI_102615.txt";
open (GENOME,$genome_report_file) or die "Cannot open input file \"prokaryotes_NCBI_102615.txt\"\n";
while (<GENOME>) {
  next if (/^#/);
  chomp;
  my @data = split /\t/,$_;
  my ($species, $gsize, $accession) = @data[0,6,9];
  $accession =~ s/\.\d+//; # remove version in accession.version format for matching against tCE
  $genome_size{$species} = $gsize;
  $genome_size{$accession} = $gsize;
}
close GENOME;

#input: tCE-Nov5-2014.3.fas.
#>C131005043 CP003659|Cyanobacteria|Anabaena cylindrica PCC 7122|1735539|1735615|Ile|GAT|0|0||||||DDBJ/ENA/GenBank taxaddress:00.04.00.00.00.00.00.00.03 STEML:GGGCTAT STEMRS:ATGGCCC ID:A CCA:CCT LEN:7 SCORE:35 pos8,9:TA W:cc
#ggttcattaaGGGCTATTAGCTCAGGTGGTTAGAGCGCACCCCTGATAAGGGTGAGGTCC
#CTGGTTCGAGTCCAGGATGGCCCACCTgaagataatt
#>C131005044 CP003659|Cyanobacteria|Anabaena cylindrica PCC 7122|1735698|1735771|Ala|TGC|0|0||||||DDBJ/ENA/GenBank taxaddress:00.04.00.00.00.00.00.00.03 STEML:GGGGGTT STEMRS:AACCTCC ID:A CCA:Cat LEN:7 SCORE:35 pos8,9:TA
#attattggatGGGGGTTTAGCTCAGTTGGTAGAGCGCCTGCTTTGCAAGCAGGATGTCAG
#CGGTTCGAGTCCGCTAACCTCCACattggaaaagag
#>C131005045 CP003659|Cyanobacteria|Anabaena cylindrica PCC 7122|1859062|1859135|Pro|GGG|0|0||||||DDBJ/ENA/GenBank taxaddress:00.04.00.00.00.00.00.00.03 STEML:CGGGGCG STEMRS:CGCTCCG ID:A CCA:ttt LEN:7 SCORE:35 pos8,9:TA
#gttaagtaacCGGGGCGTAGCGCAGCTTGGTAGCGCGCCACTTTGGGGTAGTGGAGGTCG
#TGGGTTCGAATCCCGCCGCTCCGAtttttaaatgtga
#>C131005046 CP003659|Cyanobacteria|Anabaena cylindrica PCC 7122|2293644|2293716|Arg|CCG|0|0||||||DDBJ/ENA/GenBank taxaddress:00.04.00.00.00.00.00.00.03 STEML:GGGCGCG STEMRS:CGCGCTC ID:G CCA:ttt LEN:7 SCORE:35 pos8,9:TG W:pos89nTA


##Organism/Name	TaxID	BioProject Accession	BioProject ID	Group	SubGroup	Size (Mb)	GC%	Chromosomes/RefSeq	Chromosomes/INSDC	Plasmids/RefSeq	Plasmids/INSDC	WGS	Scaffolds	Genes	Proteins	Release Date	Modify Date	Status	Center	BioSample Accession	Assembly Accession	Reference	FTP Path	Pubmed ID
# Salmonella enterica subsp. enterica serovar Saintpaul str. SARA29	439847	PRJNA19463	19463	Proteobacteria	Gammaproteobacteria	4.92896	52.2	-	-	-	-	ABAN01	182	4774	4538	2007/05/10	2015/08/18	Contig	TIGR	SAMN02415272	GCA_000170235.1	-	Salmonella_enterica/GCF_000170235	21602358
# Salmonella enterica subsp. enterica serovar 4,[5],12:i:- str. CVM23701	440534	PRJNA19465	19465	Proteobacteria	Gammaproteobacteria	4.89592	52.3	-	-	-	-	ABAO01	113	4762	4598	2007/05/10	2015/08/18	Contig	TIGR	SAMN02415273	GCA_000170255.1	-	Salmonella_enterica/GCF_000170255	21602358


# Command-line options:
&getopts('hI');

$opt_I and do {
  print STDERR "-I mode: Generating input for iTol figure\n"; 
};

@laa = qw/Ala Arg Asn Asp Cys Gln Glu Gly His Ile xIle Leu Lys Met Phe Pro Pseudo Pyl SeC SeC(p) Ser Stop Thr Trp Tyr Val Ini seC Undet Sup/;
@saa = split //,"ARNDCQEGHIJLKMFP\$OZZS*TWYVXZ?*";

#now reordered from most to least in all 
@dlaa =  qw/Ini Asp Asn Ile Gly Val His Tyr Ala Trp Ser Lys Phe Gln Cys Pro Met Thr Arg Glu xIle Leu SeC Pyl Pseudo Stop/; 

for (0..$#laa) {
  $saa{$laa[$_]} = $saa[$_]; 
}

%warncodes = qw/W:CCApredicted A W:cca B W:cc C W:shortLength D W:pos89nTA E W:tCE_5prime_error F W:tCE_3prime_error G/; 


# view on dynamic programming prediction in model_cca: <stemr><id-base><cca><trailer>

# W:CCApredicted (A)  if <cca> eq "CCA", ie correctly annotated in tCE
# W:cca (B) if <cca> =~ /cca/i, so all A should also be B, and all tCE-FN-CCA (our predicted <cca> ne "CCA") should be "B not A"
# W:cc (C) if <cca> =~ /^cc/
# W:shortLength (D) if predicted FPE of Acceptor stem is < 7
# W:pos89nTA (E) if the tCE-annoted 8th and 9th bases are not "T" and "A"
# W:tCE_5prime_error (F) if the reannotated/predicted FPE of the AS contains lower-case characrers
# W:tCE_3prime_error (G) if the reannotated/predicted TPE of the AS contains lower-case characrers

while (<>) {
  next unless (/\>/);
  chomp;
  my ($L,$R) = split /taxaddress:/,$_;
  $L =~ />(\S+)\s+(.+)$/;
  my $id = $1;
  my $TCE = $2;
  my ($genomeID,$phylum,$sp,$fp,$tp,$aa,$ac,@tce) = split /\|/,$TCE;
  my $saa = "";
  if ($tce[6] =~ /initiator/) {
    $saa = $saa{"Ini"};
  }
  elsif ($tce[6] =~ /Met\(Ile\)/) {
    $saa = $saa{"xIle"};
  }
  elsif (exists $saa{$aa}) {
    $saa = $saa{$aa};
  }
  else {
    die "$aa cant key %saa at $_\n"; 
  }
  my $tfam;
  if ($_ =~ /tfam:(\w)/){
    $tfam = $1;
    if ($phylum !~ /archae/){
      if ($tfam eq "I") {
	$tfam = "J";
      }
      $reclass{$saa}{$tfam}++;
      $saa = $tfam;
    }
  }
  my ($taxadd,$steml,$stemr,$idbase,$caa,$len,$score,$ta,@warns) = split ' ',$R;
  $leaf{$taxadd} = 1;

  my @addbits = split /\./,$taxadd;
  my $address = "";
  
  while (my $addbit = (shift @addbits)) {
    if ($address) {
      $address = join ".",$address,$addbit; 
    }
    else {
      $address = $addbit; 
    }
    $N{$address}++; ## total tRNAs at this address
    $aa{$address}{$saa}++;


    if ((not exists $seen_sp{$sp}) and ((exists $genome_size{$sp}) or (exists $genome_size{$genomeID}))) {
      $Gsize{$address} += (exists $genome_size{$sp} ? $genome_size{$sp} : $genome_size{$genomeID});
      $num_genomes_of_known_size{$address}++;
      $num_genomes{$address}++;
    }
    elsif (not exists $sp{$taxadd}) { ## NO GENOME SIZE DATA AVAILABLE
      $num_genomes{$address}++;
    }

    my @warncodes = ();
    foreach my $warn (@warns) {
      next if ($warn =~ /tfam:/);
      push @warncodes, $warncodes{$warn}; 
      $wN{$address}{$warn}++;
      $waa{$address}{$saa}{$warn}++;
    }    
    my $warncodes = join "",@warncodes;
    $wcN{$address}{$warncodes}++;
  }

  unless (exists $seen_sp{$sp}) {
    $seen_sp{$sp}=$1;
    $sp{$taxadd} = $sp;
  }
}


my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
$now = sprintf "%4d-%02d-%02d %02d:%02d:%02d\n",$year+1900,$mon+1,$mday,$hour,$min,$sec;
$filename = "tCE-Nov5-2014.3.fas";
#$scriptname = "compute_CCA_mss_figure.pl";
$title = "Analysis of CCA templating in  tRNADB-CE ver. 8.0, Oct., 2014 release by David H. Ardell";

if ($opt_I) {
  &print_iTol();
}
else {
  &print_header();
  &print_tree();
  &print_trailer();
}  

sub print_header() {
  print <<"QQ_HEADER_QQ"; 
<HTML>
  <HEAD>
      <TITLE>$title</TITLE>
        <script type="text/javascript" src="jquery.js"></script>
        <link href="jquery.treeTable.css" rel="stylesheet" type="text/css" />
        <script type="text/javascript" src="jquery.treeTable.js"></script>
        <script type="text/javascript">
 
        \$(document).ready(function() {
          \$(".results").treeTable( {
             treeColumn: 1,
             indent: 14,
             clickableNodeNames: true
          });
         });   
        </script>

  </HEAD>
  <BODY BGCOLOR=#FFFFFF LINK="#00615F" VLINK="#00615F" ALINK="#00615F">
<U><B>Title: $title</B></U><BR><br>
<U><B>Date: $now</B></U><BR><br>
<U><B>Input: $filename or tCE-Nov5-2014.taxsort.model_cca_U0_tfam.fas</B></U><BR><br>
<U><B>Generated By: perl compute_heatmap.pl tCE-Nov5-2014.3.fas > Ardell_Hou_2015.html</B></U><BR><br>
<U><B>Execution dependencies: addresses_v4.txt.gz and prokaryotes_NCBI_102615.txt</B></U><BR><br>
<U><B>Open in: any javascript-capable web-browser</B></U><BR><br>
<U><B>Function dependencies: jquery.js, jquery.treeTable.css, jquery.treeTable.js, toggle-collapse-dark.png, toggle-collapse-light.png, toggle-expand-dark.png, toggle-expand-light.png</B></U><BR><br>
<U><B>Description:</B></U>
Supplementary data with frequency analytics for Ardell and Hou (2015) 
Analysis of CCA-templating in Bacterial and Archaeal tRNA genes from a reannotation of Version 8 of tRNAdb-CE. 

Uses NCBI Taxonomy data 

Two reannotations were carried out: <ol> <li>Reannotation of function
on CAU-anticodon tRNAs, assignment to classes M (elongator Met), X
(initiator), or J (LAU-anticodon eleongator Ile) using TFAM and the
Silva model as described in Ardell and Hou 2015 "High Frequencies of
CCA-Templating in Bacterial Initiator tRNA Genes" </li>
<li>Reannotation of CCA-templating, with verification of the modeling
of the acceptor stem using dynamic programming. We assumed that if CCA
occurs just after the annotated acceptor stem, that the gene templates
CCA.
</li>
</ol>

The dynamic programming algorithm works as follows: seven bases of the
 annotated 5' end are taken from the database entries and the best
 pairing segment near the annotated 3' end is calculated by dynamic
 programming. The following parameters were used to generate these
 specific results:

<BR><br>
<dl>
<dt>
Number of bases of annotated 3' end searched
</dt>
<dd>
12
</dd>
<dt>
Number of bases of annotated 3' trailer
</dt>
<dd>
5
</dd>
<dt>
Match bonus (including G:U and U:G)
</dt>
<dd>
4
</dd>
<dt>
Mismatch bonus
</dt>
<dd>
1
</dd>
<dt>
Annotation bonus (pairing within boundaries annotated in tRNAdb-CE)
</dt>
<dd>
1 or 0
</dd>
<dt>
Gap penalty
</dt>
<dd>
-5
</dd>
</dl> 
<BR><br>
The algorithm segments the 17 bases from the 3'end into segments: [3'stem][id-base][cca?][trailer]
Certain conditions were tallied and appear at the end of the rows.
Here are the meanings of these conditions.
<dl>
<dt>
A
</dt>
<dd>
W:CCApredicted: if [cca?] eq "CCA", correctly annotated in tCE
</dd>
<dt>
B
</dt>
<dd>
"W:cca" if [cca?] =~ /cca/i. All A are also B, so our tRNAdb-CE CCA-templating false negatives are "B and not A"
</dd>
<dt>
C
</dt>
<dd>
"W:cc" if [cca?] =~ /^cc/
</dd>
<dt>
D
</dt>
<dd>
"W:shortLength" if predicted FPE of Acceptor stem is < 7
</dd>
<dt>
E
</dt>
<dd>
"W:pos89nTA" if the tCE-annoted 8th and 9th bases are not "T" and "A"
</dd>
</dl> 
<br><br>
Reclassifications of bacterial data based on TFAM with Silva model:<br>
<table>
<thead>
<tr>
<th></th>
<th>M</th>
<th>X</th>
<th>J</th>
</thead>
</tr>
<tbody>
<tr>
<td>M</td>
<td>$reclass{M}{M}</td>
<td>$reclass{M}{X}</td>
<td>$reclass{M}{J}</td>
</tr>
<tr>
<td>X</td>
<td align="right">0</td>
<td>$reclass{X}{X}</td>
<td align="right">0</td>
</tr>
<tr>
<td>J</td>
<td align="right">$reclass{J}{M}</td>
<td align="right">0</td>
<td align="right">$reclass{J}{J}</td>
</tr>
</tbody>
</table> 
QQ_HEADER_QQ
}



sub print_tree() {
  my $style = "style=\"vertical-align:bottom; font-family: arial, sans-serif; font-size:12pt;\"";
  print "<table class=\"results\">\n";
  print "\t<thead>\n";
  print "\t\t<tr>\n";
  print "\t\t\t<th $style>No. Genomes</th>\n";
  print "\t\t\t<th $style>Avg. Genome Size (MB)</th>\n";
  print "\t\t\t<th $style>Taxon</th>\n";
  print "\t\t\t<th $style>All</th>\n";
  foreach my $laa (@dlaa) {
    print "\t\t\t<th $style>$laa</th>\n";
  }
  print "\t\t</tr>\n";
  print "\t</thead>\n";
  print "\t<tbody>\n";
  open(ADDRESSES, "zless addresses_v4.txt.gz |")  or die "Couldn't fork: $!\n";
  while (<ADDRESSES>) {
    chomp;
    my ($add,@n) = split ' ',$_;
    my $taxID = pop @n;
    my $n = join " ",@n;
    $add =~ s/#//;
    my $tag = $add;
    $tag =~ s/\./-/g;
    if (exists $N{$add} and not $seen_tag{$tag}) {
      $seen_tag{$tag} = 1;
      my @tag=split/-/,$tag;
      my $parent_tag = "";
      unless (scalar @tag == 1) {
	$parent_tag = join "-",splice(@tag,0,-1);
      }
      my $class = "";
      if (exists $seen_tag{$parent_tag}) {
	$class = join "","child-of-",$parent_tag;
      }
      print "\t\t<tr id=\"$tag\"";
      if ($class) {
	print " class=\"$class\"";
      }
      print ">\n";
      &print_stats($n,$add);
      print "\t\t</tr>\n";
    }
  }
  close(ADDRESSES);
  print "\t</tbody>\n";
  print "</table>\n";
}



sub print_iTol() {
  open(ADDRESSES, "zcat addresses_v4.txt.gz |")  or die "Couldn't fork: $!\n";
  my @adds = ();
  while (<ADDRESSES>) {
    chomp;
    my ($add,@n) = split ' ',$_;
    my $taxID = pop @n;

    ## Added this as a cheap, quick dirty data reduction 
    my $n;
    if (@n == 1) {
      $n = $n[0];
    }
    elsif ($n[0] =~ /["']Candidatus/ and $n[1] =~ /(\w+)["']/) {
      $n = sprintf "Ca. %s",$1;
    }
    else {
      next;
    }


    $add =~ s/#//;
    my $tag = $add;
    $tag =~ s/\./-/g;
    my @output = ();
    if (exists $N{$add} and not $seen_tag{$tag}) {
      $seen_tag{$tag} = 1;
      push @output, "$taxID";
      if (exists $num_genomes{$add}) {
	push @output, sprintf ",%d",($num_genomes{$add});
      }
      else {
	push @output, ",0";
      }
      if (exists $Gsize{$add} and exists $num_genomes_of_known_size{$add}) {
	push @output, sprintf ",%3.1f",($Gsize{$add}/$num_genomes_of_known_size{$add});
      }
      else {
	push @output, ",0";
      }
      my $saa = $saa{Ini}; 
      my $ini = (exists $aa{$add}{$saa} ?  $aa{$add}{$saa} : 0);
      my $ini_cca = (exists $waa{$add}{$saa}{"W:cca"} ?  $waa{$add}{$saa}{"W:cca"} : 0);
      my $ini_n_cca = $ini - $ini_cca;
      my $cca = (exists $wN{$add}{"W:cca"} ?  $wN{$add}{"W:cca"} : 0);
      my $elo_cca = ($cca - $ini_cca);
      my $elo = ($N{$add} - $ini);
      my $elo_n_cca = $elo - $elo_cca;
      # #my ($G, $df, $p) = (0,0,0);
      # #if ($ini_cca > 0 && $ini_n_cca > 0 && $elo_cca > 0 && $elo_n_cca > 0) {
      # 	my $Gtest = Statistics::Distributions::GTest->new();
      # 	$Gtest->read_data ( { table => [[$ini_cca,$ini_n_cca],[$elo_cca,$elo_n_cca]] } );
      # 	$Gtest->G();
      # 	($G, $df, $p) = $Gtest->results();
      # }
      push @output, sprintf ",%6.4f", ($elo_cca/$elo);
      push @output, sprintf ",%6.4f", ($ini_cca/($ini == 0 ? 1 : $ini));
      push @output, ",$elo_cca,$elo,$ini_cca,$ini";#,$G,$df,$p";
      push @output, "# $n $add\n";
      $data{$add} = \@output;
      push @adds,$add;
    }
  }
  close(ADDRESSES);
  my %seen = ();
  foreach my $add (@adds) {
    my @add = split /\./,$add;
    while (@add) {
      pop @add;
      my $subadd = join ".",@add;
      $seen{$subadd} = 1;
    }
  }
  foreach my $add (@adds) {
    unless (exists $data{$add}) {
      warn "no data for $add\n";
    }
    else {
      unless (exists $seen{$add}) {
	print join "",@{$data{$add}};
      }
      else {
	print join ",",$data{$add}[0],$data{$add}[-1];
      }
    }
  }
}


sub print_stats(){ ## called in print_tree 
  my ($name,$address) = @_;
  my $style = "style=\"vertical-align:bottom; font-family: arial, sans-serif; font-size:14pt;\"";

  if (exists $num_genomes{$address}) {
    printf "\t\t\t<td $style >%d</td>\n",$num_genomes{$address};
  }
  else {
    printf "\t\t\t<td $style >%s</td>\n","ND";
  }
  
  if (exists $Gsize{$address}) {
    printf "\t\t\t<td $style >%4.1f</td>\n",($Gsize{$address}/$num_genomes_of_known_size{$address});
  }
  else {
    printf "\t\t\t<td $style >%4s</td>\n","ND";
  }

  print "\t\t\t<td $style>$name</td>\n";
  my $cca = (exists $wN{$address}{"W:cca"} ?  $wN{$address}{"W:cca"} : 0);
  my $bg_color = &compute_bg_color($cca/$N{$address});
  my $fg_color = &compute_fg_color($cca/$N{$address});
  printf "\t\t\t<td bgcolor=$bg_color style=\"color:$fg_color;vertical-align:bottom; font-family: arial, sans-serif; font-size:10pt\">%6d / %-6d %4.1f%%</td>\n",$cca,$N{$address},(100 * $cca/$N{$address});
  foreach my $dlaa (@dlaa) {
    my $saa = $saa{$dlaa}; 
    $aa = (exists $aa{$address}{$saa} ?  $aa{$address}{$saa} : 0);
    if ($saa eq "X" && $aa == 0 && $leaf{$address}){
      printf STDERR "%s has no annotated initiator genes.\n",$name;
    }
    $aa_cca = (exists $waa{$address}{$saa}{"W:cca"} ?  $waa{$address}{$saa}{"W:cca"} : 0);
    my $bg_color = &compute_bg_color($aa_cca/($aa == 0 ? 1 : $aa));
    my $fg_color = &compute_fg_color($aa_cca/($aa == 0 ? 1 : $aa));
    printf "\t\t\t<td bgcolor=$bg_color style=\"color:$fg_color;vertical-align:bottom; font-family: arial, sans-serif; font-size:10pt\">%6d / %-6d %4.1f%%</td>\n",$aa_cca,$aa,(100 * $aa_cca/($aa == 0 ? 1 : $aa));
  }
  my $wc;
  foreach my $wc_key (sort {$wcN{$address}{$b} <=> $wcN{$address}{$a}} keys %{ $wcN{$address} } ) {
    $wc = (exists $wcN{$address}{$wc_key} ?  $wcN{$address}{$wc_key} : 0);
    my $bg_color = &compute_bg_color($aa_cca/($aa == 0 ? 1 : $aa));
    my $fg_color = &compute_fg_color($aa_cca/($aa == 0 ? 1 : $aa));
    printf "\t\t\t<td bgcolor=$bg_color style=\"color:$fg_color;vertical-align:bottom; font-family: arial, sans-serif; font-size:10pt\">%6d / %-6d %4.1f%%%s</td>\n",$wc,$N{$address},(100* $wc/$N{$address}),$wc_key;
  }
}

# colors from http://colorbrewer2.org/?type=sequential&scheme=RdPu&n=5
# sub compute_bg_color(){
#   my $score= sprintf "%d", (100 * shift);
#   my $color = "#FFFFFF";
#   if ($score >= 80) {
#     $color = "#0868AC";
#   }
#   elsif ($score >= 60) {
#     $color = "#43A2CA";
#   } 
#   elsif ($score >= 40) {
#     $color = "#7BCCC4";
#   }
#   elsif ($score >= 20) {
#     $color = "#BAE4BC";
#   }
#   elsif ($score > 0) {
#     $color = "#F0F9E8";
#   }
#   return $color;
# }

# finer scale created with http://meyerweb.com/eric/tools/color-blend/#F0F9E8:0868AC:10:hex
# now with http://tristen.ca/hcl-picker/#/hlc/20/1/253241/EFEE69
# here is a more orange to blue one: 
# http://tristen.ca/hcl-picker/#/hlc/20/1/1C2834/F3BC55

# http://tristen.ca/hcl-picker/#/hlc/20/1/0B3128/F7B257
# #0B3128  #10382C  #16402F  #1D4732  #254F34  #2D5736  #375F38  #416639  #4C6E39  #58753A  #657C3A  #73833B  #818A3C  #90913D  #A0973F  #B19D41  #C2A245  #D3A84A  #E5AD50  #F7B257

sub compute_bg_color(){
  my $score= sprintf "%f", (100 * shift);
  my @colors = map {sprintf "#%s",$_} reverse qw/0B3128  10382C  16402F  1D4732  254F34  2D5736  375F38  416639  4C6E39  58753A  657C3A  73833B  818A3C  90913D  A0973F  B19D41  C2A245  D3A84A  E5AD50  F7B257/;
  my $num = scalar @colors;
  my $unit = (100 / $num);
  my $bin = (($score / $unit) - (($score % $unit) / $unit));

  my $color;
  if ($score == 0) {
    $color = "#FFFFFF";
  }
  elsif ($score == 100) {
    $color = $colors[-1];
  }
  else {
    $color = $colors[$bin];
  }
  return $color;
}



#182631,#1B333E,#1C414B,#1C4F57,#1D5E61,#1F6D6A,#257D71,#2F8C77,#3D9C7A,#4FAB7C,#64BA7C,#7BC97B,#95D879,#B1E577,#CFF275,#F0FF74

#192631,#1C333E,#1E414B,#1E4F56,#1F5E61,#226D6A,#287D71,#328C76,#409C7A,#52AB7C,#66BA7C,#7DC97C,#97D77A,#B2E578,#D0F276,#F0FE76


sub compute_fg_color(){
  my $score= sprintf "%f", (100 * shift);
  my $color = "#000000";
  if ($score >= 20) {
    $color = "#FFFFFF";
  }
  return $color;
}

sub print_trailer() {
  print <<"QQ_TRAILER_QQ"; 
<BR><BR>
</BODY>
</HTML>
QQ_TRAILER_QQ
}
