#!/usr/bin/perl
################################################################################
#
# tm_shift.pl = Tm shift calculator from tm_calc.pl output file .tmc.csv
#
# Version Date:	March 26, 2012
#
# Authors:	Frank Zucker,
#		BioMolecular Structure Center
#		University of Washington, Seattle, WA, USA
#
################################################################################
#
# Read in XML file from tm_calc, xxx.tmc.csv
# Write out csv table and html tables with shift = Tm - Tm(minimum) columns
#
# Use Tm from all transitions, compared to minimum transition and to minimum
# transition for that transition number.  
# Allow choice of one or more control transitions.
# Show both slope and delta in csv file and first html table, sorted by
# sample number.
# Write html tables allowing multiple transition rows per sample,
# including links to plots from tm_calc.pl.
# Sort by sample and transition number within sample, 
# by transition number and sample within transition number if >1 transition,
# by Tm (shift from the minimum transition),
# by Tm within transition number (shift within transition number) if >1 trans.
#
################################################################################

use strict;
use warnings;

use XML::Simple;
use Data::Dumper;

# use Params::Validate qw(:all);
use Cwd 'abs_path';
# use IO::File;
# use IO::CaptureOutput qw(capture);
# use File::Copy;
# use File::Path qw(make_path remove_tree);
# use DateTime;

my $debug = 0;

my $xml = new XML::Simple;         
my $k = 2*log(3+2*sqrt(2));
my $key = <<"EOL";
transition_number	= Number of transition 
Tm		= "Melting Temperature", transition midpoint
sd_tm_s		= standard deviation of that Tm estimated from 1 curve
Tm_Shift	= difference from lowest (or control) Tm
Tm_Rank		= Order by descending Tm, 1 to N for highest to lowest of N Tms
FWHM		= Full width at half maximum slope
FWHM_Rank	= Order by ascending FWHM: narrowest = 1
Slope		= Maximum slope, dI/dT at Tm from model
I_delta_t	= Intensity change as a fraction of total transition changes
I_delta_Rank	= Order by decreasing intensity change; highest = 1
Fit_quality	= Problems in fitting this transition
Data_quality	= Overall problems with data
EOL

if (!@ARGV) {
	print STDERR <<"EOL";
USAGE:
	tm_shift IN_FILE.tmc.csv 

where IN_FILE.tmc.csv is an XML file e.g. output from tm_calc.pl.
Output:
IN_FILE.tmc.shift.csv = table of shifts for max. slope and delta Tm
IN_FILE.tmc.shift.html = web page with same table plus tables sorted by Tm

Key for IN_FILE.tmc.shift.csv output table:
$key
EOL
	exit(1);
}
my $html_key1 =<<"EOL";
<a name="key"> </a>
<h3>Key</h3>
<table border='1px' cellspacing='0' cellpadding='3px' rules='row'>
<tr> <td>
N<sub>tr</sub> </td><td> number of the transition, counting from the lowest temperature Tm as 1.
	</td> </tr>
<tr> <td>
T<sub>m</sub></td><td> Midpoint for that transition </td> </tr>
<tr> <td>
(SD)</td><td> standard deviation of T<sub>m</sub> estimated from a single curve</td> </tr>
<tr> <td>
T<sub>m</sub> Shift </td> <td> Difference between this T<sub>m</sub> and a reference 
T<sub>m</sub>. By default, that reference is the lowest T<sub>m</sub> for all samples.
EOL

my $html_key_trans = <<"EOL";
For tables sorted by transition number first, the reference is the lowest T<sub>m</sub>
for each transition number.
EOL

my $html_key2 = <<"EOL";
The default references are shown with gray background around the "Control" checkbox in the 
first column.  Select one or more checkboxes to change the reference to the average of
all selected T<sub>m</sub>s.
</td> </tr>
<tr> <td>
T<sub>m</sub> Rank </td> <td> Order by descending T<sub>m</sub>; 1 to N from 
 highest to lowest of N samples</td> </tr>
<tr> <td>
FWHM </td> <td> Full width at half maximum slope for the transition</td> </tr>
<tr> <td>
Slope </td> <td>Maximum dI/dT for the transition from the model 
</td> </tr>
<tr> <td>
&Delta;I<sub>t</sub> </td> <td> Intensity change as a fraction of the total of all transition changes
(1.00 for models with 1 transition, > 0.5 for the larger of 2 transitions)
</td> </tr>
<tr> <td>
Fit Quality </td> <td> Problems with fitting this transition
</td> </tr>
<tr> <td>
Data Quality </td> <td> Problems with data overall 
</td> </tr>
</table>
EOL


my $fname = '';
my $out = '';
while (@ARGV) {
	my $next_arg = shift;
	if ($next_arg eq '-d') {
		$debug++;
	} elsif (! $fname) {
		$fname = $next_arg;
	} else {
		$out = $next_arg;
	}
}
if (! $out) {
	$out = $fname;
	$out =~ s/.csv//g;
}
my $html = $out;
$out .= '.shift.csv';
$html .= '.shift.html';
my $return = tm_shift($fname, $out, $html, $debug);
print STDERR $return if $return;
exit(0);

sub tm_shift {
my ($fname, $out, $html, $debug) = @_;

if (! -e $fname) {
	return ("Cannot find file $fname\n");
}
my $tm_data = eval { 
	$xml->XMLin( $fname, 
		ForceArray => ['SAMPLE', 'TRANSITION'] ) 
		};
if ($@) {
	return ("Cannot parse file $fname:\n$@");
}
my $warning = 0;
if (! open HTML, ">$html") {
	$warning = "Warning: cannot open HTML file $html for writing.\n";
	$html = 0;
}
if (! open OUT, ">$out") {
	if ($warning) {
		return ("Cannot open either HTML file $html\n or CSV file $out");
	}
	print STDERR "Warning: cannot open CSV file $out for writing.\n";
	$out = 0;
}

print "Got data $tm_data\n" if $debug;
my $fit_dir	= exists_or_zero( $tm_data, 'fit' );
my $derived	= $$tm_data{'DERIVED_VALUES'};
print "derived = ",Dumper $derived if $debug > 4;
my $data 	= $$derived{'DATA'};
print "data = ",Dumper $data if $debug > 4;
my $y_axis	= $$data{'Y_AXIS'};
print "y_axis = ",Dumper $y_axis if $debug > 2;

my $html_abs = $html;
my $last_slash = 0;
my $html_path = $html_abs;
if ($html) {
	$html_abs = abs_path($html_abs);
	$last_slash = rindex($html_abs,'/') + 1;
	$html_path = substr($html_abs, 0, $last_slash );
}
my $fit_link = 0;
if ($fit_dir) {
	$fit_link = "<a href='file://$fit_dir/Tm_Summary.html";
	my $fit_path  = substr($fit_dir, 0, rindex($fit_dir,'/') + 1);
	print "Fit dir: ".substr($fit_dir, $last_slash)."\n" if $debug;
	if ($fit_path eq $html_path) {
		$fit_dir = substr($fit_dir, $last_slash);
		$fit_link = "<a href='$fit_dir/Tm_Summary.html";
	}
}
my $out_link = 0;
if ($out) {
	my $out_abs = $out;
	$out_abs = abs_path($out_abs);
	my $out_path = substr($out_abs, 0, rindex($out_abs,'/') + 1 );
	$out_link = "<a href='file://$out'>";
	if ($out_path eq $html_path) {
		my $out_file = substr($out_abs, $last_slash);
		$out_link = "<a href='$out_file'>";
	}
}
# print "Fit dir: $fit_dir\n";

# print Dumper($y_axis) if $debug;

my $samples 	= $$y_axis{'SAMPLE'};
my @sample_names = keys(%$samples);
my @sample_value = values(%$samples);
my $n  = @sample_names;
my $n1 = $n - 1;
print "$n sample names: @sample_names\n" if $debug;

my $tm_min	= 100; # lowest Tm for any sample
my @tm_min_trans = ();
my @name_list	= ();
my @d_quality_list = ();
$#name_list = $n1;
$#d_quality_list = $n1;

# Set up list of sample and transition numbers for each transition such that
# sample_list[i] = sample # for ith transition
# trans_list[i]  = transition # for ith transition

# Set up hashes of arrays of transitions, arrays of values, etc.
# all_values_hash{tm, fwhm, etc} = array with n elements, n=total #transitions
my @sample_list = ();
my @trans_list  = ();
my %all_values_hash = ();
my %all_ranks_hash = ();
my @value_type_list = qw( number I_delta Tm FWHM sd_tm quality );
my @rank_type_list = qw( Tm I_delta FWHM );
my $rank_type_string = join(' ', @rank_type_list);

my %sort_order = ( Tm => 1, FWHM => -1, I_delta => 1 );

my %value_hash = ();
# my %rank_hash = ();
foreach my $value_type ( @value_type_list ) {
	my @value_list = ();
	# $#value_list = $n1;
	$all_values_hash{$value_type} = \@value_list;

	# $#rank_list = $n1;
	# next if $rank_type_string !~ /$value_type/;
	# my @rank_list = ();
	# $all_ranks_hash{$value_type} = \@rank_list;
}

my %null_transition = ( Tm => 0, FWHM => 0, I_delta => 0, slope => 0,
			sd_tm => 0, quality => 'none', number => 0 );

# Construct an index to an ordered list of well numbers, e.g. (1 25),
# so skipped numbers don't leave gaps in the arrays.
# s_num_list has 1 element for each sample = sample number for that position
# in the sample array as read by XML.

my @s_num_list = ();
# Collect all sample (well) numbers and get range of transition counts

my $trans_max = 0;
my $trans_min = 100;
my $trans_sum = 0;

foreach my $j (0..$n1) {
	my $s = $sample_value[$j];	# Don't rely on key for values
	my $s_num = $$s{'well_number'};
	print "Sample $j: $s_num = ",Dumper $s if $debug > 2;
	push @s_num_list, $s_num;
	my $t = $$s{'TRANSITION'};
	my $nt = scalar(@$t);
	print "Sample $j, $s_num has $nt transitions: ",Dumper $t if $debug > 1;
	if ($nt) {
		$trans_max = $nt if $nt > $trans_max;
		$trans_min = $nt if $nt < $trans_min;
		$trans_sum += $nt;
	} else {
		$trans_sum += 1;	# blank sample for no transitions
	}
}
return ("No samples found in $fname!") if @s_num_list == 0;

print "Found ",scalar(@s_num_list)," samples, $trans_sum transitions, ".
	"from $trans_min to $trans_max transitions per sample\n" if $debug;

# Sort sample numbers in ascending numerical order
# my @s_num_sorted = sort { $s_num_list[$a] <=> $s_num_list[$b] } (0..$#s_num_list);
my @s_num_sorted = sort { $a <=> $b } @s_num_list;

# Make an index such that index[sample number] => position in array of samples,
# e.g. for well list (1, 25): 1 => 0, 25 => 1
# s_num_index has 1 more than the number of samples, with 1 extra at 0.
# If all wells are used, this is equivalent to s_num - 1
# If there were millions of wells, it would be worth doing a hash
# but there will almost always be < 100 so just use an array pre-filled with -1

my @s_num_index = ();
my $s_max = $s_num_sorted[ -1 ];
$#s_num_index = $s_max;
@s_num_index[ ( 0..$s_max ) ] = ((-($s_max+1))..(-1));
print "Sample num last: $s_max = $#s_num_index\n" if $debug;
print "  index=@s_num_index\n" if $debug;
@s_num_index[ @s_num_sorted ] = (0..$n1);
print "Sample num: \n list: @s_num_list \n sort: @s_num_sorted \n" if $debug;
print "index: @s_num_index\n" if $debug;
print "length list: ",scalar(@s_num_list),"\n" if $debug;
print "length sort: ",scalar(@s_num_sorted),"\n" if $debug;
print "length indx: ",scalar(@s_num_index),"\n" if $debug;

# Make an array of hash references for samples sorted in sample number order

my @sample_sort = ();
$#sample_sort = $n1;

foreach my $j (0..$n1) {
	# $j is sample order in sample_names and sample_value, from XML
	my $s_name = $sample_names[$j]; 	# Same name may recur, so
	my $s	   = $sample_value[$j];		# don't rely on hash for values
	print  "Sample: ", Dumper($s) if $debug > 3;
	my $s_num = $$s{'well_number'};
	my $i = $s_num_index[ $s_num ]; 	# index in ordered list of samples
	$name_list[$i] = $s_name;
	$sample_sort[$i] = $s;
}

# Make an array of array refs s.t. the ith element is a list of 
# indeces in the sample and transition lists for (i+1)th transitions.
# E.g. @{$trans_num_lists[0]} is a list of 1st transitions

my @trans_num_lists = ();
my $cid_control = "xx";

foreach my $i (0..$n1) {

	# $i is sample index in sample number order
	my $s = $sample_sort[$i];		# don't rely on hash for values
	print  "Sample: ", Dumper($s) if $debug > 3;
	my $s_num = $$s{'well_number'};
	print "Sample $i: well number $s_num\n" if $debug;
	my $tm = 0.0;
	my $sd_tm = 0;
	my $delta = 0;
	my $fit_quality = " ";
	my $fwhm  = 0;
	my $t_num = 0;
	my $data_quality = " ";
	$data_quality = exists_or_zero($s,'data_quality_problem');
	$data_quality = " " if ! $data_quality;
	$d_quality_list[$i] = $data_quality;
	my $i_max = exists_or_zero( $s, 'Imax_obs' );
	my $delta_sum = 0;
	my $transitions = exists_or_zero( $s, 'TRANSITION' );
	if ($transitions) {
		print "Transition type: ref($transitions)\n" if $debug>2;
		print "Transitions: ",Dumper($transitions) if $debug>2;
		my @transition_list = ();
		if (ref($transitions) eq "HASH") {
			push @transition_list, $transitions;
		} else {
			@transition_list = @$transitions;
		}
		my $nt = scalar(@transition_list);

		# Make a new array of transitions sorted in trans. number order 
		# and get total of delta I's

		my @trans_sort = ();
		$#trans_sort = $nt - 1;

		foreach my $ix ( 0..($nt-1) ) {
			my $t = $transition_list[$ix];
			$delta = exists_or_zero( $t,'I_delta');
			$delta_sum += $delta;
			$t_num = $$t{'number'};
			my $it = $t_num - 1;
			$trans_sort[ $it ] = $t;
		}
		$$s{ trans_sort } = \@trans_sort;

		# Use trans_sort array to add values in trans. number order

		foreach my $it ( 0..($nt-1) ) {
			my $t = $trans_sort[ $it ];
			push @sample_list, $s_num;
			push @trans_list, $it + 1;
			my $t_num = exists_or_zero( $t, 'number' );
			print "Transition it $it t_num $t_num list size ",
				scalar(@sample_list),"\n" if $debug;

			my $delta = exists_or_zero( $t, 'I_delta' );
			my $fwhm = exists_or_zero( $t, 'FWHM' );
			my $tm = exists_or_zero( $t, 'Tm' );
			my $slope = $delta / (4*$k);
			$slope /= $fwhm if $fwhm;
			$slope /= $i_max if $i_max;

			# ${$transition_list[$it]}{'slope'} = $slope;
			push @{$all_values_hash{ slope }}, $slope;
			print "Transition $it: slope $slope delta $delta ".
				"fwhm $fwhm\n" if $debug;
			# $sd_tm = $$t{'sd_tm'};
			# $fit_quality = " ";
			# $fit_quality = $$t{'quality'} if !exists_or_zero( $t,'quality');

			# Store transition 
			# Store Tm, width and delta in separate lists

			for my $v_type ( @value_type_list ) {
				my $value = exists_or_zero( $t, $v_type );
				$value /= $delta_sum if $v_type eq "I_delta" &&
					  $delta_sum > 0;
				print "delta $value  delta_sum $delta_sum\n" if
					$debug && $v_type eq "I_delta";
				$value = " " if (! $value) && $v_type eq "quality";
				push @{$all_values_hash{ $v_type }}, $value;
			}
			# Find lowest Tm 
			if ( $tm && $tm < $tm_min ){
				$tm_min = $tm;
				# $cid_control = "c".scalar(@sample_list);
			}
			# Find lowest Tm for this transition number
		       	while ($t_num > @tm_min_trans) {
				push @tm_min_trans, 100;
			}
			$tm_min_trans[$t_num-1] = $tm if $tm && $tm < $tm_min_trans[$t_num-1];
			while ($t_num > @trans_num_lists) {
				my @tnum_list = ();
				print "t num $t_num: add to trans_num_list size ",
						scalar(@trans_num_lists)."\n" if $debug;
				push @trans_num_lists, \@tnum_list;
			}
			push @{ $trans_num_lists[ $trans_max - $t_num ] }, $#sample_list;
			print "trans_num_list ",Dumper @trans_num_lists if $debug;
		}
	} else {
		$d_quality_list[$i] = "NO TRANSITIONS";
		$$s{ trans_sort } = 0 ;
		push @sample_list, $s_num;
		push @trans_list, 0;
		for my $v_type ( @value_type_list ) {
			push @{ $all_values_hash{ $v_type } }, 0;
		}
	}
	print "Tm min: $tm_min Tm min trans: ",@tm_min_trans,"\n" if $debug > 1;
}

print "Tms: ",@{$all_values_hash{Tm}},"\n" if $debug;
print "Sample_list: ".join(', ',@sample_list)."\n" if $debug;
print "Trans_list:  ".join(', ',@trans_list)."\n" if $debug;
# print "Tm min: $tm_min. \nTm_list: @tm_list\n" if $debug;

my $t_num_max = $#trans_num_lists;

# Use trans_num_list to make an array s.t. the ith element is the index to the 
# sample and transition list of the ith element in descending transition number 
# then sample order.
# Also make an array of rank indeces for trans_tm, spanning all transition numbers

my @trans_sample_list = ();

foreach my $t_list ( @trans_num_lists ) {
	push @trans_sample_list, @$t_list;
}
my @trans_sample_index = ();
$#trans_sample_index = $#trans_sample_list;
@trans_sample_index[ @trans_sample_list ] = (0..$#trans_sample_list);
print "trans_sample_list: @trans_sample_list \n".
	"trans_sample_index: @trans_sample_index\n" if $debug;

my @trans_tm_index = ();
my @trans_tm_rank = ();
$#trans_tm_index = $#trans_sample_list;
$#trans_tm_rank = $#trans_sample_list;

	my $v_hash = ();
	# Sort and rank  Tm, width and delta from separate lists
	print "Sort ... \n" if $debug;
	for my $v_type ( @rank_type_list ) {
		my $v_list = $all_values_hash{ $v_type };
		my $nt = scalar(@{$v_list});
		print "Sort v_type $v_type, list @{$v_list}\n" if $debug;
		my $sign = $sort_order{ $v_type };
		my @order = sort { $$v_list[$b]*$sign <=> $$v_list[$a]*$sign }
				 0..($nt-1);
		my @rank = ();
		$#rank = $nt - 1;
		@rank[ @order ] = (1..$nt);
		print "v_type: $v_type \nOrder: @order\n ".
			"Rank: @rank\n" if $debug;
		$all_ranks_hash{ $v_type } = \@rank;
		print "all_ranks_hash{ $v_type }: ",Dumper $all_ranks_hash{$v_type} if $debug;
		if ($v_type =~ /tm/i) {
			# For each transition number, sort and rank by Tm within 
			# transition number
			my $tt_position = 0;
			foreach my $it (0..$t_num_max) {
				# my $it = $t_num_max - $jt;	# n-1 to 0
				my @t_list = @{$trans_num_lists[ $it ]};
				my @values = @$v_list[@t_list];
				$nt = scalar(@values);
				my $n1 = $nt - 1;
				$#order = $n1;
				my @order = sort
				    { $values[$b]*$sign <=> $values[$a]*$sign }
						0..$n1;
				my @rank = ();
				$#rank = $n1;
				@rank[ @order ] = (1..$nt);
				print "trans_tm it $it, order: @order \n rank: @rank ".
			       		"t_list[order] @t_list[@order]\n" if $debug;
				if ($it) {
					# Add these ranks to existing list
					push @{$all_ranks_hash{trans_tm}}, @rank;
				} else {
					# Start a list of ranks
					$all_ranks_hash{trans_tm} = \@rank;
				}
				foreach my $itt ( 0..$#order ) {
					$trans_tm_index[ $t_list[ $order[$itt] ] ] = $tt_position;
					$trans_tm_rank[$tt_position] = $t_list[$order[$itt]];
					$tt_position ++;
				}
				# push @trans_tm_rank, @t_list[ @order ];
			}
			print "all_ranks_hash{trans_tm}: ",Dumper $all_ranks_hash{trans_tm} if $debug;
			print "trans_tm_index; @trans_tm_index\n".
				"trans_tm_rank: @trans_tm_rank\n" if $debug;
		}

	}

	print "all_ranks_hash: ",Dumper %all_ranks_hash if $debug > 1;

my @headers_id = qw(well_number sample_name);

my @headers_trans = qw(Transition_Number Tm sd_tm Tm_Shift Tm_Rank
	FWHM FWHM_Rank Slope I_delta_t I_delta_Rank Fit_Quality);
my $table_start = "<table border='1px' cellspacing='0' cellpadding='2px'>\n";
my $hj = "</th> \n\t\t<th>";	# header join

my $table_headers_id = "\t<tr>\n\t\t<th>Num. $hj Name </th>\n";
my $table_headers_trans = "\t\t<th> N<sub>tr</sub> $hj T<sub>m</sub> (SD) $hj ".
			"T<sub>m</sub> Shift $hj T<sub>m</sub> Rank $hj ".
			"FWHM $hj Slope $hj &Delta;I<sub>t</sub> ".
			"</th>\n\t\t<th> Fit Quality </th>\n";
my $table_headers_dq = "\t\t<th rowspan='2'> Data Quality </th>\n\t</tr>\n";
my $table_headers_all = <<"EOL";
	<tr>
		<th rowspan='2'>Control</th>
		<th colspan='2'>Sample</th>
		<th colspan='8'>Transitions</th>
$table_headers_dq
$table_headers_id
$table_headers_trans 
	</tr>
EOL

my @table_type_list = $trans_max == 1 ? ('tm') : qw( tm trans_sample trans_tm );
my %table_string = ( trans_sample => '', tm => '', trans_tm => '' );
my %table_title = ( 
	tm		=> 'for All Transitions Sorted by T<sub>m</sub>',
	trans_sample 	=> ' Within Each Transition, Sorted by Transition '.
				'Number then Sample',
	trans_tm	=> 'Within Each Transition, Sorted by Transition '.
				'Number then T<sub>m</sub>',
		);
my $links = 	" </p> <hr />\n<p> Go to ";
$links .= 	"$fit_link'>plots</a>, to " if $fit_link;
$links .= 	"$out_link csv file</a>, to ".
		"<a href='#key'>key</a>, ".
		" or to the table sorted by ".
		"<a href='#sample'>sample number</a>, \n";
if ($trans_max == 1) {
	$links .= "or by <a href='#tm'>Tm </a>.\n";
} else {
	$links .= "by <a href='#tm'>Tm </a>, by \n".
		"<a href='#trans_sample'>transition number then sample</a>, or by \n".
		"<a href='#trans_tm'>transition then Tm </a>.\n".
		"</p> <hr/> \n";
}
my $html_key = "$html_key1 ". ($trans_max > 1 ? "$html_key_trans" : "") .
		"$html_key2";
print HTML <<"EOL" if $html;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" 
                      "http://www.w3.org/TR/html4/loose.dtd">
<HTML> 
	<HEAD> 
		<TITLE>Tm Shifts for $fname</TITLE> 
		<style type="text/css">
.default_control {
	background-color: lightgray;
	// border-style: solid;
	// border-width: 3px;
	// border-color: gray;
}
.new_line {
	background-color: #6666FF;
	line-height: 1px;
	padding: 0px;
	border: 0px;
}
		</style>
		<script type="text/javascript">

window.onload = function() { setControl(0); }

function setControl(event) {
	var new_val = 0;
	var new_id  = 'xx';
	if (event) {
		var new_check = event.target;
		new_val = new_check.checked;
		var new_id  = new_check.id;
	}
	var checks = document.getElementsByName("control");
	var nchecks = checks.length;
	var sum = 0;
	var n = 0;
	for (i=0; i < nchecks; i++) {
		var check = checks[i];
		var cid = check.id;
		if (cid == new_id && check.checked != new_val) {
			check.checked = new_val;
		}
		var flag = check.checked;
		if (flag) {
			var id = "t" + cid.substr(1);
			sum = sum + Number(document.getElementById(id).innerHTML);
			n = n + 1;
		}
	}
	var control = 0;
	if (n > 0) {
		control = sum / n;
		var shifts = document.getElementsByName('shift');
		var nshifts = shifts.length;
		for (i=0; i<nshifts; i++) {
			var shift = shifts[i];
			var tid = 't' + shift.id.substr(1);
			var val = Number(document.getElementById(tid).innerHTML)
						- control;
			shift.innerHTML = val.toFixed(1);
		}
	} else {
		if (event) {
			setTimeout( "window.location.reload()", 100 );
			for (i=0; i < nchecks; i++) {
				var check = checks[i];
				var cid = check.id;
				if (cid == '$cid_control' ) {
					check.checked = 'true';
				}
			}
		}
	}
}
		</script>
	</HEAD> 
	<BODY style="font-family: Arial,Helvetica,sans-serif">
<a name='top'>
<h1>T<sub>m</sub> Shifts</h1>
<h3>for $fname</h3>
$html_key
<p> The tables have the same data, sorted in different orders. 
If no controls are selected, the minimum T<sub>m</sub> is taken as the
control (the minimum for that transition number in tables sorted first
by transition number).
</p>
<a name="sample"> </a>
$links
<h2>
T<sub>m</sub> Shifts sorted by Sample then Transition within Sample
</h2>
$table_start
$table_headers_all
EOL

print OUT join(',', @headers_id).",".join(",", @headers_trans) if $out;

if ($html) {
	my $transition_warning = <<"EOL";
<i> The last two tables, sorted by transition number, assume
a T<sub>m</sub> in one sample should be compared to the T<sub>m</sub> with 
the same transition number in another sample. </i>
EOL
	$transition_warning = ($trans_max == $trans_min) 
		? ($trans_max == 1 ? "" : "<p>Note: $transition_warning</p>" )
		: "<h3> <b>WARNING: $transition_warning</h3>";
	foreach my $table_type ( @table_type_list ) {
		# print HTML "$table_headers_trans";
		my $table_warning = $table_type =~ /trans/ ? $transition_warning : '';
		$table_string{ $table_type } = <<"EOL";
<a name="$table_type">
</a>
$links
<h2>
T<sub>m</sub> Shifts $table_title{ $table_type }
</h2>
$table_warning
$table_start
$table_headers_all
EOL
	}
}

print OUT ",data_quality\n" if $out;
print HTML "\t</tr>\n";

# Print values for each row: well number, sample name, data quality,
# For csv:
#   well number, sample name
#   For _max_slope and _max_delta:
# 	Transition_Number Tm sd_tm Tm_Shift Tm_Rank FWHM FWHM_Rank
# 	Slope I_delta I_delta_Rank Fit_Quality
#   data quality
# For HTML:
#   well number, sample name
#	Transition_Number Tm sd_tm Tm_Shift Tm_Rank FWHM 
# 	Slope I_delta Fit_Quality
#   data quality

my $dj = "</td>\n\t\t<td align='center'>";	# data join

my $trans_last = $#sample_list;
my %table_row_hash = ();
my %tm_list_hash = ();
foreach my $table_type ( @table_type_list ) {
	my @table_row_list = ();
	$#table_row_list = $trans_last;
	$table_row_hash{ $table_type } = \@table_row_list;
	if ($table_type =~ /trans_/) {
		my @tm_list = ();
		$tm_list_hash{ $table_type } = \@tm_list;
	}
}
# print "table row hash, before: ",Dumper %table_row_hash if $debug > 1;
my $header_lines = 20;
print "1+$#name_list Names: @name_list\n" if $debug;
print "all_ranks_hash Idelta: @{$all_ranks_hash{I_delta} }\n" if $debug;

my $s_old = -1;
my $n_lines = 0;
my $new_sample_line = "\t<tr>\t<td> </td> <td class='new_line'></td>\n".
			"\t\t<td colspan='10'> </td></tr>";
my $new_trans_line = "\t<tr>\t<td colspan='3'> </td>\n".
			"\t\t<td class='new_line'></td> <td colspan='8'></td></tr>";
# my $blank_line = "<tr><td colspan='12'> </td></tr>";

print "Sample list: @sample_list\nTrans list: @trans_list\n" if $debug;
for my $i (1..scalar(@sample_list)) {

	my $j = $i - 1;
	my $s_num = $sample_list[ $j ];
	my $t_num = $trans_list[  $j ];
	my $s1 = $s_num_index[ $s_num ]; 	
	my $t1 = $t_num - 1;
	my $tm 	  = ${ $all_values_hash{ Tm 	 } }[$j];
	my $shift = $tm - $tm_min;
	my $check_this = "check='checked'";
	my $checked_string = $shift ? '' : $check_this;
	my $checked_string_trans = $tm == $tm_min_trans[$t1] ? '' : $check_this;
	my $class_this = "class='default_control'";
	my $class = $shift ? '' : $class_this;
	my $class_trans = $tm == $tm_min_trans[$t1] ? $class_this : '';
	print "Row $i, index $j: s_num $s_num, s1 $s1 name  '$name_list[$s1]',  t_num $t_num\n" if $debug;
	print OUT "$s_num,\"$name_list[$s1]\"" if $out;
	my $id_string = <<"EOL";
	<tr>
		<td align='center' $class><input type='checkbox' name='control' id='c$i'
	       		$checked_string onclick="setControl(event)" /></td>
		<th> 
EOL
	my $id_string_trans = <<"EOL";
	<tr>
		<td align='center' $class_trans><input type='checkbox' name='control' id='c$i'
	       		$checked_string_trans onclick="setControl(event)" /></td>
		<th> 
EOL
	$id_string .= ($fit_link) ? "\t\t$fit_link#$s_num'>$s_num</a> " : "$s_num ";
	$id_string .= "$hj $name_list[$s1] </th>\n";
	$id_string_trans .= ($fit_link) ? "\t\t$fit_link#$s_num'>$s_num</a> " : "$s_num ";
	$id_string_trans .= "$hj $name_list[$s1] </th>\n";
	if ($html) {
		if ($n_lines && $s_num != $s_old) {
			print HTML $new_sample_line;
			if (($n_lines % $header_lines) > $header_lines - 3) {
				print HTML "$table_headers_all";
				$n_lines = 0;
			}
		}
		$s_old = $s_num;
		if ($n_lines && !($n_lines % $header_lines)) {
			print HTML "<tr><td colspan='11'> </td></tr>\n".
				"$table_headers_all";
		}
		$n_lines ++;
		print HTML "$id_string";
	}
	my $dq_string = "\t\t<td> $d_quality_list[$s1] </td>\n\t</tr>\n";

	my $delta = ${ $all_values_hash{ I_delta } }[$j];
	my $slope = ${ $all_values_hash{ slope	 } }[$j];
	my $sd_tm = ${ $all_values_hash{ sd_tm	 } }[$j];
	my $fwhm  = ${ $all_values_hash{ FWHM	 } }[$j];
	my $t_rank = ${ $all_ranks_hash{ Tm 	 } }[$j];
	my $w_rank = ${ $all_ranks_hash{ FWHM	 } }[$j];
	my $d_rank = ${ $all_ranks_hash{ I_delta } }[$j];

	# my $t_num = ${ $all_values_hash{ number	 } }[$j];
	my $quality = ${ $all_values_hash{ quality } }[$j];
	printf OUT ",%u,%.1f,%.2f,%.1f,%u,%.2f,".
		"%u,%.5f,%.2f,%u,\"%s\"",
		$t_num,
		$tm, 
		$sd_tm,
		$shift,
		$t_rank,
		$fwhm,
		$w_rank,
		$slope, 
		$delta,
		$d_rank,
		$quality
			if $out;
	next if ! $html;
	
	my $data_string1 = sprintf 
		"\t\t<td align='center'> %u $dj ".
		"<span id='t%u' name='tm'>%.1f</span> (".
		"%.2f) $dj ".
		"<b> <span id='s%u' name='shift'>",
		$t_num,
		$i,
		$tm, 
		$sd_tm,
		$i;
	my $shift_string = sprintf "%.1f</span> </b> $dj ",  $shift;
	my $data_string2 = sprintf 
		"<b> %u </b> $dj ".
		"%.2f $dj ".
		"%.5f $dj ".
		"%.2f $dj ".
		"%s </td>\n" ,
		$t_rank,
		$fwhm,
		$slope, 
		$delta,
		$quality;

	my $data_string = "$data_string1 $shift_string $data_string2";
	print HTML "$data_string";

	my $row_string = "$id_string $data_string $dq_string";
	${$table_row_hash{ tm		}}[ $t_rank - 1 ] = $row_string;

	$shift = $tm - $tm_min_trans[$t_num - 1];
	$shift_string = sprintf "%.1f</span> </b> $dj ",  $shift;
	$row_string = "$id_string_trans $data_string1 $shift_string $data_string2 $dq_string";

	my $i_rank = $trans_sample_index[ $j ];
	# print "trans_sample: j $j i_rank: $i_rank\n" if $debug;
	${$table_row_hash{ trans_sample }}[ $i_rank ] = $row_string;

	$i_rank = $trans_tm_index[ $j ];
	${$table_row_hash{ trans_tm 	}}[ $i_rank ] = $row_string;
	print "trans_tm: j $j i_rank $i_rank \n" if $debug;

	print OUT ",\"$d_quality_list[$s1]\"\n" if $out;
	print HTML "$dq_string" if $html;
}

	print "table row hash: ",Dumper %table_row_hash if $debug > 1;

if ($html) {
	for my $table_type ( @table_type_list ) {
		print "Table type $table_type\n" if $debug;
		print HTML "</table>\n\n$table_string{ $table_type } ";
		my $old_tnum = -1;
		$n_lines = 0;
		for my $i (0..$#sample_list) {
			if ($table_type =~ /trans/) {
				my $tnum = $table_type eq 'trans_sample' ? 
					# $trans_sample_list[$i] :
					$trans_list[ $trans_sample_list[$i] ] :
					# $trans_tm_index[$i];
					$trans_list[ $trans_tm_rank[$i] ];
				if ($old_tnum > 0 && $tnum != $old_tnum) {
					print HTML $new_trans_line;
					if ($n_lines > $header_lines /2) {
						print HTML "$table_headers_all";
						$n_lines = 0;
					}
				}
				print "i $i tnum $tnum old $old_tnum\n" if $debug;
				$old_tnum = $tnum;
			}
			print HTML "$table_headers_all"
				if ($n_lines && ! ($n_lines % $header_lines) );
			print HTML ${ $table_row_hash{ $table_type } }[ $i ];
			$n_lines ++;
		}
	}
	print HTML <<"EOL";
</table>
$links
<hr />
</body>
</html>
EOL
	close HTML;
}
close OUT if $out;
return(0);
}

sub exists_or_zero {
	my ($x, $y) = @_;
	return 0 if ! (defined $x && $x && defined $y && $y);
	print "Look for $y in $x\n" if $debug > 3;
	my %h = %$x;
	return ($h{$y}) if exists $h{$y} && defined $h{$y};
	return 0;
}
