#!/usr/bin/perl
################################################################################
#
# tm_calc.pl = Tm Iput Module and calculator for PROSPERO
#
# Version Date:	December 17, 2012
#
# Authors:	Frank Zucker
#		Hae Young Kim
#		Aug 2009
#		BioMolecular Structure Center
#	 	Dept. of Biochemistry
#		University of Washington
#
# Input Module for Thermal Melt curves for PROSPERO,
# Prediction of crystallization from Sequence and Protein Experimental Results
#
# Transform .csv, .tad, or other delimited text files into derived values
# Tm, Tw, R30, Rmt etc., one row per sample column in csv format.
# Optionally write raw data in standardized csv format.
# Wrap all output in XML.
#
# Write out gnuplot command files to fit and plot if plotting requested.
# Include legends at top of, and links to legengs throughout, both web pages.
# Rearrange keys and line widths for clarity.
#
############################################################################
# As of v1.05, wrap human-readable csv table of derived values in <TABLE>,
# and below that write original data in XML format as;
# <DERIVED_DATA> 
#	<TABLE>
#"Sample",Well_Number,Tm_max_slope,Tm_avg,Rtm,R30,I30,Itm,Imax_obs
#"Sample 1",1,...
#...
#	</TABLE>
#	 <DATA>
#	 	<X_axis label="Temperature (Celsius)">
# T1,T2,T3...Tn
#	 	</X_axis>
#		<Y_axis label="Fluoresence">
#			<SAMPLE name="..." well_number="n" Tm_max_slope...*>
# I1,I2,I3...In
#			</SAMPLE>
#			<SAMPLE name="..." ...>
# I1,I2,I3...In
#			</SAMPLE>
#		</Y_axis>
#	 </DATA>
# </DERIVED_VALUES>
#
# *SAMPLE attributes include Tm_max_slope, Tm_avg, Rtm, R30, I30, Itm, Imax_obs.
# If the -f flag is used, samples with transitions will also have attributes
# transition_count, major_transition, and Imin_transition, and will have 
# multiple TRANSITION tags before the intensity data, each with attributes 
# number (1 to 3), I_delta, Tm and FWHM.
#
# If the -r flag is used, the T and I data is also printed in the original
# orientation, with a header row and one row for each T with all its I's.
################################################################################

################################################################################
#
# Main wrapper: accept file in, file out and columns from command line
# 		default = std in, std out, all columns 
################################################################################

use strict;
use warnings;
use Cwd 'abs_path';
use Data::Dumper;
use DateTime;
use IO::File;
use IO::CaptureOutput qw(capture);
use File::Copy;
use File::Remove 'remove';
use File::Path qw(make_path remove_tree );
use File::Spec qw(catdir catfile splitpath);
use Params::Validate qw(:all);
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );

use utf8;

my $DEBUG = 0;
my $html = 1;
my $GNUPLOT = "gnuplot";
my $GNUPLOT_SERVER = "/usr/local/bin/gnuplot";
my $k4 = log(3+2*sqrt(2)) / 2;
$GNUPLOT = $GNUPLOT_SERVER if -e $GNUPLOT_SERVER;

my $gnuplot_grid_command = 'set grid xtics ytics lw 0.5';
my $svg_terminal_command = "set terminal svg mouse jsdir 'http://skuld.bmsc.washington.edu/FIT/download/'\n";
my $tmin_all = 100;
my $tmax_all = 0;
my $use_all = 0;

# Include "fit.pl" in this file for portability

my $version_ID = "tm_calc_2.20";	# Fit multiple transitions w/exp. bg
# [--derive] 
#	"\t --derive\tmeans write derived Tm and other values as XML & csv\n".

# my $script = substr($0, 1 + rindex($0,($0 =~ /\\/) ? "\\" : "/"));
my ($dummy_volume, $dummy_path, $script) = File::Spec->splitpath( $0 );

my $help_text = <<EOL;
	Tm Caclulator $version_ID: derive Tm and other values from curves.
USAGE:
$script <in_file> | -  [-o (- | <out_file>)]  [-c <columns>] [-r | --raw]
  [(-w | --web | -f | --fitdir) [<fit_dir>]]  [(-p | --plot) [<plot_type]]
  [(-m | --mindelta) <min_delta> ]  [-x | =-exp]  [(-s | --smooth) <window>]
  [-t | --track]  [-v | --verbose]  [-d | --debug]  [--version]  [-h | --help]

>>>> You must supply either <in_file> or '-' (dash) meaning STANDARD IN. <<<<<

	Items in <angle brackets> should be replaced by the real thing,
	Items in [square brackets] are optional. "a | b" means a or b.
	-h or --help or no input specifier prints this text.
Main output file: XML including a csv table of derived values including Tm as T
at max. slope and Tm as mean of T's at half max. slope, followed by raw data
wrapped in XML tags: <X>X1,X2...</X> and <SAMPLE>Y1,Y2...</SAMPLE>. 

All flags are OFF by default.  Flags are:

-r or --raw	Include raw data as standardized csv in the XML output.
-f or --fit 	Fit one or more Boltzmann curves to data using gnuplot; include
		    the resulting Tm(s) in the main output file table and XML.
-p or --plot	Plot raw data, total fit, each transition and derivatives;
            	    -p png puts Tm_Details.html & Tm_Summary.html in <fit_dir>,
		    and creates svg as well as png plots.
-w or --web 	Shortcut for '-f <fit_dir> -p png'. If no <fit_dir> is given,
		    then <name>_fit in the current directory is used where
		    <in_file> is <path>/<name>.<ext> a directory. If <in_file>
		    is '-', <fit_dir> is 'fit' in the current directory.
-x or --exp 	Use exponential decay background in curve fitting.
-t or --track  	Write the sample number and name (column heading) to STD ERR
-v or --verbose	Write some intermediate values to STD OUT, including all models
-d or --debug  	Write copious intermediate values to STD OUT

Default values are:
<out_file> ... 	If <in_file> is given as e.g. <path>/<file>.csv, then the main
		output file is named <file>.tmc.csv. That file is written to
		<fit_dir> if -f <fit_dir> is used, otherwise it goes to the 
		current directory.  If input is from '-' (STANDARD IN) then 
		output goes to STANDARD OUT e.g. screen or pipe. 
<columns>  ... 	Use all sample columns.
<fit_dir>  ... 	Use a temporary fit directory e.g. /tmp/<in_file>/<column>; 
               	    do NOT read existing fits or write to a named directory.
<min_delta>    	0.02 = fraction of total intensity change for smallest peak.
<window>   ...	3 = size in degrees of smoothing window	(15 points for OM RTPCR)
<plot_type>    	ps for Postscript; the only other tested option is png.
               	   Only works if -f is used

Use -w to fit and make web pages with plots in <fit_dir>, or in ./<in_name>_fit
       if <fit_dir> is not given, or in ./fit if <in_file> is not given.
OR use -f <fit_dir> -p png to fit and make web pages in <fit_dir>.  Pages are
Tm_Summary.html with 1 plot per sample and Tm_Details.html, 3 per transition+.

If given, <columns> can be a comma-separated list of numbers, wells, or ranges,
e.g. "1-3,B3-5,C10-d02". The first sample column after "Temp" is number 1
Wells match the letter and number ignoring case and leading 0: "A2" = "a02".
Ranges are number-number or well-well where well ranges go from the first
to the last column as found in the file, if both first and last are found.
	NOTE: Lists must be either WITHOUT_SPACES or "enclosed in quotes."
	Buffers with spaces and commas are not (yet) recognized.
EOL

# Parse command line options
{
my ($infile, $outfile, $column_str, $derive, $raw, $fit, $plot, $min_delta,
	$track, $verbose, $debug, $bg_exp_flag, $smooth) = 
	get_command_line_args("columns|col|cols|c=s", $version_ID,$help_text);

# $verbose = $debug if ($debug && !$verbose);
my $gnudir = $fit eq '1' ? 0 : $fit;

my @columns = ("all");
@columns = split(/,/,$column_str) if ($column_str);
if ($column_str =~ /[0-9]-/) {
	my @tmp = ();
	foreach (@columns) {
		if ($_ =~ /-/) {
			print "Parse range $_\n" if $debug;
			my $range = $_;
			my $dash = index($range, '-');
			my $start = substr($range,0,$dash);
			my $stop  = substr($range,($dash+1));
			if (! $stop) {
				# Use just the start column for N-
				$stop = $start;
				if (0) { 	# DO NOT use all the rest
					$use_all = 1;
					if ($start =~ /^[0-9]/) { $stop = '96'; }
					else { $stop = '12'; }
				}
			}
			if ($start =~ /^[0-9]+$/ && $stop =~ /^[0-9]+$/ &&
				$start <= $stop) {
				push @tmp, ($start..$stop);
				print "| $_ | from $start to $stop\n" if $debug;
				print "List:",join(',',($start .. $stop)),"\n" if $debug;
			} else {
				if (($start =~ /^[A-z][0-9]+$/) && 
					($stop =~ /^[0-9]+$/)) {
					$stop = substr($start,0,1).$stop;
					$range = "$start-$stop";
					print "Fix text range: $range = $start to $stop\n" if $debug;
				} else {
					print "Text range: $start to $stop\n" if $debug;
				}
				push @tmp, $range;
			}
		} else {
			push @tmp, $_;
		}
	}
	@columns = @tmp;
}
print "Read ",(1+$#columns)," columns '",join("','", @columns),"' from ", $infile || "STD IN",
	" to ", $outfile || "STD OUT","\n" if ($verbose);
print "ARGV left:",join("|",@ARGV),"\n" if ($verbose);

# Pass infile, outfile and columns to parsing routine

my $result = parse_tm(	{	infile	=> $infile, 
				outfile	=> $outfile, 
				columns	=> \@columns,
				derive	=> $derive,
				raw	=> $raw,
				fit	=> $fit,
				gnudir	=> $gnudir,
				plot	=> $plot,
				min_delta => $min_delta,
				track	=> $track,
				verbose	=> $verbose, 
				version => $version_ID,
				debug	=> $debug,
				bg_exp_flag => $bg_exp_flag,
				smooth	=> $smooth,
			} );

print "Result $result" if ($verbose);
print STDERR "ERROR IN PARSING TM" if (!$result);
exit(!$result);
}

################################################################################
#
# get_command_line_args = generic command to get input module command lines
#
# In: non-standard option(s) i.e. other than file in, out, verbose, debug,
# 						version and help.
#	 version string, help string
# Out: input and output file names, non-standard parameter, verbose, debug
#
# Exits after printing version, help, or command-line parsing error.
#
################################################################################

sub get_command_line_args {
	my ($option,$version_ID, $help_text) = @_;
	use Getopt::Long;
	Getopt::Long::Configure("bundling", "ignore_case_always");
	my $infile = 0;
	my $outfile = 0;
	my $newparam = 0;
	my $derive = 1;
	my $raw = 0;
	my $fit = '-1';
	my $plot = '-1';
	my $html = -1;
	my $min_delta = 0.02;
	my $verbose = 0;
	my $track = 0;
	my $debug = 0;
	my $version = 0;
	my $help = 0;
	my $bg_exp_flag = 0;
	my $smooth = 3;
	my $result = GetOptions("in|filein|i=s"	  => \$infile,
				"out|fileout|o=s" => \$outfile,
				$option		 => \$newparam,
				"derive"	=> \$derive,
				"raw|r"		=> \$raw,
				"fit|fitdir|f:s"=> \$fit,
				"plot|p:s"	=> \$plot,
				"web|w:s"	=> \$html,
				"mindelta|m=f"	=> \$min_delta,
				"track|t+"	=> \$track,
				"verbose|v+"	=> \$verbose,
				"debug|d+" 	=> \$debug,
				"version"	=> \$version,
				"help|h|?"	=> \$help,
				"exp|x"		=> \$bg_exp_flag,
				"smooth|s=f"	=> \$smooth,
				);
	
	# Convert optional values to 1 if flag is given with no value

	print "Before: Fit: '$fit' plot: '$plot' html: '$html'\n" if $debug;
	$fit  = $fit  ? ($fit  eq '-1' ? 0 : $fit ) : 1;
	$plot = $plot ? ($plot eq '-1' ? 0 : $plot) : 1;
	$html = $html ? ($html eq '-1' ? 0 : $html) : 1;
	print "After: Fit: '$fit' plot: '$plot' html: '$html'\n" if $debug;

	print "bg_exp_flag: $bg_exp_flag\n" if $debug;
	
	$infile = shift @ARGV if (@ARGV && !$infile);
	print "Infile: $infile\n" if $debug;
	if ($version) 
	{
		print("Version $version_ID\n");
		exit(0);
	}
	if ($help || !$result || !$infile)
	{
		print "$help_text";
		exit(!$result);
	}
	if ($html) {
		$plot = 'png';
		if ($html ne '1') {
			$fit = $html;
		} else {
			if (!$fit || $fit eq '1') {
				(my $dummy_vol, my $dummy_path, $fit) = 
					File::Spec->splitpath( $infile ) if
					$infile && $infile ne '-';
				# $fit = $infile;
				# $fit =~ s/.*\///g;
				# $fit =~ s/.*\\//
				if ($fit) {
					$fit =~ s/\.(csv|tad|tad2|xls|xlsx)$/_fit/g;
					# $fit =~ s/\.csv$/_fit/g;
				} else {
					$fit = 'fit';
				}
			}
			$fit .= '_fit' if $fit eq $infile;
		}
		print "New Fit: $fit plot: $plot\n" if $debug;
	}
	
	return ($infile, $outfile, $newparam, $derive, $raw, $fit, $plot,
		$min_delta, $track, $verbose, $debug, $bg_exp_flag, $smooth);
}
################################################################################
#
# parse_tm = parser for Tm files for PROSPERO Tm input module
#
# In: input filename (default: standard in), 
#	 output filename (default: standard out),
#	 columns as integers or text (default: 1 and 2)
#	 verbose and debug flags (no default)
# Out: write selected columns from input as standard csv to output
# Return: 1 on success, 0 on failure
#
################################################################################

sub parse_tm {

	my %params = validate( @_, {	
					infile	=> { type => SCALAR },
					outfile	=> { type => SCALAR },
					columns	=> { type => ARRAYREF},
					raw		=> { type=>SCALAR, default=>0},
					derive	=> { type=>SCALAR, default=>1},
					fit	=> { type=>SCALAR, default=>0},
					gnudir	=> { type=>SCALAR, default=>0},
					plot	=> { type=>SCALAR, default=>0},
					min_delta => { type=>SCALAR, default=>0.02},
					track	=> { type=>SCALAR, default=>0},
					version	=> { type=>SCALAR, default=>"0.4"},
					verbose	=> { type=>SCALAR, default=>0},
					debug	=> { type =>SCALAR, default=>0},
					bg_exp_flag => { type =>SCALAR, default=>1},
					smooth	=> { type =>SCALAR, default=>3},
					} );
	my $infile	= $params{'infile'};
	my $outfile	= $params{'outfile'};
	# dereference the reference to arrays
	my $columnref = $params{'columns'};
	my @columns	= @$columnref;
	# my @columns 	= @$params{'columns'};
	my $print_deriv	= $params{'derive'};
	my $fit		= $params{'fit'};
	my $gnudir	= $params{'gnudir'};
	my $plot	= $params{'plot'};
	my $min_delta	= $params{'min_delta'};
	my $print_raw	= $params{'raw'};
	my $track 	= $params{'track'};
	my $version 	= $params{'version'};
	my $verbose 	= $params{'verbose'};
	my $debug	= $params{'debug'};
	my $bg_exp_flag	= $params{'bg_exp_flag'};
	my $smooth	= $params{'smooth'};

	my $extension	= ".tmc.csv";		# Append to output file name
	
	# Open input file if needed 

	my $delim = 0;
	my $ncols = 0;
	# Read lines into array to be parsed after delimiter is detected
	my @lines = ();
	my $infilename = $infile;
	if ($infile && $infile ne '-') 
	{
		# Is input file a .tad file? 
		# If so, transform it to csv then parse csv
		if ($infile =~ /\.tad2?$/)
		{
			my %tadhash = tad2csv($infile) or die
				"ERROR: Cannot convert $infile from tad to csv!";
			my $newinfile = $tadhash{'outfile'};
			$ncols = $tadhash{'ncols'};
			$infile = $newinfile;
			$delim = ',';
			open INFILE, $infile or die 
				"ERROR OPENING CONVERTED INFILE $infile\n$!";
		} else {
			if (! -e $infile) {
				warn "CANNOT FIND INPUT FILE $infile\n";
				exit(1);
			}
			open INFILE, $infile or die 
				"ERROR OPENING INFILE $infile\n$!";
		}
		while (<INFILE>) {
			chomp;
			s/\s*$//g;
			push @lines, $_;
		}
		close INFILE;
	} else {
		$infilename = 0;
		while (<>) {
			chomp;
			s/\s*$//g;
			push @lines, $_;
		}
	}
	# If lines are separated by ^M (/r) only, split them out.
	print "Found ",@lines+0," lines, first one is ",length($lines[0])," long\n" if $debug;
	if (@lines == 1) {
		my @tmp = split /\r/, $lines[0];
		@lines = @tmp;
		print "Split to ",@lines+0," lines, first one is ",length($lines[0])," long\n" if $debug;
	}
	print "First 4 lines:",join('|',@lines[0..3]),"\n" if $debug && $#lines>= 3;
	# For files already processed by this program, take source and skip derived values
	if (join('|',@lines[0..3]) =~ /\<TM_DATA/i || $infilename =~ /\.tmc\.csv/i) {
		my $version_in = 0;
		for my $line (@lines[0..3]) {
			print "Line: $line\n" if $debug;
			next if $line !~ /version/i;
			($version_in = $line) =~ s/.*version="//g;
			$version_in =~ s/\".*//g;
			last if $version_in;
		}
		my $oldversion = ($version_in =~ /(^|tm_calc.)1\.0[0-4]/);
		print "Version in: '$version_in'; version: ",
			($oldversion ? 'old' : 'new'),"\n" if $debug;
		print "TMC file: skip tags and derived values\n" if $debug;
		my $wraptag	= "TM_DATA";
		my $rawtag	= "RAW_DATA";
		$rawtag		= "DATA" if ! $oldversion;
		my $keeptags	= "($rawtag|HEADER|FOOTER)";
		my $parsed = parse_xml( { 	lines	 => \@lines,
						wraptag  => 'TM_DATA',
						keeptags => $keeptags,
						rawtag	 => $rawtag,
						debug	 => $debug,
						verbose	 => $verbose,
					}
				      );
		my $tmp_infilename = $$parsed{'in_file_name'} 
			   if exists $$parsed{'in_file_name'};
		$infilename = $tmp_infilename if -e $tmp_infilename;
		@lines = ();
		push @lines, @{$$parsed{'header'}} if exists $$parsed{'header'};
		my $rawline = @lines;	# $$parsed{'RAW_LINE'};
		if ($oldversion) {
			push @lines, @$parsed{$rawtag},"";
		} else {	
			# Sample name array
			my $sample = $$parsed{'sample_names'};
			print "Sample names: ",Dumper($sample) if $debug;
			push @lines, "Temperature,\"".join('","',@$sample)."\"";
			my $temp_in = $$parsed{'temperature'};
			my $int_in  = $$parsed{'intensity'};
			print "Intensities: ",Dumper($int_in) if $debug > 3;
			for (my $i=0; $i<@$temp_in; $i++) {
				my $row = $$temp_in[$i];
				for (my $j=0; $j<@$int_in; $j++) {
					$row .= ",${$$int_in[$j]}[$i]";
				}
				push @lines, $row;
				print "Intn row $i: $row\n" if $debug
						&& ($i < 5 || $debug > 1);
			}
		}
		push @lines, @{$$parsed{'footer'}} if exists $$parsed{'footer'};
		$delim = ',';
		if ($#lines > $rawline) {
			my @fields = split /,/, $lines[$rawline+1]; 
			$ncols = 0;
			foreach (@fields) { 
				$ncols ++ if $_ gt " ";
			}
		}
		print "TMC file: delim='$delim', ncols=$ncols\n" if $debug;
		print "New input:\n",join("\n",@lines),"\n" if $debug>1;


		
	}

	print "Before: delimiter |$delim| ncols |$ncols| last line $#lines\n" if $debug;
	if (! $delim || !$ncols) {
		# Get a hash reference from subroutine
		my $delim_values =find_delimiter( {	lines	=> \@lines,
							debug	=> $debug,
							verbose	=>$verbose } );
		# print ":",join(":",@delim_values), "\n" if $debug;
		$delim = $$delim_values{'delim'};
		$ncols = $$delim_values{'ncols'};
	}
	print "After:  delimiter |$delim| ncols |$ncols|\n" if $debug;
	my $head_values = find_headline( { 	lines => \@lines, 
						delim => $delim,
						head => 'Tem',
		  					ncols => $ncols,
						debug => $debug,
								verbose	=> $verbose,
		  				} );
	# If find_headline fails, bail out
	die "ERROR: no header line found!\n" if (! $head_values);
	my $headline = $$head_values{'header_line'};
	my $fixedcol = $$head_values{'fixed_col'};
	my $headersref = @$head_values{'headers'};
	my @headers  = @$headersref;
	
	print "Header is line $headline, temp is column $fixedcol\n" if $debug;
	print "Headers are \n'",join("'\n'",@headers[(0..List::Util::min(5,$#headers))]),"\n ... \n" if $debug;
	my $ic = 0;
	# $outfile = "" if ($outfile eq '-');
	if ($outfile && $outfile ne '-') {
		# Add the extension .tmc.csv onto the output file, if it's absent
		$outfile = $outfile . $extension if ($outfile !~ /$extension$/);
	} elsif ($infilename && $outfile ne '-') {
		# Get the input file name without the path
		(my $fname = $infile) =~ s/.*\///g;
		$fname =~ s/.*\\//g;
		# Add the extension .tmc.csv to the input file name, if any
		if ($fname =~ /\.[^.][^.][^.]?$/) {
			# Replace existing extension
			$outfile = substr($fname,0,rindex($fname,".")).$extension;
		} else {
			# Append to file name with no extension
			$outfile = $fname.$extension;
		}
		if ($gnudir) {
			if (! -e $gnudir) {
				if (! mkdir( $gnudir ) ) {
					print STDERR "Warning: cannot create directory 
						$gnudir: $_\n";
				}
			}
			if (-e $gnudir && -d $gnudir) {
				$outfile = File::Spec->catfile( $gnudir, $outfile );
			}
		}
	}
	
	my $out = 0;
	if ($outfile && $outfile ne '-') {
		my ($outvol, $outpath, $outname) = File::Spec->splitpath($outfile);
		print "outvol: '$outvol' outpath: '$outpath', outname: $outname\n" if $debug;
		my $outdir = File::Spec->catpath( $outvol, $outpath, '');
		print "outfile: '$outfile' outdir: '$outdir'\n" if $debug;
		if ($outdir && ! -e $outdir) {
			mkdir( $outdir ) or die
				"ERROR MAKING DIRECTORY $outdir\n$!";
		}
		open OUTFILE, ">$outfile" or die 
			"ERROR OPENING OUTFILE $outfile\n$!";
		$out = \*OUTFILE;
	} else {
		$out = \*STDOUT;
	} 
	my $tmp_name = $infilename ? $infilename : $outfile;
	$tmp_name = "anon" if ! $tmp_name || $tmp_name eq '-';
	$tmp_name =~ s/.*\///g;
	$tmp_name =~ s/.*\\//g;
	
	my $col;

	my @all_intensities = ();
	my @all_heads = ();
	my $last_data_line = 0;
	my $n_per_line = 50;
	my $timestr = localtime;
	print $out "<TM_DATA version=\"$version\" mindelta=\"$min_delta\" ".
			"runtime=\"$timestr\"\n";
	print $out " smoothing_window=\"".($smooth+0)."\"";
	print $out " background=\"".($bg_exp_flag ? 'exponential' : 'constant').
			"\"\n";
	print $out " source=\"",abs_path($infilename),"\"\n" if $infilename;
	if ($fit && $fit ne '1' ) {
		my $abs_fit = $fit;
		mkdir $fit if (! -e $fit);
		$abs_fit = abs_path( $abs_fit ) if -e $fit;
		print $out " fit=\"", $abs_fit,"\"\n";
	}
	if ($outfile eq '-') {
		print $out " dest=\"STDOUT\"";
	} elsif ($outfile) {
		print $out " dest=\"",abs_path($outfile),"\"";
	}
	print $out ">\n";
	print $out "<HEADER> <![CDATA[ \n", join("\n",@lines[(0..($headline-1))]),
			"\n]]> </HEADER>\n"	if $headline;
	my $temperature	= ();
	# Use all sample columns if no columns are specified or "all" is given
	if (!$columns[0] || $columns[0] eq "all") {
		@columns = (1..($ncols-($fixedcol+1)))
	} else {
		my (@tmp) = find_columns( {	headers	=> \@headers,
						fixedcol => $fixedcol,
						cols	=> \@columns,
						verbose	=> $verbose, 
						debug	=> $debug 
					} );
		@columns = @tmp;
	}

	my $super_norm	 	= "superpose_smooth_norm";
	my $super_cmd		= $super_norm.".gp";
	my $super_bg_cmd	= $super_norm."_bg.gp";
	my $super_plot 		= $super_norm.".$plot";
	my $super_plot_bg  	= $super_norm."_bg.$plot";
	(my $super_plot_svg	= $super_plot) 	  =~ s/png/svg/g;
	(my $super_plot_bg_svg 	= $super_plot_bg) =~ s/png/svg/g;
	my $super_cmd_rel	= $super_cmd;
	my $super_bg_cmd_rel	= $super_bg_cmd;

	$html = 0 if ! $plot || $plot !~ /png/i;
	if ($html && $fit && $gnudir) {
		print "gnudir: '$gnudir'\n" if $debug;
		mkdir $gnudir if (! -e $gnudir);
		if (! open HTML, ">".File::Spec->catfile(
					$gnudir, "Tm_Details.html") ) {
			warn "WARNING - cannot open HTML file in $gnudir\n$!";
			$html = 0;
		} elsif (! open HTML_SUM, ">".File::Spec->catfile(
					$gnudir, "Tm_Summary.html") ) {
			warn "WARNING - cannot open HTML summary file in $gnudir\n$!";
			$html = 0;
		} else {
			print HTML <<"EOL";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" 
                      "http://www.w3.org/TR/html4/loose.dtd">
<HTML> 
<HEAD> 
	<TITLE>Tm Details for $tmp_name</TITLE> 
	<STYLE type='text/css'>
		.used {
			border:5px solid lightgreen;
		}
		.not_used {
			border:4px solid lightgray;
		}
	</STYLE>
</HEAD> 
<BODY style="font-family: Arial,Helvetica,sans-serif">
<a name='top'>
	<center>
		<font size='+2'>
			<b>
				 &nbsp;T<sub>m</sub> Details for $tmp_name
			</b>
		</font>
		<br>in $gnudir
	</center>
</a>
EOL
			print HTML_SUM <<"EOL";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" 
                      "http://www.w3.org/TR/html4/loose.dtd">
<HTML> <HEAD> <TITLE>Tm Summary for $tmp_name</TITLE> </HEAD> 
<BODY style="font-family: Arial,Helvetica,sans-serif">
<a name="top">
	<center>
		<font size='+2'>
			<b>
				&nbsp;T<sub>m</sub> Summary for $tmp_name
			</b>
		</font>
		<br>in $gnudir
	</center>
</a>
</center>
EOL
			print HTML "<center>\n\tusing ".
				($bg_exp_flag ? 'exponential' : 'constant').
					" background\n</center>\n";
					
			print HTML_SUM "<center>\n\tusing ".
				($bg_exp_flag ? 'exponential' : 'constant').
					" background\n</center>\n";
		} 
	}

	my $svg_object_end = "type='image/svg+xml' width='600' height='480'>";
	if ($html) {
		my $outpath = "";
		if ($outfile && $outfile ne '-') {
			$outpath = $outfile;
			$outpath = File::Spec->abs2rel( $outfile, $gnudir ) if $gnudir;
		}
		print HTML_SUM <<"EOL";
<table align='center' border='0'>
	<tr> 
		<td align='center'> 
			<object data='$super_plot_svg' $svg_object_end 
				<img src='$super_plot' 
				alt="Plot of all samples superimposed in progress . . . "> 
			</object>
			<br/>Click on sample name in key to toggle line off and on
		</td>
		<td align='center'> 
			<object data='$super_plot_bg_svg'  $svg_object_end
				<img src='$super_plot_bg' alt=" "> 
			</object>
			Click on sample name in key to toggle line off and on
		</td>
	</tr>
	<tr> 
		<td>
			Download gnuplot command to plot all samples
			<a href="$super_cmd_rel"> $super_cmd_rel </a> </td>
		<td align='center'>Download command with background subtraction
			<a href="$super_bg_cmd_rel"> $super_bg_cmd_rel </a> </td>
	</tr>
EOL
		print HTML_SUM <<"EOL" if $outpath;
	<tr>
		<td>Download main output file 
			<a href='$outpath'> $outpath </a>
			with table of T<sub>m</sub>s for all samples.
		</td>
	</tr>
EOL
		print HTML_SUM "</table>\n";
	}

	# style='border-collapse:collapse;'>

	my $html_table_head = << "EOL";
<table align='center' border='1' cellpadding='4' cellspacing='0'>
	<tr>
		<td>Trans-<br>ition</td>
		<th>T<sub>m</sub> (s.d.)</th>
		<th>Slope</th>
		<th>Delta*</th>
		<th>FWHM</th>
		<th>Fit Problem</th>
	</tr>
EOL

	if ($html && @columns > 0) {
		my $str = "<h3>Sample Index:</h3>\n".
			"<table width='90%' align='center'>\n<tr>\n";
		$str = "<h3>Sample Index:</h3>\n".
			"<table width='90%' border='1' align='center'>\n<tr>\n"
			if $debug > 1;
		my $br = 0;
		my $n = 5;
		$n = 6 if (@columns == 96);
		foreach my $c (@columns) {
			$str .= "<td><font size='+1'><a href='#$c'>$c".
					"</a></font></td>\n";
			$br ++;
			if ($br == 2*$n) {
				$str .= "<td>&nbsp;&nbsp;&nbsp;&nbsp;</td>\n";
			} elsif ($br == $n || $br == 3*$n) {
				$str .= "<td>&nbsp;&nbsp;</td>\n";
			} elsif ($br == $n*4 ) {
				$br = 0;
				$str .= "</tr><tr>\n";
			}
		}
		if (1 < @columns && @columns < 5) {
			foreach my $c ($br .. 4) {
				$str .= '<td>&nbsp;&nbsp;</td> ';
			}
		}
		$str .= "</tr></table>\n";

		print HTML "$str See <a href='Tm_Summary.html'>".
					"T<sub>m</sub> Summary Plots</a>\n";
		print HTML_SUM "$str See <a href='Tm_Details.html'>".
					"T<sub>m</sub> Details Plots</a>\n";
		my $legend_plus = <<EOL;
Transition midpoint temperature (T<sub>m</sub>) and 
transition intensity range from I<sub>min</sub> to I<sub>max</sub>, 
 vertical thick blue bar(s); transition temperature range
(full width at half maximum slope, FWHM) and 
intensity at transition midpoint (I<sub>Tm</sub>), 
horizontal thick green bar(s).
EOL
		my $legend_boltzmann = <<EOL;
<b>Curve Fitting:</b> Unsmoothed observed fluorescence intensity is fit with a background
and one or more intensity transitions <i>I<sub>n</sub></i>: 
<br/> &nbsp; &nbsp; <i>I = I<sub>bg</sub> + I<sub>1</sub> + I<sub>2</sub> + &hellip;</i>
where 
&nbsp; &nbsp; <i>I<sub>n</sub> = &Delta;I / 
{1 + e<sup>(T<sub>M</sub> - T) / T<sub>W</sub> </sup> } </i>,
&nbsp; <i>&Delta;I = I<sub>max</sub> - I<sub>min</sub> </i> and 
&nbsp; <i>T<sub>W</sub></i> is proportional to the full width at half maximal slope 
(FWHM). &nbsp; <i>I<sub>bg</sub> = I<sub>min</sub> </i> for the first transition
(constant) unless exponentially decaying 
background is allowed with the -x option and decay is detected, in which
case either:
<br/> <i>&nbsp; &nbsp; I<sub>bg</sub> = I<sub>init</sub> &times; e<sup>kT</sup> 
</i>(decay from <i>I<sub>init</sub></i> to zero)
<br/> or <i>I<sub>bg</sub> = I<sub>min</sub> + 
(I<sub>init</sub> - I<sub>min</sub>) &times; e<sup>kT</sup> </i>
(decay from <i>I<sub>init</sub></i> to <i>I<sub>min</sub></i>).
When <i>I<sub>min</sub></i> is far below zero, this gives a nearly 
linear decreasing background.
EOL
		my $old_legend_boltzmann = <<EOL;
Each transition is fit with a Boltzmann function:
<table> <tr> <td rowspan='3' valign='center'><i> I = </i></td> 
<td align='center'><i> &Delta;I <sup>&nbsp;</sup> </i></td> </tr>
<tr> <td> <hr  style='height: 2px; margin: 0'/> </td> </tr>
<tr> <td align='center'> <i> 1 + e<sup>( T<sub>M</sub> - T ) /
T<sub>W</sub> </sup> </i> </td></tr>
</table>
where <i>&Delta;I = I<sub>max</sub> - I<sub>min</sub></i> and 
<i>T<sub>W</sub></i>
is proportional to the full width at half maximal slope (FWHM).
The curve is fit with a sum of such transitions and a background.
Background is constant (I<sub>min</sub> for the first
transition), exponentially decaying to zero, or exponentially decaying to
a negative number which in some cases gives a nearly constant background
slope.
EOL
		print HTML_SUM <<EOL;
<h3>Legends for each sample's figure and table</h3>
<p>
<b>Figure: Differential Scanning Fluorimetry Curve.</b> 
Fluorescence Intensity (arbitrary units) vs Temperature (&deg;C).
Observed intensity, black '+'; smoothed observations, black curve;
final fitted model, red curve; residual (smoothed observations - fit),
green curve; background, blue curve. 
$legend_plus
<br/>
$legend_boltzmann 
<br/>
<b>Table: Transition Models.</b> 
Overall data problems, if any, in text above table. If no transition
found, no table is displayed.
Problems with fitting, if any, to the right.
Pale green background, transition(s) with maximum slope or <i>&Delta;I</i>.
Since these may be in different rows, transition are numbered from low to high 
<i>T<sub>m</sub></i> rather than by slope or <i>&Delta;I</i>.

<b>T<sub>m</sub></b>, transition midpoint; 
<b>s.d.</b>,  deviation of observed from expected intensity near <i>T<sub>m</sub></i>.
Note: this s.d. indicates data and fit quality of one experiment, not expected deviation 
between experiments. 
<b>Slope</b>, <i>(dI/dT)<sub>max</sub> = dI/dT</i> at <i>T<sub>m</sub></i> from model.
<b>Delta</b>, transition intensity change <i>&Delta;I</i> relative to 
maximum observed intensity:
<i>&Delta;I&nbsp;/&nbsp;I<sub>max obs</sub></i>
(and relative to the largest &Delta;I: 
<i>&Delta;I&nbsp;/&nbsp;&Delta;I<sub>max</sub></i>). 
For data baselined to minimum intensity, a common default setting, 
<i>I<sub>max obs</sub></i> is the total observed intensity change. 
If that change is largely due to intensity decay, then  
<i>&Sigma;&nbsp;(&Delta;I<sub>i</sub>&nbsp;/&nbsp;I<sub>max obs</sub>)</i>&nbsp;<<&nbsp;1.
<b>FWHM</b>, temperature range with slope &ge; half maximal slope. 
See <a href="Tm_Details.html">details</a> for values from 
models with other numbers of transitions.
</p>
EOL
		print HTML <<EOL;
<h3>Legend for each sample's set of figures</h3>
<p>
Each sample has three rows (fit, transitions, derivatives) 
and at least as many columns as transitions in the final model. 
For all three rows: observed fluorescence or derivative, black '+';
smoothed observations, black curve; fitted model, red curve. 
<br/> Complete legends:
<br/>
<b>Differential Scanning Fluorimetry Curve Iterative Fitting.</b>
Final fitted model, column with pale green background above top row
and thin green outline;
intermediate steps in iteration towards final model, if any, to the
left with grey background; possible additional transition tested and 
rejected (e.g. for not significantly improving the model), to the right
with gray background.
<br/><b>Overall model, top row:</b> Fluorescence Intensity
(arbitrary units) vs Temperature (&deg;C). 
Observed fluorescence, black '+';
smoothed observations, thick black curve;
fitted model, thin red curve; 
residual (smoothed observations - fit), thin green curve;
background from model, thin blue curve. $legend_plus

<br/><b>Individual transitions, middle row:</b>
Fluorescence with background (bg) subtracted vs Temperature. 
Observed fluorescence minus bg , black '+';
smoothed observations minus bg, black curve; 
fitted model minus bg, red curve. 
Individual transition models with I<sub>min</sub> subtracted,
thick colored curves. 
Individual transition curves and vertical blue bars at T<sub>m</sub>
go from zero to
&Delta;I&nbsp;=&nbsp;I<sub>max</sub>&nbsp;-&nbsp;I<sub>max</sub> 
so that it is easier to compare intensity changes among transitions. 
Green bars show
temperature range of transition as in top row, at &Delta;I /2. 

<br/><b>Derivatives, bottom row:</b>
Derivative of fluorescence intensity (dI/dT) vs Temperature. 
Observed derivative, black '+';
smoothed derivative, black curve; fitted model, red curve.
Derivatives of individual transitions, curves colored as in middle
row but using thin lines for clarity.
For exponentially decaying backgrounds: 
derivative of model background, thin dark blue curve; 
smoothed observed derivative with that background derivative subtracted,
thin green curve. Individual transition peaks should fit this curve.
(For constant backgrounds, these curves overlap the X axis and the black
line, respectively).
T<sub>m</sub> and maximum slope from the model, vertical blue bars; 
temperature range at half-maximum slope (spanning peaks at half height),
horizontal green bars.
<br/><b>Curve Fitting:</b> See <a href='Tm_Summary.html'>summary</a>
EOL
	}
	if ($html) {
		print HTML "<hr />\n<TABLE cellpadding='3'>\n";
		print HTML_SUM "<hr />\n<TABLE>\n";
	}

	# Find last non-blank temperature
	my $lasttemp = 0;
	my $ystring = "";
	my $alt = " alt='NO CURVE FITTING ATTEMPTED'>";
	my $alt_txt = 'NO CURVE FITTING ATTEMPTED';
	my $old_col = $columns[-1];

	# Clear out old gnuplot commands, if any
	print "Clear old commands: gnudir=$gnudir\n" if $debug;
	if ($gnudir) {
		$super_cmd 		= File::Spec->catfile( $gnudir, $super_cmd );
		$super_bg_cmd   	= File::Spec->catfile( $gnudir, $super_bg_cmd );
		my $path_plot 		= File::Spec->catfile( $gnudir, $super_plot );
		my $path_plot_svg 	= File::Spec->catfile( $gnudir, $super_plot_svg );
		my $path_plot_bg	= File::Spec->catfile( $gnudir, $super_plot_bg );
		my $path_plot_bg_svg	= File::Spec->catfile( $gnudir, $super_plot_bg_svg );
		if (-e $gnudir && -d $gnudir) {
			remove($super_cmd) 	if (-e $super_cmd);
			remove($super_bg_cmd)	if (-e $super_bg_cmd);
			remove($path_plot) 	if (-e $path_plot);
			remove($path_plot_svg) 	if (-e $path_plot_svg);
			remove($path_plot_bg) 	if (-e $path_plot_bg);
			remove($path_plot_bg_svg) if (-e $path_plot_bg_svg);
			print "Remove $super_plot, $super_plot_bg\n" if $debug;
		}
	}
	
	foreach $col (@columns) {
		$ic ++;
		my $next_col = $ic < @columns ? $columns[$ic] : 'top';
		my $column_values = get_column( { lines => \@lines,
						headers	=> \@headers,
						headline => $headline,
						fixedcol => $fixedcol,
						datacol  => $col,
						delim  => $delim, 
						verbose	=> $verbose, 
						debug	=> $debug 
						} );
		# Skip if no data was found for this column
		if (! $column_values) {
			print STDERR "WARNING: No data for column $col!\n" if !$use_all;
			next;
		}
		$temperature	= $$column_values{'temperature'};
		my $intensity	= $$column_values{'intensity'};
		my $header	= $$column_values{'header'};
		print STDERR "Sample $col: $header\n" if $track;
		
		$last_data_line = $$column_values{'last_line'} if (! $last_data_line)
			&& exists($$column_values{'last_line'});
		$last_data_line = $#{$intensity} + $headline + 1 if (! $last_data_line);
		print "Column $col temps: ",join(' ',@$temperature[1..25]),"\n",
			"Intensity ",join(' ',@$intensity[1..25]),"\n" if $debug;
		if ($print_raw) {
			push @all_intensities, $intensity;
		}
		push @all_heads, $header;
		# Read from existing gnu directory, or write to non-existant directory
		my $gnuin  = 0;
		my $gnuout = 0; 
		my $gnudir_col = $gnudir ? "$gnudir/$col" : 0;
		if ($gnudir_col) {
			my $gp_param_file = _generate_gnuplot_datafilename( { 
				stem => "$gnudir_col/".$tmp_name.'.'.$col,
				type => "parameter", version => 1 } );
			if ($debug) {
				$gnuout = $gnudir_col;
				if (-e $gnuout) {
					my $ext = 1;
					while (-e "$gnuout.$ext") {
						$ext ++;
					}
					print "Moving $gnuout to $gnuout.$ext\n";
					if (! move("$gnuout", "$gnuout.$ext")) {
						print "Cannot move $gnuout!\n";
						if (!remove_tree("$gnuout")) {
							print "Cannot remove ",
								"$gnuout\n";
						}
					}

				}
				print "Write to gnuplot fitting directory ",
					"$gnuout\n";
			} elsif (-e $gnudir_col && -e $gp_param_file) {
				$gnuin = $gnudir_col;
				print "Read from gnuplot fitting directory ",
					"$gnuin\n" if $verbose;
			} else {
				$gnuout = $gnudir_col;
				print "Write to gnuplot fitting directory ",
					"$gnuout\n" if $verbose;
			}
		}

		if ($print_deriv) {
			my $html_solutions = "<th>Sample $col Transitions</th>";
			my $html_deriv = "<th>Sample $col Derivatives</th>";
			my $html_table = $html_table_head;
			my $t = tm_fit( { 	intensity	=> $intensity,
						temperature	=> $temperature,
						fit	=> $fit,
						gnuin	=> $gnuin,
						gnuout	=> $gnuout,
						plot	=> $plot,
						min_delta => $min_delta,
						verbose	=> $verbose,
						debug	=> $debug,
						name	=> $tmp_name.'_'.$col,
						bg_exp_flag	=> $bg_exp_flag,
						smooth	=> $smooth,
						sample_name => $header,
					} );
			if (! $t ) {
				my $msg =  "ERROR - fitting not done!";
				print $out "$msg\n</TM_DATA>\n";
				return 0;
			}	
			if ($print_deriv && $col eq $columns[0]) {
#				Use overall version, not version of tm_fit
#				my $version = 0;
#				$version = $$t{'version'} 
#					if (exists $$t{'version'});
#				if ($version) {
#					print $out "<DERIVED_VALUES version=\"".
#							"$version\">\n";
#				} else {
#					print $out "<DERIVED_VALUES>\n";
#				}
				print $out "<DERIVED_VALUES>\n";
				print $out "\t<TABLE>\n";
				print $out "\"sample_name\",well_number,".
					"Tm_max_slope,".
					"Tm_avg,FWHM,Rmt,R30,I30,Itm,Imax_obs";
				# For multiple Boltzmann fits, report:
				# transition count, major transition (from 1),
				# overall minimum and 3 parameters for each 
				# transition: Tm, Tw and Id=Imax-Imin
				print $out ",Number_of_Transitions,",
					"Major_Transition,".
					"Max_Delta_Transition,".
					"R_abs,I_min_fraction,".
					"I_exp_initial_fraction,I_exp_decay,".
					"Transition_Number,".
					"Tm,SD_of_Tm,dI/dT,I_delta_fraction,FWHM_fit,".
					"Major_Transition_Flag,Transition_Quality,Data_Quality"
						if $fit;
					# "Tm_2,dI/dT_2,I_delta_2_fraction,FWHM_2,".
					# "Tm_3,dI/dT_3,I_delta_3_fraction,FWHM_3,".
					# "Tm_4,dI/dT_4,I_delta_4_fraction,FWHM_4,".
					# "Tm_5,dI/dT_5,I_delta_5_fraction,FWHM_5" 
				print $out "\n";
				for (my $i=6; $i < @$temperature; $i++) {
					$lasttemp = $i;
					last if (@$temperature[$i] eq '');
				}
			}
			my $i = 1;
			if ($debug > 1) {
				print  "keys ",join(',',keys(%$t)),"\n";
				print  "values ",join(',',values(%$t)),"\n";
				print  "header\t$header\n";
				print  "ic\t$ic\n";
				print  "i\t$i\n";
				print  "Tm max slope\t$$t{'Tm_max_slope'}\n";
				print  "Tm avg\t$$t{'Tm_avg'}\n";
				print  "I30\t$$t{'I_30'}\n";
				print  "R30\t$$t{'R30'}\n";
				print  "Rmt\t$$t{'Rmt'}\n";
				print  "Imax\t$$t{'I_max_obs'}\n";
			}
			my $tm_max_slope = exists $$t{'Tm_max_slope'} 
						? $$t{'Tm_max_slope'} : 0;
			printf $out 
			    "\"%s\",%u,%.1f,%.1f,%.2f,%.3f,%.3f,%.5f,%.5f,%.5f",
				$header, 
				$col, 
				$$t{'Tm_max_slope'}, $$t{'Tm_avg'}, 
				$$t{'FWHM'},
				$$t{'Rmt'}, $$t{'R30'}, 
				$$t{'I_30'}, $$t{'I_tm'}, $$t{'I_max_obs'};
			$ystring .= sprintf "\t\t\t<SAMPLE name=\"%s\" ".
				"well_number=\"%u\" ".
				"Tm_max_slope=\"%.1f\" Tm_avg=\"%.1f\" ".
				"FWHM=\"%.2f\" ".
				"Rmt=\"%.3f\" R30=\"%.3f\" ".
				"I30=\"%.5f\" Itm=\"%.5f\" Imax_obs=\"%.5f\"",
				$header, 
				$col, 
				$$t{'Tm_max_slope'}, $$t{'Tm_avg'}, 
				$$t{'FWHM'},
				$$t{'Rmt'}, $$t{'R30'}, 
				$$t{'I_30'}, $$t{'I_tm'}, $$t{'I_max_obs'};

			my $cmd_file_base = "";

			if ($fit) {
				print "Tm fit result: ",Dumper($t) if $debug;
				# Print up to 3 fitted residual transitions (fitting to be done)
				my $ntrans = 0;
				my $transitions = 0;
				if (exists $$t{'transitions'}) {
					$transitions = $$t{'transitions'};
					if ($transitions) {
						print "Transitions returned: ",
						Dumper(@$transitions) if $debug;
						$ntrans  = @{$transitions};
					}
				}
				my $nmajor=exists_or_zero(\%$t,'major_transition');
				my $ndelta=exists_or_zero(\%$t,'max_delta_transition');
				my $imin = exists_or_zero(\%$t,'i_min_trans');
				my $iinit= exists_or_zero(\%$t,'bg_init');
				my $iexp = exists_or_zero(\%$t,'bg_exp');;
				my $rmsd = exists_or_zero(\%$t,'RMSD');;0;
				my $rabs = exists_or_zero(\%$t,'R_abs');;
				my $imax = exists_or_zero(\%$t,'I_max_obs');
				$imax = 1 if $imax < 1e-10;
				printf $out ",%u,%u,%u,%.4f,%.3f,%.3f,%.7f", 
					$ntrans, $nmajor, $ndelta, $rabs, 
					$imin/$imax, $iinit/$imax, $iexp;
				my $discontinuity = exists_or_zero(\%$t,
							'discontinuity');
				my $dtext = '';
				my $dtype=exists_or_zero($discontinuity,'type');
				if ($discontinuity) {
					if ($dtype eq 'y') {
					    $dtext = 'sudden intensity jump';
					} elsif ($dtype eq 'x') {
					    $dtext = 'sudden temperature jump';
					} elsif ($dtype eq 'ylim') {
					    $dtext = 'intensity plateaus';
					}
					my $t_skip = exists_or_zero(
						$discontinuity, 't_skip');
					$dtext .= sprintf(" at %.1f C",$t_skip)
						if $dtype ne 'drop' && $t_skip;
				} elsif (!$transitions) {
					my $reason=exists_or_zero(\%$t,'reason');
					$dtext = $reason ? $reason 
							 : 'NO INTENSITY GIVEN!';
				}
				$ystring .= sprintf(" transition_count=\"%u\" ".
					"major_transition=\"%u\" ".
					"max_delta_transition=\"%u\" ".
					"RMSD=\"%.5f\" ".
					"R_abs=\"%.5f\" ".
					"Imin_transition=\"%.5f\" ".
					"I_initial=\"%.5f\" ".
					"I_exp_decay=\"%.7f\"",
					$ntrans, $nmajor, $ndelta, $rmsd, $rabs, 
					$imin, $iinit, $iexp);
				$ystring .= " data_quality_problem=\"$dtext\" " 
					if $dtext;
				$ystring .= ">\n";
				print "ystring end:",substr($ystring,-20),"\n" if $debug;
				print "Data quality problem: $dtext\n" 
					if $debug && $dtext;
				print "Min = $imin / $imax = ",$imin/$imax,"\n"
					if $debug;
				print HTML << "EOL" if $html;
<tr> <td colspan='4'>
	 <a name='$col'><h3>Sample $col: $header</a>
	 <a href='Tm_Summary.html#$col'>(summary)</h3></a>
     </td>
</tr>
<tr> <th><a href='#$next_col'>NEXT</a></th> 
     <th>1 Transition</th> <th>2 Transitions</th> <th>3</th> <th>4</th> <th>5</th> </tr> 
<tr> <th>Sample $col Fitted</th>
EOL
				print HTML_SUM << "EOL" if $html;
<tr><td>
	<a name='$col'><b>Sample $col: $header</b></a>
	<a href='Tm_Details.html#$col'>(details)</a>
    </td>
</tr>
<tr><td colspan='2'>
EOL
				my $it = 1;
				if ($ntrans) {
				    my $nt = @$transitions;
				    my $max_id = 0;
				    $max_id = exists_or_zero($$transitions[ $ndelta - 1 ],'Id');
				    foreach my $trans (@$transitions) {
					my $tm_fit = exists_or_zero($trans,'Tm');
					my $sd_tm = exists_or_zero($trans,'sd_tm');
					my $fwhm = exists_or_zero($trans,'FWHM');
					my $id   = exists_or_zero($trans,'Id');
					my $slope = $id/ ($fwhm ? $fwhm*$k4:1);
					my @qlist = ();
					push @qlist, '! delta > 2x max' if 
						$id > 10*$imax;
					push @qlist, '! std. dev. above 10 C' if
						$sd_tm > 10.0;
					push @qlist, 'std. dev. above 2 C' if
						$sd_tm > 2.0 && $sd_tm <= 10.0;
					push @qlist, 'no upward slope' if 
						! $tm_max_slope;
					push @qlist, 
					  'major transition not near max. slope'
					  if ($it == $nmajor && $dtype ne 'y'
					  	&& abs($tm_max_slope-$tm_fit) > 
						List::Util::max(2,2*$sd_tm));
					push @qlist, 'residual above 0.50' if
						$rabs > 0.5;
					push @qlist, 
					  'transition width below 0.51 C' if
						$fwhm <= 0.51;
					push @qlist,
					  'transition width above 50 C' if
						$fwhm >= 50;
					my $quality = '';
					$quality = join('; ',@qlist) if @qlist;
					print "quality: '$quality'\n@qlist\n"
						if $debug;
					my $qtext = $quality ? "? $quality" : '';
					
					printf $out "\n,%u,,,,,,,,,,,,,,,",$col
					    if $it > 1;
					printf $out ",%u,%.1f,%.2f,%.5f,%.3f,".
						"%.2f",
						$it,
						$tm_fit,
						$sd_tm,
						$slope,
						$id/ ($imax ? $imax : 1.),
						$fwhm;
					print $out ",".
					    ($it==$nmajor && $it==$ndelta ? '#'
					    : $it==$nmajor ? 's' 
					    : $it==$ndelta ? 'd' : '');
					print $out ",$qtext,".
						($it == 1 ? "$dtext" : '');
					if ($html) {
					    print "Col $col it $it tmpname $tmp_name\n"
					    	if $debug;
					    my $f1 = sprintf "%s_%i_%i",
						$tmp_name, $col, $it;
					    $f1 = File::Spec->catfile($col,$f1);
					    my $obase = "<object data='$f1";
					    my $fbase = "<img src='$f1";
					    print "fbase: $fbase\n" if $debug;
					    my $class = $it==$nt? "class='used'"
					    			: "class='not_used'";
					    my $bg = $it==$nt	? "lightgreen"
					    			: "lightgray";
					    my $txt = $it==$nt	? "FINAL FIT"
					    			: "not used";
					    my $th = "\t<th $class>";
					    print HTML "$th$txt<br>&nbsp;";
					    if (-e "$gnudir/$f1.png") {
						print HTML <<"EOL";
$obase.svg' $svg_object_end 
$fbase.png' $alt 
</object> &nbsp;
EOL
					    } else {
					    	print HTML "$alt_txt\n";
					    }
					    print HTML "<br>$dtext" if $dtext;
					    print HTML "<br>$qtext" if $qtext;
					    print HTML "</th>\n";
					    if (-e "$gnudir/$f1".'_solution.png') {
						$html_solutions .= "$th$obase"."_solution.svg' $svg_object_end\n".
						"$fbase"."_solution.png' $alt \n</object></th>\n";
					    } else {
					    	$html_solutions .= "$th".
					    	    "$alt_txt</th>\n";
					    }
					    if (-e "$gnudir/$f1".'_derivative.png') {
						$html_deriv .=	"$th$obase"."_derivative.svg' $svg_object_end\n".
						"$fbase"."_derivative.png' $alt</th>\n";
					    } else {
					        $html_deriv .= "$th".
					            "$alt_txt</th>\n";
					    }
					    $bg = ($it == $nmajor && $nt > 1)
						?'#CCFFCC' : 'white';
					    my $bgd = ($it == $ndelta && $nt > 1)
						?'#CCFFCC' : 'white';
					    $html_table .= sprintf "\t<tr>\n".
						"\t\t<th>%u</th>".
						" <td>%.1f&nbsp;(%.2f)</td>".
						" <td align='right'".
						" bgcolor='$bg'>%.5f</td>".
						" <td align='right'".
						" bgcolor='$bgd'>%.2f (%.2f)</td>".
						" <td align='right'>%.2f</td>\n",
						$it,
						$tm_fit,
						$sd_tm,
						$slope,
						$id/ ($imax ? $imax : 1.),
						$id/ ($max_id ? $max_id : 1.),
						$fwhm;
					    $html_table .= "\t\t".($qtext 
					    	? "<th>$qtext</th>" 
						: "<td align='center'>".
						  '<em>none<em></td>')."\n";
					    $html_table .= "\t</tr>\n";
					    if ($it == $nt) {
						$cmd_file_base = "$f1"."_";
					    	if (-e File::Spec->catfile(
							$gnudir,$f1.".png")) {
						    print HTML_SUM <<"EOL";
$obase.svg' $svg_object_end
$fbase.png' $alt
</object>
</td>
EOL
						} else {
						    print "$alt_txt</td>";
						}
						print HTML_SUM "<td>";
						print HTML_SUM 'Data problem: '.
							"<b>$dtext</b><p>\n"
							if $dtext;
						# Append smooth_norm_bg plot command to
						# superposition command
						my $bg_local = File::Spec->catfile(
							$gnudir, 
							$f1."_smooth_norm_bg.gp");
						open SUPER_BG, $bg_local or warn
							warn "Can't open local superposed - bg plot command file $bg_local\n$!";
						my @bg_one = <SUPER_BG>;
						close SUPER_BG;
						if (@bg_one) {
							open SUPER_BG, 
							">>$super_bg_cmd" or
							warn "Can't open general superposed - bg plot command file $super_bg_cmd\n$!";
							print SUPER_BG@bg_one;
							close SUPER_BG;
						}
					    }
					}
					print "ystring   2:",substr($ystring,-20),"\n" if $debug;
					$ystring .= sprintf
						"\t\t\t\t<TRANSITION ".
							"number=\"%u\" ".
							"I_delta=\"%.5f\" ".
							"I_tm=\"%.5f\" ".
							"Tm=\"%.1f\" ".
							"sd_tm=\"%.2f\" ".
							"FWHM=\"%.2f\" ".
							"quality=\"%s\" />\n",
					    	$it,
						$$trans{'Id'},
						$$trans{'Itm'},
						$$trans{'Tm'},
						$sd_tm,
						$$trans{'FWHM'},
						$quality ? $quality : 'ok';
					print "ystring   3:$ystring\n" if $debug;
					$it++;
				    }
				} elsif ($html) {
				    my $f1 = sprintf "%i\/%s_%i_1",
				    	$col, $tmp_name, $col;
				    my $fname = "$f1.png";
				    $cmd_file_base = "$f1"."_";
				    if (-e "$gnudir/$fname") {
				        print HTML_SUM <<"EOL";
	<object data='$f1.svg' $svg_object_end
	<img src='$fname' $alt
	</object>
</td>
EOL
				    } else {
				    	print HTML_SUM "NO PLOT</td>\n";
				    }
				    print HTML_SUM "<td valign='center'>";
				    print HTML_SUM "<hr color='red' />".
					"\n<div align='center'><em><b>".
					"No transition found</em></b></div>".
					"<hr color='red' />\n";
				    print HTML_SUM "<b>$dtext</b>\n" if $dtext;
				    # print HTML_SUM "</td>\n";
				    $html_table = '';
				}
				if ($html) {
					my $fname = sprintf "%s_%i_%i",
						$tmp_name, $col, $it;
					$fname = File::Spec->catfile($col, $fname);
					my $fbase = "<img src='$fname";
					my $obase = "<object data='$fname";
					printf HTML "\t<th class='not_used'>Not used:";
					my $reason=exists_or_zero($t,'reason');
					print HTML " $reason\n" if $reason;
					if (-e "$gnudir/$fname.png") {
					    printf HTML <<"EOL";
		<br>
		$obase.svg' $svg_object_end
			$fbase.png' $alt
		</object>
	</th>
EOL
					    $html_solutions .= "\t<th class='not_used'>$obase"."_solution.svg' $svg_object_end\n".
					    	"$fbase"."_solution.png' $alt </object> </th>\n";
					    $html_deriv .= "\t<th class='not_used'>$obase"."_derivative.svg' $svg_object_end\n".
					   " $fbase"."_derivative.png' $alt </object> </th>\n";
					} else { 
					    print HTML "<br>$gnudir/$fname not",
					    	" found\n" if $debug;
					    printf HTML "<br>$alt_txt</th>\n";
					    $html_solutions .= 
					    	"\t<th>$alt_txt</th>\n";
					    $html_deriv .= 
					    	"\t<th>$alt_txt</th>\n";
					}
				}
			} else {
				$ystring .= ">\n";
			}
			print $out "\n";
			if ($html) {
				print HTML << "EOL";
</tr>
<tr>$html_solutions</tr>
<tr>$html_deriv</tr>
<tr><td><hr /></td>
    <td colspan='2'>
	<a href='#$old_col'>PREVIOUS</a> &nbsp; &nbsp; &nbsp; 
    	<a href='#top'>TOP</a> &nbsp; &nbsp; &nbsp; 
EOL
				my $cmd_links = "";
				my $link_str = "";
				my $plural = " ";
				my $link_details = " or plot transitions and derivatives: ";
				foreach my $cmd_type ( qw(fit plot 
						plot_solution plot_derivative) ) {
				    my $cmd_file_name = "$cmd_file_base$cmd_type.gp";
				    if (-e "$gnudir/$cmd_file_name") {
					if ($cmd_links) {
					    $cmd_links .= " and " 
					    	if $cmd_type !~ /plot_/;
					    $plural = "s ";
					}
				    	$cmd_links .= $cmd_type if $cmd_type !~ /plot_/;
					my $new_link = "\t\t<a href=".
					    "'$cmd_file_name'>$cmd_file_name".
					    "</a>\n&nbsp;&nbsp; ";
				    	$link_str .= $new_link if $cmd_type !~ /plot_/;
				    	$link_details .= $new_link if $cmd_type =~ /plot_/;
				    }
				}
				$cmd_links = "\t&nbsp; &nbsp; &nbsp; ".
					"gnuplot command$plural to $cmd_links data:\n".
				   "$link_str" if $cmd_links;
				print HTML $cmd_links.$link_details if $cmd_links;
				print HTML << "EOL";
    </td>
    <td colspan='2'><hr /></td>
</tr>
EOL
				print HTML_SUM << "EOL" if $html_table;

$html_table
</table>
<em>*Delta = ratio of fluorescence intensity change in this transition to maximum observed intensity 
(or to maximum transition intensity change).
</em>

EOL
				print HTML_SUM << "EOL";
	</td>
</tr>
<tr><td colspan='3'>
	<a href='#$next_col'>NEXT</a> &nbsp; &nbsp; &nbsp; 
	<a href='#$old_col'>PREVIOUS</a> &nbsp; &nbsp; &nbsp;
	<a href='#top'>TOP</a> &nbsp; &nbsp; &nbsp; 
EOL
				print HTML_SUM $cmd_links if $cmd_links;
				print HTML_SUM << "EOL";
    </td>
</tr>
<tr>
    <td colspan='3'><hr /></td>
</tr>

EOL
			}
			$ystring .= split_data_lines( {
				n_per_line => $n_per_line,
				data	   => $intensity,
				debug	   => $debug,
				} );
			$old_col = $col;
			$ystring .= "\t\t\t</SAMPLE>\n";
			print "ystring   4:$ystring\n" if $debug;

		}
	}

	# Use superposition plot commands super_cmd and super_bg_cmd
	my $dummy = "0 lt -2 title ''\n";
	open SUPER, ">>$super_cmd" or warn "Can't open $super_cmd $!";
	print SUPER $dummy;
	close SUPER;
	open SUPER, ">>$super_bg_cmd" or warn "Can't open $super_bg_cmd $!";
	print SUPER $dummy;
	close SUPER;
	if ($plot) {
		open ( GNUPLOT, "|$GNUPLOT") or warn "\tCan't open $GNUPLOT for superposition plots, please make sure that gnuplot is in your path! $1";
		print "Change to $gnudir and plot:\n $super_cmd \n".
			"$super_bg_cmd \n" if $debug;
		if ($tmin_all >= $tmax_all) {
			$tmin_all = "*";
			$tmax_all = "*";
		} else {
			# Round T range out to multiple of 5 degrees.
			# $tmin_all = ( (sprintf "%i", $tmin_all/5) - 0.9999)*5;
			# $tmax_all = ( (sprintf "%i", $tmax_all/5) + 0.9999)*5;
		}
		$super_cmd = File::Spec->abs2rel($super_cmd, $gnudir);
		$super_bg_cmd   = File::Spec->abs2rel($super_bg_cmd, $gnudir);

		print "gnudir: '$gnudir'\n" if $debug;
		print GNUPLOT <<"EOL";
cd "$gnudir"
set terminal $plot font "arial"
EOL
		my $super_command =  <<"EOL";
set output "$super_plot"
set xrange [$tmin_all:$tmax_all]
load "$super_cmd"
set output "$super_plot_bg"
load "$super_bg_cmd"
EOL
		print GNUPLOT $super_command;
		if ($plot =~ /png/i) {
			$super_command =~ s/png/svg/g;
			print GNUPLOT $svg_terminal_command;
			print GNUPLOT $super_command;
		}
		close GNUPLOT;
		print "super_command = \n$super_command\n" if $debug;
	}

	print $out "<!-- NOTE: I_min, I_exp_initial & I_delta_N are fractions ",
		" of maximum observed fluorescent intensity (Imax_obs).\n",
		"  Tm and FWHM are in degrees Celsius.\n",
		"  On the right, major transitions are marked:\n",
		"      '#' = both maximum slope and intensity delta\n",
		"      's' = maximum slope only,\n",
		"      'd' = maximum delta only.\n",
		"  Transitions with questionable quality have '?' to the right -->\n" if $fit;
	print $out "\t</TABLE>\n" if $print_deriv;
	#
	# Print derived and raw data in XML format
	#
	
	
	# Print X axis label and values
	print $out "\t<DATA>\n";
	print $out "\t\t<X_AXIS label=\"Temperature (Celsius)\">\n";
	print $out split_data_lines( {
				n_per_line => $n_per_line,
				data	   => $temperature,
				debug	   => $debug,
				} );
	# print $out join(',',@$temperature[0..$lasttemp])."\n";
	print $out "\t\t</X_AXIS>\n";
	
	# Print Y axis label
	print $out "\t\t<Y_AXIS label=\"Fluoresence\">\n";
	# Print Y values for each sample
	print "ystring   5:$ystring\n" if $debug;

	print $out "$ystring";
	print $out "\t\t</Y_AXIS>\n";
	print $out "\t</DATA>\n";
	
	print $out "</DERIVED_VALUES>\n" if ($print_deriv);
	if ($print_raw) {
		print $out "<RAW_DATA>\n";
		# my @head_fields = split /$delim/,$lines[$headline];
		# Print headers for raw data
#		print $out "$headers[$fixedcol],\"";
		print $out "Temp.,\"";
		print $out join('","', @all_heads),"\"\n";
#		for (my $i = 0; $i < @columns; $i++) {
#			foreach $col (@columns) 
#			if ($col =~ /^[0-9]+$/) {
#				print $out ",$head_fields[$fixedcol+$col]";
#			} else {
#				print $out ",$col";
#			}
#		}
#		print "\n";
		# Print values of raw data
		for (my $i=0; $i < @$temperature; $i++) {
			last if ($i > 5 && @$temperature[$i] eq '');
			print $out "@$temperature[$i]";
			for (my $j=0; $j < @columns; $j++) {
				print $out ",${$all_intensities[$j]}[$i]" 
				  if defined(${$all_intensities[$j]}[$i]);
			}
			print $out "\n";
		}
		print $out "</RAW_DATA>\n";
	}
	print $out "<FOOTER> <![CDATA[ \n",
		join("\n",@lines[(($last_data_line+1) .. $#lines)]),
		"\n]]> </FOOTER>\n" if ($last_data_line < $#lines);
	print $out "</TM_DATA>\n";
	close OUTFILE;
	if ($html) {
		my $end = "</TABLE><hr />\n".
			"<div align='center'><em>### end ###</em></div>\n".
			"</BODY></HTML>\n";
		print HTML $end;
		print HTML_SUM $end;
		close HTML;
		close HTML_SUM;
	}
	exit(0);
}


sub split_data_lines{
	my %param = validate( @_, {	data => { type => ARRAYREF },
					n_per_line => { type=>SCALAR, 
							default=> 50 },
					debug 	   => { type=>SCALAR, 
							default=>0 },
					verbose	   => { type=>SCALAR, 
							default=>0 },
					test	   => { type=>SCALAR,
							default=>0 },
			  	  } );
	my @data	= @{$param{'data'}};
	my $n_per_line  =   $param{'n_per_line'};
	my $debug 	=   $param{'debug'};
	my $test  	=   $param{'test'};
	# $test = 1;
	return '' if ! scalar(@data);
	my $last_line = $#data;
	if ($test) {
		print "DO NOT split ",@data+0," data points from 0 to $last_line\n" 
			if $debug;
		return join(',',@data[0..$last_line])."\n";
	}
	
	my $i = 0;
	my $str = '';
	print "Split 0 to $last_line out of ",@data+0,"\n" if $debug;
	for ($i=0; $i< $last_line - $n_per_line; $i += $n_per_line) {
		print "$i to ",$i+$n_per_line-1,"\n" if $debug;
		$str .= join(',', @data[$i..($i+$n_per_line-1)]).",\n";
	}
	print "$i to $last_line\n" if $debug;
	$str .= join(',',@data[$i..$last_line])."\n";
	return $str;
}

###############################################################################
#
# parse_xml: extract data from XML in e.g. .tmc.csv files and put it into a hash
#
# In: lines of text from .tmc file, tag names
# Out: Text arrays of HEADER, FOOTER and for old version, RAW_DATA;
#	for versions after tm_calc_1.04, return temperature array and
#	intensity array of array refs.
###############################################################################

sub parse_xml {

	my %param = validate( @_, {
				lines	 => {	type	=> ARRAYREF },
				wraptag  => {	type	=> SCALAR,
						default => 'TM_DATA' },
				keeptags => {	type	=> SCALAR,
						default => 
						  '(DATA|HEADER|FOOTER)' },
				rawtag	 => {	type	=> SCALAR,
						default => 'DATA' },
				debug	 => {	type	=> SCALAR, 
						default	=> 0      },
				verbose	 => {	type	=> SCALAR, 
						default	=> 0      },
			  	  } );
	my @lines	= @{$param{'lines'}};
	my $wraptag	= $param{'wraptag'};
	my $keeptags	= $param{'keeptags'};
	my $rawtag	= $param{'rawtag'};
	my $debug	= $param{'debug'};
	my $verbose	= $param{'verbose'};

	# Trim out extra junk added by saving "csv" files in Excel:
	#    Drop double quote at beginning of line,
	#         double quote followed by commas at end of line,
	#         double quote before or after a comma (leave just comma),
      #         one of two double quotes in a row ("" -> ")

	my @newlines = ();
	foreach my $line (@lines) {
		if ( $line =~ /"/) {
			print "line |$line|\n " if $debug > 1;
			if ( $line =~ /^".*",*$/) {
				$line =~ s/^"//g;
				$line =~ s/",*$//g;
				print "  => |$line|\n" if $debug > 1;
			}
			$line =~ s/",/,/g;
			$line =~ s/\,"/,/g;
			$line =~ s/""/"/g;
			print "  ==> |$line|\n" if $debug > 1;
		} elsif ($line =~ /^[,.0-9 ]+$/ && $line !~ /,\s*$/) {
			# Add a comma at end of a line of numbers, in case
			# it got taken out by Excel. Remove last comma later.
			$line .= ",";
		}
		push @newlines, $line; 
	} 
 	@lines = @newlines;

	my $text   = join("\n", @lines);
	my @tokens = split '<', $text;
	my %result = ();

	# Go through file keeping header, raw data and footer lines but not tags
	# Use file text with lines joined by \n; split this into tokens by '<',
	# giving tokens:
	# 	... (possible junk before wrapper)
	# 	TM_DATA ... source='.........' ... >
	#	HEADER> header contents
	#	/HEADER>
	#	DERIVED_VALUES> ...
	#	/DERIVED_VALUES>
	# then either:
	#	RAW_DATA>
	#		Temp,"Sample Label 1","Sample Label 2", ...
	#       	20.0,0.123,0.345, ...
	#		...
	#		90.0,...
	#	/RAW_DATA>
	# or:
	#	DATA>
	#	X_AXIS label="Temperature, Celsius">
	#		20,20.2,20.4,...
	#	/X_AXIS>
	#	Y_AXIS label="Fluorescence">
	#	SAMPLE name="a2" ...>
	#	TRANSITION ... />
	#		0.0123, 0.0124, ...
	#	/SAMPLE
	#	SAMPLE ...
	#	/SAMPLE
	#	...
	#	/Y_AXIS
	# then:
	#	FOOTER
	#	/FOOTER
	#	/TM_DATA

	# Capture source from wrapper, header and footer tags, and either
	# all of RAW_DATA tag or X_AXIS, SAMPLE name and SAMPLE data.
	
	my @int_in  = ();	# array of refs to Y arrays
	my @sample  = ();	# array of sample names
	my $state = -2;		# -2 = before wrapper tag,
				# -1 = within wrapper, before source 
				#  0 = between keep tags
				#  1 = start keep tag
				#  2 = inside keep tag
	my $tag    = 0;
	
	print "Parse XML: ",@lines+0," lines, ",@tokens+0," tokens\n" 
		if $debug;
	print "Wrapper=$wraptag, keep=$keeptags, raw=$rawtag\n" if $debug;
	print "First 3 lines: ",join("\n",@lines[0..2]),"\n" if $debug;
	foreach my $token (@tokens) {
		print "State: $state, Token: '$token'\n" if $debug > 1;
		last if ($token =~ /^\/$wraptag/i);
		$state = 2 if $state == 1;	# state 2 = inside keep tag
		$state = -1 if ($token =~ /^$wraptag/i);
		# For all <{Alpha}*> ... or <{Alpha}* ...>, but NOT <.../>
		# Do NOT change tag for tags without content e.g. TRANSITION
		if ($token =~ /^[A-z]/ && $token !~ /\/>/) {
			($tag = $token) =~ s/[\s>].*//g;	# trim trailing text
		}
		my $close_tag = 0;
		$close_tag = substr($token,1,length($tag)) 
			if substr($token,0,1) eq '/';
		print "Close tag $close_tag\n" if $close_tag && $debug;
		if ($close_tag =~ /^$keeptags/i) {
			$state = 0;			# close keep tag
			next;
		}
		next if $close_tag;			# close any other tag
		print "Tag '$tag', state $state\n" if $debug > 1;
		if ($state == -1) {
			# Get source file name, if any
			if ($token =~ /source=/si) {
				(my $src = $token) =~ s/.*source=["']//sg;
				print "Source 1: $src\n" if $debug;
				$src =~ s/["'].*//sg;
				print "Source 2: $src\n" if $debug;
				$result{'in_file_name'} = $src if ($src);
				$state = 0;
			}
		}
		(my $value = $token) =~ s/.*>\s*//sg;	# trim leading space
		$value =~ s/\s*$//sg;			# trim trailing space
		print "Value '$value'\n" if $debug;
		if ($tag =~ /$keeptags/i) {
			$state = 1;			# open keep tag
			if ($value gt ' ') {			# skip - no contents
				$state = 2;
				print "keep tag $tag: value='$value'\n" if $debug>1;
				if ($tag =~ /(RAW_DATA|HEADER|FOOTER)/i) {
					my @keep_data = split "\n", $value;
					$result{lc($tag)} = \@keep_data;
				}
			}
			
		# Process tags within <DATA>: X_AXIS, SAMPLE
		} elsif ($tag =~ /^X_AXIS/i) {
			if ($value =~ /,/) {
				# $value =~ s/,,+//sg;
				# $value =~ s/"//sg;
				$value =~ s/\s//g;
				$value =~ s/,$//g;
				my @temp_in = split /,/,$value;
				$result{'temperature'} = \@temp_in;
				my $n3 = @temp_in - 3;
				my $n1 = @temp_in - 1;
				print "Parsed ",@temp_in+0," temps, ",
					join(' ',@temp_in[0..3])," ... ",join(' ',@temp_in[-3..-1]),"\n" if $debug;
			}
		} elsif ($tag =~ /^SAMPLE/i) {	
			if ($token =~ /name=\"/i) {
				(my $name = $token) =~ s/.*name=["']//gi;
				# print "Name: $name\n" if $debug;
				my $q = index $name, '"', 1;
				$q = index $name, "'" if $q < 1;
				$name = substr $name, 0, $q;
				push @sample, $name;
				print "Name: $name\n" if $debug > 1;
			}
			if ($value =~ /,/) {
				$value =~ s/,,+//sg;
				$value =~ s/"//sg;
				$value =~ s/\s//g;
				my @int_row = split /,/, $value;
				push @int_in, \@int_row;
				print "Parsed ",@int_row+0," intensities ".
					"for sample ",@int_in+0,"\n" if $debug;
				print "Values: | ",join(' | ',@int_row[0..3]),
					" | ... | ", join(' | ',@int_row[-3..-1]),"\n" if $debug > 1 || 
					($debug > 0 && @int_in < 5);
			}
		}
	}
	print "Parsed ",@int_in+0," samples and ",@sample+0," names\n" if $debug;
	print "Samples = | ",join(' | ',@sample),"\n" if $debug > 1;
	my $junk = 'xyz';
	$result{'sample_names'} = \@sample;
	$result{'intensity'}	= \@int_in;
	print "Header:\n-->",join("\n-->",@{$result{'header'}}),"\n" if $debug;
	print "Footer:\n-->",join("\n--<",@{$result{'footer'}}),"\n" if $debug;
	return \%result;
}

####################################################################
#
# find_headline - find header line of table = 1st with N delimiters 
#
# Pass in array of lines, delimiter, and number of columns
# Pass out index of first line with the right number of non-blank columns,
# and the column of the fixed text e.g. "Tem" for temperature.
####################################################################

sub find_headline {
	my %param = validate( @_, {	lines => { type => ARRAYREF },
							delim => { type=>SCALAR, default=>',' },
							head  => { type=>SCALAR,default=>'Tem'},
					ncols => { type=>SCALAR, default=>2 },
					debug => { type=>SCALAR, default=>0 },
							verbose	=> { type=>SCALAR, default=>0 },
			  	  } );
	my @lines = @{$param{'lines'}};
	my $delim = $param{'delim'};
	my $head  = $param{'head'};
	my $ncols = $param{'ncols'};
	my $debug = $param{'debug'};
	my $verbose=$param{'verbose'};
	my $i = -1;
	my $n = $#lines;
	my $old_count = -1;
	my $fallbackline = -1;
	my $fallbackcol = -1;
	print "Find headline, head=$head, delim=$delim, ncols=$ncols\n" if $debug;
	my @fields = ();
	foreach my $line (@lines) {
		$i ++;
		print "  Line $i = '$line'\n" if $debug;
		next if (! $line =~ /$delim/);
		# Count number of non-blank fields split by delimiter
		my $count = 0;
		@fields = split_quoted_delim("$delim", $line);
		print "fields: \n'",join("'\n'",@fields[(0..List::Util::min(5,$#fields))]),"'\n...\n" if $debug;
		my $headcol = -1;
		my $j = 0;
		foreach (@fields) { 
			print "	field='$_'\n" if $debug > 1;
			s/^\s*//g;
			if ($_ ne '') { 
				$count ++; 
				$headcol = $j if ($_ =~ /^$head/);
				print "	  headcol=$headcol\n" if $debug > 1;
			}
			$j ++;
		}
		print "Find headline: found ",($#fields+1)," fields for line $i, col $headcol\n" if $debug; 
		print "First 5 headers:\n'",join("'\n'",@fields[(0..List::Util::min(5,$#fields))]),"'\n" if $debug; 
		return ( { header_line => $i, fixed_col => $headcol,
				headers => \@fields } )
			  if ($count >= $ncols-1 && $headcol >= 0);
		$fallbackline = $i if ($count == $ncols);
		$fallbackcol = $headcol if ($headcol >= 0);
		# if ($count) {
			# # Stop on finding 2 in a row with almost the right number
			# return ($i-1) if ($count == $old_count);
			# $old_count = $count;
		# }

		# Give up half-way through the file.
		last if ($i > $n / 2);
	}
	my @next_line_fields = split /$delim/, $lines[$fallbackline + 1];
	for (my $i=0; $i<@next_line_fields; $i++) {
		@fields = split_quoted_delim($delim,$lines[$fallbackline]);
		return ( { header_line => $fallbackline, fixed_col => $i, 
				headers => \@fields } )
			if ( $next_line_fields[$i] =~ /^\s*[0-9][0-9]\.[0-9]$/);
	}
	return 0;
}

####################################################################
#
# find_delimiter = find comma, tab or other consistent delimiter 
#
# Returns delimiter character if any, number of columns if fixed, or 0,
#		and number of columns found.
# Pass in reference to file handle and (optionally) number of digits expected:
# 	digits_left_1  = Number to left of decimal place in first real number
# 	digits_right_1 = Number of right of decimal place in first real number
# 	digits_left_2  = Number to left of decimal place in other real numbers
# 	digits_right_2 = Number of right of decimal place in other real numbers
#
##################################################################

sub find_delimiter {
	my %params = validate( @_,{	
			lines => { type	=> ARRAYREF },
			digits_left_1	=> { type => SCALAR, default => 2 },
			digits_right_1	=> { type => SCALAR, default => 1 },
			digits_left_2	=> { type => SCALAR, default => 1 },
			digits_right_2	=> { type => SCALAR, default => 4 },
				debug		=> { type => SCALAR, default => 0 },
				verbose		=> { type => SCALAR, default => 0 } 	
				  } );

	my @lines = @{$params{'lines'}};
	my $nlines = @lines;
	my $dig_l1 = $params{'digits_left_1'};
	my $dig_r1 = $params{'digits_right_1'};
	my $dig_l2 = $params{'digits_left_2'};
	my $dig_r2 = $params{'digits_right_2'};
	my $debug  = $params{'debug'};
	my $verbose = $params{'verbose'};
	print "find_delimiter in $nlines, digits = $dig_l1,$dig_r1,$dig_l2,$dig_r2\n" if ($debug > 1);

	# Scan lines of input file for 10 lines with consistent delimiter 
	# Count number of each possible delimiter character on each line
	#
	# Store number of times the count is the same for each character
	# Stop when any character's "same" count reaches 10, or the number 
	# of lines read reaches 100 (no delimiter found)

	# my $delim_str = ",\tsw:;|~!@#\$%^&*_=i/?()[]{}<>";
	my $delim_str = ",\tsw:;|~!@#\$%^&_=i/";
	my @delim_arr = split //, $delim_str;
	print join(',',@delim_arr),"\n" if $debug > 1;
 	my @count = ();
	my $n = 0;
	my $i = 0;
	my $j = 0;
	foreach $i (@delim_arr) {
		push @count, 0;
	}
	my $m1 = 25;
	my $m2 = 75;
	if ($nlines < $m2) {
		$m1 = $nlines / 4;
		$m2 = $nlines / 2;
	}
	my $m = $m2 + 1 - $m1;
	print "m=$m m1=$m1 m2=$m2\n" if $debug > 1;
	# my $maxlines = 100;
	# my $start_test = $nlines/2;

	# Test the lines from $m1 to $m2 for delimiter

	# Initiallize hash of delim and linenum-delim
	my %occurs;
	my %totals;
	foreach $j (@delim_arr) {
		$j = 't' if ($j eq "\t");
		$totals{$j} = 0;
		foreach $i ($m1..$m2) {
			$occurs{ "$i-$j" } = 0;
		}
	}
	# $totals{'white'} = 0;
	# foreach $i ($m1..$m2) { $occurs{ "$i-white" } = 0; }

	foreach $i ($m1..$m2) {
		my $white = 1;
		print "$i: $lines[$i]" if $debug >2;
		my @chars = split //, $lines[$i];
		# print join(':',@chars),"\n" if $debug>2;
		foreach $j (@chars) {
			print "'$j'\n" if $debug >3;
			if (index("$delim_str", "$j") >= 0 && $j ne 'w' || $j eq ' ')
					{
				print "Index of '$j' in delim: ",index("$delim_str","$j"),"\n" if $debug >2;
				$j = 't' if ($j eq "\t");
				$j = 's' if ($j eq ' ');
				$occurs{ "$i-$j" } = $occurs{ "$i-$j" } + 1;
				$totals{ $j } = $totals{ $j } + 1;
				print "'$j' '$i-$j'\n" if $debug >2;
				# print "occurs $occurs{"$i-$j"}\n" if $debug >3;
			}
			if ( $j =~ /\s/ ) {
				if (! $white ) {
					$occurs{"$i-w"} =$occurs{"$i-w"}+1;
					$totals{"w"} =$totals{"w"}+1;
					$white = 1;
				}
			} else  { 
				$white = 0 
			};
		}
	}
	my @any = ();
	my $nperline = 0;
	foreach $j (@delim_arr) {
		$j = "\t" if $j eq 't';
		my @fields = split /$j/, "$lines[$m1]";
		my $nfields = @fields;
		print "find delim: delim '$j' $nfields fields ",join(' : ',@fields),"\n"
			if $debug > 1;
		$j = 't' if ($j eq "\t");
		$j = 's' if ($j eq ' ');
		print "'$j' total: $totals{$j}\n" if $debug > 1;
		if ($totals{$j}) {
			$nperline = $occurs{"$m1-$j"};
			$nperline = $nfields - 1 if ($nperline > $nfields-1);
			print "start: nperline=$nperline, nfields=$nfields\n" if $debug>1;
			while ($nperline > 0 && $fields[$nperline] le " ") { 
				print "  nperline $nperline field ".
					"'$fields[$nperline]'\n" if $debug > 1;
				$nperline --; 
			}
			print "$nperline\n" if $debug > 1;
			foreach $i (($m1+1)..$m2) {
				my $n_this_line =$occurs{"$i-$j"};
				print "$n_this_line =? $nperline\n" if $debug > 2;
				if ($n_this_line < $nperline) {
					# Allow early end e.g. for SGC Transforms
					$nperline = -1 if i$ - $m1 < 25 && 
								$n_this_line > 2;
					last;
				}
			}
			print "$j $nperline\n" if $debug > 1;
			if ($nperline > 0) {
				print "Found delim '$j',",($nperline+1),"\n" if $debug;
				$j = "\t" if ($j eq 't');
				$j = " " if ($j eq 's');
				print "  ==> delim '$j'/n" if $debug;
				print "return '$j',",($nperline+1),"\n" if $debug > 1;
				return( {delim => "$j",ncols =>($nperline+1)} );
			} else {
				push @any, $j;
			}
		}
	}
	# Check for fixed length - to be done
	# Return first delimiter that occurs at least once on each line
	my $max = 0; 
	my $most = 0;
	foreach $j (@any) {
		$i = $totals{$j};
		return ( {delim => $j, ncols => int($i/$m) }) if ($i >= $m);
		if ($i > $max) {
			$max = $i;
			$most = $j;
		}
	}
	# If no delimiter occurs once on each line, return most frequent delim.
	return ( { delim => "$most", ncols => (int($max/$m)+1) } );
}

###################################################################
#
# find_columns - find columns given a header or range of headers
#
# Pass in the header line, delimiter, first data column number and 
# an array of column specifiers as numbers or text where text may be 
# a range e.g. A2-B4.
#
# Pass out an array of column specifiers as all numbers, with ranges
# of text expanded into all columns between the first and last column
# by position in the file (NOT alphabetically), and array of headers.
#
#####################################################################

sub find_columns {
	my %params = validate ( @_, {	headers	=> {type => ARRAYREF},
					fixedcol=> {type => SCALAR, default=>3},
					cols	=> {type => ARRAYREF },
					debug	=> {type => SCALAR, default=>0},
					verbose	=> {type => SCALAR, default=>0},
				} );
	my @allheaders 	= @{$params{'headers'}};
	my @cols	= @{$params{'cols'}};
	my $fixedcol	= $params{'fixedcol'};
	my $verbose 	= $params{'verbose'};
	my $debug	= $params{'debug'};

#	my @allheaders 	= split /$delim/, $headtxt;
	my @headers 	= @allheaders[(($fixedcol+1) .. $#allheaders)];
	my @headers_out = ();
	print "Headers: ",join(',',@headers),"\n" if $debug;
	print "Columns: ",join(',',@cols),"\n" if $debug;
	my @result = ();
	foreach my $col (@cols) {
		$col =~ s/^\s*//g;
		$col =~ s/\s*$//g;
		print "Find col $col\n" if $debug;
		if ( $col =~ /^[0-9]+$/ ) {
			push @result, $col;
		} else {
			my $start = $col;
			my $stop  = $col;
			if ( $col =~ /-/ ) {
					my $dash = index($col, '-');
					$start = substr($col,0,$dash);
					$stop  = substr($col,($dash+1));
					$start =~ s/\s*$//g;
					$stop  =~ s/^\s*//g;
					# Allow for e.g. A2-6
					if ($start =~ /^[A-Ha-h][0-9][0-9]?$/ && 
						$stop  =~ /^[0-9][0-9]?$/) {
						$stop = substr($start,0,1).$stop;
					}
			}
			my $inrange = 0;
			my @newset = ();
			my $found_end = 0;
			foreach my $i (1..@headers) {
				my $thishead = $headers[$i-1];
				$thishead =~ s/^\s*//g;
				$thishead =~ s/\s*$//g;
				next if (!$thishead);
				print "  Test: col $i, '$thishead' in '$col'?\n" if ($debug);
				$inrange = 1 if match_well($thishead,$start);
				
				if ($inrange) {
					push @newset, $i;
					print " FOUND $thishead at '$i'\n" if ($debug);
				}
				if (match_well($thishead, $stop)) {
					push @result, @newset;
					$found_end = 1;
					last;
				}
			}
			print STDERR "\nWARNING: Cannot find start of range column '$start'\n\n" 
				if ! @newset;
			print STDERR "\nWARNING: Cannot find end of range column '$stop'\n\n" 
				if ! $found_end && $stop ne $start;
		}
	}
	print STDERR "\nERROR: No columns found!\n\n" if ! @result;
	return (@result);
}		

#####################################################################
#
# match_well - match identical strings or wells, e.g. A2=A02, 
#		or "A2: ..."=A2=A02
#####################################################################
sub match_well {
	my ($a, $b) = @_;
	return (1) if ($a =~ /^$b$/i);		# exact match, ignore case
	return (0) if (	$a !~ /^[A-H][0-9][0-9]?/i ||
			$b !~ /^[A-H][0-9][0-9]?$/i);	# a or b is not a well
	my $ac = uc(substr($a,0,1));
	my $bc = uc(substr($b,0,1));
	my $sep = ":";				# separator eg : in A02: ...
	# an is first, and if any, second digit
	my $an = substr($a,1,1);
	$an = substr($a,1,2) if ($a =~ /^[A-h][0-9][0-9]/);
	# Separator is character after last digit in well, if any; default = :
	$sep = substr($a,length($an)+1,1) if (length($a) > length($an)+1);
	return (0) if ($sep ne ":");		# a is neither just a well nor well: 
	my $bn = substr($b,1);
	# Match letters and numbers before the separator, e.g. A02=a2
	return ($ac eq $bc && $an == $bn);
}

	
#####################################################################
#
# split_quoted_delim - split text on delim combining quoted tokens
#
# Pass in: delimiter, text e.g. A,"B, C, D",E
# Pass out: array of values e.g. "A", "B, C, D", "E"
#####################################################################

sub split_quoted_delim {
	my ($delim, $text) = @_;
	return 0 if (! $text);
	my $debug = 0;
	my @fields = split /$delim/, $text;
print "Split quoted delim=$delim, text=$text\n" if $debug;
	return 0 if ! @fields;
print "'",join("'\n'",@fields[0..$#fields]),"'\n" if $debug;
	return (@fields) if ($text !~ /["']/);
	my @newfields = ();
	my $newvalue = "";
	my $q = "";
	foreach (@fields) {
		print "   field $_\n" if $debug;
		if ($_ =~ /^["']/) {
			$newvalue = substr($_,1);
			$q = substr($_,0,1);
			if ($newvalue =~ /$q$/) {
				$newvalue = substr($newvalue,0,-1);
				print "whole value $newvalue\n" if $debug;
				push @newfields, $newvalue;
				$newvalue = "";
			} else {
				print "      new value start $newvalue\n" if $debug;
			}
		} elsif ($newvalue && $_ =~ /$q$/) {
			$newvalue .= $delim.substr($_,0,length($_)-1);
			print "      end value with $_ to $newvalue\n" if $debug;
			push @newfields, $newvalue;
			$newvalue = "";
		} elsif ($newvalue) {
			$newvalue .= $delim.$_;
			print "      extend value with $_ to $newvalue\n"  if $debug;
		} else {
			push @newfields, $_;
		}
	}
print "End Split quoted fields=\n'",join("'\n'",@newfields[0..List::Util::min(5,$#newfields)]),"'\n" if $debug;
	return (@newfields);
}


###################################################################
#
# get_column - pull out a pair of columns from data lines
#
# Pass in data lines, header line number, fixed and data column numbers
# and delimiter.
# Pass out header value and arrays for data and fixed columns.
# datacol is column number after fixed col, counting from 1 = 1st to the right
#
###################################################################

sub get_column {
	my %params = validate ( @_, {	lines	 => { type => ARRAYREF },
					headers	 => { type => ARRAYREF },
					headline => {type=>SCALAR, default=>0 },
					fixedcol => {type=>SCALAR, default=>0 },
					datacol	 => {type=>SCALAR, default=>1 },
					delim	 => {type=>SCALAR,default=>','},
					debug	 => {type =>SCALAR, default=>0},
					verbose	 => {type =>SCALAR, default=>0} 	
					} );
# start:
	my $i = 0;
	my @fixed = ();
	my @data  = ();
	my $dcol = 0;
	my $head = 0;
	my @lines 	= @{$params{'lines'}};
	my $delim 	= $params{'delim'};
	my $headline 	= $params{'headline'};
	my @headers 	= @{$params{'headers'}};	# split /$delim/, $lines[$headline];
	my $datacol  	= $params{'datacol'};
	my $fixedcol 	= $params{'fixedcol'};
	my $verbose 	= $params{'verbose'};
	my $debug	= $params{'debug'};

	print "Get column '$datacol'\n" if ($debug);
	if ($datacol =~ /^[0-9]+$/) {
		$dcol = $datacol + $fixedcol;
		return 0 if ($#headers < $dcol);
		$head = $headers[$dcol];
	} else {
		# Search for a single column, or first column in an alphabetic range
		print "Text column header '$datacol'\n" if ($debug);
		$head = $datacol;
		$head =~ s/^\s*//g;
		$head =~ s/\s*$//g;
		my $start = $head;
		my $stop = $head;
		if ($head =~ /-/) {
				my $dash = index($head, '-');
				$start = substr($head,0,$dash);
				$stop  = substr($head,($dash+1));
		}
		foreach $i (($fixedcol+1)..@headers) {
			next if (!$i);
			my $thishead = $headers[$i];
			$thishead =~ s/^\s*//g;
			$thishead =~ s/\s*$//g;
			print "	Is col $i, '$thishead' = '$head'?\n" if ($debug);
			if ($thishead >= $head && $thishead <= $head) {
				$dcol = $i;
				print " FOUND $head at '$i'\n" if ($debug);
				last;
			}
		}
		return 0 if (! $dcol);
	}
	print "Get column # $dcol\n" if $debug;

	my $last_line = scalar(@lines) - $headline;
	my $top_short = 1;
	foreach $i (($headline+1)..@lines) {
		print "Got line $i: $lines[$i]\n" if $debug && $i < $headline+5;
		next if (! $lines[$i]);
		my @fields = split /$delim/, $lines[$i];
		print "\tGot ",@fields+1," fields\n" if $debug && $i < $headline+5;

		# Skip blank or short lines just after header line
		next if scalar(@fields) < $dcol && $i < $headline + 5 && $top_short;
		$top_short = 0;

		# Stop if temperature is null, non-numeric, or 
		# blank and we're not at the start
		if ( @fields < $fixedcol ||
	             (! exists( $fields[$fixedcol] ) ) ||
	             $fields[$fixedcol] eq '' ||
		     $fields[$fixedcol] =~ /[^.0-9 ]/ ||
		    ($i > 5 && $fields[$fixedcol] le ' ') ) {
			print "End of data at line $i: $lines[$i]\n" if $debug;
			last;
		}
		# Skip if not enough fields in record or temp is blank
		next if (@fields < $dcol);
		$fields[$fixedcol] =~ s/\s//g;
		push @fixed, $fields[$fixedcol];
		push @data,  $fields[$dcol];
		$last_line = $i;
		print "\t\tGot data $fields[$dcol]\n" if $debug && $i < $headline+5;
	}
	print "Got ",scalar(@fixed)," lines of X values\n" if $debug;
	print "Got ",scalar(@data)," lines of Y values for column $dcol\n" if $debug;
	print "2nd to last: '$fixed[-2]','$data[-2]'\n" if $debug && scalar(@data) >= 2;
	print "Last   data: '$fixed[-1]','$data[-1]'\n" if $debug && scalar(@data) >= 2;
	my $footer = join("\n",@lines[(($last_line+1) .. $#lines)]);
	print "Footer lines $last_line to ",scalar(@lines),":\n$footer\n" if $debug;
	if ($footer =~ /Plate Setup/i && $head =~ /^[A-H][0-9]+$/ ) {
		
		# Get sample name from plate setup in footer

		my $plate_setup_str = "Plate Setup";
		my $plate_start = index( uc($footer), uc($plate_setup_str) ) +
			length($plate_setup_str);
		my @well_lines = split /\n/, substr( $footer, $plate_start + 1);
		my $well_col = 0;
		my $desc_col = 3;
		my $head_test = uniform_well_name( $head );
		print "Look for description for header $head_test\n" if $debug;
		my $add_name = '';
		foreach my $well_line (@well_lines) {
			next if ! $well_line;
			my @fields = split /,/, $well_line;
			if ($well_line =~ /Well,/i) {
				foreach my $i_field (0 .. $#fields) {
					if ($fields[$i_field] =~ /Well/i) {
						$well_col = $i_field;
					} elsif ($fields[$i_field] =~ /Description/i) {
						$desc_col = $i_field;
					}
				}
			} elsif (uniform_well_name( $fields[$well_col] ) eq $head_test) {
				 $add_name = " $fields[$desc_col]";
				 # last;
			}
		}
		# $head .= $add_name if $add_name;
		$head = $add_name if $add_name;
	}
		
	return ( { header => $head,
			temperature  => \@fixed,
			intensity	=> \@data,
			last_line	=> $last_line,
		} );
}
		
# Turn a01-h12 to A1-H12: upper case, no leading zero

sub uniform_well_name {
	my ($in) = @_;
	return 0 if ! $in;
	my $out = uc($in);
	$out = substr($out,0,1) . substr($out,2,1) if $out =~ /[A-Z]0[1-9]/;
	return $out;
}



sub tad2csv { # to be written: pass tad file to tad2csv.pl
}


sub tm_fit {
	my %params = validate(@_, {	
			verbose		=> {	type	=> SCALAR,
						optional=> 1,
						default	=> 0, },
			debug		=> {	type	=> SCALAR, 
						default	=> 0 },
			intensity	=> {	type	=> ARRAYREF },
			temperature	=> {	type	=> ARRAYREF },
			fit		=> {	type	=> SCALAR,
						optional=> 1,
						default	=> 0, },
			name		=> {	type	=> SCALAR,
						default	=>0 },
			gnuin		=> {	type	=> SCALAR,
						default => 0 },
			gnuout		=> {	type	=> SCALAR,
						default => 0 },
			min_delta	=> {	type	=> SCALAR,
						default => 0.02 },
			plot		=> {	type	=> SCALAR, 
						default => 0},
			bg_exp_flag	=> {	type	=> SCALAR, 
						default => 1},
			smooth		=> {	type	=> SCALAR, 
						default => 3},
			sample_name	=> {	type    => SCALAR,
						default => ''},
	} );
	my %results = (	
				FWHM		=> 0,
				R30		=> 2,
				Rmt		=> 1,
				Tm_avg	=> 0,
				Tm_max_slope => 0,
				I_max_calc => 0,
				I_max_obs => 0,
				I_min_calc => 0,
				I_min_obs => 0,
				I_30	=> 0,
				I_tm	=> 0,
			);
#	Use overall tm_calc version, not tm_fit version
#	$results{'version'}	= '1.01';

	my $intensity	= $params{'intensity'};
	my $temperature	= $params{'temperature'};
	my $fit		= $params{'fit'};
	my $gnuin	= $params{'gnuin'};
	my $gnuout	= $params{'gnuout'};
	my $plot	= $params{'plot'};
	my $min_delta	= $params{'min_delta'};
	my $debug	= $params{'debug'};
	my $verbose 	= $params{'verbose'};
	my $name 	= $params{'name'};
	my $bg_exp_flag = $params{'bg_exp_flag'};
	my $smooth 	= $params{'smooth'};
	my $sample_name	= $params{'sample_name'};
	print "verbose = $params{'verbose'}\n" if $debug;
	print "tm_fit: plot = '$plot'\n" if $debug;
	
	my $npoints = sanity_check( { 
					intensity => $intensity, 
					temperature => $temperature 
				} );
	if ($npoints < 20) {
		if ($npoints) {
			warn "Only $npoints data points!  Please check that this file is complete.";
		} else {
			warn "Arrays are of differing lengths!  Please correct the columns so that the temperature and intensity readings are both the same count.";
			return(0);
		}
	}

		

	my $i_min_observed = List::Util::min(@$intensity);

	# print "OBSERVED I_MIN = $i_min_observed\n";

	my $degree_per_step = ($temperature->[10] - $temperature->[0])/10;
	my $step_per_degree = 1.0;
	$step_per_degree = 1.0 / $degree_per_step if ($degree_per_step > 0.0);
	my $window = int($smooth * $step_per_degree);	# 3 -> 15 for 0.2 C steps, 3 for 1 C steps
	print "$degree_per_step degrees per step, window=$window\n" if $debug;	
	my $smooth_temperature	= smooth_curve( {	
							series			=> $temperature, 
							window			=> $window, 
							extrapolate_step	=> .2 
						} );

	my $smooth_intensity	= smooth_curve( {
							series		=> $intensity,
							window		=> $window,
							baseline	=> $i_min_observed,
							debug		=> $debug,
						} );

	my $derivative_intensity = derive_curve( {	
							intensity	=> $smooth_intensity,
							temperature	=> $smooth_temperature,
						} );

	# foreach my $entry ( @$smooth_intensity ) {  print $entry . "\n"; }


	my $step_count = $#{ $derivative_intensity} - 1;
	my ($slope_max, $slope_max_index) = find_max_slope( { list => $derivative_intensity } );
	#print "Max slope:\t$slope_max\n";
	#my $slope_max_index = $step_count  ;

	my $i_tm_first	= $smooth_intensity->[$slope_max_index];	# Intensity at the max slope
	my $t_m_first = $smooth_temperature->[$slope_max_index];	# temperature at the max_slope


	print "last index of deriv intensity is " . $#{$derivative_intensity} . "\n" if $debug;
	print "last index of smooth intensity is " . $#{$smooth_intensity} . "\n" if $debug;
	print "step count is $step_count\n" if $debug;
	
	# Find maximum observed intensity after Tm (max. slope)

	my $i_max_observed = List::Util::max( @$intensity );
#	my $i_max_smoothed = List::Util::max( @$smooth_intensity );
#	print "int max smooth=$i_max_smoothed, last smooth=$#{$smooth_intensity}, count=$step_count\n" if $debug;
	print "int max obs=$i_max_observed, last smooth=$#{$smooth_intensity}, count=$step_count\n" if $debug;
	if ($slope_max_index && $slope_max_index < $step_count) {
##		$i_max_observed = List::Util::max @$intensity[ 
##			( $slope_max_index .. $#{$intensity} ) ]
#		my ( $index ) = grep { $smooth_intensity->[$_] eq $i_max_smoothed } 0 .. $#{$smooth_intensity};
#		print "index $index\n" if $debug;
#		$i_max_observed = $smooth_intensity->[$index] if $index && $index <= $#{$smooth_intensity};
#		$i_max_observed = List::Util::max @$intensity[ 
#			( List::Util::max(0,$index) .. $#{$intensity} ) ]
#			if $index && $index <= $#{$intensity};
	}
	print "Max intensity after point $slope_max_index: $i_max_observed\n" 
		if $debug;
	$results{'I_min_obs'}	= $i_min_observed;	# should be ~0
	$results{'I_max_obs'}	= $i_max_observed;

	# Output values:
	my $t_m_avg	= 0;	# Tm in Celsius
	my $t_w		= 0;	# TW in Celsius, melting width

	my $i_30	= 0;	# Intensity @ 30degrees Celsius
	my $i_min	= 0;
	my $i_max_c	= 0;	# max intensity calculated 
	my $i_tm	= 0;

	my $r_30	= 2;	# ratio of intensity at 30degrees C to intensity at Tm
	my $r_mt	= 1;	# Fraction of intensity change in other transitions
	my $fwhm	= 0;
	my $i_tm_2	= 0;
	my $tm_minus_2tw	= 0;
	my $i_delta_major	= 0;

	$i_30 = intensity_at_temperature( {	
				temperature_in_celsius => 30,
				intensity	=> $smooth_intensity,
				temperature => $smooth_temperature } );
	$results{'I_30'}	= $i_30;
	if ($slope_max > 0 ) {
		my $transition = transition_width( {
								intensity_derivative => $derivative_intensity,
								intensity		=> $smooth_intensity,
								temperature		=> $smooth_temperature,
								slope_max_index	=> $slope_max_index,
								debug			=> $debug,
								verbose			=> $verbose,
							}) ;

		$t_w	= $transition->{t_w};
		$t_m_avg= $transition->{t_m_avg};

		$fwhm	= $transition->{fwhm_avg};
		$i_tm	= $transition->{i_tm_fwhm};
		$r_30 = $i_30 / $i_tm;


		$tm_minus_2tw = $t_m_avg - (2 * $t_w);
		$i_tm_2	= find_value_from_temperature( {
						temperature	=> $tm_minus_2tw,
						temperature_list=> $smooth_temperature,
						value_list	=> $smooth_intensity, } );

		$i_min	= calculate_intensity_minimum( {	
						intensity_TM	=> $i_tm,
						intensity_TM_2	=> $i_tm_2,
									});
		$i_delta_major = 2 * ( $i_tm - $i_min);

		$i_max_c	= $i_min + $i_delta_major;
		$r_mt		= $i_max_c > 0
					? 1 - ($i_max_c - $i_min) / $i_max_c 
					: 1;

		if ( $params{'verbose'} ) {
			print "Doing the final calc!!!\n";
			print "\ti_tm:\t$i_tm\n";
			print "\tt_m_avg:\t$t_m_avg\n";
			print "\tT_m-2Tw:\t$tm_minus_2tw\n";
			print "\tI_tm2:\t$i_tm_2\n";
			print "\tImin:\t$i_min\n";
			print "\tImax_calc\t$i_max_c\n";
			print "\tRmt:\t$r_mt\n";
			print ".................\n";
		}



	# extra stuff for frank
		# $results{'I_max_from_derivative'} = $i_max;
		$results{'I_max_calc'} = $i_max_c ;
		$results{'I_min_calc'}	= $i_min;
		$results{'I_tm'}	= $i_tm_first;
		$results{'FWHM'}	= $fwhm;

	# results

		$results{'Tw'} = $t_w;
		$results{'Tm_avg'} = $t_m_avg;
		$results{'Tm_max_slope'} = $t_m_first;
		$results{'R30'} = $r_30;
		$results{'Rmt'} = $r_mt;
	}
	# Try fitting with exp. decay even if there is no positive slope
	# if ($fit) {
	
		# Initialize transition results to zero
		
		$results{'major_transition'} = 0;
		$results{'max_delta_transition'} = 0;
		$results{'i_min_trans'}	= 0;
		$results{'transitions'} = 0;
	
				
		# Do real fitting using gnuplot if requested, or
		# just find max after looking for discontinuities and
		# (if requested) exponential decay
		
		my $fit_results = tm_fit_transitions(
			temperature	=> $temperature,
			intensity	=> $intensity,
			max_count	=> 5,
			min_delta	=> $min_delta,
			tm		=> $t_m_avg,
			FWHM		=> $fwhm,
			i_delta		=> $i_delta_major,
			i_min		=> $i_min,
			debug		=> $debug,
			verbose		=> $verbose,
			name		=> $name,
			fit		=> $fit,
			gnuin		=> $fit ? $gnuin : 0,
			gnuout		=> $fit ? $gnuout : 0,
			plot		=> $fit ? $plot : 0,
			bg_exp_flag	=> $bg_exp_flag,
			smooth		=> $smooth,
			sample_name	=> $sample_name,
		);

		my $reason = exists_or_zero($fit_results,'reason');
		$results{'reason'} = $reason if $reason;
		print "Reason for stopping: $reason\n" if $debug && $reason;
		my $discontinuity = exists_or_zero($fit_results,
					'discontinuity');
		$results{'discontinuity'} = $discontinuity if $discontinuity;
		
		my $nt = exists_or_zero($fit_results,'max_transitions');
		print "Max of $nt fit transition results\n" if $debug;
		if ($fit_results && $nt) {

			if ($debug) {
				my $m = $$fit_results{'model'};
				for (my $ii=1; $ii<=$nt; $ii++) {
					my $mn = $$m{"$ii"};
					print "Solution $ii:",
						Dumper($$mn{'solution'});
				}
				print "Reason: ",Dumper($reason);
			}
					
			
			# Return fitting results as:
			# 	Number of major transition (counting from 1)
			# 	Imin = One minimum value for all
			#	transitions = ref to an array of hash refs,
			#	    one hash per transition containing Tm, FWHM,
			# 	    and Id = fluorescence intensity delta.
			# Transitions should be in the array by increasing Tm; 
			# the major transition should be the one with max slope
			# where transition slope is proportional to Id / FWHM 
			# (slope = Fd / 4*Tw to be precise).
			#
			# Note: the major transition is now taken as the one
			# with the highest product of slope x Idelta, to make
			# sure we don't use a steep but narrow transition.
			
			if (exists $$fit_results{'model'} ) {
				my $models = $$fit_results{'model'};
				# For now, just use the last model; 
				# AIC check partially done: stop after (local) min. AIC
				my $model = $$models{"$nt"};
				
				# Measures of the difference between the model 
				# and the data, to be used eg for AIC
				$results{'RMSD'} = $$model{'RMSD'};
				$results{'R_abs'} = $$model{'R_abs'};
				print "RMSD: $results{'RMSD'}\n" if $debug;
	
				my $solution		= $$model{'solution'};
				$results{'i_min_trans'}	= $$solution{'i_min'};
				$results{'bg_init'}	= $$solution{'bg_init'};
				$results{'bg_exp'}	= $$solution{'bg_exp'};
				$results{'major_transition'} = 
						$$solution{'major_transition'};
				$results{'max_delta_transition'} = 
						$$solution{'max_delta_transition'};

				print "Found $nt transitions. Steepest=",
					"$results{'major_transition'}, Biggest=",
					"$results{'max_delta_transition'}, ",
					"Imin=$results{'i_min_trans'}\n" 
						if $verbose && $nt && 
					exists $results{'major_transition'};
				my @transitions = ();
				for (my $it=1; $it <= $nt; $it++) {
					my %t = (
					    Tm	 => $$solution{"tm$it"},
					    sd_tm=> $$solution{"sd_tm$it"},
					    FWHM => $$solution{"fwhm$it"},
					    Id	 => $$solution{"i_delta$it"},
					    Itm	 => $$solution{"i_tm$it"}
					);
					push @transitions, \%t;
				}
				print "Transitions: ",Dumper(@transitions) if $debug;
				$results{'transitions'} = \@transitions;
			}

			# Replace original estimates of Tm_max_slope, Tm_avg, 
			# Tw, FWHM, Idelta, Itm, R30, Rmt

			if (exists_or_zero($fit_results, 'Tm_max_slope')) {
				$results{'Tm_max_slope'} = $$fit_results{
								'Tm_max_slope'};
				$results{'Tm_avg'}  = $$fit_results{'Tm_avg'};
				$results{'Tw'}	    = $$fit_results{'Tw'};
				$results{'FWHM'}    = $results{'Tw'}*$k4*4;
				my $itm_trans	    = $$fit_results{'I_tm'};
				my $imin_trans	    = $$fit_results{'I_min_calc'};
				my $id_trans = ($itm_trans - $imin_trans)*2.;
				$results{'I_tm'}    = $itm_trans;
				$results{'I_min_calc'} = $imin_trans;
				$results{'I_max_calc'} = $itm_trans+$id_trans;
				$results{'R30'}	  =$results{'I_30'}/$itm_trans
								 if $itm_trans;
				$results{'Rmt'}	  =1.-$id_trans/$i_max_observed
				  			     if $i_max_observed;
			}

		}
#	}

	if ($verbose) {
		print "I_max_slope:\t$i_tm_first\n";
		print "T_max_slope:\t$t_m_first\n";

		print "Max slope:\t$slope_max\n";
		#print "Tm_first:\t$t_m_first \n";
		print "I30:\t\t$i_30\n";
		print "Itm:\t\t$i_tm\n";
		print "Imax:\t\t$i_max_observed\n";
		print "I_tm_2:\t\t$i_tm_2\n";
		print "Imin:\t\t$i_min\n";
		#print "fwhm_diff:\t$fwhm_diff\n";
		print "fwhm:\t\t$fwhm\n";
		print "t_m_avg:\t\t$t_m_avg\n";
		print "Tw:\t\t$t_w\n";
		print "Imin:\t\t$i_min\n";
		print "Imax_calc:\t$i_max_c\n";

	
		print "..........OUTPUT \n";
		#print "Ti:\t$$t_i\n";
		print "Tw:\t$t_w\n";
		print "Tm_avg:\t$t_m_avg\n";
		print "R30:\t$r_30\n";
		print "Rmt:\t$r_mt\n";
		print "Imax:\t$i_max_observed\n";
		# print "Reason:\t$reason\n";
	}

	return \%results;
}

# Plan:
# 1) Read in a table, must specify columns to run fit on
# 2) For each peak, find the differential scanning fluorimetry (aka thermal melt curve) 
#		readings 
# 


# Smooth - a linear smooth on the temperature and intensity (col 1 and 2)
# Use c cycles to smooth (more or less)  So you will avg c cycles, centered at the step n




sub smooth_curve {

	my %params = validate( @_ ,	{	
									window	=> 
										{	default	=> 15 },
									series => 
										{	type	=> ARRAYREF },
									extrapolate_step =>
										{	default		=> 0,
											optional	=> 1 },
						
									debug	=> 
										{ 	type => SCALAR, 
											default => 0 },
									baseline	=>
										{	default		=> 0,
											optional	=> 1},								
								} );

	my $debug	= $params{debug};
	my $series	= $params{series};
	my $window	= $params{window};
	

	my $extrapolate_step = $params{extrapolate_step};
	my $smooth_range = int( $window / 2 );
	my @smoothed = ();
	my $step_count = @$series - 1;
		
	print "Sub smooth_curve step count is $step_count\n" if $debug;
	print "[floor, ceil] \tsum\tsmoothed\n" if $debug > 1;
	for my $i ( 0 .. $step_count ) {

	my $sum = 0;
	my $floor = $i - $smooth_range;
	my $ceiling = $i + $smooth_range ;

	# For edge conditions, we pad either end of the array with a constant value.  in the
	# default case, whatever happens to be in the first and last location of the array. 
	# If exptrapolate steps is set to a postive number, we assume a constant descent at the
	# beginning and ascent at the end of the step.
	if ($i <= $smooth_range) {
		$sum = ($smooth_range - $i) * ( $series->[0] - $params{'baseline'} ); 

		if ($extrapolate_step > 0) {
			my $linear = 0;
			for( my $j = $i; $j < $smooth_range ; $j++ ) {
				$linear += ( $smooth_range - $j ) * $extrapolate_step;
			}
			#print "\t\tsum is $sum \n";
			#print "\t\tlinear is $linear \n";
			$sum = $sum - $linear;
		}
 		$floor = 0;
	} elsif ($i > ($step_count - $smooth_range) ) {
		$sum = ($smooth_range - $step_count + $i) * ($series->[$step_count] - $params{'baseline'});

		$ceiling = $step_count;

		if ($extrapolate_step > 0) {
			my $overhang = $smooth_range - $step_count + $i ;
			my $linear = 0;
			# print "overhand is $overhang\n";
			for( my $j = 0 ; $j < $overhang; $j++ ) {
				my $test = $series->[$step_count] - $params{'baseline'} + ( $j + 1 ) * $extrapolate_step;
				$linear += $test;
			#	print "\t\t\t step $j is $test\n";
			}
			$sum = $linear;
			print "\t\t\tsum is $sum \n" if $debug > 1;
			print "\t\t\tlinear is $linear \n" if $debug > 1;
		}
	}

	# sum over the range
	for ( my $x = $floor; $x <= $ceiling; $x++) {
		#print "\t\t\t+ $series->[$x]\n";
		$sum += ($series->[$x] - $params{'baseline'});
	} 	
	$smoothed[$i] = $sum / $window;
	#if ($i > 300 ) {
	#print "[$floor, $ceiling] \t$sum\t" . $smoothed[$i] . "\n";
	#print "$i \t$sum\t" . $smoothed[$i] . "\n";
	#}
	
	}
	return \@smoothed;

}

# Derivative

sub derive_curve {
	my %params = validate( @_ ,	{	
									intensity => 
										{ type		=> ARRAYREF },
									temperature => 
										{ type		=> ARRAYREF },
								} );

	
	my $int = $params{intensity};
	my $tem = $params{temperature};
	my $window = $params{window};


	my @derivative = ();
	my $step_count = @$int - 2;

	
	for my $i ( 1 .. $step_count ) {
		# print "step is $i of $step_count\n";	
		$derivative[$i] = ( $int->[$i + 1]  - $int->[$i - 1] ) /  ( $tem->[$i + 1] - $tem->[$i - 1] );
	}

	return \@derivative;
	
}

# First Approximation

sub first_approximation {

	my %params = validate( @_ ,	{	
									intensity => 
										{ type		=> ARRAYREF },
									temperature => 
										{ type		=> ARRAYREF },
									
								} );

	my %results = {};
}

# Sanity Check
sub sanity_check {

	my %params = validate( @_ ,	{	
						intensity => 
							{ type	=> ARRAYREF },
						temperature => 
							{ type	=> ARRAYREF },
					} );

	my $intensity	= $params{'intensity'};
	my $temperature	= $params{'temperature'};
	my $intensity_length	= @$intensity;
	my $temperature_length	= @$temperature;


	if ($intensity_length == $temperature_length) {
		return $temperature_length;
	}

	return 0;
}

# Calculate the intensity at a temperature
sub intensity_at_temperature {
	
	my %params = validate( @_ ,	{	
									intensity => 
										{ type		=> ARRAYREF },
									temperature => 
										{ type		=> ARRAYREF },
									temperature_in_celsius => 
										{ type		=> SCALAR, },
								} );
	
	my $intensity = $params{intensity};

	my $temperature_to_find = $params{temperature_in_celsius};
	my $temperature = $params{temperature};
	my $index = 0;
	my $index_count = @$temperature;

	# print "temperature count is $index_count\n";	

	while( $index < $index_count ) {
		if( $temperature->[$index] >=  $temperature_to_find ) {
			last;
		}
		$index++;
	}

	# print "index with $temperature_to_find is $index\n";
	# print "then the i30 is $intensity[ $index ]\n";

	return $intensity->[ $index ];

}


# Tw = transition width.  For the derivative, the range of temperatures which the slope is at least 1/2 of the max slope.
sub transition_width {

	my %params = validate( @_ ,	{	
									intensity => { 
										type		=> ARRAYREF 
									},
									intensity_derivative => { 
										type		=> ARRAYREF 
									},
									temperature =>	{ 
										type		=> ARRAYREF 
									},
									slope_max_index  =>	{ 
										type		=> SCALAR 
									},
									verbose		=> {	
										type		=> SCALAR,
										optional	=> 1,
										default		=> 0, 
									},
									debug		=> { 
										type		=> SCALAR, 
										default		=> 0 
									},
	} );
	my $debug	= $params{'debug'};
	my $verbose 	= $params{'verbose'};

	my $index	= $params{slope_max_index};
	my $tem		= $params{temperature};
	my $derivative	= $params{intensity_derivative};
	my $intensity	= $params{intensity};


	my $slope_max = $derivative->[ $index ];


	my %transition = (	t_w		=> 0,
				fwhm_avg	=> 0,
				fwhm_diff	=> 0,
			);
	my $t_w = 0;
	my $half_slope = $slope_max / 2;

	#print ".........FWHM Calc\n";
	#print "index is $index\n";
	print "At $tem->[$index] max slope=$slope_max; half $half_slope\n" if $debug;


	my $upper_bound = $slope_max + $half_slope;
	my $lower_bound = $slope_max - $half_slope;
	

	my $d_above_min = 0;
	my $d_below_min = 0;
	my $d_above_max = 0;
	my $d_below_max = 0;

	my $t_above_min = 0;
	my $t_above_max = 0;
	my $t_below_min = 0;
	my $t_below_max = 0;

	my $i_above_min = 0;
	my $i_above_max = 0;
	my $i_below_min = 0;
	my $i_below_max = 0;

	my $above_tm = $index + 1;
	my $below_tm = $index - 1 ;

	if( $below_tm < 1 ) { $below_tm = 1; }
	if( $above_tm < 1 ) { $above_tm = 1; }
	print "Below tm: $below_tm  Above tm: $above_tm\n" if $debug;
	$d_above_max = $derivative->[ 1 ];
	$t_above_min = $tem->[ 0 ];
	$i_above_min = $intensity->[ 0 ];
	if ($half_slope > 1e-3) {
		print "$#{$derivative} derivatives\n" if $debug;
		while( $above_tm < $#{$derivative} && 
		       $derivative->[ $above_tm ]  > $half_slope ) {
			print "\t $tem->[$above_tm]: >$derivative->[$above_tm]\n" if $debug>1;
			$d_above_max = $derivative->[$above_tm];
			$t_above_min = $tem->[ $above_tm ];
			$i_above_min = $intensity->[ $above_tm ];
			$above_tm++;
			print "above_tm: $above_tm\n" if $debug > 1;
		}
	} else {
		print "Slope < 0.001 !\n" if $debug;
	}
	$above_tm = List::Util::min($#{$derivative},$above_tm);	
	$d_above_min = $derivative->[$above_tm];	
	$t_above_max = $tem->[ $above_tm ];
	my $t_hm_avg_above = ($t_above_max + $t_above_min ) / 2;
	my $d_avg_above = ($d_above_max + $d_above_min ) / 2;
	my $i_avg_above = ($i_above_max + $i_above_min ) / 2;
	print "\t>x $d_avg_above [ $d_above_min, $d_above_max] \n" if $debug;
	print "\t>t ". $t_hm_avg_above . "\t [$t_above_min, $t_above_max] \n" if $debug;
	print "\t>i $i_avg_above [ $i_above_min, $i_above_max] \n" if $debug;

	print "half slope $half_slope, below_tm $below_tm\n" if $debug;
	$t_below_min = $tem->[ 0 ];
	$t_below_max = $tem->[ 0 ];
	$d_below_min = $derivative->[ 1 ];
	$d_below_max = $derivative->[ 1 ];
	$i_below_min = $intensity->[ 0 ];
	$i_below_max = $intensity->[ 0 ];
	print "d below min: $d_below_min  i_below_min: $i_below_min\n" if $debug;
	if ($half_slope > 1e-3) {
		while( $below_tm && $derivative->[ $below_tm ]  > $half_slope ) {
			#print "\t<". $derivative->[$below_tm] . "\n";
			print "\t $tem->[$below_tm]: >$derivative->[$below_tm]\n" if $debug>1;
			$d_below_max = $derivative->[ $below_tm ];
			$t_below_max = $tem->[ $below_tm ];
			$i_below_max = $intensity->[ $below_tm ];
	
			$below_tm = $below_tm - 1;
		}
		$below_tm = 0 if $below_tm < 0;
		$t_below_min = $tem->[ $below_tm ];
		$d_below_min = $derivative->[ $below_tm ? $below_tm : 1 ];
		$i_below_min = $intensity->[ $below_tm ];
		print "d below min->$d_below_min  i_below_min->$i_below_min\n" if $debug;
	}
	
	my $t_hm_avg_below = ( $t_below_max + $t_below_min ) / 2;
	my $d_avg_below = ($d_below_min + $d_below_max) / 2;
	my $i_avg_below = ($i_below_min + $i_below_max) / 2;

	print "\t<x $d_avg_below \t[ $d_below_min, $d_below_max] \n" if $debug;
	print "\t<t ". $t_hm_avg_below . "\t [$t_below_min, $t_below_max]\n" if $debug;
	print "\t<i ". $i_avg_below . "\t [$i_below_min, $i_below_max]\n" if $debug;


	#$transition{'fwhm_diff'} = abs($t_hm_avg_below - $t_hm_avg_above);
	#$transition{'fwhm_diff'} = 0.4;
	#print "AVGS are : $t_hm_avg_below, $t_hm_avg_above\n";
	
	my $new_tm = ($t_hm_avg_below + $t_hm_avg_above) / 2;

	$transition{'fwhm_avg'} = abs($t_hm_avg_below - $t_hm_avg_above);
	print "Tm avg = ($t_hm_avg_below + $t_hm_avg_above)/2 = $new_tm; ",
		"FWHM = $transition{'fwhm_avg'}\n" if $debug;
	$transition{'t_m_avg'} = $new_tm;
	$transition{'i_tm_fwhm'} = find_value_from_temperature( { temperature => $new_tm, temperature_list => $tem, value_list => $intensity} );
	#print "NEW tm_fwhm is $transition{'t_m_avg'}\n";
	#print "NEW I_tm_fwhm is $transition{'i_tm_fwhm'}\n";
	$transition{'t_w'} = $transition{'fwhm_avg'} / 3.52549434807817; 

	#print ".........\n";
	return \%transition;

}


# Imin = Min intensity of the major transition 
sub calculate_intensity_minimum {

	my %params = validate( @_ ,	{	
									intensity_TM => 
										{ type		=> SCALAR },
									intensity_TM_2 => 
										{ type		=> SCALAR },
								} );

	my $exp_sq = exp(2);
	my $I = $params{'intensity_TM'};
	my $I_2 = $params{'intensity_TM_2'};

	my $result = $I - ($I - $I_2) * ($exp_sq + 1) / ( $exp_sq - 1);
	return $result;
	# return $params{'intensity_TM'} - ( 1.313 * ( $params{'intensity_TM'} - $params{'intensity_TM_2'} ) );

}

sub find_value_from_temperature {

	my %params = validate( @_ ,	{	
									temperature =>
										{ type		=> SCALAR },
									temperature_list => 
										{ type		=> ARRAYREF },
									value_list	=> 
										{ type		=> ARRAYREF },
								} );
	my $tmp = $params{'temperature'};
	my $val = $params{'value_list'};
	my $tmps = $params{'temperature_list'};

	my $index = 0;
	my $count =  $#{$tmps};
	while( $index < $count ) {
		if( $tmp <= $tmps->[$index] ) {
			if( $index > 0) { 
				$index = $index - 1;
			}
			# print "\t\tFOUDN atindex $index for $tmp is [" . $tmps->[$index] .  ", " . $val->[$index] . "]\n";
			return $val->[$index];
		}
		$index++;
	}
}

sub find_temperature_from_value {
	my %params = validate( @_ ,	{	
									value =>
										{ type		=> SCALAR },
									temperature_list => 
										{ type		=> ARRAYREF },
									value_list	=> 
										{ type		=> ARRAYREF },
								} );
	my $tmp = $params{'value'};
	my $val = $params{'value_list'};
	my $tmps = $params{'temperature_list'};

	my $index = 0;
	my $count = $#{ $val } - 1;

	while( $index < $count ) {
		if( $val->[$index] >= $tmp ) {
			if( $index > 0) { 
				$index = $index - 1;
			}
			return $tmps->[$index];
		}
		$index++;
	}
}





# Find the largest slope in the derivatives array. Since we're approximating the
# derivative from the intensity readings, the first and last positions in the array are empty.
sub find_max_slope {
	my %params = validate( @_, {	list	=>
										{ type => ARRAYREF},
	});

	my $array = $params{'list'};
	my $count = @$array - 2;
	my $index = 1;
	my $max_index = 1;
	my $max = $array->[1];

	while( $index < $count ) {
		if( $max < $array->[$index] ) {
			$max = $array->[$index];
			$max_index = $index;
		}
		$index++;
	}
	#print "index is $max_index and max is $max, and count is $count\n";
	return ($max, $max_index);
}

######################################################################
#
# Fit multiple transitions to Tm curve using gnuplot's L-M fitter.
# 
# Method:
# 1) Make initial guesses of Tm, FWHM, Idelta, Imin based on the average of 
#    temps at half max. slope, fitting points (Tm, Itm) and (Tm-2Tw, Itm-2tw)
# 2) Estimate range of points to fit: Tmin = Tm - FWHM, Tmax Tm + FWHM/2
# 3) Refine Tmin: scanning down from Tm-FHWM, look for the last T with
#    dI/dT near 0 or > 0 but increasing with T (i.e. positive 2nd deriv.)
# 4) Attempt to fit with max iterations 2000 for transition 1, 500 for others
# 5) If fit does not converge, use last result anyway; issue warning if verbose 
#
# Do NOT try to optimize residual - it fits the wrong part of the curve.
#    Find RMSD = R(Tmid = Tmin).
#    Set incr = 2, Tlo = Tmin - incr, Thi = Tmin + incr (if there's room)
# 3) Find R(Tlo) and R(Thi) using 50 iterations from the initial guess
# 4) If Tlo has lowest R, new Tmid = Tlo, find R(new Tlo = Tmid - incr);
#    if Thi has lowest R, new Tmid = Thi, find R(new Thi = Tmid + incr);
#    else R(Tmid) is lowest; set incr = incr / 2, stop if incr < degrees per step.
#    If R(Tmin) < R(Tlo) <= R(Thi), new Thi = Tmid, find R(Tmid = (Tlo+Thi)/2);
#    If R(Tmin) < R(Thi) <  R(Tlo), new Tlo = Tmid, find R(Tmid = (Tlo+Thi)/2).
# 5) Repeat step 4 until either incr < step or Tlo is best and it's T[0].
# 6) Repeat 3 through 5 for Tmax
# 7) Do another 100 iterations with the optimum Tmin, Tmax
# 8) Repeat 7 until RMSD change is less than 1% (or < 1e-6?).
#
######################################################################

sub tm_fit_transitions {
use PDL;
	my %params = validate( @_, {	
					temperature	=> { type => ARRAYREF },
					intensity	=> { type => ARRAYREF },
					tm		=> { type    => SCALAR,
							     default => 0 },
					FWHM		=> { type    => SCALAR,
							     default => 0 },
					i_delta		=> { type    => SCALAR,
							     default => 0 },
					i_min		=> { type    => SCALAR,
							     default => 0 },
					max_count	=> { type    => SCALAR, 
							     default => 4},
					min_delta	=> { type    => SCALAR, 
							     default => 0.15
							   },
					name		=> { type    => SCALAR, 
							     default => 'batch_unamed'
							   },
					fit		=> { type    => SCALAR,
							     default => 1 },
					gnuin		=> { type    => SCALAR,
							     default => 0 },
					gnuout		=> { type    => SCALAR,
							     default => 0 },
					verbose		=> { type    => SCALAR,
							     default => 0 },
					debug		=> { type    => SCALAR,
							     default => 0 },
					plot		=> { type    => SCALAR, 
							     default => 0},
					bg_exp_flag	=> { type    => SCALAR, 
							     default => 1},
					smooth		=> { type    => SCALAR, 
							     default => 3},
					sample_name	=> { type    => SCALAR,
							     default => '' },
				} );
	# Pull arguments from hash
	my $temperature	= $params{'temperature'};
	my $intensity	= $params{'intensity'};
	my $max_count	= $params{'max_count'};
	my $min_delta	= $params{'min_delta'};
	my $tm		= $params{'tm'};
	my $fwhm	= $params{'FWHM'};
	my $i_delta	= $params{'i_delta'};
	my $i_min	= $params{'i_min'};
	
	my $verbose	= $params{'verbose'};
	my $debug	= $params{'debug'};
	my $name	= $params{'name'};
	my $fit		= $params{'fit'};
	my $gnuin	= $params{'gnuin'};
	my $gnuout	= $params{'gnuout'};
	my $plot	= $params{'plot'};
	my $bg_exp_flag	= $params{'bg_exp_flag'};
	my $smooth	= $params{'smooth'};
	my $sample_name	= $params{'sample_name'};

	# print "tm_fit_transitions: params=",Dumper(%params) if $debug;
	print "tm_fit_transitions: plot '$plot' fwhm $fwhm sample $sample_name\n" if $debug;

	# Make (and maybe remove a preexisting) directory to store gnuplot's files
	DateTime->now->set_time_zone( 'America/Los_Angeles' );
	my $ymd = DateTime->now->ymd('_');
	my $hms = DateTime->now->time('_');

	my $working_directory = "/tmp/$name" . "_" . $ymd . "_" . $hms;
	if ($gnuin && -e $gnuin && -d $gnuin) {
		$working_directory = $gnuin;
		print "Reading from gnuplot intermediate directory $gnuin\n" 
			if $verbose;
	} else {
		$gnuin = 0;
		if ($gnuout) {
			$working_directory = $gnuout;
			print "Writing to gnuplot intermediate directory $gnuout\n" 
				if $verbose;
			if (-e $working_directory) {
				print "OOPS! gnuplot directory $gnuout exists!\n" 
					if $verbose;
				if (!remove_tree($working_directory)) {
					print "Failed to remove $gnuout.\n" 
						if $verbose;
					my $suffix = 1;
					while (-e $working_directory."_$suffix") {
						print $gnuout."_$suffix exists!\n" 
							if $verbose;
						$suffix ++;
					}
					$working_directory .= "_$suffix";
					print "Writing to gnuplot directory $working_directory\n" 
						if $verbose;
				}
			}
		}
	}
	
	if (! $gnuin) {
		my @existing_directory = make_path( $working_directory );
		
		if (scalar( @existing_directory) == 0 ) {
			my $new_directory_suffix = int( rand(10) );
			$working_directory .= $new_directory_suffix;
			if ($verbose ) {
				print "You already had an existing directory.   \t\nWe are going to try another directory  $working_directory..\n";
			}
			# we tried to remove the pre-existing directory to remake it, but was getting problems in windows.  
			#remove_tree( $working_directory );
			#make_path( $working_directory );
		}
	}
	my $file_stem = File::Spec->catdir( ($working_directory , $name) )  ;
	# my $file_stem = $working_directory .  "/" .  $name  ;

	if ($verbose) {
		print "writing to path at $working_directory, file_stem $file_stem\n"
	}
	
	# sanity test that all inputs have the same length
	my $observed_points = @$temperature;
	
	# Create two PDL arrays and fill with the x and y values
	my $x = PDL->new($temperature);		
	my $y = PDL->new($intensity);
	my $nx = nelem($x);		
	if (! $nx || ! nelem($y)) {
		print "WARNING: no data given!\n";
		return 0;
	}

	my $sum_y = sum( $y );
	my $max_y = max( $y ) - min( $y );
	
	if ( $debug ) {
		print "\t******* Beginning the Tm fit process ******\n";
		print "\tSum of y is $sum_y, max y = $max_y\n";
		print "\t$observed_points data points are observed\n";
	}
	if (! $max_y) {
		print "ERROR: no intensity given!\n";
		return { reason => 'NO INTENSITY GIVEN' };
	}

	# setup the input data files with the observed values into name.dat
	# and the initial parameters file
	my $gp_data_file = _generate_gnuplot_datafilename( { stem => $file_stem  } );
	wcols $x, $y, $gp_data_file, { HEADER => "# T  \"$sample_name\"" };

	my $iteration = 0;
	my $rabs_old = 100;
	my $aic_old  = 1e10;
	my $npoints_old = 0;

	# my $a_init_1 = 0;
	# my $a_init_n = 0;
	
	my %all_models	= ( 	directory	=> $working_directory,
#				model		=> (),
			  );

	my $tmin = 0;
	my $tmax = 0;
	my $discontinuity = {};

	# Adjust smoothing window (not min_delta) up if the data is noisy
	# 1) Take a smoothed average of 2 points near the beginning
	# 2) Fit a line between them
	# 3) Subtract the raw data from that line
	# 4) Find the standard deviation
	# NEW: 5) set smoothing window large enough to give standard error of 
	# 	  N points < min delta
	
	# OLD: 5) Set min_delta to n*sd if it's < n*sd, n=something between 1 and 2
	
	# Estimating n:
	# Transitions have FWHM from ~1 to 10 C = 5 to 50 points on an OM.
	# Default smoothing is gaussian over 3 C = 15 points on an OM
	#
	# The difference between low and high should be significant using
	# a small number of points N. I.e. min delta should be >2*standard error
	# of the mean = standard deviation / sqrt(N) for N points:
	# i.e. min delta > 2*sd/sqrt(N).  =~ 1 * sd for N = 4. But 1.5 seems to
	# work better. This is equivalent to min delta > 3sd/sqrt(N).
	# Try this: 
	# If sd * alpha > min delta, raise min delta to alpha*sd and
	# increase smoothing window by a factor of (alpha*sd / min delta)^2 
	# 
	# Estimate std dev. by fitting lines to several short early segments; 
	# use minimum deviation from those fitted lines
	my $sd = 1e10;
	my $n = 20;
	for (my $i=0; $i<30; $i+=10) {
		my $sl = "$i:".($i+$n-1);
		my $xsl = $x->slice($sl);
		my $ysl = $y->slice($sl);
		# Find m, b for i = m*t + b; b = i - m*t using least squares
		my $xm = sum($xsl) / $n;
		my $ym = sum($ysl) / $n;
		my $m = (sum($xsl*$ysl)/$n - $xm * $ym) / 
			(sum($xsl*$xsl)/$n - $xm * $xm);
		my $b = $ym - $m * $xm;
		my $diff = $ysl - ($m * $xsl + $b);
		my $this_sd = sqrt( sum($diff*$diff) / ($n-1) );
		$sd = $this_sd if $i == 0 || $this_sd < $sd;
	}
	my $smooth_window = $smooth;	# Smooth over 3 degrees by default
	# my $degrees_per_step = ($x->at(-1) - $x->at(0)) / $observed_points;
	my $degrees_per_step = (max( $x ) - min( $x ) ) / $observed_points;
	$degrees_per_step = 1 if ! $degrees_per_step;
	$smooth_window /= $degrees_per_step;
	my $alpha = 0.75;	# 1.0 makes min delta too large
	my $beta  = $alpha*sqrt($smooth_window);
	my $min_delta_y = $min_delta * $max_y;
	printf "Standard deviation = %.7f, min delta y = %.7f, a*sd/min = %.3f\n",
		$sd, $min_delta_y, $alpha*$sd / $min_delta_y if $verbose;
	if ($sd * $alpha > $min_delta_y) {
		my $new_window = $beta * $sd / $min_delta_y;
		$min_delta = $alpha * $sd / $max_y;
		$new_window *= $new_window;
		printf "New smoothing window = %.2f, new min delta=%.4f\n",
			$new_window, $min_delta if $verbose;
		my $max_window = $nx / 2;	# 10 / $degrees_per_step;
		$new_window = $max_window if $new_window > $max_window;
		if ($new_window > $smooth_window) {
			printf "Change smoothing window from %i to %i due to ".
				"std dev of %.5f, min delta y %.5f\n", 
				$smooth_window, $new_window, $sd, $min_delta_y
				if $verbose;
			$smooth_window = $new_window;
		}
	}
	$smooth_window = sprintf "%u", $smooth_window;
	print "smooth window: $smooth_window\n" if $debug;

	# TO BE DONE: move deriv. max. count & smoothing cycle here, to
	# change overall smooth_window instead of just smooth_deriv window

	my $bg_min_flag = 0;
	my $center_first = 1;
	my $max_slope = 0;
	my $reason = 0;
	my $extreme_tm_old = 0;
	my $extreme_d_old = 0;
	my $extreme_w_old = 0;
	my $smooth_count = 0;
	my $smooth_limit = 3;
	my $smooth_factor = 2;
	my $retry_bg_min = 0;
	my $first_reason = '';
	my $high_slope = 0;
	my $min_deriv = 0;
	my $truncate = 0;
	
	while ( $iteration < $max_count ) {

		$iteration ++;
		my $gp_params_file = _generate_gnuplot_datafilename( { stem => $file_stem, version =>  $iteration, type => "parameter" } );

		print "Starting iteration $iteration\n" if $verbose;

		my $init_params =
		_setup_parameters(	{
						name		=> $name,
						iteration	=> $iteration,
						x		=> $x,
						y		=> $y,
						sum_y		=> $sum_y,
						tm		=> $tm,
						FWHM		=> $fwhm,
						i_delta		=> $i_delta,
						i_min		=> $i_min,
						verbose		=> $verbose,
						debug		=> $debug,
						file_stem	=> $file_stem,
						gnuin		=> $gnuin,
						min_delta	=> $min_delta,
						min_deriv	=> $min_deriv,
						tmin		=> $tmin,
						tmax		=> $tmax,
						discontinuity	=> $discontinuity,
						bg_exp_flag	=> $bg_exp_flag,
						bg_min_flag	=> $bg_min_flag,
						center_first	=> $center_first,
						smooth_window	=> $smooth_window,
					}
		);
		print "Initial params for iteration $iteration: ",Dumper($init_params) if $debug;
		$reason = exists_or_zero($init_params,'reason');
		if ($iteration == 1 && ! $min_deriv) {
			$min_deriv = exists_or_zero($init_params,'min_deriv');
			$high_slope = exists_or_zero($init_params,'max_deriv') >
						$min_deriv * 5.;
			print "High slope = |$high_slope|, max deriv=",
				exists_or_zero($init_params,'max_deriv'),
				" min deriv=$min_deriv\n" if $debug;
		}
		if (!$init_params || $reason){
			$first_reason = $reason if $reason && !$first_reason;
			print "Setup for transition $iteration failed:\n",
				"center $center_first, smooth $smooth_window, ",
				"bg_min_flag $bg_min_flag\n\t$reason\n" 
				if $verbose || $debug;
			next if retry_guess( { 
					iteration	=> \$iteration,
					center_first 	=> \$center_first,
					smooth_window	=> \$smooth_window,
					smooth_count	=> \$smooth_count,
					bg_min_flag 	=> \$bg_min_flag,
					init_params 	=> $init_params,
					high_slope 	=> $high_slope,
					reason		=> $reason,
					nx		=> $nx,
					file_stem	=> $file_stem,
					debug		=> $debug,
					verbose		=> $verbose,
				} );
			$max_count = $iteration - 1;
			print "Fit complete with ",$iteration-1," iterations\n"
				if $verbose || $debug;
			plot_no_fit( {	input_file	=> $gp_data_file,
					file_stem	=> $file_stem,
					plot		=> $plot,
					name		=> $name,
					verbose		=> $verbose,
					debug		=> $debug,
					sample_name	=> $sample_name,
				   } ) if $plot && $iteration == 1 && ! $gnuin;
			last;
		}

		if ($iteration==1&&exists_or_zero($init_params,'Tm_max_slope')){
			$all_models{Tm_avg}	  = $$init_params{'Tm_avg'};
			$all_models{Tm_max_slope} = $$init_params{'Tm_max_slope'};
			$all_models{Tw}		  = $$init_params{'Tw'};
			$all_models{I_tm}	  = $$init_params{'I_tm'};
			$all_models{I_min_calc}	  = $$init_params{'I_min_calc'};
			# Just do initial guess if fitting not requested
			return \%all_models if ! $fit;
		}

		# Store tmin and tmax fit range for next cycle
		
		$tmin = $$init_params{'t_min'};
		$tmax = $$init_params{'t_max'};
		if ($tmin < $x->at(0)) {
			$tmin = $x->at( 0);
			$$init_params{'t_min'} = $tmin;
		}
		if ($tmax > $x->at(-1)) {
			$tmax = $x->at(-1);
			$$init_params{'t_max'} = $tmax;
		}
		print "Tm fit transitions iteration $iteration: ",
				"tmin, max $tmin, $tmax\n" if $debug;
		$tmin_all = $tmin if $tmin < $tmin_all;
		$tmax_all = $tmax if $tmax > $tmax_all;
		
		# Get discontinuity from first pass only
		$discontinuity =  $$init_params{'discontinuity'}
			if exists $$init_params{'discontinuity'} && 
				 $iteration == 1;
		$bg_min_flag = $$init_params{'bg_min_flag'} if $iteration == 1;

		# capture makes gnuplot shut up.  otherwise, we'd get a ton of output from gnuplot to STDERR
		if (! $gnuin) {
			print "Boltzmann fit for $iteration peaks sample $sample_name\n" if $debug;
			print "file stem $file_stem\n" if $debug;
			if ($debug > 1) {
				_boltzmann( {	
						input_file	=> $gp_data_file,
						params_file	=> $gp_params_file,
						peak_count	=> $iteration,
						min_delta	=> $min_delta,
						name		=> $name,
						verbose		=> $verbose,
						debug		=> $debug,
						file_stem	=> $file_stem,
						init_params	=> $init_params,
						plot		=> $plot,
						# smooth_window	=> $smooth_window,
						fit_maxiter	=> 20,
						sample_name	=> $sample_name,
					} )
			} else {
				capture {
				    _boltzmann( {	
						input_file	=> $gp_data_file,
						params_file	=> $gp_params_file,
						peak_count	=> $iteration,
						min_delta	=> $min_delta,
						name		=> $name,
						verbose		=> $verbose,
						debug		=> $debug,
						file_stem	=> $file_stem,
						init_params	=> $init_params,
						plot		=> $plot,
						fit_maxiter	=> 2000,
						sample_name	=> $sample_name,
						# smooth_window	=> $smooth_window,
					} )
				    };
			} 
		}

		print "Returned from gnuplot fitting for cylce $iteration\n" if $debug;

		# Append solutions to hash one at a time, to make it easier
		# to stop when there's nothing left to fit 
		# (sum of deltas ~= ymax, or max slope in residual ~= 0 )
		# Use _tm_fit_append_return_hash, NOT _tm_fit_build_return_hash

		my $npoints_fit = sprintf "%i",($tmax - $tmin) / $degrees_per_step;
		my $new_model = _tm_fit_append_return_hash ( {
						x		=> $x,
						y		=> $y,
						iteration	=> $iteration,
						name		=> $name,
						verbose		=> $verbose,
#						pooled		=> $p,
						sum_y		=> $sum_y,
						file_stem	=> $file_stem,
						debug		=> $debug,
						directory	=> $working_directory,
						min_delta	=> $min_delta,
						npoints_fit	=> $npoints_fit,
						init_params	=> $init_params,
			} );
		$reason = exists_or_zero($new_model, 'reason');
		if (! $new_model || $reason) {
			$first_reason = $reason if $reason && !$first_reason;
			if ($reason) {
				print "Transition $iteration model failed:\n",
					"center $center_first, smooth $smooth_window, ",
					"bg_min_flag $bg_min_flag\n\t$reason\n" 
					if $verbose || $debug;

				next if retry_guess( { 
					iteration	=> \$iteration,
					center_first 	=> \$center_first,
					smooth_window	=> \$smooth_window,
					smooth_count	=> \$smooth_count,
					bg_min_flag 	=> \$bg_min_flag,
					init_params 	=> $init_params,
					high_slope 	=> $high_slope,
					reason		=> $reason,
					nx		=> $nx,
					file_stem	=> $file_stem,
					debug		=> $debug,
					verbose		=> $verbose,
				    } );
			}
			$max_count = $iteration - 1;
			print "No valid model found for iteration $iteration: ",
				"$reason\n" if $verbose;
			$reason = 'No valid model found' if ! $reason;
			last;
		}
		print "New model returned:".
			"\n\textreme_tm = ",	$$new_model{'extreme_tm'}.
			"\n\textreme_d = ",	$$new_model{'extreme_d'}.
			"\n\textreme_w = ",	$$new_model{'extreme_w'}.
			"\n\tR_abs\t= ",	$$new_model{'R_abs'}.
			"\n\tRMSD\t= ",		$$new_model{'RMSD'}.
			"\n\tmean\t= ",		$$new_model{'mean'}.
			"\n\tsmallest_delta=",	$$new_model{'smallest_delta'}.
			"\n\tsolution = ",Dumper($$new_model{'solution'})
				if $debug;
          
		# Stop and ignore the last model if the smallest delta is
		# below the minimum delta

		my $smallest_delta = $$new_model{'smallest_delta'};
		$max_slope = $$new_model{'max_slope'};
		
		if ($smallest_delta < $min_delta * $max_y / 
			($iteration == 1 ? 2 : 1) ) {
			print "STOP ITERATION: smallest delta in round ".
				"$iteration is $smallest_delta which is below ".
				$min_delta*$max_y," = $min_delta * $max_y\n" 
					if $verbose;
			next if retry_guess( { 
					iteration	=> \$iteration,
					center_first 	=> \$center_first,
					smooth_window	=> \$smooth_window,
					smooth_count	=> \$smooth_count,
					bg_min_flag 	=> \$bg_min_flag,
					retry_bg_min 	=> $iteration == 1,
					init_params 	=> $init_params,
					high_slope 	=> $high_slope,
					reason		=> $reason,
					nx		=> $nx,
					file_stem	=> $file_stem,
					debug		=> $debug,
					verbose		=> $verbose,
				} );
			$max_count = $iteration -1;
			$reason = 'Intensity change below threshhold';
			last;

		}

		my $extreme_tm	= exists_or_zero($new_model,'extreme_tm');
		my $extreme_w	= exists_or_zero($new_model,'extreme_w');
		my $extreme_d	= exists_or_zero($new_model,'extreme_d');
		printf "extreme_tm=$extreme_tm old=$extreme_tm_old ".
			" w=%.1f old %.1f d=%.1f old %.1f\n", $extreme_w, 
			$extreme_w_old, $extreme_d, $extreme_d_old if $debug;

		# Try 1st iteration again with a bigger smoothing window if
		# Tm is very close to start, i.e. curve does not start at 
		# background. Giveup after a few tries
		
		if ($iteration == 1 && ($extreme_tm > 2 || 
			($extreme_tm > 1 && $extreme_w))) {
			$reason = $extreme_tm > 2 
				  ? 'Transition too close to start of range'
				  : 'Transition too wide and close to ends';
			if ($smooth_count < $smooth_limit &&
				 $smooth_window*$smooth_factor < $nx / 3) {
				# Try first iteration again, with more smoothing
				$smooth_window=int($smooth_window*$smooth_factor);
				print "Retry first iteration: $reason. ",
					"Increase smooth window by ",
					"$smooth_factor to $smooth_window\n" 
					if $verbose;
				$iteration = 0;
				move_param_files({	stem	=> $file_stem,
							version	=> 1,
						extend	=> "smooth$smooth_count",
						});
				$smooth_count ++;
				# Bump up Tmax for weird fits
				$tmax += 1.0 if $extreme_w;
				next;
			} elsif ($extreme_tm > 2) {
				$max_count = $iteration -1;
				last;
			}
		}
		if (   exists_or_zero($discontinuity,'type') ne 'ylim' && 
		    ! $truncate && ( $extreme_d > 5.0 ||
		    ( ($extreme_tm || $extreme_w) && $extreme_d > 2.0 )  )   ) {
			# Arbitrarily shorten extreme deltas and move Tms
			# toward center
			$truncate = 1;
			my $d_nx = exists_or_zero($new_model,
						'max_delta_transition');
			$d_nx = $iteration if ! $d_nx;
			my $sln = $$new_model{'solution'};
			print "Extreme delta = $extreme_d - truncate $d_nx!!\n",
				 "Before: tm ".$$sln{"tm$d_nx"}.
					", d ".$$sln{"i_delta$d_nx"}.
					", w ".$$sln{"fwhm$d_nx"}."\n" if $debug;
			move_param_files({
					stem	=> $file_stem,
					version	=> $iteration,
					extend	=> 'extreme_delta' });
			my $p_file = _generate_gnuplot_datafilename({
					stem	=> $file_stem,
					version => $iteration,
					type	=> "parameter" });
			my $fh = new IO::File;
			$fh->open($p_file, "w");
			my $i_min   = exists_or_zero($sln,'i_min');
			my $bg_init = exists_or_zero($sln,'bg_init');
			my $bg_exp  = exists_or_zero($sln,'bg_exp');
			print $fh "i_min\t\t= $i_min\n" if $i_min || $bg_min_flag;
			print $fh <<"EOL" if ($bg_init > 1e-10);
bg_init		= $bg_init
bg_exp		= $bg_exp
EOL
			foreach my $tr (1..$iteration) {
				my $fwhm    = $$sln{"fwhm$tr"};
				my $tm	    = $$sln{"tm$tr"};
				my $i_delta = $$sln{"i_delta$tr"};
				if ($tr == $d_nx) {				
					# Truncate: Move Tm towards center
					if ( $fwhm > 10) {
						$fwhm = 10.;
					} elsif ($fwhm < 2) {
						 $fwhm = 2.;
					}
					$tm = ($tm + ($x->at(0)+$x->at(-1))/2. ) /2.;
					$i_delta = max($y);
					print "After:  tm $tm, d $i_delta, w $fwhm\n"
						if $debug;
					# print "Solution = ",Dumper($$new_model{'solution'}) if $debug;
 				}
				my $w = $fwhm - 0.5;
				print $fh <<"EOL";
tm$tr		= $tm
w$tr		= $w
i_delta$tr	= $i_delta
EOL
			}
			$fh->close;
		}
		
		# $rabs_old = $all_models{models}{$iteration-1}{R_abs} if ($iteration>1);
		my $rabs = exists_or_zero($new_model,'R_abs');
		my $d_rabs = $rabs_old - $rabs;
		printf "Rabs old-new= %.5f - %.5f = %.5f, min_delta=%.5f\n",
			$rabs_old, $rabs, $d_rabs, $min_delta if $debug;

		# Best model = peak with lowest corrected AIC:
		#	AIC = n * ln(R) + 2K + 2K(K+1)/(n-K-1)
		# where n = number of points fit
		#	R = RMSD^2, 
		#	K = number of parameters = 3+3b for b Boltzmanns
		# Calculate AIC and stop when it goes up.
		# Alternative: use lowest BIC = n*ln(R) + K*ln(n)

		my $aic = $aic_old;
		my $r = exists_or_zero($new_model,'RMSD');
		if ($r) {
			$r *= $r;
			my $n = $npoints_fit;	# ($tmax - $tmin) / $degrees_per_step;
			my $k = 3 + 3*$iteration;
			$aic = $n * log($r) + 2*$k + 2*$k*($k+1)/($n - $k - 1)
				if ($n - $k > 1);
			print "AIC $aic_old to $aic for $iteration with $n data points, ",
				"$k parameters, ssq dev = $r\n" if $debug;
		}
		
		# Stop iterating if: min delta != 0 AND iteration > 1 AND
		#	AIC goes up OR 
		#	R_abs change less than min delta/2 with same npoints OR
		#	R_abs change less than min delta * 4 AND
		#		the 2 transitions are close in Tm and slope

		# Skip these tests if the new model corrects an extreme Tm,
		# width or delta, e.g. the old model had a Tm above or below 
		# the T range, and the new model's Tms are not as far out.
		
		# Stop fitting and do not use this transition if it's very close
		# to the beginning and it's not the first iteration
		
		my $stop_iteration = 0;
		if ($min_delta && $iteration > 1 && 
			$extreme_tm >= $extreme_tm_old &&
			$extreme_d  >= $extreme_d_old &&
			$extreme_w  >= $extreme_w_old ) {

			my $d_rabs_test = 1;

			# Allow slightly smaller change for 2nd transition than 
			# for 3rd, assuming 2nd is more likely to be real

			my @min_change_list = (1, 1, 3., 2., 1.5, 1., .75, .5);
			my $min_change_denom = $min_change_list[$iteration]; # 5;
			my $min_close_factor = $iteration + 1; # 4;
			printf "Min rabs change %.5f min close change %.5f".
				" n*rabs=%.5f  n*rabs old=%.5f\n",
				($min_delta/$min_change_denom),
				($min_delta*$min_close_factor),
				$npoints_fit*$rabs, $npoints_old*$rabs_old
				if $debug;
			if ($aic > $aic_old) {
				print "STOP ITERATION: PASSED AIC MINIMUM\n". 
				    "AIC for ",$iteration-1," trans=$aic_old\n".
				    "AIC for ",$iteration,  " trans=$aic_old\n"
				    if $verbose;

				# Do NOT append the new model if AIC goes up
				$stop_iteration = 1;
				$reason = 'Passed optimum fit (minimum AIC)';

			} elsif ($d_rabs_test && 
			    $d_rabs < $min_delta / $min_change_denom &&
			    $npoints_fit <= $npoints_old) {
#			    $npoints_fit * $rabs <= $npoints_old * $rabs_old
				printf "STOP ITERATION: DELTA R_ABS < MIN_DELTA "
				    ."/ %.1f:\n\tR_abs from %i to %i ".
				    "transitions = %.4f - %.4f = %.4f < %.4f ".
				    "with %i and %i points\n",
					$min_change_denom, $iteration-1, 
					$iteration, $rabs_old, $rabs,
					$rabs_old - $rabs, $min_delta/$min_change_denom,
					$npoints_old, $npoints_fit
					if $verbose;

				# Do NOT append the new model if delta Rabs < min_delta/2
				$stop_iteration = 1;
				$reason = 'R_abs change below threshhold';
			} elsif ($extreme_tm > 1 && $extreme_tm_old <= 1 &&
				  ($extreme_tm > 3 || 
				    exists_or_zero($$new_model{'solution'},
						'bg_exp') > 1e-10)) {

				# Try again if transition moves close to ends 
				# and either Tm is at start, or transition 
				# (Tm+-FWHM) is at edge and exp. bg is used

				print "New Tm too close to ends: extreme_tm=",
					"$extreme_tm at iteration $iteration\n"
					if $debug;
				$stop_iteration = 1;
				$reason = 'Transition too close to edge of data';
			} elsif ($d_rabs < $min_delta*$min_close_factor 
				 &&
				 # $npoints_fit <= $npoints_old
				 $npoints_fit*$rabs <= $npoints_old*$rabs_old
				 ) {
				# Does the new model put 2 similar Tms near each other?
				print "Look for close Tms\n" if $debug;
				my $close_tms = find_new_close_tms( {
						    old_models	=> \%all_models,
						    new_model	=> $new_model,
						    n		=> $iteration,
						    debug	=> $debug,
						    verbose	=> $verbose,
					} );
				if ($close_tms) {
					printf "STOP ITERATION: DELTA R_ABS < ".
					    "MIN DELTA x %.1f FOR CLOSE Tms:\n\t".
					    "R_abs from %i to %i transitions =".
					    " %.4f - %.4f = %.4f < ".
					    "%.4f\n",$min_close_factor,
					    $iteration-1, $iteration,
					    $rabs, $rabs_old, $rabs_old-$rabs,
					    $min_delta * $min_close_factor
					    if $verbose;
					$stop_iteration = 1;
					$reason = 'Tms too close together';
				}
			}
			if ( $stop_iteration ) {				
				print "Transition $iteration fails AIC or Rabs test.\n",
					"center $center_first, smooth $smooth_window, ",
					"bg_min_flag $bg_min_flag\n\t$reason\n" 
					if $verbose || $debug;
				next if retry_guess( { 
					iteration	=> \$iteration,
					center_first 	=> \$center_first,
					smooth_window	=> \$smooth_window,
					smooth_count	=> \$smooth_count,
					bg_min_flag 	=> \$bg_min_flag,
					init_params 	=> $init_params,
					high_slope 	=> $high_slope,
					reason		=> $reason,
					nx		=> $nx,
					file_stem	=> $file_stem,
					debug		=> $debug,
					verbose		=> $verbose,
				    } );

				$max_count = $iteration - 1;
				last;
			}
		}
		$rabs_old = $rabs;
		$aic_old  = $aic;
		$npoints_old = $npoints_fit;
		$extreme_tm_old = $extreme_tm;
		$extreme_d_old = $extreme_d;
		$extreme_w_old = $extreme_w;
		$all_models{model}{$iteration} = $new_model;
		# $center_first = 0 if $extreme_tm == 1;
	}
	$all_models{max_transitions} = $max_count;
	$reason = $first_reason if $first_reason;
	$all_models{reason} = $reason if $reason;
	$all_models{discontinuity} = $discontinuity if exists_or_zero(
					$discontinuity, 'type');
	return \%all_models;
}

# Retry this iteration: make a new guess of initial parameters
sub retry_guess {
	my %params = validate( @_, {	
				iteration	=> { type => SCALARREF },
				center_first 	=> { type => SCALARREF },
				smooth_window	=> { type => SCALARREF },
				smooth_count	=> { type => SCALARREF },
				bg_min_flag 	=> { type => SCALARREF },
				init_params 	=> { type => HASHREF },
				retry_bg_min 	=> { type => SCALAR,
								default => 0, },
				high_slope 	=> { type => SCALAR,
								default => 0, },
				reason		=> { type => SCALAR,
								default => 0, },
				nx		=> { type => SCALAR,
								default => 0, },
				file_stem	=> { type => SCALAR,
								default => 0, },
				debug		=> { type => SCALAR, 
								default => 0 },
				verbose		=> { type  => SCALAR, 
								default => 0 },
			} );

	my $iteration	 = $params{'iteration'};
	my $center_first = $params{'center_first'};
	my $smooth_window= $params{'smooth_window'};
	my $smooth_count = $params{'smooth_count'};
	my $bg_min_flag	 = $params{'bg_min_flag'};

	my $init_params	 = $params{'init_params'};
	my $retry_bg_min = $params{'retry_bg_min'};
	my $high_slope	 = $params{'high_slope'};
	my $reason	 = $params{'reason'};
	my $nx		 = $params{'nx'};
	my $file_stem	 = $params{'file_stem'};
	my $debug	 = $params{'debug'};
	my $verbose	 = $params{'verbose'};

	my $smooth_factor = 2;
	my $smooth_limit = 3;

	my $extend = ($$center_first ? 'in' : 'out')."_smooth$$smooth_window".
			($$bg_min_flag ? '_bg' : '');
	print "Retry guess in: extend = $extend, iteration=$$iteration\n" if $debug;
	my $retry = 0;
	if ($retry_bg_min && $init_params && ! $$bg_min_flag && 
		 ! exists_or_zero($init_params, 'bg_min_flag') &&
		   exists_or_zero($init_params, 'bg_init')>1e-10) {
		print "Try bg min flag\n" if $debug;
		$$bg_min_flag = 2;
		$$center_first = 1;
		$retry = 1;
		# Move all iterations down to 2,
		# and then remove iteration 1 after loop
		while ($$iteration > 1) {
			move_param_files({
				stem	=> $file_stem,
				version	=> $$iteration,
				extend	=> $extend });
			$$iteration --;
		}
		while ($$smooth_count) {
		    $$smooth_window /= $smooth_factor;
		    $$smooth_count --;
		}
	} elsif ($$iteration == 1 && ! $high_slope) {
		print "Give up at first iteration: no high slope\n" if $debug;
	} elsif ($$center_first) {
		print "\tTry ends\n" if $verbose;
		$$center_first = 0;
		$retry = 1;
	} elsif ($$iteration > 1 && $$smooth_count) {
		print "Transition $iteration failed\n" if $debug;
	} elsif (   # $reason ne 'No positive slope' && 
		  $high_slope && $$smooth_count < $smooth_limit &&
		  $$smooth_window * $smooth_factor < $nx / 3 ) {
		$$smooth_window=int($$smooth_window * $smooth_factor);
		print "Try smoothing window $$smooth_window\n" if $verbose;
		$retry = 1;
		$$smooth_count ++;
		$$center_first = 1;
	}

	if ($retry) {
		move_param_files({
				stem	=> $file_stem,
				version	=> $$iteration,
				extend	=> $extend});
		$$iteration --;
	}
	print "Retry guess out: retry = $retry, center=$$center_first, ",
		"smooth=$$smooth_window, bg_min_flag=$$bg_min_flag, ",
		"iteration=$$iteration\n" if $debug;
	return ($retry);
}

sub move_param_files {
	my %params = validate( @_, {	stem	=> SCALAR,
					version	=> SCALAR,
					extend	=> SCALAR, 
				 } );
	my $file_stem	= $params{'stem'};
	my $version	= $params{'version'}; 
	my $extend = $params{'extend'};
	my @plist = ();
	my $p_file = _generate_gnuplot_datafilename({
					stem	=> $file_stem,
					version => $version, 
					type	=> "parameter" });
	push @plist, ($p_file, "$p_file.old");
	foreach $p_file (@plist) {
		move("$p_file", "$p_file.$extend") if (-e "$p_file");
	}
	return if (1);
	# DON'T move plots, too - from name.png to name.<extend>.png
	my $pext = '';
	foreach my $ptry ('.png', '.ps', '.gif', '.jpg', '.tiff', '.svg') {
		$p_file = _generate_gnuplot_datafilename( { 
					stem	  => $file_stem , 
					version   => $version,
					extension => $ptry } );
		if (-e $p_file) {
			$pext = $ptry;
			last;
		}
	}
	@plist = ($p_file);
	$p_file = _generate_gnuplot_datafilename( { 
					stem	  => $file_stem , 
					version	  => $version,
					type	  =>  "solution",
					extension => $pext } );
	push @plist, $p_file; 
	$p_file = _generate_gnuplot_datafilename( { 
					stem	  => $file_stem , 
					version	  => $version,
					type	  =>  "derivative",
					extension => $pext } );
	push @plist, $p_file; 
	foreach $p_file (@plist) {
		(my $tofile = $p_file) =~ s/.$pext$/.$extend.$pext/g;
		move("$p_file", "$tofile") if (-e "$p_file");
	}
	return;
}


# For iteration n, find if there are 2 transitions with close Tm and slope
# which were not there in the last transition.

sub find_new_close_tms {
	my %params = validate( @_, {	old_models => {	type 	=> HASHREF },
					new_model  => {	type 	=> HASHREF },
					n	=> { 	type 	=> SCALAR },
					debug	=> { 	type	=> SCALAR, 
							default => 0 },
					verbose	=> { 	type 	=> SCALAR, 
							default => 0 },
					} );
	my $old_models	= $params{'old_models'};
	my $model2	= $params{'new_model'};
	my $n		= $params{'n'};
	my $verbose	= $params{'verbose'};
	my $debug	= $params{'debug'};

	print "Find new close tms: new solution $n = ",Dumper($$model2{'solution'})
		if $debug;
	
	my $close2 = find_close_tms( {	model	=> $model2,
					n	=> $n,
					debug	=> $debug,
					verbose	=> $verbose,
					} );
	return $close2;

	# Logic to be written to check if old close Tms were re-used
	
	# my $model1 = $$models{model}{"$n-1"};
	# my $close1 = find_close_tms( {	model	=> $model1,
	#				n	=> $n - 1,
	#				debug	=> $debug,
	#				verbose	=> $verbose,
	#				} );
	# return 1 if ! $close1;
	# my $t1a = $$close1{'tma'};
	# my $t1b = $$close1{'tmb'};
	# my $t2a = $$close2{'tma'};
	# my $t2b = $$close2{'tmb'};
	# my $t2_mean = ($t2a + t2b)/2;
	# return 0 if ($t1a <= $t2_mean && $t2_mean <= $t1b);
	# return 1;
}

# Look through the transitions in a model for pairs close in Tm and slope
sub find_close_tms {
	my %params = validate( @_, {	model	=> { 	type 	=> HASHREF },
					n	=> { 	type 	=> SCALAR },
					debug	=> { 	type	=> SCALAR, 
							default => 0 },
					verbose	=> { 	type 	=> SCALAR, 
							default => 0 },
					} );
	my $model = $params{'model'};
	my $n	  = $params{'n'};
	my $verbose	= $params{'verbose'};
	my $debug	= $params{'debug'};
	return 0 if ($n < 2);
	my $solution = $$model{'solution'};
	my %result = ();
	my $old_t = $$solution{'tm1'};
	my $old_w = $$solution{'fwhm1'};
	   $old_w  = 1 if ! $old_w;
	my $old_d = $$solution{'i_delta1'};
	my $old_s = $old_d / $old_w;		# slope =~ delta / width
	# Assume peaks are sorted by ascending Tm.
	printf "Find close Tms for %i Tms\nn %i T %.2f W %.2f S %.7f\n",
		$n, 1, $old_t, $old_w, $old_s if $debug;
	my $r = 4.0;
	my $factor = ($r-1) / ($r + 1);
	my $k = log(3 + 2*sqrt(2));
	for (my $ip=2; $ip <= $n; $ip++) {
		my $new_t = $$solution{"tm$ip"};
		my $new_w = $$solution{"fwhm$ip"};
		my $new_d = $$solution{"i_delta$ip"};
		printf "n %i T %.2f W %.2f S %.7f\n", $ip, $new_t, $new_w, 
			($new_w ? $new_d/$new_w : 0) if $debug;
		next if ! $new_w || ! $new_d || ! $new_t;
		my $new_s = $new_d / $new_w;

		# Consider 2 peaks close if their Tm's are less than 
		# the sum of half their widths (< mean FWHM), AND 
		# either the ratios of their widths is close to 1, 
		# 	i.e. between 1/r and r for r ~ 2, 
		# OR the slope between goes above 10% of the higher slope at Tm
		# 	sampling at 1/4, 1/2 and 3/4 of the way between.
		#
		# Test a/b ratio between 1/r and r using |a-b| < (a+b)*(r-1)/(r+1)
		# For a>b, this is	a(r+1)-a(r-1) < b(r-1)+b(r+1)
		#				   2a < 2br
		#				  a/b < r
		# For b>a, it comes out to	  b/a < r
		#
		# Test slopes using dI/dT= (Idelta/Tw)*f/(1+f)^2,f=e^((Tm-T)/Tw),
		#	where Tw = FWHM / k, k =log(3 + 2*sqrt(2)),
		# Slope at Tm for one transition is delta_I/4*Tw=delta_I*k/4*FWHM
		# Calculate & compare slopes without the factor k, i.e. compare
		# max(new_s,old_s)/4=max(Idelta/FWHM)/4 to 
		#	  new_s * f1/(1+f1)^2 + old_s * f1/(1+f2)^2
		#	= Idelta_1/FWHM_1 * ... + Idelta_2/FHWM_2 * ...
		
		if ($new_t - $old_t < ($new_w + $old_w)/2) {
		
			my $close = 0;
			if (abs($new_w - $old_w) < $factor * ($new_w + $old_w)) {
			 #&&abs($new_s - $old_s) < $factor * ($new_s + $old_s)
				$close = 1;
			} else {
				my $max_s = List::Util::max($new_s,$old_s)*1.1/4.0;
				my $t_incr = ($new_t - $old_t)/4;
				printf "Test slopes from T %.2f to %.2f by %.2f ".
					" for > %.7f\n", $old_t, $new_t, $t_incr,
					$max_s if $debug;
				
				# Test slopes at 3 points between old and new T
				for (my $i=1; $i<4; $i++) {
					my $t = $old_t + $i * $t_incr;
					my $f1 = exp(($new_t-$t)*$k/$new_w);
					my $f2 = exp(($old_t-$t)*$k/$old_w);
					printf "Slope at %i/4, T=%.2f is %.7f\n", 
					    $i, $t,
					    $new_s*$f1/((1+$f1)*(1+$f1)) + 
					    $old_s*$f2/((1+$f2)*(1+$f2)) if $debug;
					printf "Slope from %i,%i = %.7f, %.7f\n", 
						$ip-1, $ip,
					    $old_s*$f2/((1+$f2)*(1+$f2)),
					    $new_s*$f1/((1+$f1)*(1+$f1)) if $debug > 1;
					if ($new_s*$f1/((1+$f1)*(1+$f1)) + 
					    $old_s*$f2/((1+$f2)*(1+$f2)) > $max_s) { 
					    print "FOUND CLOSE TMs at $i/4 for #",
					    	"$ip\n" if $debug;
						$close = 1;
						last;
					}
				}
			}
			if ($close) {
				my %result = (	tma => $old_t,
						tmb => $new_t,
						wa  => $old_w,
						wb  => $new_w,
						sa  => $old_s,
						sb  => $new_s );
				return \%result;
			}
		}
		$old_t = $new_t;
		$old_w = $new_w;
		$old_d = $new_d;
		$old_s = $new_s;
	}
	return 0;
}

# For iteration n, calculate files for residual to be saved to "name_n_residual.dat" 
sub _tm_fit_append_return_hash  {
	my %params = validate( @_, {	
					x		=> { type => SCALARREF },
					y		=> { type => SCALARREF },
					sum_y		=> { type => SCALAR },
					name		=> { type => SCALAR },
					file_stem	=> { type => SCALAR },
					iteration	=> { type => SCALAR },
					directory	=> { type => SCALAR },
					npoints_fit	=> { type => SCALAR,
								default => 0 },
					debug		=> { type => SCALAR, 
								default => 0 },
					verbose		=> { type => SCALAR, 
								default => 0 },
					min_delta	=> { type => SCALAR, 
							     default => .02},
					init_params	=> { type => HASHREF },
				}
			);
	my $x		= $params{'x'};
	my $y		= $params{'y'};
#	my $pooled	= $params{'pooled'};
	my $sum_y	= $params{'sum_y'};
	my $name	= $params{'name'};
	my $file_stem	= $params{'file_stem'};
	my $iteration	= $params{'iteration'};
	my $verbose	= $params{'verbose'};
	my $debug	= $params{'debug'};
	my $directory	= $params{'directory'};
	my $min_delta	= $params{'min_delta'};
	my $npoints_fit	= $params{'npoints_fit'};
	my $init_params = $params{'init_params'};
	my $tmin_init	= $$init_params{'t_min'};
	my $tmax_init	= $$init_params{'t_max'};

	my $ny		= nelem($y);
	my $y_mean	= sum($y)/$ny;
#	my $y_minus_mean= $y - ($y_mean / $ny);
#	my $variance	= sum( $y_minus_mean * $y_minus_mean ) / $ny;
#	$all_models{'variance'} = $variance;
	if (! nelem($x)) {
		print "NO TEMPERATURE DATA for iteration $iteration !" if $verbose;
		return { reason => "NO TEMPERATURE DATA" };
	}
	my $degrees_per_step = ($x->at(-1)-$x->at(0)) / nelem($x);
	# my $sq2p = sqrt( 8 * atan2(1, 1) );

	print "Append hash for Iteration $iteration \n" if $debug;

	# Make sure the fit converged, i.e. gnuplot variable "FIT_CONVERGED"=1
	my $gp_variables_file   = _generate_gnuplot_datafilename( { stem => $file_stem , version =>  ($iteration) , type => "variables" });
	if (-e $gp_variables_file) {
		my ($cvalues, $cparams) = rcols($gp_variables_file, {PERLCOLS => [0] }, 2);
		my %cvariables = ();
		@cvariables{@$cparams} = list( $cvalues );
		if (! $cvariables{'FIT_CONVERGED'}) {
			print "WARNING: Fit failed to converge for iteration ",
				"$iteration\n" if $verbose;
			# return 0;
		}
	}

	my $residual_file   = _generate_gnuplot_datafilename( { stem => $file_stem , version =>  ($iteration) , type => "residual" });
#	my $background_file = _generate_gnuplot_datafilename( { stem => $file_stem , version => ($iteration) , type => "background" });
	my $fitted_file     = _generate_gnuplot_datafilename( { stem => $file_stem , version => ($iteration) , type => "fitted" });
	my $parameter_file  = _generate_gnuplot_datafilename( { stem => $file_stem , version => ($iteration) , type => "parameter" });

	return {reason => 'CANNOT FIND RESIDUAL FILE'} if (! -e $residual_file);
	my $y_residual	= rcols( $residual_file,  1 , { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' } );
#	my $background	= rcols( $background_file, 1, { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' });
	my $y_fitted	= rcols( $fitted_file, 1, { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' });

	my $observed_points	= nelem( $y_residual );
	my $sum_abs_residual	= sum( abs( $y_residual ) );
#	my $sum_background	= sum( $background );
	my $sum_background	= 0;
	my $R_abs		= $sum_abs_residual / ($sum_y - $sum_background);
	my $total_area		= ($sum_y - $sum_background) * $degrees_per_step;

	my $RMSD	= sqrt( sum( $y_residual * $y_residual ) / $observed_points );
	my $mean	= ( $sum_y - $sum_background) / $observed_points;
	my $RMSD_div_mean = $RMSD / $mean;
	

	# Using the $params and $values lists, create a hash with the keys in $params and values in $values.
	# We had some oddness with rcols reading in the wrong columns of text
	my ($values, $params) = rcols($parameter_file, {PERLCOLS => [0] }, 2);

	my %solution_unsorted = ();
	@solution_unsorted{@$params} = list( $values );


	# Sort solution peaks in order by Tm, and get summaries for testing
	
	my $sort_result = sort_peaks( { solution => \%solution_unsorted, 
					npeaks	 => $iteration } );
	my $ndx_ref = $$sort_result{'index'};
	my @ndx = @$ndx_ref;
	print "Peak order: ",join(",",@ndx),"\n" if $debug;
	# Keep original imin value
	my %solution = (
			i_min  => exists_or_zero(\%solution_unsorted,'i_min'),
			bg_init => abs(
				   exists_or_zero(\%solution_unsorted,'bg_init')),
			bg_exp  => abs(
				   exists_or_zero(\%solution_unsorted,'bg_exp')),
			);
	my $smallest_delta = 1e10;
	my $max_slope = 0;
	my $max_slope_ndx = 0;
	my $tmax = 0;
	my $tmin = 100;
	my $max_width = 0;
	my $tm_min = 100;
	my $tm_max = 0;
	my $max_delta = 0;
	my $max_delta_ndx = 0;
	my $major_fwhm = 0;
	my $extreme_tm = 0;
	my $extreme_w  = 0;
	my $sum_widths = 0;
		
	# Add peaks in order by start, and find min. peak area
	print "Solution unsorted: ",Dumper(%solution_unsorted) if $debug;
	foreach my $ip (1..$iteration) {
		my $i = $ndx[$ip];
#		foreach my $j ('tm', 'fwhm', 'i_delta') {
#			$solution{"$j$ip"} = abs(\%solution_unsorted{"$j$i"});
#		}
		my $tm_i   = abs(exists_or_zero(\%solution_unsorted,"tm$i")); 
		my $fwhm_i = abs(exists_or_zero(\%solution_unsorted,"w$i")) + 0.5;
		my $delta  = abs(exists_or_zero(\%solution_unsorted,"i_delta$i"));
		$solution{"tm$ip"}	= $tm_i;
		$solution{"fwhm$ip"}	= $fwhm_i;
		$solution{"i_delta$ip"}	= $delta;
		$tm_min = $tm_i if $tm_i < $tm_min;
		$tm_max = $tm_i if $tm_i > $tm_max;
		$sum_widths += $fwhm_i;
		$tmin = List::Util::min($tmin, $tm_i - $fwhm_i*0.75);
		my $tmax_i = $tm_i + $fwhm_i/2;  # Tm + FWHM/2
		my $tm_nxs = which( $x >= $tm_i );
		my $tm_nx = nelem($tm_nxs) ? $tm_nxs->at(0) : 0;
		$tmax = $tmax_i if $tmax_i > $tmax || $ip == 1;
		$smallest_delta = $delta if $ip==1 || $delta < $smallest_delta;
		my $width= abs($solution{"fwhm$ip"});
		$max_width = $width if $width > $max_width;
		my $slope = $width ? $delta/$width : 0;

		# Test for major transition using both slope and delta

		if ($slope > $max_slope) {
			$max_slope = $slope;
			$max_slope_ndx = $ip;
			print "Current max slope = $max_slope at $ip,",
				"delta $delta fwhm $fwhm_i\n" if $debug;
		}
		print "Current max delta = $max_delta at $ip,",
				"delta $delta\n" if $debug;
		if ($delta > $max_delta) {
			$max_delta = $delta;
			$max_delta_ndx = $ip;
		}
		
		# Old test: slope > max slope, and delta > 1/4 max delta and 
		# max fwhm > 1/4 max fwhm
		# if (($slope > $max_slope && 
		#    $delta > $major_delta/4. && $fwhm_i > $major_fwhm/4.) || 
		#    $delta > $major_delta*4. || $fwhm_i > $major_fwhm*4. ) 

		print "Tmax = $tmax, delta = $delta, major transition = $ip\n"
			if $debug;
		my $i_tm   = 0;
		if ($tm_nx) {
			$i_tm = $y->at($tm_nx);
		} elsif ($tm_i < $x->at(0) && $slope) {
			# Extrapolate down using Tm, Tw and Idelta
			$i_tm = $y->at( 0) + $delta*(1/2 - 1/
				(1+exp( ($tm_i - $x->at( 0)) / ($k4*4))));
		} elsif ($tm_i > $x->at(-1) && $slope) {
			# Extrapolate up using using Tm, Tw and Idelta
			$i_tm = $y->at(-1) + $delta*(1/2 - 1/
				(1+exp( ($tm_i - $x->at(-1)) / ($k4*4))));
		}
		$solution{"i_tm$ip"} = $i_tm;
		# Estimate error of Tm = std dev of Temp near Tm (within 2 C)
		# Use slope estimate to find RMSD of T from fit line 
		# Formula should be I = I_tm + (T - Tm) * slope,
		#	i.e. T = Tm + (I - I_tm) / slope
		if ($slope) {
			# my $ntest = $width < 4 ? $width : 4;
			my $ntest = $width;
			# Pick an odd number of steps - e.g. 21
			$ntest = int($ntest / (2*$degrees_per_step)+0.5)*2 + 1;
			$ntest = 2 if $ntest <= 1;
			my $n2 = int($ntest / 2);
			my $a = $tm_nx - $n2;
			$a = nelem($x) - $ntest if $tm_i > $x->at(-1);
			$a = 0 if $a < 0;
			my $b = $a + $ntest - 1;
			$b = nelem($y)-1 if $b >= nelem($y);
			my $ssq =sum(($x->slice("$a:$b") - ($tm_i + 
				     ($y->slice("$a:$b") - $i_tm)/$slope))**2);
			$solution{"sd_tm$ip"} = sqrt($ssq /($ntest-1));
			print "T - Tcalc: ",($x->slice("$a:$b") - ($tm_i + 
				     ($y->slice("$a:$b") - $i_tm)/$slope)),"\n"
				     if $debug;
			print "SSQ Tm $ip = $ssq, SD=",$solution{"sd_tm$ip"},"\n"
				if $debug;
		}
	}
	my $avg_width = $sum_widths / $iteration;

	# Stop and ignore the last model if it's ridiculous, or at least warn:
	# Any Tm is within 2 steps of either end of the T range, 
	# Max FWHM > 50% of the T range for 2nd or higher transition,
	# Any I delta < 5% of the I range (unless it's the first transition)

	my $t_lo = $x->at( 0);
	my $t_hi = $x->at(-1);	
	if ($tm_min < $t_lo  + $degrees_per_step) {
		printf "WARNING: Tm %.1f too close to minimum temperature %.1f\n",
			$tm_min, $t_lo if $verbose;
		# return 0;
		$extreme_tm = 4;
	} elsif ($tmin < $t_lo - $degrees_per_step) {
		printf "WARNING: transition start ~%.1f is below min temp. %.1f\n",
			$tmin, $t_lo if $verbose;
		$extreme_tm = 3;
	} elsif ($tmin < $t_lo + $degrees_per_step) {
		printf "WARNING:  transition start ~%.1f is near min temp. %.1f\n",
			$tmin, $t_lo if $verbose;
		$extreme_tm = 2;
	} elsif ($tm_max > $t_hi - $degrees_per_step) {
		$extreme_tm = 1.5;
		printf "WARNING: Tm %.1f at or above maximum temperature %.1f\n",
			$tm_max, $x->at(-1) if $verbose;
	} elsif ($tm_min - $avg_width/4 < $tmin_init || 
		 $tm_max + $avg_width/4 > $tmax_init) {
		printf "WARNING: Tm %.1f or %.1f is not within ".
			"fit temperature range %.1f to %.1f\n", $tm_min, $tm_max,
			$tmin_init, $tmax_init if $verbose;
		# return 0;
		$extreme_tm = 1;
	}
	if ($max_width > ($t_hi - $t_lo) / 2) {
		printf "WARNING: FWHM %.1f > 1/2 of temperature range\n",
			$max_width if $verbose;
		$extreme_w = $max_width / ($t_hi - $t_lo);
		#return{reason=>'TRANSITION WIDTH > 1/2 of TEMPERATURE RANGE'};
	} elsif ($max_width < 1.0) {
		printf "WARNING: FWHM %.2f < 1 C\n", $max_width if $verbose;
		$extreme_w = - $max_width;
		#return{reason=>'TRANSITION WIDTH > 1/2 of TEMPERATURE RANGE'};
	}

	my $max_y = max($y) - min($y);
	my $extreme_d = $max_delta/$max_y;
	$extreme_d = 0 if $extreme_d < 1.5;

	if ($iteration > 1 && $smallest_delta < $max_y * $min_delta) {
		printf "STOP ITERATION: Intensity change %.5f < ".
			"min delta %.5f = %.4f * %.5f\n", $smallest_delta,
			$min_delta * $max_y, $min_delta, $max_y if $verbose;
		return {reason => 
			'Intensity change of transition below threshhold'};
	}

	my $fit_points = $observed_points;
	if ($npoints_fit) {
		$fit_points = $npoints_fit;
		# my $tmax_ndxs = which( $x > $tmax );
		# if (nelem($tmax_ndxs)) {
		#	my $tmax_ndx = $tmax_ndxs->at(0);
			if ($fit_points < nelem($y_residual)) {
				# my $tmax_ndx = $fit_points - 1;
				# Find 1st, last nx st tmin_init<=t<=tmax_init
				my $tmax_ndxs = which($x <= $tmax_init);
				my $tmin_ndxs = which($x >= $tmin_init);
				my $tmax_ndx = nelem($tmax_ndxs) 
					? $tmax_ndxs->at(-1) : nelem($x) - 1;
				my $tmin_ndx = nelem($tmin_ndxs) 
					? $tmin_ndxs->at(0) : 0;
				my $yslice = "$tmin_ndx:$tmax_ndx";
				my $y_resid_slice = $y_residual->slice($yslice);
				$sum_abs_residual = sum( abs($y_resid_slice) );
				$sum_y = sum( $y->slice($yslice) );
				$R_abs = $sum_abs_residual / $sum_y;
				$RMSD  = sqrt( sum( $y_resid_slice * 
					$y_resid_slice ) / $fit_points );
				$total_area = $sum_y * $degrees_per_step;
				$mean	= $sum_y / $fit_points;
				$RMSD_div_mean = $RMSD / $mean;
			}
		# }
	}
	$solution{'major_transition'} = $max_slope_ndx;
	$solution{'max_delta_transition'} = $max_delta_ndx;
	print "Max slope found = $max_slope at $max_slope_ndx\n" if $debug;
	print "Solution sorted: ",Dumper(%solution) if $debug;

	print "Solution: Imin=$solution{'i_min'},\t Tm1=$solution{'tm1'},  ".
		"FWHM=$solution{'fwhm1'},  Idelta=$solution{'i_delta1'}\n"
		if $debug;

	if ( $verbose > 1 ) {
		print "\tSum( abs( residual) )		$sum_abs_residual	\n";
		print "\tSum( background )		$sum_background	\n";
		print "\ttotal_area			$total_area\n";
		print "\tR_abs				$R_abs\n";
		print "\tRMSD				$RMSD\n";
		print "\tmean				$mean\n";
		print "\tRMSD/mean			$RMSD_div_mean\n";
		print "\tFit points			$fit_points\n";
		print "\tSolution:",Dumper(\%solution);
	}
	
	# DO NOT USE THE FOLLOWING MIN. PEAK AREA TEST
	# Stop appending to results hash if min. peak < pean_min * total area
	# if ($min_area < $peakmin) {
	# 	$all_models{'max_transitions'} = $iteration;
	# 	printf "Stopping iteration: min peak area for model %i ".
	# 		"= %.4f < peakmin = %.4f\n", $iteration,
	# 		$min_area, $peakmin if $verbose; 
	# 	$max_count = $iteration;
	# }

	# Return model for the iteration to be appended

	my $model = 	{ 
				solution	=> { %solution },
				y_fitted	=> [ list( $y_fitted ) ] ,
				y_residual	=> [ list( $y_residual ) ],
				R_abs		=> $R_abs,
				RMSD		=> $RMSD,
				mean		=> $mean,
				smallest_delta	=> $smallest_delta,
				# npoints_fit	=> $fit_points,
				extreme_tm	=> $extreme_tm,
				extreme_w	=> $extreme_w,
				extreme_d	=> $extreme_d,
			};
	print "New model to be returned: ",Dumper($model) if $debug > 2;
	return $model;
}


# Find and write initial parameters for iteration n
# Parameters = Imin overall, n*(Tm, FWHM, Idelta)
# Range to be fit = min(Tm - FWHM) to max(TM+FWHM/2)
# For iteration n, write out to file "name_n_parameter.dat"

sub _setup_parameters {
use PDL;
	my %params = validate( @_, {	
					x	=> {	type	=> SCALARREF },
					y	=> {	type	=> SCALARREF },
					sum_y	=> {	type	=> SCALAR,
							default	=> 0 },
					tm	=> {	type	=> SCALAR,
							default => 0 },
					FWHM	=> {	type	=> SCALAR,
							optional=> 1,
							default => 0 },
					i_delta	=> {	type	=> SCALAR,
							default => 0 },
					i_min	=> {	type => SCALAR,
							default => 0 },
					bg_exp_flag => {type	=> SCALAR,
							default => 1 },
					bg_min_flag => {type	=> SCALAR,
							default => 0 },
					center_first => {type	=> SCALAR,
							default => 1 },
					file_stem => { type => SCALAR },
					name	  => { type => SCALAR},
					iteration => { type => SCALAR },
					verbose	  => { type => SCALAR, default => 0 },
					debug	  => { type => SCALAR, default => 0 },
					gnuin	  => { type => SCALAR, default => 0 },
					min_delta => { type => SCALAR, default =>.02 },
					min_deriv => { type => SCALAR, default =>.001 },
					tmin	  => { type => SCALAR, default => 0 },
					tmax	  => { type => SCALAR, default => 0 },
					discontinuity => { type => HASHREF,
							   default => 0 },
					smooth_window => { type => SCALAR,
							   default => 15 },
				}
			);
	my $x		= $params{'x'};
	my $y		= $params{'y'};
	my $sum_y	= $params{'sum_y'};
	$sum_y = sum( $y ) if ! $sum_y;
	my $tm		= $params{'tm'};
	my $fwhm	= $params{'FWHM'};
	my $i_delta	= $params{'i_delta'};
	my $i_min	= $params{'i_min'};
	my $file_stem	= $params{'file_stem'};
	my $name	= $params{'name'};
	my $iteration	= $params{'iteration'};
	my $verbose	= $params{'verbose'};
	my $debug	= $params{'debug'};
	my $gnuin	= $params{'gnuin'};
	my $min_delta	= $params{'min_delta'};
	my $min_deriv	= $params{'min_deriv'};
	my $bg_exp_flag = $params{'bg_exp_flag'};
	my $bg_min_flag = $params{'bg_min_flag'};
	my $center_first= $params{'center_first'};
#	my $width	= $params{'width'};
#	$width = 4.0 if ! $width;
	my $parameters	= '';
	my %init_params = ();
	my $discontinuity = $params{'discontinuity'};
	print "_setup_params: discontinuity before iteration $iteration:",
			Dumper(\$discontinuity) if $debug && $discontinuity;

	my $tmin	= $params{'tmin'};
	my $tmax	= $params{'tmax'};
	my $points_to_smooth = $params{'smooth_window'};
	
	# $tmin	= $x->at( 0) if ! $tmin;
	# $tmax	= $x->at(-1) if ! $tmax;
	my $filename = _generate_gnuplot_datafilename( { stem => $file_stem, version => $iteration, type => "parameter" } );

	my $min_y	= min($y);
	my $delta_y	= max($y) - $min_y;
	my $min_delta_y = $min_delta * $delta_y;

	if ($debug) {
		print "\n***************** $iteration Boltzmann Initial Parameters ***********\n";
		print "File $filename; init. Tm $tm, fwhm $fwhm, Idelta $i_delta\n";
	}

	# Points in 3 degrees = 3 * npoints / (Tmax - Tmin)
	# my $points_to_smooth = int(3*nelem($x) / ($x->at(-1) - $x->at(0)));
	my $min_length = $points_to_smooth * 5/3;
	# Always include center point by making number of points odd
	$points_to_smooth += 1 if ! $points_to_smooth % 2;
	my $x_smooth = _smooth( { x => $x, 
				  n => $points_to_smooth,
				  type => "Gaussian", # "linear",	# 
				  debug => $debug ? $debug - 1 : 0,
				  negatives => 0,
				  ends => "extrapolate" } );

	my $bg_init = 0;
	my $bg_exp  = 0;
	if ( $iteration == 1 ) {
		
		my $guess = guess_tm_params( {
						x	=> $x_smooth,
						y	=> $y,
						n_smooth=> $points_to_smooth,
						debug	=> $debug,
						verbose	=> $verbose,
						nx_min	=> 0,
						nx_max	=> -1,
						min_delta_y => $min_delta_y,
						min_deriv => $min_deriv,
						tmin	=> $tmin,
						tmax	=> $tmax,
						file_stem => $file_stem,
						first	=> 1,
						bg_exp_flag => $bg_exp_flag,
						bg_min_flag => $bg_min_flag,
						center_first=> $center_first,
					} );
		print "Guess returns $guess min delta $min_delta_y\n" if $debug;
		return 0 if ! $guess;
		my $reason = exists_or_zero($guess,'reason');
		return $guess if $reason;

		# Flag = 1 to replace all, 0 = replace only those missing
		my $flag = 1;
		$tm	 = $$guess{'tm'} if $flag || ! $tm;
		$fwhm	 = $$guess{'FWHM'} if $flag || ! $fwhm;
		$i_delta = $$guess{'i_delta'} if $flag || ! $i_delta;
		$i_min	 = $$guess{'i_min'} if $flag || ! $i_min;
		$bg_exp	 = $$guess{'bg_exp'};
		$bg_init = $$guess{'bg_init'};
		$bg_min_flag = $$guess{'bg_min_flag'};
		$tmin	 = $$guess{'t_min'};
		$tmax	 = $$guess{'t_max'};
		$min_deriv = $$guess{'min_deriv'};
		my $max_deriv = $$guess{'max_deriv'};
		print "First guess: Tm $tm id $i_delta range $tmin - $tmax\n"
			if $debug;

		my $tm_avg	 = $$guess{'Tm_avg'};
		my $tm_max_slope = $$guess{'Tm_max_slope'};
		my $tw		 = $$guess{'Tw'};
		my $i_tm	 = $$guess{'I_tm'};
		my $i_min_calc	 = $$guess{'I_min_calc'};

		$discontinuity = $$guess{'discontinuity'} if exists 
				 $$guess{'discontinuity'};
		my $skip_ndx = exists_or_zero($discontinuity,'skip_ndx');
		my $skip_type = exists_or_zero($discontinuity,'type');
		my $skip_low  = exists_or_zero($discontinuity,'skip_low');
		my $hi_skip  = exists_or_zero($discontinuity,'hi_skip');
		my $y_jump_at_low_x = $skip_low || 
			($skip_ndx > 0 && $skip_type ne 'drop' &&
			($skip_ndx < nelem($x)/3 || $skip_type eq 'ylim'));
					;
		print "Discontinuity after 1st iteration: ",
			" low y jump: $y_jump_at_low_x, ",
			Dumper(\$discontinuity) if $debug && $discontinuity;
		print "No discontinuity\n" if $debug && ! $discontinuity;
		my $nx_max = nelem($x) - 1;
		$nx_max = $skip_ndx - 1 if $skip_ndx && ! 
					($skip_low || $y_jump_at_low_x);
		$nx_max = $hi_skip - 1 if $hi_skip;
		
		# If there's exp. decay, start from lower T unless there's a 
		# discontinuity
		my $t_drop = 1.0;
		
		$tmin = $tmin*(1.0-$t_drop) + $x->at(0)*$t_drop if $bg_init && 
							! $y_jump_at_low_x;

		# Don't use imin if bg_min_flag is not set and there's exp. decay.
		$i_min = 0 if (! $bg_min_flag) && ($bg_init > 1e-10); 
			# || abs($i_min) < $min_delta_y);
		
		# initial parameters
		
		if ($debug) {
			print "\tFirst iteration, setting up file $filename\n";
			#print "index is $tmp_index\n";
			#print "index_2 is $tmp_index_2\n";
			print "\ti_min = $i_min\n";
			print "\ttm = $tm\n";
			print "\tfwhm = $fwhm\n";
			print "\ti_delta = $i_delta\n";
			print "\tbg_init = $bg_init\n";
			print "\tbg_exp = $bg_exp\n";
			print "\tbg_min_flag = $bg_min_flag\n";
		}
		if ($i_delta <= 0) {
			print "CANNOT FIT DATA: NO POSITIVE SLOPE!\n";
			return { reason => 'NO POSITIVE SLOPE', 
				 min_deriv => $min_deriv,
				 max_deriv => $max_deriv,
				};
		}

		# Stop before a large drop above the first transition
		# if there's room to worry about there

		# if (! $bg_init > 1e-10 && )
		if ($tmax < $x->at($nx_max) - 5) {
			my $y_above_bg = $y - ($i_min+($bg_init > 1e-10 ? 
				abs($bg_init-$i_min)*exp(-abs($bg_exp)*$x) : 0));
			my $tmax_nx	= which( $x >= $tmax )->at(0);
			my $i_tmax	= $y_above_bg->at($tmax_nx);
			my $hi_slice	= $y_above_bg->slice("$tmax_nx:$nx_max");
			my $hi_max	= max( $hi_slice );
			my $hi_max_nx	= which( $hi_slice == $hi_max)->at(0);
			$hi_max_nx	+= $tmax_nx;
			my $hi_slice2   = $y_above_bg->slice("$hi_max_nx:$nx_max");
			my $hi_min	= min( $hi_slice2 );
			my $min_y_above = min( $y_above_bg );
			my $hi_lim = $min_y_above + 0.9*($hi_max-$min_y_above);
			print "Test drop after Tm: Tmax $tmax at $tmax_nx  ",
				"hi max $hi_max at $hi_max_nx min $min_y_above",
				" hi min $hi_min   hi lim $hi_lim\n" if $debug;
			my $nh = nelem($hi_slice);
			my $a = List::Util::min(10,$nh-1);
			print "T above $tmax_nx:",
					$x->slice("$tmax_nx:".($tmax_nx+$a)),"\n",
				"F:\t", $y->slice("$tmax_nx:".($tmax_nx+$a)),"\n",
				"F-bg:\t",$y_above_bg->slice("0:$a"),"\n",
				"hi slice:",$hi_slice->slice("0:$a"),"\n" 
				if $debug;
			if ($hi_min < $hi_lim) {
				my $lim_nx = which($hi_slice2 < $hi_lim)->at(0);
				$lim_nx += $hi_max_nx;
				my $lim_t = $x->at($lim_nx);
				print "Found drop after $lim_t at $lim_nx\n" 
					if $debug;
				my $disc = { t_skip 	=> $lim_t,
					     skip_ndx	=> $lim_nx,
					     type	=> 'drop',
					   };
				if ($discontinuity) {
					my $old_t_skip = exists_or_zero(
						$discontinuity,'t_skip');
					if ($old_t_skip > $lim_t || 
						! $old_t_skip) {
						$discontinuity = $disc;
					}
				} else {
					$discontinuity = $disc;
				}
			}
		}


		if (! $gnuin) {
			my $fh = new IO::File;
			$fh->open($filename, "w");
			my $w = $fwhm - 0.5;
			print $fh 
"i_min\t\t= $i_min\n" if $i_min || $bg_min_flag;
			print $fh <<"EOL";
tm1		= $tm
w1		= $w
i_delta1	= $i_delta
EOL
			if ($bg_init > 1e-10) {
				print $fh <<"EOL";
bg_init		= $bg_init
bg_exp		= $bg_exp
EOL
			}
			$fh->close;
		}
		printf "Initial estimate for 1st iteration: tm %.1f fwhm %.1f".
			" i_delta %.3f i_min %.5f, bg init,exp %.5f, %.5f\n", 
			$tm,$fwhm, $i_delta, $i_min, $bg_init, $bg_exp 
			if $verbose;

		%init_params = (tm_init		=> $tm, 
				fwhm_init	=> $fwhm, 
				i_delta_init	=> $i_delta,
				i_min		=> $i_min,
				t_max		=> $tmax,
				t_min		=> $tmin,
				bg_init		=> $bg_init,
				bg_exp		=> $bg_exp,
				bg_min_flag	=> $bg_min_flag,
				discontinuity	=> $discontinuity,
				Tm_avg		=> $tm_avg,
				Tm_max_slope	=> $tm_max_slope,
				Tw		=> $tw,
				I_tm		=> $i_tm,
				I_min_calc	=> $i_min_calc,
				min_deriv	=> $min_deriv,
				max_deriv	=> $max_deriv,
				 );
	} else {
		# we have an iteration step beyond 1, so we must build on the previous solved parameters
		# determine the files with the previous solution, and load the data into PDLs
		my $previous_iteration = $iteration - 1;
		my $residual_file	= _generate_gnuplot_datafilename( { stem => $file_stem , version =>  ($previous_iteration) , type => "residual" });
#		my $background_file	= _generate_gnuplot_datafilename( { stem => $file_stem , version => ($previous_iteration) , type => "background" });
		my $solved_params_file	= _generate_gnuplot_datafilename( { stem => $file_stem , version => ($previous_iteration) , type => "parameter", extension => ".dat" });

		# Load the values, stored in the 2nd column of the files into PDLs
		#print "residual $residual_file\n";
		my $residual	= rcols( $residual_file,  1 , { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' } );
		#print "background\n";
#		my $background	= rcols( $background_file, 1, { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' });
		#print "solved_parameters\n";
		# my $solved_parameters	= rcols( $solved_params_file, 2 );
		my ($values, $solved_params) = rcols($solved_params_file, 
						{PERLCOLS => [0] }, 2);
		my %solution = ();
		@solution{@$solved_params} = list( $values );

		# my $n_solved_parameters	= nelem($solved_parameters);
		if ($debug) {
			# print "$n_solved_parameters solved parameters\n";
			# print "Solved parameters value = $solved_parameters\n";
			# print "Dump of solved parameters:\n",Dumper($solved_parameters);
			print "Solution: ",Dumper(%solution);
		}
		
		$bg_init = exists_or_zero(\%solution,'bg_init');
		$bg_exp  = exists_or_zero(\%solution,'bg_exp');
		$i_min = exists_or_zero( \%solution,'i_min' );
		# $i_min = 0 if abs($i_min) < $min_delta_y && ! $bg_init;
		print "I min before test =$i_min\n" if $debug;
		$i_min = 0 if (! $bg_min_flag) && ($bg_init > 1e-10 || 
				abs($i_min) < $min_delta_y);
		print "I min after  test =$i_min\n" if $debug;

		my @tm_set = (); 
		my @fwhm_set = ();
		my @delta_set = (); 
		my $delta_sum = 0;
		my $fwhm_max = 0;

#		if ($n_solved_parameters >= 1+3*($iteration-1)) {
#			for (my $ii=0; $ii+1<$iteration; $ii++) 
#				print "Get solved parameters for cycle $ii:",
#					1+3*$ii," to ",3+3*$ii,"\n" if $debug;
#				push @tm_set,   $solved_parameters->at(1+3*$ii);
#				push @fwhm_set, $solved_parameters->at(2+3*$ii)
#							+ 0.5;
#				push @delta_set,$solved_parameters->at(3+3*$ii);
#		}

		for (my $ii=1; $ii<$iteration; $ii++) {
			print "Get solved parameters for cycle $ii\n" if $debug;
			my $tmi	= exists_or_zero(\%solution,"tm$ii");
			my $wi	= exists_or_zero(\%solution,"w$ii");
			my $fwhmi = $wi ? $wi + 0.5 : 0;
			my $di	= exists_or_zero(\%solution,"i_delta$ii");
			push @tm_set,	 $tmi;
			push @fwhm_set,  $fwhmi;
			push @delta_set, $di;
			# my $tlo = $tmi - $fwhmi;
			# my $thi = $tmi + $fwhmi / 2;
			# $tmin = $tlo if $tlo < $tmin;
			# $tmax = $thi if $thi > $tmax;
			$delta_sum += $di;
		}

		#print "observed_points\n";
		my $observed_points		= nelem( $residual );

		my $sum_abs_residual	= sum( abs( $residual ) );
#		my $sum_background	= sum( $background );
		my $sum_background	= 0;
		my $R_abs	= $sum_abs_residual / ($sum_y - $sum_background);
		my $RMSD	= sqrt( sum( $residual * $residual ) / $observed_points );
		my $mean	= ( $sum_y - $sum_background) / $observed_points;

		if ($verbose > 1) {
			print "Residual\n";
			for (my $i=0; $i<$observed_points; $i++) {
				printf "%.4f\n", at($residual,$i);
			}
		}

		my $nx_min = 0;
		my $nx_max = -1;
		# my $ymax = max( $y );
		# my $min_delta_i = $min_delta * $ymax;	# / 2;

		# i_min is the intensity unaccounted for BELOW the transitions
		# i_max_gap is the intensity unaccounted for ABOVE transitions

		# my $i_max_gap = $ymax - ($i_min + $delta_sum);
		my $i_max_gap = $delta_y - ($i_min + $delta_sum);

		# Is either i_min or i_max_gap bigger than half min delta i?
		# Skip the test if any Tm's are out of the fitting range
		
		my $tm_lo = List::Util::min(@tm_set);
		my $tm_hi = List::Util::max(@tm_set);
		
		if ($tm_lo > $tmin && $tm_hi < $tmax && 
			$i_max_gap < $min_delta_y && $i_min < $min_delta_y &&
			max( $residual ) < $min_delta_y) {
			printf 
"STOP ITERATION: All but < %.3f of observed intensity change %.5f is\n".
 "\taccounted for by %u transitions: I_min_calc = %.5f, I_max_calc = %.5f and\n".
 	"\tmax residual (I_obs - I_calc) = %.5f.\n",
 				$min_delta, $delta_y, $iteration-1, $i_min,
				$i_min + $delta_sum, max( $residual )
					if $verbose || $debug;
			my %result = ( reason => 
				'Intensity change accounted for in '.
				($iteration-1).' transitions' );
			return \%result;
		}
		
		# $min_delta_y = List::Util::min($min_delta_y, 
		#				$delta_sum * $min_delta/2);
		
		my $skip_ndx = 0;
		my $t_skip = 0;
		if ($discontinuity) {
			$skip_ndx = $$discontinuity{'skip_ndx'} if exists
				    $$discontinuity{'skip_ndx'};
			$t_skip   = $$discontinuity{'t_skip'} if exists
				    $$discontinuity{'t_skip'};
		}

		# New logic: 
		# Look at whole range each time, instead of just one part.
		
		# Old logic:
		# At least one of imin or imax_gap > minimum delta i. 
		# Look at low transition if Imin > min delta i AND 
		# 	there's no discontinuity below current tmin
		#	(leave high transition for the next iteration);
		# ELSE look at high transition if imax gap > min delta i AND
		# 	there's no discontinuity above tmax;
		# ELSE look low if imin > min delta i AND the discontinuity
		#	is far enough (5 degrees) below the current tmin,
		# ELSE look high if imax gap > min delta i AND discontinuity
		#	is far enough (5 degrees) above the current tmax,
		# ELSE look all over for residual bump above min delta i
		
				
		my $guess = guess_tm_params( {
						x	=> $x_smooth,
						y	=> $residual,
						n_smooth=> $points_to_smooth,
						debug	=> $debug,
						verbose => $verbose,
						nx_min	=> $nx_min,
						nx_max	=> $nx_max,
						min_delta_y => $min_delta_y,
						min_deriv => $min_deriv,
						tmin	=> $tmin,
						tmax	=> $tmax,
						discontinuity => $discontinuity,
						file_stem => 0,
						first	=> 0,
						center_first=> $center_first,
					   } );
		my $reason = exists_or_zero($guess, 'reason');
		if (! $guess || $reason) {
			if ($center_first) {
				$center_first = 0;
				$guess = guess_tm_params( {
					x	=> $x_smooth,
					y	=> $residual,
					n_smooth=> $points_to_smooth,
					debug	=> $debug,
					verbose => $verbose,
					nx_min	=> $nx_min,
					nx_max	=> $nx_max,
					min_delta_y => $min_delta_y,
					min_deriv => $min_deriv,
					tmin	=> $tmin,
					tmax	=> $tmax,
					discontinuity => $discontinuity,
					file_stem => 0,
					first	=> 0,
					center_first=> $center_first,
				   } );
				$reason = exists_or_zero($guess, 'reason');
			}
			if (! $guess || $reason) {
				print "STOP ITERATION # $iteration: ",
					"no valid guess found\n" if $verbose;
				return $guess;
			}
		}
		print "Guess for cycle $iteration: ",Dumper($guess) if $debug;
		my $tm_init	 = $$guess{'tm'};
		my $fwhm_init	 = $$guess{'FWHM'};
		my $i_delta_init = $$guess{'i_delta'};
		my $i_min_init	 = $$guess{'i_min'};

		print "Before check: i min $i_min i_min_init $i_min_init ",
			"bg_min_flag $bg_min_flag\n" if $debug;
		# NEW LOGIC:
		# Don't use imin if bg_min_flag is not set and either
		# 	imin is near 0 or there's exp. decay bg.
		# If imin not 0 and there's no exp. decay bg, i_min_init is
		# from the residual, so it should be added to existing i_min

		if ($bg_init > 1e-10 && ! $bg_min_flag) {
		 	$i_min_init = 0;	# += $i_min;
		} else {
			# $i_min_init = $i_min if $i_min < $i_min_init &&
			# 		($i_min || ! $bg_min_flag);
			$i_min_init += $i_min;
			$i_min_init = 0 if abs($i_min_init) < $min_delta_y 
					&& ! $bg_min_flag;
		}
		print " After check: i min $i_min i_min_init $i_min_init ",
			"bg_min_flag $bg_min_flag\n" if $debug;

		# OLD LOGIC:
		# For 2nd guesses, i_min is a real transition start value,
		# not a term in calculating exponential background.
		# If bg_init exists, new i_min should be added to old i_min;
		# otherwise, old i_min was also a transition start, and
		# new i_min should replace old i_min if it's lower.

		# if ($bg_init > 1e-10) {
		# 	$i_min_init += $i_min;
		# } else {
		#	$i_min_init = $i_min if $i_min < $i_min_init;
		#	$i_min_init = 0 if abs($i_min_init) < $min_delta_y;
		# }

		my $new_tmin	 = $$guess{'t_min'};	# tm_init - $fwhm_init;
		my $new_tmax	 = $$guess{'t_max'};	# $tm_init + $fwhm_init/2;
		$tmin = $new_tmin if $new_tmin < $tmin;
		$tmax = $new_tmax if $new_tmax > $tmax;

		print "Tmin $tmin <= new tmin $new_tmin << ",
			"new tmax $new_tmax <= Tmax $tmax\n" if $debug;
		print "Tm residual = $tm_init, fwhm=$fwhm_init,",
			"i delta $i_delta_init  i min $i_min_init\n" if $debug;
		printf "Initial estimate for iteration %u: tm %.1f fwhm %.1f ".
			"i_delta %.3f i_min %.5f\n", $iteration, $tm_init, 
			$fwhm_init, $i_delta_init, $i_min_init if $verbose;
		
		if ($debug) {
			print "\tBuild on the previous solved parameters in $solved_params_file\n";
			print "\tsum of the abs of the residual is $sum_abs_residual\n";
#			print "\tsum of the backgroundis $sum_background\n";
			#print "\n\tPrevious params are: $solved_parameters with " .  nelem( $solved_parameters ) . " elements\n";

			#print "\tResiduals have: " . nelem( $residual ) . " elements\n";

			print "\tR_abs	= $R_abs\n";
			print "\tRMSD	= $RMSD\n";
			print "\tmean	= $mean\n";
			print "\tRMSD/mean = " . $RMSD / $mean . "\n";
			print "\n";
			print "\tTm$iteration     = $tm_init\n";
			print "\tFWHM$iteration   = $fwhm_init\n";
			print "\tIdelta$iteration = $i_delta_init\n";
			print "\tImin$iteration   = $i_min_init\n";
		}
		if (! $gnuin) {
#			copy($solved_params_file, $filename) or die "Copy failed: $!";
#			my $fh = new IO::File $filename, O_WRONLY | O_APPEND;

			# Re-write whole parameters file with new I_min,
			# rather than just appending guesses for new transition

			my $fh = new IO::File;
			$fh->open($filename, "w");
			if ($i_min_init) {
				print $fh <<"EOL";
i_min		= $i_min_init
EOL
			} elsif ($bg_min_flag) {
				print $fh <<"EOL";
i_min		= 1e-30
EOL
			}
			my $w = 0;
			for (my $ii=1; $ii<$iteration; $ii++) {
				my $iim1 = $ii-1;
				$w = $fwhm_set[$iim1] - 0.5;
				if ($delta_set[$iim1]) {
					print $fh <<"EOL"
tm$ii		= $tm_set[$iim1]
w$ii		= $w
i_delta$ii	= $delta_set[$iim1]
EOL
				}
			}
			$w = $fwhm_init - 0.5;
			print $fh <<"EOL";
tm$iteration		= $tm_init
w$iteration		= $fwhm_init
i_delta$iteration	= $i_delta_init
EOL
			if ($bg_init > 1e-10) {
				print $fh <<"EOL";
bg_init		= $bg_init
bg_exp		= $bg_exp
EOL
			}
			$fh->close;
		}
		%init_params = (
				tm_init		=> $tm_init, 
				fwhm_init	=> $fwhm_init, 
				i_delta_init	=> $i_delta_init,
				i_min		=> $i_min_init,
				t_max		=> $tmax, 
				t_min		=> $tmin, 
				bg_init		=> $bg_init,
				bg_exp		=> $bg_exp,
				bg_min_flag	=> $bg_min_flag,
				);
	}

	return \%init_params;
}

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;
	my %h = %$x;
	return ($h{$y}) if exists $h{$y} && defined $h{$y};
	return 0;
}
sub exists_or_else {
	my ($x, $y, $z) = @_;
	return $z if ! (defined $x && $x && defined $y && $y);
	print "Look for $y in $x\n" if $DEBUG;
	my %h = %$x;
	return ($h{$y}) if exists $h{$y} && defined $h{$y};
	return $z;
}

# Take running average of N point of X
sub _smooth {
	my %params = validate( @_, {	
					x	=> {	type	=> SCALARREF },
					n	=> { 	type	=> SCALAR, 
							default => 20 },
					type	=> {	type	=> SCALAR, 
							default => "Gaussian"},
					debug	=> {	type	=> SCALAR, 
							default => 0 },
					negatives => {	type	=> SCALAR,
							default	=> 0 },
					ends	=> {	type	=> SCALAR,
							default	=> 0 },
				} );
	my $x = $params{'x'};
	my $n = int($params{'n'});
	my $stype = $params{'type'};
	my $negatives = $params{'negatives'};
	my $ends = $params{'ends'};
	my $gflag = lc($stype) =~ /^g/;
	my $debug = $params{'debug'};

	# Copy positive X's into Y from n/2 to len + n/2 - 1 = len places:
	# E.g. len = 10, n=5, n2 = 2, copy x(0 to 9) to y(2 to 11)
	#
	#                 0                       len-1
	# x:              |<----------len---------->|
	# y:    |<--n/2-->|<----------len---------->|<--n/2-->|
	#       0         n2                      ln2m1      len+n-1
	# ycenter:        |<----------------------->|

	my $len	    = nelem($x);
	$n = int($len/2 -1) if $n > $len/2 - 1;
	my $n2	    = int($n/2);
	my $ln2m1   = $n2 + $len - 1;
	my $y	    = zeroes($len + $n);
	my $ycenter = slice($y, "$n2:$ln2m1");

	# Use only positive X's since negative X's are either background
	# fluctuations or over-estimates from another peak.
	
	my $p = List::Util::min($len-1,10);
	print "Sub _smooth $len values, window = $n, ends='$ends',",
		" neg = |$negatives|\nx[0:$p]=",$x->slice("0:$p"),"\n" if $debug;
	print "\tn2=$n2, ln2m1=$ln2m1, y=",nelem($y)," values, ycenter =",
		nelem($ycenter)," values\n" if $debug;
		
	if ($negatives) {
		$ycenter .= $x;
	} else {
		$ycenter .= $x * ($x > 0.0);
	}
	if ($ends) {
		my $step1 = 0;
		my $step2 = 0;
		if ($ends ne 'constant' && $len > $n) {
			# Extrapolate using average of 0 to n and n to 2n, and
			# -2n-1 to -n-1, -n-1 to -1. Each slice is n; diff is n,
			# so step = (sum(b)/n - sum(a)/n)/n = (sum(b)-sum(a))/nn
			my $slice1a = "0:$n";
			my $slice1b = "$n:".(2*$n);
			my $slice2a = (-2*$n-1).":".(-$n-1);
			my $slice2b = (-$n-1).":-1";
			print "Slices 1a,b, 2a,b=$slice1a, $slice1b, ",
				"$slice2a, $slice2b" if $debug;
			$step1 = (  sum( $x->slice($slice1b) ) - 
				    sum( $x->slice($slice1a) )  ) / ($n*$n);
			$step1 = (  sum( $x->slice($slice2b) ) - 
				    sum( $x->slice($slice2a) )  ) / ($n*$n);
		}
		print "_smooth step = $step1, $step2\n" if $debug;
		for (my $i=0; $i < $n2; $i++) {
			# From n2-1 to n2 - n2 = 0; from n2 to 1
			print "Set y[",$n2 - ($i+1),"] to y[",$n2 - $i,"] - ",
				"$step1 = \n" if $debug > 1;
			print "\t",$y->at($n2 - $i) - $step1,"\n" if $debug > 1;
			(my $tmp = $y->slice($n2   - ($i+1))) .= 
						$y->at($n2  - $i) - $step1;
			# From ln2m1 + 1 to ln2m1 + n2 = len + n; 
			#			from ln2m1 to len + n - 1
			print "Set y[",$ln2m1+$i+1,"] to y[",$ln2m1+$i,"] + ",
				"$step2 = \n" if $debug > 1;
			print "\t",$y->at($n2 - $i) - $step2,"\n" if $debug > 1;
			($tmp = $y->slice($ln2m1 + $i+1)) .= 
						$y->at($ln2m1 + $i) + $step2;
		}
	}
	print "Y start = 0 to $n2, y end = $ln2m1 to end\n" if $debug;
	print "y start: ",$y->slice("0:$n2"),"\ny end: ",$y->slice("$ln2m1:-1"),
			"\n" if $debug;
	print "y: $y\n" if $debug > 2;		
	my $z = zeroes($len);
	my $w = zeroes($n);
	$w .= 1.0 / $n;
	if ($gflag) {
		# Use Gaussian weighting: exp(-x^2/2), x=-2 to 2 = 95% of peak
		# gx = -1 to 1 in n steps
		my $gx = (sequence($n)*2.0/($n-1.0) - 1.0)*2.0;
		my $gy = exp(-($gx*$gx)/2.0);
		$w = $gy / sum $gy;
		print "Gaussian weights:",$w,"\n" if $debug > 1;
	}
	
	my $j = 0;
	for (my $i=0; $i<$n; $i++) {
		$j = $i + $len - 1;
#		print "_smooth 3: i,j=$i,$j\n";
		$z = $z + slice( $y, "$i:$j") * $w->at($i);
		print "_smooth $i: z(20)=",at($z,20),"\n" if $debug > 2;
	}
	print "_smooth: ",Dumper($z) if $debug > 2;
	print "_smooth: ",slice($z,'0:20'),"\n" if $debug > 1;
#	my %return_hash = ( smoothed => $z );
	return $z;
}

sub guess_tm_params {
	my %params = validate( @_, { 
				x	=> {	type	=> SCALARREF },
				y	=> {	type	=> SCALARREF },
				n_smooth => {	type	=> SCALAR,
						default	=> 15 },
				min_delta_y => {type	=> SCALAR,
						default	=> 0.02 },
				min_deriv => {	type	=> SCALAR,
						default => 1e-5 },
				debug	=> {	type 	=> SCALAR, 
						default	=> 0 },
				verbose	=> {	type	=> SCALAR,
						default	=> 0 },
				nx_min  => {	type	=> SCALAR,
						default	=> 0 },
				nx_max  => {	type	=> SCALAR,
						default	=> -1 },
				tmin  => {	type	=> SCALAR,
						default	=> 0 },
				tmax  => {	type	=> SCALAR,
						default	=> 0 },
				discontinuity => { type => HASHREF,
						default	=> 0 },
				file_stem => {	type => SCALAR,
						default => 0 },
				first	  => {	type => SCALAR,
						default => 0 },
				bg_exp_flag => {type => SCALAR,
						default => 1 },
				bg_min_flag => {type => SCALAR,
						default => 0 },
				center_first   => {type => SCALAR,
						default => 0 },
#				bg_init	=> {	type => SCALAR,
#						default => 0 },
#				bg_exp	=> {	type => SCALAR,
#						default => 0 },
		} );

	
	my $x		= $params{'x'};
	my $y_raw	= $params{'y'};
	my $n_smooth	= $params{'n_smooth'};
	my $nx_min	= $params{'nx_min'};
	my $nx_max	= $params{'nx_max'};
	my $tmin_in	= $params{'tmin'};
	my $tmax_in	= $params{'tmax'};
	my $min_delta_y	= $params{'min_delta_y'};
	my $min_deriv	= $params{'min_deriv'};
	my $discontinuity = $params{'discontinuity'};
	my $debug	= $params{'debug'};
	my $verbose	= $params{'verbose'};
	my $file_stem	= $params{'file_stem'};
	my $first	= $params{'first'};
	my $bg_exp_flag = $params{'bg_exp_flag'};
	my $bg_min_flag = $params{'bg_min_flag'};
	my $center_first= $params{'center_first'};
#	my $bg_init	= $params{'bg_init'};
#	my $bg_exp	= $params{'bg_exp'};
	my $n = nelem( $x );
	$nx_max = $n + $nx_max if $nx_max < 0;	# -1 -> last element
	my $n_1 = $n - 1;
	my $n_2	= $n - 2;
	my $n_3 = $n - 3;
	
	# Find changes in raw intensity for discontinuity detection and
	# to get minimum derivative.
	# dy_raw(i)      = y(i+1)        - y(i), i=0 to n-2 (i+1=1 to n-1)
	# dy_raw_test(i) = y(i+1+nx_min) - y(i+nx_min) = dy_raw(i+nx_min) 
	#    i+nx_min=0 to nx_max-1 (i+nx_min+1=1 to nx_max), 
	#    so i=0 to nx_max - nx_min - 1, and
	#    dy_raw_test(nx_max-nx_min-1) = dy_raw(nx_max-1)
	# Take test slice after discontinuity detection sets nx_min and _max.
	
	my $dy_raw  = $y_raw->slice("1:-1") - $y_raw->slice("0:-2");
	# my $dy_raw_test = $dy_raw->slice("$nx_min:".($nx_max-1));

	my $min_length = ($n_smooth * 5) / 3; # about 5 degrees
	my $x_range = $x->at(-1) - $x->at(0);
	my $steps_per_degree = $x_range ? sprintf "%i", $n/$x_range : 1;
	print "Guess: nsmooth=$n_smooth, min_length=$min_length\n" if $debug;
	if ($nx_max + 1 - $nx_min < $min_length) {
		print "STOP GUESS: not enough points between $nx_min and ",
			"$nx_max\n" if $verbose || $debug;
		return { reason => 
			"Not enough points between $nx_min and $nx_max" };
	}
	my $k = log(3 + 2*sqrt(2));

	my %result = ();
	my $reason = '';
	
	print "Guess tm params: n=$n, nx_min $nx_min, nx_max $nx_max\n",
		"tmin $tmin_in, tmax $tmax_in center first $center_first\n",
		"first $first bg_min_flag $bg_min_flag bg_exp $bg_exp_flag\n" if $debug;
	print "    discontinuity: ",Dumper($discontinuity) if $debug;
	
	# Check for discontinuities in intensity or temperature:
	# delta x > 3*mean, or max delta y_raw > 5*next lower delta

	my $dx = $x->slice("2:$n_1") - $x->slice("0:$n_3");

	my $skip_ndx = 0;
	my $skip_list = pdl[];
	my $t_skip = 0;
	my $skip_type = 0;
	my %new_disc = ();
	my $two_skip_flag = 0;
	my $skip_low = 0;
	my $hi_skip = 0;
	if ($discontinuity) {
		$skip_ndx = exists_or_zero($discontinuity,'skip_ndx');
		$t_skip   = exists_or_zero($discontinuity,'t_skip');
		$skip_type = exists_or_zero($discontinuity,'type');
		$skip_list = exists_or_zero($discontinuity,'skip_list');
		$hi_skip   = exists_or_zero($discontinuity,'hi_skip');
		$skip_low  = exists_or_zero($discontinuity,'skip_low');
		print "#+#+#+# DISCONTINUITY at $skip_ndx, $t_skip\n" if $debug;
		if ($skip_low) {
			$two_skip_flag = 1;
			$nx_min = $skip_ndx + 1;
			print "Low skip at $nx_min\n" if $debug;
		}
		if ($hi_skip) {
			$two_skip_flag = 1;
			$nx_min = $skip_ndx + 1;
			$nx_max = $hi_skip - 1;
			print "2nd DISCONTINUITY at $hi_skip\n" if $debug;
		}
	} elsif ($first) {
		my $max_dx = max( $dx );
		my $y_hi  = $y_raw->slice("$nx_min:$nx_max");
		# my $y_hi  = $y_raw->slice("$nx_min:-1");
		## my $y_hi  = $y_raw->slice("$tm_nx:-1");
		my $y_max = max( $y_hi );
		my $y_max_ndxs = which( $y_hi == $y_max ) + $nx_min;
		my $y_max_diff;
		my $y_max_contig_ndxs;
		my $n_y_max_contig = 0;
		if (nelem($y_max_ndxs) > 3) {
			# Subtract each index from its neighbor and look for 1's
			my $y_max_0 = $y_max_ndxs->slice("0:-2");
			my $y_max_1 = $y_max_ndxs->slice("1:-1");
			$y_max_diff = $y_max_1 - $y_max_0;
			my $y_max_contig = which($y_max_diff == 1);
			$n_y_max_contig = nelem($y_max_contig);
			if ($n_y_max_contig > 3) {
				print "Found $n_y_max_contig contig. y_lim\n"
					if $debug;
				$skip_list = $y_max_ndxs->index($y_max_contig);
				$y_max_contig_ndxs = $skip_list;
			}
		}
		
		if ($max_dx > 3 * sum( $dx )/nelem( $dx ) ) {
			$skip_ndx = which( $dx == $max_dx )->at(0);
			$t_skip = $x->at($skip_ndx);
			$skip_type = 'x';
			print "WARNING: DISCONTINUITY IN TEMPERATURE AT $t_skip",
				" - T changes $max_dx degrees C in one step!\n"
				if $nx_min < $skip_ndx && $skip_ndx < $nx_max 
				|| $debug;
			%new_disc =  ( 	skip_ndx => $skip_ndx,
					t_skip	 => $t_skip,
					type	 => 'x' 
				    );
		} elsif ($n_y_max_contig > 3) { # List::Util::max(3,$n_smooth)

			# Fluorescence stays exactly at an upper limit for 
			# at least 4 points: assume the detector has reached 
			# its limit, and do not try to fit those points.
			#
			# If curve hits limit near beginning,
			# 	If it drops long enough then goes back to limit,
			#		set nx_min and nx_max to that stretch
			#	else set nx_min to after last point at y limit.
			# If curve hits limit well above start, 
			#	set nx_max to before start of limit.

			my $y_lim_ndx = $y_max_contig_ndxs->at(0);
			my $y_lim_ndx2 = $y_max_contig_ndxs->at(-1);
			print "From $nx_min to $nx_max, found $n_y_max_contig",
				" contiguous points at intensity limit from ",
				"$y_lim_ndx to $y_lim_ndx2\n" if $debug;
			# Find longest stretch below limit between 1st and last
			my $max_discontig = max($y_max_diff);
			print "Found gap of $max_discontig points within y limit; ",
				"min length = $min_length\n" if $debug;
			if ($max_discontig > $min_length * 2) {
				# Find last position of max discontig
				my $ndx = which($y_max_diff == $max_discontig
						)->at(-1);
				if ($ndx) {
					$two_skip_flag = 1;
					$y_lim_ndx = $y_max_ndxs->at($ndx);
					$hi_skip   = $y_max_ndxs->at($ndx+1);
					my $remains = $hi_skip + 1 - $y_lim_ndx
								- $min_length;
					$y_lim_ndx += $n_smooth; 
					if ($remains > 4*$n_smooth) {
						$y_lim_ndx += 2*$n_smooth;
					} elsif ($remains > 2*$n_smooth) {
						$y_lim_ndx += $n_smooth;
					}
					$nx_max    = $hi_skip - 1;
					$nx_min	   = $y_lim_ndx + 1;
					$skip_low  = 1;
					my $sl_txt = ($ndx-1).":".($ndx+1);
					print "Found discontiguity in y limit:",
						" $nx_min to $nx_max = T ",
						$x->at($nx_min)," to ", 
						$x->at($nx_max)," ndx $ndx",
						", y_max_ndxs[$sl_txt] = ",
						$y_max_ndxs->slice($sl_txt),
						"\n" if $debug; 
				} else {
					warn "ERROR in program logic";
				}
			}
			if (! $two_skip_flag && $y_lim_ndx <= $min_length * 2) {
				# There's no long enough break in ylim.
				# Set nx_min if ylim is close to start.
				# Otherwise, fall through and set nx_max

				my $remains = $nx_max - $y_lim_ndx2 
						- $min_length;
				if ($remains > 1) {
					$two_skip_flag = 1;
					$skip_low  = 1;
					$y_lim_ndx = $y_lim_ndx2;
					if ($remains > 4*$n_smooth) {
						$y_lim_ndx += 2*$n_smooth;
					} elsif ($remains > 2*$n_smooth) {
						$y_lim_ndx += $n_smooth;
					}
					$nx_min    = $y_lim_ndx + 1;
					print "Found low T y limit: $nx_min = ",
					    $x->at($nx_min)," C\n" if $debug;
				} else {
					print "Y lim too close to both ends\n"
						if $debug;
					return { reason => 
					'Fluorescense at max for most of curve',
						discontinuity => \%new_disc, };
				}
			}
			$skip_ndx = $y_lim_ndx;
			$t_skip   = $x->at($y_lim_ndx);
			$skip_type = 'ylim';
			# $tmax = $y_lim_t if $y_lim_t < $tmax; 
			print "WARNING: Fluorescence limit found at $t_skip\n" 
				if $verbose;
			print "   ### Found Y limit at T $t_skip, ndx ",
				"$y_lim_ndx #### \n" if $debug;
			%new_disc =  ( 	skip_ndx => $skip_ndx,
					t_skip	 => $t_skip,
					type	 => $skip_type, 
				    );
			$new_disc{'skip_list'} = $skip_list 
				if nelem($skip_list) > 3;
			$new_disc{'hi_skip'}  = $hi_skip if $hi_skip;
			$new_disc{'skip_low'}  = 1 if $skip_low;
			print "new_disc: ",Dumper(%new_disc) if $debug;
		} else {
			# Find the standard deviation of single-step changes,
			# and look for changes larger than 3xsd
			my $dy_mean = sum($dy_raw) / ($n-1);
			my $dy_sd   = sqrt((sum($dy_raw*$dy_raw) - 
						($n-1)*$dy_mean*$dy_mean)/($n-2));
			# New: Find changes > 4 x SD and > 4 neighbors,
			# or different sign from either either neighbor
			my $big_dy_ndxs1 = which( abs($dy_raw) > 4.*$dy_sd);
			print "Found ",nelem($big_dy_ndxs1),
				" big dy > 4*sd=$dy_sd at ",$big_dy_ndxs1,"\n" 
				if $debug;
			my @big_dy_list = ();
			foreach my $i (list($big_dy_ndxs1)) {
				my $d1 = $dy_raw->at($i);
				my $n0a = List::Util::max(0, $i-4);
				my $n0b = List::Util::max(0, $i-1);
				my $n2a = List::Util::min($n-2, $i+1);
				my $n2b = List::Util::min($n-2, $i+4);
				# Take mean of neighboring 4 dy each way
				my $d0 = $i ? sum($dy_raw->slice("$n0a:$n0b"))
						/ ($n0b + 1 - $n0a) : 0;
				my $d2 = $i < $n-2? sum($dy_raw->slice("$n2a:$n2b"))
						/ ($n2b + 1 - $n2a) : 0;
				# Find sum of big dy and its nearest neighbors, 
				# to check for single noise points 
				my $dn0 = abs(  ( $i        ? $dy_raw->at($i-1) : 0 ) + $d1  ); 
				my $dn2 = abs(  ( $i < $n-2 ? $dy_raw->at($i+1) : 0 ) + $d1  );
				my $dn = List::Util::min( $dn0, $dn2 );
 
				# Consider d1 a break if it's the opposite sign
				# of either neighbor, or more than 4*both, AND
				# neither neighbor is at least 1/2 as big as d1 in 
				# the opposite direction (i.e. no noise points)

				print "Dy=",$dy_raw->slice("$n0a:$n2b"),
					",\n 4*d0,d1,d2=",4*$d0,", $d1, ",4*$d2,
					" at $i, dn0, dn, dn2=$dn0, $dn, $dn2\n" if $debug;
				if (   (  $d1*$d0 < 0 || $d1*$d2 < 0 ||
					    ( abs($d1) > 4.*abs($d0) &&
					      abs($d1) > 4.*abs($d2) )  ) 
					&& $dn > abs($d1)/2   ) {
					push @big_dy_list, $i;
					print "Add $i to make list of ",
						0+@big_dy_list," breaks\n"
						if $debug;
				}
			}
			my $big_dy_ndxs = pdl[(@big_dy_list)];
			my $n_big_dy = nelem($big_dy_ndxs);
			print "Found $n_big_dy big dy > 4*neighbors at ",
				$big_dy_ndxs,"\n" if $debug;

			### OLD: Find largest single-step change in y
			## my $max_dy = max( $dy_raw );
			## my $max_dy_ndxs = which( $dy_raw == $max_dy);
			## print "Max dy = $max_dy at ",$max_dy_ndxs,"\nFirst T=",
				## $x->at( $max_dy_ndxs->at(0) ),
				## ". There are ",nelem(which($dy_raw >= $max_dy/5)),
				## " total >= max dy/5 = ",$max_dy/5,"\n" if $debug;
			## if (nelem($max_dy_ndxs) == 1) 
				### If there's only one at max, check for any other dy
				### within a factor of 5 of max dy
				## if (nelem( which($dy_raw >= $max_dy/5) ) == 1) 
					### No other dy's are above max_dy/5 - flag it

			# Handle one or several (but not many) break:
			# only consider big jumps to be invalid if 
			# there are not very many (>=5) big jumps.

			if ($n_big_dy && $n_big_dy < 5) {

			    $skip_list = $big_dy_ndxs;
			    $skip_ndx = $big_dy_ndxs->at(0);
			    print " T skip=",$x->at( $skip_ndx ),"\n" if $debug;
			    print " to ndx ",$big_dy_ndxs->at(-1),"=\n" 
			    	if $debug && $n_big_dy > 1;
			    print " T ",$x->at( $big_dy_ndxs->at(-1)),"\n" 
			    	if $debug && $n_big_dy > 1;
			    print "    Skip ndx $skip_ndx, n/3=",$n/3,"\n"
			    	if $debug;
			    $skip_type = 'y';
			    $t_skip = $x->at($skip_ndx);
			    printf 
				"WARNING - DISCONTINUITY IN FLUORESCENCE AT ".
				"%.1f: F changes %.5f".
				" in one step, more than 4x std dev %.5f\n",
				$t_skip, $dy_raw->at($skip_ndx), 4*$dy_sd 
				    if $verbose;
			    %new_disc =  ( 	skip_ndx => $skip_ndx,
						t_skip	 => $t_skip,
						type	 => 'y' 
					 );
			    $new_disc{'skip_list'} = $big_dy_ndxs 
			    	if ($n_big_dy > 1);

			    # If first break > center, use break as max
			    if ($n_big_dy > 1 && $skip_ndx < $n/3) {


				# There are several breaks and the first is low.
				# Find long enough stretch between breaks
				# nearest the center of the temperature range.
				# Look at last below and first above,
				# else scan down lo list and up hi list for 
				# break pairs far enough apart.
				
				my $lo_skip = $big_dy_ndxs->where(
						$big_dy_ndxs <  $n/3);
				my $hi_skip = $big_dy_ndxs->where(
						$big_dy_ndxs >= $n/3);
				$skip_ndx = $lo_skip->at(-1);
				my $n_lo = nelem($lo_skip);
				my $n_hi = nelem($hi_skip);
				print "$n_lo low and $n_hi high breaks\n"
					if $debug;
				my $scan_breaks = 0;
				my $hi_nx = 0;
				if ($n_hi) {
				    $hi_nx = $hi_skip->at(0);
				    print "Low and high discontinuities at ",
					"$skip_ndx, $hi_nx\n" if $debug;
				    if ($hi_nx - $skip_ndx > $min_length) {
					$nx_max = $hi_nx - 1;
					$nx_min = $skip_ndx + 1;
					$two_skip_flag = 1;
				    } else {
					print 'Breaks near center too close!',
						" Scan $n_lo lo, $n_hi hi\n"
						if $debug;
					$scan_breaks = 1;
				    }
				}
				if ($scan_breaks) {
				    my @lo_ok = ();
				    my @hi_ok = ();
				    if ($n_lo > 1) {
					foreach (my $i=$n_lo-2; $i>=0; $i--) {
					    my $new_lo = $lo_skip->at($i);
					    if ($skip_ndx-$new_lo>$min_length) {
						@lo_ok = ($new_lo, $skip_ndx);
						last;
					    }
					    $skip_ndx = $new_lo;
					}
				    }
				    if ($n_hi > 1) {
					foreach (my $i=1; $i<$n_hi; $i++) {
					    my $new_hi = $hi_skip->at($i);
					    if ($new_hi - $hi_nx>$min_length) {
						@hi_ok = ($hi_nx, $new_hi);
						last;
					    }
					    $hi_nx = $new_hi;
					}
				    }
				    if (@lo_ok > 1 && (@hi_ok == 0 ||
					$n - $lo_ok[1] < $hi_ok[0])) {
					$skip_ndx = $lo_ok[0];
					$nx_min = $skip_ndx + 1;
					$nx_max = $lo_ok[1] - 1;
					$two_skip_flag = 1;
				    } elsif (@hi_ok > 1) {
					$skip_ndx = $hi_ok[1];
					$nx_min = $hi_ok[0] + 1;
					$nx_max = $skip_ndx - 1;
					$two_skip_flag = 1;
				    } else {
					return { reason => 
					    'TOO MANY DISCONTINUITIES',
					    discontinuity => {
						t_skip => $t_skip,
						skip_ndx => $skip_ndx,
						skip_list => $big_dy_ndxs,
						type => 'y', }
						};
				    }
				}
				$t_skip = $x->at($skip_ndx);
				$new_disc{'skip_ndx'} = $skip_ndx;
				$new_disc{'t_skip'}   = $t_skip;
				$new_disc{'hi_skip'}  = $nx_max + 1;
				$new_disc{'skip_low'} = 1;
				printf "Multiple skips: new skip at ".
				    "%.1f, %d; %d skips, flag=%d\n",
				    $t_skip, $skip_ndx, $n_big_dy,
				    $two_skip_flag;
			    }
			}
		}
	}

	# If there's a discontinuity, use it as the upper or lower bound of 
	# the range to be used in the guess. Assume data after the break is 
	# invalid unless the break is in the lower third of the data, in which 
	# case use break as the lower bound.
	# 
	# If skip is between min and max, set max to skip_ndx
	# 	|------<nx_min----------skip_ndx------------nx_max>----|
	#              <-------------------->
	# If skip is above nx_max, ignore it since we won't use it anyway

	my $t_max_skip = 0;
	my $t_min_skip = 0;
	if ($two_skip_flag) {
		$t_min_skip = $x->at($nx_min);
		$t_max_skip = $x->at($nx_max);
		print "Two skips: $t_min_skip, $t_max_skip\n" if $debug;
	} elsif ($skip_ndx && $skip_ndx < $nx_max) {
		if ($skip_ndx < $nx_min + $min_length &&
		    $skip_ndx > $nx_max - $min_length) {
			print "STOPPING FIT DUE TO DISCONTINUITY AT ",
				$x->at($skip_ndx),"\n" if $verbose;
			return { reason => 
				'NOT ENOUGH DATA POINTS: DISCONTINUITY at '.
							$x->at($skip_ndx),
				 discontinuity => \%new_disc };
		}
		if ($skip_ndx > $n / 3 || $skip_type eq 'drop' || 
		    ($skip_ndx > 2*$min_length && $skip_type eq 'ylim')) {
			$nx_max = $skip_ndx - 1; 
				# ($skip_type eq 'drop' ? 1 : int($n_smooth/2));
			$t_max_skip = $x->at($nx_max) if $nx_max > 0 && 
							 $nx_max < $n;
			print "Set nx_max to $nx_max due to discontinuity\n"
				if $debug;
		} else {
			$nx_min = $skip_ndx + 1; 	# int($n_smooth/2);
			$t_min_skip = $x->at($nx_min) if $nx_min > 0 &&
							 $nx_min < $n;
			print "Set nx_min to $nx_min due to discontinuity\n"
				if $debug;
		}
	}
	
	print "After discontinuity check: $nx_min to $nx_max = ",
		$x->at($nx_min)," to ",$x->at($nx_max)," C\n" if $debug;
		
	# Max deriv should be above twice the precision of the machine,
	# where precision estimate =smallest magnitude non-zero raw deriv.
	# Calculate min_deriv the first time, then keep that value 
	
	my $dy_raw_test = $dy_raw->slice("$nx_min:".($nx_max-1));
	$min_deriv = min(  abs( $dy_raw_test->where($dy_raw_test != 0.0) )  ) 
		if $first;
	my $min_deriv_factor = 2;
	print "min_deriv = $min_deriv, factor=$min_deriv_factor\n" if $debug;
	

	# Smooth all data, then re-smooth only the region from min to max,
	# i.e. excluding the discontinuities.
	# Then find derivative d(n) = (y(n+1)-y(n-1)) / (x(n+1)-x(n-1)),
	#	n=1 to nelem(x) - 2; this smooths deriv. with window size 3
	# Only test derivatives from nx_min+1 to nx_max-1

	my $y = _smooth( {	x	=> $y_raw,
				n	=> $n_smooth,
				type	=> 'Gaussian',
				debug	=> $debug ? $debug - 1 : 0, 
				ends 	=> 'constant',	# "extrapolate",
				negatives=> 1, 
			} );	
	my $smooth_slice = "$nx_min:$nx_max";
	my $x_smooth_slice = $x->slice($smooth_slice);
	my $y_smooth_slice = $y->slice($smooth_slice);
	$y_smooth_slice .= _smooth( {	
				x	=> $y_raw->slice($smooth_slice),
				n	=> $n_smooth,
				type	=> 'Gaussian',
				debug	=> $debug ? $debug - 1 : 0, 
				ends 	=> 'extrapolate', # 'constant'
				negatives=> 1, 
			} );	
	if ($file_stem) {
		my $gp_smooth_file = _generate_gnuplot_datafilename( 
			{ stem => $file_stem, type => 'smooth' } );
		wcols $x, $y, $gp_smooth_file;
	}

	my $dy = $y->slice("2:$n_1") - $y->slice("0:$n_3");


	# my $dx = $x->slice("$first2:$nx_max") - $x->slice("$nx_min:$last2");
	# my $dy = $y->slice("$first2:$nx_max") - $y->slice("$nx_min:$last2");

	my $deriv = zeroes $x;
	$deriv->slice("1:$n_2") .= $dy / $dx;
	# Extrapolate to d0 and dn-1 assuming linear ends, e.g. d0=d1-(d2-d1)
	(my $tmp  = $deriv->slice("0:0"))   .= 2*$deriv->at( 1) - $deriv->at( 2);
	(my $tmp2 = $deriv->slice("-1:-1")) .= 2*$deriv->at(-2) - $deriv->at(-3);

	# Put a zero in the derivatives at and near skipped points, so that
	# they don't screw up plots or max. deriv. calculations
	
	if ($skip_ndx && $skip_type ne 'ylim') {
		
		# my $s = List::Util::max(0,$skip_ndx - 3).":".
		#	List::Util::min(nelem($deriv)-1,$skip_ndx+3);
		# (my $tmp3 = $deriv->at($skip_ndx-1)) .= 0;
		# (my $tmp3a= $deriv->at($skip_ndx)) .= 0;
		my $s = $skip_ndx < $nx_min 
			? (List::Util::max(0,$skip_ndx-int($n_smooth/2))).
			  ":$skip_ndx"
			: ($skip_ndx-1).":".
			  (List::Util::min($n-1,$skip_ndx + int($n_smooth/2)));
		print "Deriv before at $s near skip_ndx $skip_ndx: ",
				$deriv->slice($s),"\n" if $debug;
		(my $tmp4 = $deriv->slice($s)) .= 0;
			# (List::Util::max(0, $skip_ndx-int($n_smooth/2)).":$skip_ndx"))) .= 0 if $skip_ndx < $nx_min;
		# (my $tmp5 = $deriv->slice(($skip_ndx-1).":".
			# (List::Util::min($n-1,$skip_ndx + int($n_smooth/2))))) .= 0 if $skip_ndx >= $nx_max;
		print "Deriv  after at $s near skip_ndx $skip_ndx: ",
				$deriv->slice($s),"\n" if $debug;
		print "Blank out skipped derivative at ",($skip_ndx-1),
			" $skip_ndx and ",
			($n_smooth/2).($skip_ndx <= $nx_min ? ' down' : ' up').
			"\n" if $debug;
	}
	if (nelem($skip_list) && $skip_type ne 'ylim') {
	    foreach my $skip_nx (list($skip_list)) {
		next if $skip_nx == $skip_ndx;
		(my $tmp3 = $deriv->at($skip_nx-2)) .= 0;
		(my $tmp3a= $deriv->at($skip_nx-1)) .= 0;
		(my $tmp4 = $deriv->slice((List::Util::max(0,
			$skip_nx-int($n_smooth/2)).":$skip_nx"))) .= 0 
			if $skip_nx < $nx_min;
		(my $tmp5 = $deriv->slice("$skip_nx:".(List::Util::min($n-1, 
			$skip_nx + int($n_smooth/2))))) .= 0 
			if $skip_nx >= $nx_max;
		print "Blank out skipped deriv. at $skip_nx and ".
			($n_smooth/2).($skip_nx <= $nx_min ? ' down' : ' up').
			"\n" if $debug;
	    }
	}
	
	my $show= '0:'.(List::Util::min($n,25));
	# $show = "0:50"; # if $debug > 1;
	print "Guess: x=",$x->slice("$show"),"\n",
		"\t y=",$y->slice("$show"),"\n",
		"\t dx=",$dx->slice("$show"),"\n",
		"\t dy=",$dy->slice("$show"),"\n",
		"\t deriv=",$deriv->slice($show),"\n"if $debug;
	print "Deriv = ",$dy->slice("$show") / $dx->slice("$show"),"\n" if $debug;
	
	# Smooth the derivative with increasing window size until there are N 
	# or fewer local maxima

	my $smooth_deriv =  _smooth( {	x => $deriv, 
					n => $n_smooth, # * 3, # triple window size
					type => 'Gaussian',
					debug => $debug ? $debug - 1 : 0,
					negatives => 1,
					ends => 'constant'} ); # extrapolate" 
	my $deriv_slice = ($nx_min+1).":".($nx_max-1);
	my $smooth_deriv_slice = $smooth_deriv->slice($deriv_slice);
	$smooth_deriv_slice .= _smooth( {
					x => $deriv->slice($deriv_slice), 
					n => $n_smooth, # * 3, # triple window size
					type => 'Gaussian',
					debug => $debug ? $debug - 1 : 0,
					negatives => 1,
					ends => 'constant' } );

	my $window_factor = 1.0;	
	my $wm = 7;			# window max = max # of maxima
	while ($window_factor < 5 && 
		count_maxima({ x=>$smooth_deriv_slice, max=>$wm }) > $wm) { # 5
		$window_factor += 0.25;	
		print "Try window factor of $window_factor\n" if $debug;
		$smooth_deriv_slice .= _smooth( {	
					x => $deriv->slice($deriv_slice), 
					n => $n_smooth * $window_factor,
					type => 'Gaussian',
					debug => $debug ? $debug - 1 : 0,
					negatives => 1,
					ends => 'constant' } );
	}
	
	if ($file_stem) {
		my $gp_deriv_file = _generate_gnuplot_datafilename( 
			{ stem => $file_stem, type => 'derivative' } );
		my $gp_smooth_deriv_file = _generate_gnuplot_datafilename( 
			{ stem => $file_stem, type => 'smooth_derivative' } );
		wcols $x, $deriv, $gp_deriv_file;
		wcols $x, $smooth_deriv, $gp_smooth_deriv_file;
	}
	print "\t smooth deriv=",$smooth_deriv->slice("$show"),"\n" if $debug;

	# my $deriv_test = 0 + $smooth_deriv->slice("$nx_min:$nx_max");
	my $deriv_test = 0 + $smooth_deriv_slice;
	my $deriv_test_orig = 0 + $smooth_deriv_slice;
	my $smooth_deriv_orig  = 0 + $smooth_deriv;
	my $ns = nelem($smooth_deriv);
	my $nt = nelem($deriv_test); 
	my $d2 = $deriv_test->slice("1:-1") - $deriv_test->slice("0:-2");

	print "deriv_test has ",nelem($deriv_test)," elements from ",
		$deriv_test->slice("0:3")," to ",$deriv_test->slice("-4:-1"),
		"\n" if $debug;

	# Make a first guess of maximum slope, TW and Imin within whole range

	my $tm_avg_orig	= 0;
	my $tm_max_orig	= 0;
	my $tw_orig	= 0;
	my $i_tm_orig	= 0;
	my $i_min_orig	= 0;
	my $mx_slope_0 = max($deriv_test);
	if ($first && $mx_slope_0 > $min_deriv * $min_deriv_factor) {
		my $half_0 = $mx_slope_0 / 2.;
		my $mx_nxs_0 = which($deriv_test == $mx_slope_0)+$nx_min+1;
		my $mx_nx_0 = $mx_nxs_0->at(0);
		my $n_max = nelem($mx_nxs_0);
		# If there is more than one close point at max, take middle one
		if ($n_max > 1 && 
		    $n_max + 2 >= $mx_nxs_0->at(-1) - $mx_nxs_0->at(0)) {
			$mx_nx_0 = $mx_nxs_0->at(int($n_max/2));
		}
		$tm_max_orig	= $x->at($mx_nx_0);
		$i_tm_orig	= $y->at($mx_nx_0);
		print "Orig. tm max slope = $tm_max_orig, i_tm = $i_tm_orig ",
			" at $mx_nx_0\n" if $debug;
	
		# Find Tw from nearest points at half max slope, or
		# nearest local minima in slope, whichever is nearer
		
		my $max_ndx_test = List::Util::min($mx_nx_0-($nx_min+1), nelem($d2)-2);
		$max_ndx_test ++ if ! $max_ndx_test;
		my $d2_nxs_lo = which($d2->slice("0:".($max_ndx_test-1)) <= 0.0)
							 + $nx_min + 1;
		my $d2_nxs_hi = which($d2->slice(($max_ndx_test+1).":-1") >= 0.0)
							 + $mx_nx_0 + 1;
		# Last d2_nxs_lo (d2 <= 0) is nearest local minumum in dI/dT below Tm
		# First d2_nxs_hi (d2 > 0) is nearest local mimumum above Tm
		# Use the nearest local minumum or the first and last points
		my $d2_nx_lo = nelem($d2_nxs_lo) ? $d2_nxs_lo->at(-1):$nx_min+1;
		my $d2_nx_hi = nelem($d2_nxs_hi) ? $d2_nxs_hi->at( 0):$nx_max-1;
		my $d_lo = $smooth_deriv->at($d2_nx_lo);
		my $d_hi = $smooth_deriv->at($d2_nx_hi);
		my $r_lo = $d_lo / $mx_slope_0;
		my $r_hi = $d_hi / $mx_slope_0;
		my $r_lo_nx = $d2_nx_lo;
		my $r_hi_nx = $d2_nx_hi;
		print "Deriv min lo, hi=$d_lo, $d_hi at $d2_nx_lo, $d2_nx_hi\n",
			"\tr lo, hi = $r_lo, $r_hi at $r_lo_nx, $r_hi_nx\n" if $debug;
		if ($d_lo <= $half_0) {
			# slope minimum below Tm is below half max; 
			my $r_lo_nxs = which($smooth_deriv->slice("$d2_nx_lo:$mx_nx_0")
					< $half_0);
			if (nelem($r_lo_nxs)) {
				$r_lo_nx = $r_lo_nxs->at(-1) + $d2_nx_lo + 1;
				$r_lo = $smooth_deriv->at($r_lo_nx)/$mx_slope_0;
			} else {
				print "CANNOT FIND LOW HALF MAX DERIV ORIGINAL!\n" if $debug;
			}
		}
		if ($d_hi <= $half_0) {
			# slope minimum below Tm is below half max; 
			my $r_hi_nxs = which($smooth_deriv->slice("$mx_nx_0:$d2_nx_hi")
					< $half_0);
			if (nelem($r_hi_nxs)) {
				$r_hi_nx = $r_hi_nxs->at(0) + $mx_nx_0 - 1;
				$r_hi = $smooth_deriv->at($r_hi_nx) / $mx_slope_0;
			} else {
				print "CANNOT FIND HIGH HALF MAX DERIV ORIGINAL!\n" if $debug;
			}
		}
		my $t_hm_lo = $x->at( 0);
		my $i_hm_lo = $y->at( 0);
		my $t_hm_hi = $x->at(-1);
		my $i_hm_hi = $y->at(-1);
		my $t_r_lo = $x->at($r_lo_nx);
		my $t_r_hi = $x->at($r_hi_nx);
		my $i_r_lo = $y->at($r_lo_nx);
		my $i_r_hi = $y->at($r_hi_nx);
		my $half_ndx_lo = $r_lo_nx;
		my $half_ndx_hi = $r_hi_nx;
	
		print "ORIGINAL r lo $r_lo at $r_lo_nx, $t_r_lo C, I=$i_r_lo\n",
		      "         r hi $r_hi at $r_hi_nx, $t_r_hi C, I=$i_r_hi\n" if $debug;

		# Caclulate Tw, Idelta and Imin from lo and hi r, t and i.
		#
		# Use I = Imin+Idelta / f where f=e^((Tm-T)/Tw), then
		# For r=dI(T)/dT / dI(Tm)/dT, Tw = (Tm-T)/log(((2-r)+2sqrt(1-r)) / r),
		# For r=1/2, (Tm-T)/Tw = log(3+-2*sqrt(2)) = k
		# so FWHM = Tw*k = (Tm - T) * k / log(((2-r) + 2sqrt(1-r)) / r)
		# Find Idelta from Itm - I = Idelta/2 - Idelta/(1+f) =
		#	Idelta * 1/2 * (1 - r/(1+-sqrt(r)))
		# Then Idelta = (Itm - It)*2/(1 - r/(1+-sqrt(1-r))),
		# i_hm_lo = Itm-Idelta/2 =Itm-(Itm-It)/ (1 - r/(1+-sqrt(1-r)))
		# For r = 1/2, Idelta/2= (Itm-It) / (1 - (1/2)/(1+-sqrt(1/2)))
		#	= (Itm-It)/(+-sqrt(2)/2)

		my $tw_lo	= 0;
		my $tw_hi	= 0;
		my $imin_lo	= 0;
		my $imin_hi	= 0;
		if ($r_lo < 1.0 && $r_lo > 0.01) {
			my $r_denom = log(((2.-$r_lo)+2.*sqrt(1.-$r_lo))/$r_lo);
			$tw_lo = ($tm_max_orig - $t_r_lo) / $r_denom 
							 if $r_denom > 1e-30;
			$t_hm_lo = $tm_max_orig - $tw_lo*$k if $tw_lo;
			my $idelta_lo = ($i_tm_orig - $i_r_lo) /
					(1.-$r_lo/(1.+sqrt(1.-$r_lo)));
			$imin_lo   = $i_min_orig - $idelta_lo;
			printf "Orig Lo Tw %.2f  idelta %.5f  imin %.5f t_hm_lo %.2f\n",
				$tw_lo, $idelta_lo, $imin_lo, $t_hm_lo if $debug;
		} else {
			print "Can't get orig lo Tw, Idelta, Imin\n" if $debug;
			$r_lo = 0;
		}
		
		# Find first T above Tm w/deriv < max deriv/2
	
		if ($mx_nx_0 + 2 >= $nx_max || $r_hi >= 1.0 || $r_hi < 1e-30) {
			print "Can't get orig. hi Tw, Idelta, Imin\n" if $debug;
			$r_hi = 0;
		} else {
			my $r_denom = log(((2.-$r_hi)+2.*sqrt(1-$r_hi))/$r_hi);
			print "Orig r_denom high $r_denom\n" if $debug;
			$tw_hi = ($t_r_hi - $tm_max_orig) / $r_denom
							 if $r_denom > 1e-30;
			$t_hm_hi = $tm_max_orig + $tw_hi*$k if $tw_hi;
			my $idelta_hi = ($i_r_hi - $i_tm_orig) /
					(1.-$r_hi/(1.+sqrt(1.-$r_hi)));
			$imin_hi   = $i_min_orig - $idelta_hi;
			print "Orig hi Tw $tw_hi  idelta $idelta_hi  imin $imin_hi  ",
				"t_hm_hi $t_hm_hi\n" if $debug;
		}
		printf "Orig r hi: %.2f  r lo: %.2f\n", $r_lo,$r_hi if $debug;

		my $tm_avg_orig = $r_hi && $r_lo ? ($t_hm_hi + $t_hm_lo) / 2.
						 : $tm_max_orig;

		# Use estimates from low half-max slope if they exist,
		# or use high half-max if it exists, or set to zero.

		$tw_orig = $r_lo ? $tw_lo : $r_hi ? $tw_hi : 0;
		$i_min_orig = $r_lo ? $imin_lo : $r_hi ? $imin_hi : 0;
		print "Tm avg orig = $tm_avg_orig, tw $tw_orig, imin $i_min_orig\n" if $debug;

	} else {
		print "NO POSITIVE SLOPE!\n" if $debug && $first;
	}


	# For the first guess, if the initial intensity is high then
	# fit a bg exponentially decreasing toward 0 to judge slope for Tm & FWHM
	# If the final intensity is high, or if the slope drops below bg slope
	# before the final rise, allow a min. bg below 0 to fit that slope.
		
	my $bg_init = 0;
	my $bg_exp  = 0;
	my $bg_min = 0;
	# my $bg_min_flag = 0;

	# Use range from lowest to highest derivative		
	my $d_lim = 0.05 * (max($smooth_deriv) - min($smooth_deriv));
	print "d_lim=$d_lim\n" if $debug;
	# Points to be tested for exponential background estimate
	my $nx1 = 1 + $nx_min;	# int($n_smooth / 2) + 1;	# first
	my $nx2 = int($n_smooth/2.)  + $nx1;		# early
	my $y1 = $y->at($nx1);
	my $x1 = $x->at($nx1);
	my $y2 = $y->at($nx2);
	my $d1 = $smooth_deriv->at($nx1);

	# Y Limit for exponential bg test = min(y) + X% of (initial y-min(y))
	#				= X% of init + 100-X % of min
	my $bg_lim = 0.80;
	my $y_lim_exp = $bg_lim * $y1 + (1-$bg_lim) * min($y);
	my $nx4 = $n - $nx1;		# last

	# General Y limit = min(y) + 5% of (max(y) - min(y) = 5% max + 95% min
	my $y_lim = 0.05 * max($y) + 0.95 * min($y);

	my $last_up = 0; # nelem($deriv_test);
	my $first_up = 0;
	# DO NOT take out background slope - look for real ups only
	# $deriv_test += abs($bg_exp) * $bg_init * exp(-abs($bg_exp)*
	#			$x->slice("$nx_min:$nx_max"));

	my $test_from = List::Util::min(2*$n_smooth,50);	# $nx3);
	print "Test from $test_from, T=",$x->at($test_from+$nx_min+1),"\n" 
		if $debug;
	# Old: to -n_smooth instead of -n_smooth/2
	my $test_to = -2*$n_smooth; # -int($n_smooth*0.5);
	$test_from = 0 if $test_from >= nelem($deriv_test);
	$test_to = -int($n_smooth/2) if $skip_type eq 'drop';
	$test_to = -1 if nelem($deriv_test) - $test_from < - $test_to;
	print "Test $test_from to $test_to out of ",nelem($deriv_test),"\n" 
		if $debug;
	my $ups = which($deriv_test->slice("$test_from:$test_to") > $d_lim/2); 
			# :-1") > $d_lim);
			# :-int($n_smooth/2)) > $d_lim/2);
	if (nelem($ups)) {
		$last_up = $ups->at(-1) + $test_from - 1;
		$first_up = $ups->at(0) + $test_from + 1;
	}
	print "First, Last up  after: $first_up, $last_up; max deriv=",
		max($deriv_test->slice("$test_from:-".int($n_smooth/2))),"\n" 
		if $debug;

	# Find point before first up to test for exponential decay
	my $nx3 = List::Util::min($nt / 3, 2*$n_smooth + $nx1);	
		# which($y < $y_lim_exp)->at(0)-1; # late = last above y limit
	$nx3 = $first_up - 1 if $first_up > $nx3;
	my $y3 = $y->at($nx3);
	
	print "Guess for first iteration\n" if $debug && $first;
	print "nx1,2,3=$nx1, $nx2, $nx3; T,F1=$x1, $y1; F3=$y3\n" if $debug;
	if ($bg_exp_flag && $first && 
		($y1 - $y3 > $y_lim/2 || $y1 - $y2 > $y_lim/2)) {

		my $exp_bg1 = get_exp_bg_from_points({	x=>$x, y=>$y, nx1=>$nx1, 
							nx2=>$nx2 });
		my $exp_bg2 = get_exp_bg_from_points({	x=>$x, y=>$y, nx1=>$nx1, 
							nx2=>$nx3 });
		$bg_exp		= exists_or_zero($exp_bg1,'bg_exp');
		$bg_init	= exists_or_zero($exp_bg1,'bg_init');
		my $bg_exp2	= exists_or_zero($exp_bg2,'bg_exp');
		my $bg_init2	= exists_or_zero($exp_bg2,'bg_init');
		my $res1 = min($y_smooth_slice - 
			$bg_init  * exp(-$bg_exp  * $x_smooth_slice));
		my $res2 = min($y_smooth_slice - 
			$bg_init2 * exp(-$bg_exp2 * $x_smooth_slice));
		if ($debug) {
			print	"At ",$x->at($nx2),"; bg_exp=$bg_exp, ",
				"bg_init=$bg_init, res $res1\n",
				"At ",$x->at($nx3),"; bg_exp=$bg_exp2, ",
				"bg_init=$bg_init2, res $res2\n";
		}
		# If bg2 exists and either bg1 doesn't exist or is much worse 
		# than bg2, use bg2 - where worse means res1 << 0 and res2 > res1
		
		if (  $exp_bg2 && ( (!$exp_bg1) || 
				    ($res1 < -2*$y_lim && 
				     $res2 > $res1 + 2*$y_lim) )   ) {
			$exp_bg1 = $exp_bg2;
			$bg_exp  = $bg_exp2;
			$bg_init = exists_or_zero($exp_bg2,'bg_init');
			$res1 = $res2;
			printf "Using point %u=%.1f, exp=%.6f, ".
				"init=%.3f, res=%.4f\n", $nx3,$x->at($nx3),
				$bg_exp, $bg_init, $res1 if $debug;
		}
	
		# Allow negative bg_min if curve goes up, down, up - i.e.
		# slope goes below zero between first and last positive slopes
		# by more than 10% of total slope range
	
		my $deriv_last_up = 0;
		my $dmin = 0;
		my $nx_dmin = 0;
		my $x_dmin  = 0;
		if ($last_up > $first_up + $n_smooth) {
			$deriv_last_up = $deriv_test->slice("$first_up:$last_up");
			$dmin = min( $deriv_last_up );
			if ($debug) {
				print "deriv_last_up=$deriv_last_up\n",
				    "T=",$x->slice("$first_up:$last_up"),"\n",
				    "F=",$y->slice("$first_up:$last_up"),"\n";
				print "dmin=$dmin, d_lim=$d_lim\n";
			}
		}
		# $bg_min_flag = ($y->at($nx4) > 2*$y_lim) ? 2 : 0 ;
		# Is min deriv with background subtracted still less than zero?
		if ($dmin < -2*$d_lim) {
			# Find last position of most negative derivative 
			$nx_dmin = which( $deriv_last_up == $dmin )->at(-1);
			$nx_dmin += $nx_min + $first_up;
			$nx_dmin = $n - 1 if $nx_dmin >= $n;
			print "Found negative deriv. $dmin at $nx_dmin, T=",
				$x->at($nx_dmin),
				" between ups $first_up and $last_up\n" if $debug;
			if ($nx_dmin > 0) { # $nx_min+2*$n_smooth && $nx_dmin > $nx3)
				$bg_min_flag = 1;
				$x_dmin  = $x->at($nx_dmin);
				$dmin = $smooth_deriv->at($nx_dmin);
				print "nx_dmin > nx min $nx_min + ",
					"2*n_smooth =2* $n_smooth\n" if $debug;
				print "Neg deriv at T $x_dmin; set bg_min flag\n"
					if $debug;
			} else {
				print "Do NOT set bg_min_flag\n" if $debug;
			}
		} else {
			print "No negative deriv. before last up\n" if $debug;
			if ($bg_min_flag) {
				# If flag was set in calling program, try
				# forcing bg_min to see if we get a better fit
				$bg_min = -5*$y1;
				$bg_exp  = - $d1 / ($y1 - $bg_min);
				$bg_init = $bg_min + ($y1 - $bg_min) * 
							 exp( $bg_exp * $x1 );
				printf "Force bg_min %.5f on 2nd try; ".
					"bg_exp=%.5f, init=%.5f\n", $bg_min, 
					$bg_exp, $bg_init if $debug;
			}
		}
		if ($bg_min_flag && $nx_dmin) {
			print "Get background from slopes at $nx1=$x1 and ",
				"$nx_dmin=$x_dmin, slopes=$d1 and $dmin\n"
				if $debug;
			my $exp_bgd = get_exp_bg_from_slopes({x=>$x, y=>$y, 
				deriv=>$smooth_deriv, nx1=>1, nx2=>$nx_dmin, });
				 # { n=>5, });
			my $bg_expd	= exists_or_zero($exp_bgd,'bg_exp');
			my $bg_initd	= exists_or_zero($exp_bgd,'bg_init');
			my $bg_mind	= exists_or_zero($exp_bgd,'bg_min');
			my $resd = min(  $y_smooth_slice - 
					( $bg_mind+($bg_initd-$bg_mind) * 
					exp(-$bg_expd * $x_smooth_slice) )  );
			my $bg_sloped	= -$bg_expd*($bg_initd-$bg_mind)*
						exp(-abs($bg_expd)*$x_dmin);
			my $bg_slopep	= -$bg_exp*($bg_init)*
						exp(-abs($bg_exp)*$x_dmin);
			if ($debug) {
				print "Bg from slope: exp $bg_expd, init ",
					"$bg_initd, min $bg_mind\n";
				print "Bg slope @ min $bg_sloped from slopes\n",
				      "               $bg_slopep from points\n";
			}
			if (  $exp_bgd && ( (!$exp_bg1) || 
				(($dmin < $d_lim && $bg_sloped < $bg_slopep) ||
				 ($dmin >= $d_lim && $resd > $res1)) )  ) {
				$exp_bg1 = $exp_bgd;
				$bg_exp	 = $bg_expd;
				$bg_init = $$exp_bgd{'bg_init'};
				$bg_min  = $$exp_bgd{'bg_min'};
			}
		}
		
		print "Background: bg_min_flag=$bg_min_flag, ylim=$y_lim, d1=$d1,",
			" dmin=$dmin at $x_dmin, d_lim=$d_lim\n" if $debug;
		print "Before cycles, exp=$bg_exp, init=$bg_init, min=$bg_min\n"
			if $debug;
		my $i = 0;
		for ($i=0; $i<100; $i++) {
			my $exp_term =abs($bg_init - $bg_min) *
					exp(-abs($bg_exp)*$x_smooth_slice);
			my $min_res = min($y_smooth_slice - ($bg_min+$exp_term));
			printf "%u: Min res %.5f slope %.6f exp %.6f init %.5f ".
				" min %.5f", $i,$min_res,
				-$bg_exp*$exp_term->at($nx_dmin), $bg_exp,
				$bg_init, $bg_min if $debug;
			if ($min_res > -5*$y_lim) {
				print ": res > lim" if $debug;
				last if ! $bg_min_flag;
				print ": test slope :" if $debug;
				last if $dmin + $d_lim > -$bg_exp * 
							$exp_term->at($nx_dmin);
				# Background is not steep enough; drop bg_min
				if ($bg_min*1.05 < $y1) {
					$bg_min *= 1.05;
					print " DROP bg_min" if $debug; 
					$bg_exp  = - $d1 / ($y1 - $bg_min);
					$bg_init = $bg_min + ($y1 - $bg_min) * 
							 exp( $bg_exp * $x1 );
				} else {
					$bg_min += 0.05*$bg_min;
					last;
				}
			} else {
				# Background is too high; raise exp or drop min
				if ($bg_min_flag && $bg_min*1.05 < $y1) {
					$bg_min *= 1.05;
					print " DROP bg_min" if $debug; 
					$bg_exp  = - $d1 / ($y1 - $bg_min);
					# $bg_min  = $y1 + $d1 / $bg_exp;
					$bg_init = $bg_min + ($y1 - $bg_min) * 
							 exp( $bg_exp * $x1 );
				} else {
					$bg_exp *= 1.05;
					print ": RAISE bg_exp" if $debug;
					$bg_init = $y1 * exp( $bg_exp * $x1 );
				}
			}
			print "\n" if $debug;
		}
		print "\nAfter $i cycles, exp=$bg_exp, init=$bg_init, min=$bg_min\n"
			if $debug;
		
		# Subtract derivative of background from deriv and find new Tm
		# Derivative of (init-min)*e^(-bg_exp*x) = -bg_exp*(init-min)e^...

		$smooth_deriv += $bg_exp*
				abs($bg_init - $bg_min)*exp(-abs($bg_exp)*$x);
		$deriv_test = 0 + $smooth_deriv_slice;
		$y -= $bg_min + abs($bg_init - $bg_min)*exp(-abs($bg_exp)*$x);
	} elsif ($first) {
		print "No exponential background\n" if $debug;
	}

	# Look for first transition within the central part of whole temp. range
	# (n_ends from either end). If no positive deriv. found, include ends.
	#	T0                                                 Tn-1
	#	 |<---------smooth_deriv--------------------------->|
	#	       |<------------deriv_test---------------->|
	#	 |---->nx_min
	#	 |--------------------------------------------->nx_max
	#	       |<-n_ends->|<===first test===>|<-n_ends->|
	#              |<-------->|                  |<-------->|
	#                  test_a                    -test_b
	# Test a = n_ends - nx_min if that's above 0, e.g. n_ends if nx_min=0
	# Test b = n elements in smooth_deriv - n_ends - nx_max - 1 if <=-1
	#          e.g. -n_ends - 1 if nx_max = n elements in smooth_deriv
	
	my $max_deriv = 0;
	my $test_a = 0;		# Points to skip from nx_min forward
	my $test_b = -1;	# Points to skip from nx_max backward
	my $end_length = int(List::Util::min($nt/5,$min_length,$n_smooth));
	my $n_ends = 2*$end_length;	# int(.5 + $ns / 5);
	$n_ends = 3*$end_length if $bg_init > 1e-10;
	print "n_ends=$n_ends, end_length=$end_length, min_length=$min_length, ",
		"ns=$ns, ns/5=",$ns/5," n_smooth=$n_smooth\n" if $debug;
	# $n_ends = 3*int($min_length) if $debug;
	my $slice_text = '';
	my $max_ndx_list = pdl();
	print "Deriv test=",nelem($deriv_test)," elements: $deriv_test\n" if $debug;
	
	if ($center_first && $nt - 2*$n_ends > $min_length) {#  && $bg_min >= 0) 
		$test_a = $n_ends; 	 # List::Util::min(0, $n_ends - $nx_max);
		$test_b = $nt - $n_ends; # List::Util::min(-1, $ns - $n_ends/2 - $nx_max - 1);
		$test_b = $nt - 1 if $skip_type eq 'drop';
		print "Test from $test_a to $test_b of $nt in deriv_test = ".
			($test_a+$nx_min)." to ".
			($test_b+$nx_min + ($test_b < 0 ? $nt : 0)).
			", T=".$x->at($test_a+$nx_min)." to ".
			$x->at($test_b+$nx_min + ($test_b < 0 ? $nt : 0)).
			"\n" if $debug;
		$slice_text = "$test_a:$test_b";
		if ($test_a < $nt && $test_a < $test_b+($test_b>0 ? 0 : $nt)) {
			$max_deriv = max( $deriv_test->slice($slice_text) ); 
			$max_ndx_list = which($deriv_test->slice($slice_text) 
						== $max_deriv);
			my $mx_orig = max($deriv_test_orig->slice($slice_text));
			my $nx_orig = which($deriv_test_orig->slice($slice_text) 
						== $mx_orig);
			# If max without bg subtracted is above limit and
			# 	max with bg subtracted is not, or 
			# if max with and without background subtracted differ
			# by more than 2 degrees, use original max & deriv_test
			# Test for near overlap:  <----> <----> 
			
			if ($mx_orig > $min_deriv * $min_deriv_factor && (
			    $max_deriv <= $min_deriv * $min_deriv_factor ||
			    $max_ndx_list->at(0) + 2*$steps_per_degree <
			    $nx_orig->at(-1) || 
			    $max_ndx_list->at(-1) - 2*$steps_per_degree > 
			    $nx_orig->at(0))) {
				$max_deriv = $mx_orig;
				$max_ndx_list = $nx_orig;
				$deriv_test = $deriv_test_orig;
				$smooth_deriv = $smooth_deriv_orig;
			}
		}
		print "Max ndx list before: $max_ndx_list\n" if $debug;
		$max_ndx_list += $nx_min + $test_a;
		print "Max ndx list during: $max_ndx_list\n" if $debug;
		print "Found max deriv $max_deriv in $slice_text at ",
			"$max_ndx_list:",$deriv_test->slice($slice_text),"\n" 
			if $debug;
	} elsif ($debug) {
		print "Do NOT test the center first: n_ends=$n_ends,".
			"nt=$nt, min_length=$min_length\n" if $debug;
	}

	my $test_ends = 1;
	if ($max_deriv > 1e-10 && nelem($max_ndx_list)) {
		# Check for max slope near edge of central test range, to 
		# see if full range should be used. Increase test_ends to
		# approximately fwhm*3/2 by testing slope at max +- 4 points
		# Use Tw = (Tm - T) / log(((2-r) + 2sqrt(1-r)) / r),
		# then half width at half max = Tw*k

		my $test_range = 4;
		my $tnx = $max_ndx_list->at(-1);
		if ($tnx + $test_range < $ns - 1) {
			my $r = $smooth_deriv->at($tnx+$test_range) / $max_deriv;
			if ($r > 1e-10 && $r < 1.0) {
				my $thi = 3*$k*
				    ($x->at($tnx+$test_range) - $x->at($tnx)) /
				    log(((2.-$r) + 2*sqrt(1.-$r)) / $r);
				$thi = sprintf "%i", $thi;
				$test_ends = $thi if $thi > $test_ends;
				print "Test ends hi: r $r, thi $thi, ends $test_ends\n"
					if $debug;
			}
		}
		$tnx = $max_ndx_list->at(0);
		if ($tnx - $test_range > 0) {
			my $r = $smooth_deriv->at($tnx-$test_range) / $max_deriv;
			if ($r > 1e-10 && $r < 1.0) {
				my $tlo = 3*$k*
				    ($x->at($tnx) - $x->at($tnx-$test_range)) /
				    log(((2.-$r) + 2*sqrt(1.-$r)) / $r);
				$tlo = sprintf "%i", $tlo;
				$test_ends = $tlo if $tlo > $test_ends;
				print "Test ends lo: r $r, thi $tlo, ends $test_ends\n"
					if $debug;
			}
		}
	}
	
	if ($max_deriv <= $min_deriv*$min_deriv_factor || (nelem($max_ndx_list)
	    && ( $max_ndx_list->at(-1) <= $nx_min + $test_a + $test_ends ||
		 $max_ndx_list->at(0)  >= $nx_min + $test_b - $test_ends))) {
		if ($center_first) {
			$test_a = 0;
			$test_b = -1;
			print "No deriv > min within central part; test outer ",
				"$n_ends points\n"
				if $debug && $center_first;
			$max_deriv = max( $deriv_test );
			$max_ndx_list = which($deriv_test==$max_deriv)+$nx_min;
			print "Found max deriv $max_deriv at ",$max_ndx_list,
				" in ",$deriv_test,"\n" 
				if $debug;
		} else {
			# Center failed; exclude it and try ends separately
			my $a = $n_ends - 1;
			my $b = $nt + 1- $n_ends;
			my $s1 = $deriv_test->slice("0:$a");
			my $s2 = $deriv_test->slice("$b:-1");
			my $max1 = max($s1);
			my $max2 = $skip_type eq 'drop' ? 0 : max($s2);
			print "Exclude center: max(0:$a) = $max1, max($b:-1) =",
				" $max2\n" if $debug;
			if ($max1 >= $max2) {
				$max_deriv = $max1;
				$max_ndx_list = which($s1 == $max1) + $nx_min;
				print "Max from 0 to $n_ends=$max1 at ",
					"$max_ndx_list in $s1\n" if $debug;
			} else {
				$max_deriv = $max2;
				$max_ndx_list = which($s2 == $max2) +$nx_min+$b;
				print "Max from $b to end=$max2 at ",
					"$max_ndx_list in $s2\n" if $debug;
			}
		}
	}
	if ($max_deriv <= $min_deriv*$min_deriv_factor) {
		print "STOP GUESS: max derivative $max_deriv < ",
			"min |derivative|*$min_deriv_factor ",
			$min_deriv*$min_deriv_factor,"\n" if $verbose;
		return { reason => $first ? 'No positive slope'
					  : 'no positive slope left',
			    min_deriv => $min_deriv,
			    max_deriv => $mx_slope_0,
			    discontinuity => \%new_disc };
	}
	print "Max deriv $max_deriv > min |deriv|*2 ",2*$min_deriv,"\n" if $debug;
	print "Tested between $test_a and $test_b of $nt deriv = ".
		$x->at($test_a+$nx_min)." to ".
		$x->at($test_b+$nx_min + ($test_b < 0 ? $nt : 0))."\n" if $debug;
	print "Max ndx list  after: $max_ndx_list\n" if $debug;
	
	my $max_ndx = $max_ndx_list->at(0);
	my $tm_max_slope = $x->at($max_ndx);
	my $tm = $tm_max_slope;
	my $itm = $y->at($max_ndx);

	if ($debug) {
		print "Prelim. tm = $tm, itm=$itm at ",$max_ndx_list,"\n";
		my $c = 5;
		$c = 25 if $debug > 1;
		my $a = $max_ndx - $c;
		$a = 0 if $a < 0;
		my $b = $max_ndx_list->at(-1) + $c;
		$b = $n - 1 if $b >= $n;
		$show = "$a:$b";
		print "   Index near max: $show\n";
		print "   Temp near max: ",$x->slice($show),"\n";
		print "   Int. near max: ",$y->slice($show),"\n";
		print "   Deriv near max: ",$smooth_deriv->slice($show),"\n";
	}	

	if ($max_ndx <= $nx_min || $max_ndx >= $nx_max) {
		print "StOP GUESS: Max slope at $max_ndx outside range ",
			"$nx_min to $nx_max !\n" if $verbose;
		return { reason => 'No transition within temperature range',
			 min_deriv => $min_deriv,
			 max_deriv => $mx_slope_0, 
			 discontinuity => \%new_disc};
	}

	# If there are several points at max (nearly) in a row, take averages

	my $n_max = nelem($max_ndx_list);
	print "Found $n_max deriv at max=$max_deriv from ndx $max_ndx, tm $tm\n"
		if $debug;
	if ($n_max > 1 && ($max_ndx_list->at(-1) - $max_ndx) <= $n_max*2) {
		$max_ndx = int(sum($max_ndx_list) / $n_max + 0.5);
		$tm  = sum($x->index($max_ndx_list)) / $n_max;
		$itm = sum($y->index($max_ndx_list)) / $n_max;
		print "Avg of $n_max T's -> tm $tm\n" if $debug;
	}

	# Find local minima in slope nearest to Tm, below and above.
	# If slope minimum < half max, find T at half max closer to Tm;
	# if not, use slope minumum.

	my $r_lo = 0;
	my $r_hi = 0;
	my $t_hm_lo = $x->at( 0);
	my $i_hm_lo = $y->at( 0);
	my $t_hm_hi = $x->at(-1);
	my $i_hm_hi = $y->at(-1);
	my $half_max_deriv = $max_deriv / 2.;

	# Get delta(slope) =~ delta T * 2nd deriv. of I; 
	# d2(i) = d(i+1) - d(i), i = 0 to nt-1
	# Only the sign matters, so don't bother dividing by dx.

	# Redo 2nd derivative
	$d2 = $deriv_test->slice("1:-1") - $deriv_test->slice("0:-2");

        # |======================smooth_deriv===========================|
	# |--------------------------->max_ndx
	# |--->nx_min+1                                   nx_max-1<-----|
	#      |=================deriv_test======================|
	#      |==================d2============================|
	#      |---->test_a                           test_b<----|
	#      |====----------------->
	#          max_ndx - (nx_min+1)
	#      |======lo test=========|====hi test===============|

	my $max_ndx_test = List::Util::min($max_ndx-($nx_min+1), nelem($d2)-2);
	$max_ndx_test ++ if ! $max_ndx_test;
	my $d2_nxs_lo = which($d2->slice("0:".($max_ndx_test-1)) <= 0.0) +
								$nx_min + 1;
	my $d2_nxs_hi = which($d2->slice(($max_ndx_test+1).":-1") >= 0.0) +
								$max_ndx + 1;
						
	# Last d2_nxs_lo (d2 <= 0) is nearest local minumum in dI/dT below Tm
	# First d2_nxs_hi (d2 > 0) is nearest local mimumum above Tm
	#        |                   oo
	#        |     last         o .o
	#        |     lo min     o   . o       o
	#        | o     .      o     .  o    o
	#        |       .    o     max   o o
	# dI/dT  |    o  . o          .    .
	#        |      oo            .    .
	#        |                    .    first hi min
	#        +-------------       .
	#          Temperature        .
	#                             .
	#        !                   o.
	#        |         o     o oo .     o o o
	# d2     |            o       .
	#       0+------oo------------o---o-------
	#        |    o  .               
	#        | o     .             ooo
	#                .

	# Use the nearest local minumum or the first and last points
	my $d2_nx_lo = nelem($d2_nxs_lo) ? $d2_nxs_lo->at(-1) : $nx_min + 1;
	my $d2_nx_hi = nelem($d2_nxs_hi) ? $d2_nxs_hi->at( 0) : $nx_max - 1;
	if ($debug) {
		my $nlo = nelem($d2_nxs_lo);
		my $nhi = nelem($d2_nxs_hi);
		print "Found $nlo 2nd deriv <= 0 below Tm, last=$d2_nx_lo; ",
			" $nhi 2nd deriv >= 0 above Tm, first = $d2_nx_hi\n";
		print "Lo=",$d2_nxs_lo->slice("0:".(List::Util::min($nlo-1,3))),
		    	"...",
		    	$d2_nxs_lo->slice((-List::Util::min($nlo,3).":-1")),
			"\n" if $nlo;
		print "T=",$x->index(
			$d2_nxs_lo->slice("0:".(List::Util::min($nlo-1,3)))),
			"...",$x->index(
			$d2_nxs_lo->slice((-List::Util::min($nlo,3).":-1"))),
			"\n" if $nlo;
		print "I=",$y->index(
			$d2_nxs_lo->slice("0:".(List::Util::min($nlo-1,3)))),
			"...",$y->index(
			$d2_nxs_lo->slice((-List::Util::min($nlo,3).":-1"))),
			"\n" if $nlo;
		print "d=",$smooth_deriv->index(
			$d2_nxs_lo->slice("0:".(List::Util::min($nlo-1,3)))),
			"...",$smooth_deriv->index(
			$d2_nxs_lo->slice((-List::Util::min($nlo,3).":-1"))),
			"\n" if $nlo;
		print "d2=",$d2->index($d2_nxs_lo->slice("0:".
			(List::Util::min($nlo-1,3)))-$nx_min-1),"...\n" if $nlo;;
		print "\t...",$d2->index($d2_nxs_lo->slice(
			("-3:-1"))-$nx_min-1),"\n" if $nlo >= 3;
		print "Hi=",$d2_nxs_hi->slice("0:".(List::Util::min($nhi-1,3))),
			"...",
			$d2_nxs_hi->slice((-List::Util::min($nhi,3).":-1")),
			"\n" if $nhi;
		print "All d2: ",$d2,"\n";
		print "All d2_nxs_lo: ",$d2_nxs_lo,"\n";
		print "All d2_nxs_hi: ",$d2_nxs_hi,"\n";
	}
	my $d_lo = $smooth_deriv->at($d2_nx_lo);
	my $d_hi = $smooth_deriv->at($d2_nx_hi);
	$r_lo = $d_lo / $max_deriv;
	$r_hi = $d_hi / $max_deriv;
	my $r_lo_nx = $d2_nx_lo;
	my $r_hi_nx = $d2_nx_hi;
	print "Deriv min lo, hi=$d_lo, $d_hi at $d2_nx_lo, $d2_nx_hi\n",
		"\tr lo, hi = $r_lo, $r_hi at $r_lo_nx, $r_hi_nx\n" if $debug;
	if ($d_lo <= $half_max_deriv) {
		# slope minimum below Tm is below half max; 
		my $r_lo_nxs = which($smooth_deriv->slice("$d2_nx_lo:$max_ndx")
					< $half_max_deriv);
		print "Found ",nelem($r_lo_nxs)," < 1/2 max below Tm from ",
			"$d2_nx_lo to $max_ndx\n" if $debug;
		if (nelem($r_lo_nxs)) {
			$r_lo_nx = $r_lo_nxs->at(-1) + $d2_nx_lo + 1;
			$r_lo = $smooth_deriv->at($r_lo_nx) / $max_deriv;
			print "Deriv min lo < half max; $r_lo @ $r_lo_nx\n",
				"r_lo_nxs: ",$r_lo_nxs,"\n",
				"deriv: ",$smooth_deriv->index($r_lo_nxs),"\n" 
				if $debug;
		} else {
			print "CANNOT FIND LOW HALF MAX DERIV!\n" if $debug;
		}
	}
	if ($d_hi <= $half_max_deriv) {
		# slope minimum below Tm is below half max; 
		my $r_hi_nxs = which($smooth_deriv->slice("$max_ndx:$d2_nx_hi")
					< $half_max_deriv);
		if (nelem($r_hi_nxs)) {
			$r_hi_nx = $r_hi_nxs->at(0) + $max_ndx - 1;
			$r_hi = $smooth_deriv->at($r_hi_nx) / $max_deriv;
			print "Deriv min hi < half max; $r_hi @ $r_hi_nx\n" if $debug;
		} else {
			print "CANNOT FIND HIGH HALF MAX DERIV!\n" if $debug;
		}
	}
	my $t_r_lo = $x->at($r_lo_nx);
	my $t_r_hi = $x->at($r_hi_nx);
	my $i_r_lo = $y->at($r_lo_nx);
	my $i_r_hi = $y->at($r_hi_nx);
	my $half_ndx_lo = $r_lo_nx;
	my $half_ndx_hi = $r_hi_nx;
	
	print "Found r lo $r_lo at $r_lo_nx, $t_r_lo C, I=$i_r_lo\n",
	      "      r hi $r_hi at $r_hi_nx, $t_r_hi C, I=$i_r_hi\n" if $debug;

	# Caclulate Tw, Idelta and Imin from lo and hi r, t and i.
	#
	# Use I = Imin+Idelta / f where f=e^((Tm-T)/Tw), then
	# deriv = Idelta/Tw * f/(1+f)^2, max deriv at Tm = Idelta/4*Tw.
	# Given another deriv d = r*max at T, r = d(T)/d(Tm), 
	# r = f/(1+f)^2 / (1/4), f^2 + 2f + 1 = 4f/r, f^2-(4/r-2)f+1=0
	# then f = ( 4/r - 2 +- ((4/r-2)^2 - 4)^(1/2) ) / 2
	#      f =  2/r - 1 +- (16/r^2 - 16/r + 4 - 4)^(1/2)/2
	#        =  (2 - r +- 2(1-r)^1/2)/r
	# So use e^((Tm-T)/Tw) = (2-r +- 2*sqrt(1-r)) / r to find FWHM:
	# For r=1/2, (Tm-T)/Tw = log(3+-2*sqrt(2)) = k
	# For other r, Tw = (Tm - T) / log(((2-r) + 2sqrt(1-r)) / r),
	# then half width at half max = Tw*k = (Tm - T) * k / log(...)
	# T at half-max = Tm - (Tm - T) * k / log(...)
	#
	# Find Idelta from Itm - I = Idelta/2 - Idelta/(1+f) =
	#	Idelta * (1/2 - 1/(1+  (2-r +- 2sqrt(1-r))/r  )) =
	#	Idelta * (1/2 - r/(r + 2 - r +- 2sqrt(1-r))) =
	#	Idelta * (1/2 - r/(2 +- 2*sqrt(1-r))
	#	Idelta * 1/2 * (1 - r/(1+-sqrt(r)))
	# Then Idelta = (Itm - It)*2/(1 - r/(1+-sqrt(1-r))),
	# i_hm_lo = Itm-Idelta/2 =Itm-(Itm-It)/ (1 - r/(1+-sqrt(1-r)))
	# For r = 1/2, Idelta/2= (Itm-It) / (1 - (1/2)/(1+-sqrt(1/2)))
	#	= (Itm-It)/(1 - 1/(2+-sqrt(2))) 
	#	= (Itm-It)/(1 - (2-+sqrt(2))/(4-2))
	#	= (Itm-It)/(1 - 1 +- sqrt(2)/2)
	#	= (Itm-It)/(+-sqrt(2)/2)

	print "Look from $nx_min to $max_ndx for deriv in ",
		nelem($smooth_deriv)," elements of smooth_deriv \n" if $debug;
	print "Values from ",	$smooth_deriv->at($nx_min)," to ",
				$smooth_deriv->at($max_ndx),"\n" if $debug;
 	#	$t_hm_lo = $x->at($half_ndx_lo);
 	#	$i_hm_lo = $itm - ($itm - $y->at($half_ndx_lo))/sqrt(2);
		
	my $tw_lo	= 0;
	my $imin_lo	= 0;
	my $idelta_lo	= 0;
	my $tw_hi	= 0;
	my $imin_hi	= 0;
	my $idelta_hi	= 0;
	if ($r_lo < 1.0 && $r_lo > 1e-30) {
		my $r_denom = log(((2.-$r_lo)+2.*sqrt(1.-$r_lo))/$r_lo);
		$tw_lo = ($tm - $t_r_lo) / ($r_denom > 1e-30 ? $r_denom : 1.0);
		$t_hm_lo = $tm - $tw_lo*$k;
		$idelta_lo = ($itm - $i_r_lo)*2/(1.-$r_lo/(1.+sqrt(1.-$r_lo)));
		$imin_lo   = $itm - $idelta_lo / 2;
		printf "Lo Tw %.2f  idelta %.5f  imin %.5f t_hm_lo %.2f\n",
			$tw_lo, $idelta_lo, $imin_lo, $t_hm_lo if $debug;
	} else {
		print "Can't get lo Tw, Idelta, Imin\n" if $debug;
		$r_lo = 0;
	}
		
	# Find first T above Tm w/deriv < max deriv/2
	
 	#	$i_hm_hi = $itm + ($y->at($half_ndx_hi)-$itm)/sqrt(2);
	if ($max_ndx + 2 >= $nx_max || $r_hi >= 1.0 || $r_hi < 1e-30) {
		print "Can't get hi Tw, Idelta, Imin\n" if $debug;
		$r_hi = 0;
	} else {
		my $r_denom = log(((2-$r_hi)+2*sqrt(1-$r_hi))/$r_hi);
		$tw_hi = ($t_r_hi - $tm) / ($r_denom > 1e-30 ? $r_denom : 1.0);
		$t_hm_hi = $tm + $tw_hi*$k;
		$idelta_hi = ($i_r_hi - $itm)*2/(1-$r_hi/(1+sqrt(1-$r_hi)));
		$imin_hi   = $itm - $idelta_hi / 2;
		print "hi Tw $tw_hi  idelta $idelta_hi  imin $imin_hi  ",
			"t_hm_hi $t_hm_hi\n" if $debug;
	}
	printf "r hi: %.2f  r lo: %.2f\n", $r_lo,$r_hi if $debug;

	my $tm_nx = $max_ndx;
	my $use_tm_avg = 0.0;
	my $use_fwhm_min = 0.0;
	my $use_lo = 1.0;
	my $tm_avg = 0;
	my $tw_avg = 0;
	if ($r_hi && $r_lo) {
		$tm_avg = ($t_hm_hi + $t_hm_lo) / 2.;
		$tw_avg = ($tw_hi + $tw_lo)/2;
	} elsif ($r_lo) {
		$tm_avg = $tm;
		$tw_avg = $tw_lo;
	} elsif ($r_hi) {
		$tm_avg = $tm;
		$tw_avg = $tw_hi;
	}
	print "Tm avg = $tm_avg\n" if $debug;

	print "Guess: tm $tm at index $tm_nx\n" if $debug;
	my $fwhm_avg = abs($t_hm_hi - $t_hm_lo);
	my $fwhm_hi = 2.* ($t_hm_hi - $tm);
	my $fwhm_lo = 2.* ($tm - $t_hm_lo);
	printf "FWHM mean: %.2f  lo: %.2f  hi: %.2f\n", 
		$fwhm_avg, $fwhm_lo, $fwhm_hi if $debug;
	my $imin_avg = ($imin_hi + $imin_lo)/2.;
	my $idelta_avg = ($idelta_hi + $idelta_lo)/2.;

	printf "Imin mean: %.4f  lo: %.4f  hi: %.4f\n", 
		$imin_avg, $imin_lo, $imin_hi if $debug;
	printf "Idelta mean: %.4f  lo: %.4f  hi: %.4f\n", 
		$idelta_avg, $idelta_lo, $idelta_hi if $debug;

	my $fwhm   = $fwhm_lo;
	my $idelta = $idelta_lo;
	my $tw	   = $tw_lo;
	my $imin   = $imin_lo;
	if ($r_lo > 1e-10 && $tw_lo > 1e-10 && 
	    ($use_lo == 1.0 || ! $r_hi  > 1e-10 || 
	    ($use_fwhm_min == 1.0 && $fwhm_lo && $fwhm_lo <= $fwhm_hi))) {
		print "Use fwhm lo\n" if $debug;
	} elsif ($r_hi  > 1e-10 && $tw_hi > 1e-10 && (! $r_lo  > 1e-10 || 
	    ($use_fwhm_min == 1.0 && $fwhm_hi && $fwhm_lo > $fwhm_hi))) {
		print "Use fwhm hi\n" if $debug;
		$fwhm = $fwhm_hi;
		$tw   = $tw_lo;
		$imin = $imin_hi;
		$idelta = $idelta_hi;
	} elsif ($use_lo > 1e-10 && $tw_hi > 1e-10 && $tw_lo > 1e-10 &&
	    $use_fwhm_min > 1e-10 && $r_lo  > 1e-10 && $r_hi > 1e-10) {
		print "Use $use_lo lo + $use_fwhm_min min\n" if $debug;
		my $fwhm_min   = $fwhm_lo <= $fwhm_hi ? $fwhm_lo   : $fwhm_hi;
		my $tw_min     = $fwhm_lo <= $fwhm_hi ? $tw_lo	    : $tw_hi;
		my $imin_min   = $fwhm_lo <= $fwhm_hi ? $imin_lo   : $imin_hi;
		my $idelta_min = $fwhm_lo <= $fwhm_hi ? $idelta_lo : $idelta_hi;
		$fwhm	= $use_lo * $fwhm_lo	+ $use_fwhm_min * $fwhm_min;
		$tw	= $use_lo * $tw_lo	+ $use_fwhm_min * $tw_min;
		$imin	= $use_lo * $imin_lo	+ $use_fwhm_min * $imin_min;
		$idelta	= $use_lo * $idelta_lo	+ $use_fwhm_min * $idelta_min;
	} else {
		print "Use fwhm avg\n" if $debug;
		$fwhm = $fwhm_avg;
		$tw   = $tw_avg;
		$imin = $imin_avg;
		$idelta = $idelta_avg;
	}

	if ($use_tm_avg > 1e-30) {
		my $m1 = 1.0 - $use_tm_avg;
		$tm	= $use_tm_avg * $tm_avg		+ $m1 * $tm;
		$fwhm	= $use_tm_avg * $fwhm_avg	+ $m1 * $fwhm;
		$tw  	= $use_tm_avg * $tw_avg		+ $m1 * $tw;
		$imin	= $use_tm_avg * $imin_avg	+ $m1 * $imin;
		$idelta = $use_tm_avg * $idelta_avg	+ $m1 * $idelta;
		# $tm_nx = int( ($half_ndx_hi + 1 - $half_ndx_lo) / 2 );
		my $tm_nxs = which($x >= $tm);
		if (nelem($tm_nxs)) {
			$tm_nx = $tm_nxs->at(0);
			if ($tm_nx > 0 && nelem($tm_nxs) > 1) {
				my $t1 = $x->at($tm_nx-1);
				my $t2 = $x->at($tm_nx);
				# Shift index one down if tm is closer to lower T
				print "Guess: t(n-1),tm,t(n)=$t1, $tm, $t2 ",
					" at n=$tm_nx\n" if $debug;
				$tm_nx -- if $tm - $t1 < $t2 - $tm;
			}
		} else { 
			$tm_nx = nelem($smooth_deriv);
		}
	}

	print "FWHM $fwhm, tw $tw, idelta $idelta imin $imin\n" if $debug;
	
	# Use average Tm and FWHM to find Tw and thus imin:
	# my $tw = $fwhm_avg / (2*$k);		# 2k = 3.52549434807817; 
	# my $tm_tw2 = $tm_avg - 2 * $tw;
	# print "First estimates: tm $tm, imin $imin, idelta $idelta\n",
	#	"tw=$tw, tm-tw*2=$tm_tw2\n" if $debug;

	# if ($half_ndx_lo > 0 && $x->at(0) <= $tm_tw2) {
	#	my $tm_tw2_ndx = which($x >= $tm_tw2)->at(0);
	#	my $itm_tw2 = $y->at($tm_tw2_ndx);
	#	my $exp_sq = exp(2);
	#	$imin = $itm - ($itm - $itm_tw2)*($exp_sq + 1)/($exp_sq - 1);
	#	$idelta = 2*($itm - $imin);
	#	print "Use low only: I(tm)=$itm, I(tm_tw*2)=$itm_tw2\n" if $debug;
	# } elsif ($r_hi && ! $r_lo) {
	#	# If hi half is ok but lo half failed, use hi half only
	#	$fwhm	= 2*($t_hm_hi - $tm);
	#	$tw	= $fwhm / (2*$k);
	#	$idelta = 2*($i_hm_hi - $itm);
	#	$imin	= $itm - $idelta/2;
	#	print "Use hi only\n" if $debug;
	# }
	print "Guess estimates: imin $imin, idelta $idelta,  ", 
		"t_hm_lo, hi=$t_hm_lo, $t_hm_hi; Tm avg=$tm, ",
		"fwhm = $fwhm, \n" if $debug;
#	$imin = 0 if $bg_init; # && $first; # $bg_init * exp(-bg_exp*$x->at(0)) 

	my $min_est_denom = 2.0;
	if (! $first && $idelta < $min_delta_y/$min_est_denom) {
		print "STOP GUESS: I delta $idelta < min delta y / ".
			"$min_est_denom =", $min_delta_y/$min_est_denom,
			"\n" if $verbose;
		return { reason =>'Estimated intensity change below threshhold',
			 min_deriv => $min_deriv,
			 max_deriv => $mx_slope_0,
			 discontinuity => \%new_disc, };
	}
	print "I delta $idelta > min delta $min_delta_y / $min_est_denom\n" 
		if $debug;

	my $tmin = $tm - $fwhm / 2;	# Start scans near Tm to find close
	my $tmax = $tm + $fwhm / 2;	# but distinct 2nd transitions
	print "#### Find t range: 1st guess = $tmin to $tmax #######\n" if $debug;

	# Find start and end of T range to be fit. 
	# 1) Smooth derivative over 5 points to reduce noise problems

	print "Find T min: start at $tmin ------\n" if $debug;
	my $nx = 0;

	my $nx_tmin = 0;

	# Start at lowest T if we're below it already, or if there's an
	# exponential background with no lo jumps and I is near bg at T0
	
	if ($tmin <= $x->at(0)
		|| ($first && $bg_init > 1e-10 && ! $skip_low )) {
		#	&& $y->at(0)*1.25 > 
		#	bg_min+($bg_init-$bg_min)*exp(-abs($bg_exp)*$x->at(0)))

		$tmin = $x->at(0);			# Tmin below range?
		print "Tmin set to lowest t = $tmin\n" if $debug;
	} elsif ($tmin_in && $tmin > $tmin_in) {
		# If Tm - FWHM is above old Tmin, use old Tmin 
		print "Tm - FWHM = $tmin > old tmin $tmin_in\n" if $debug;
		$tmin = $tmin_in;
		$nx_tmin = which($x <= $tmin)->at(-1) if $x->at(0) >= $tmin;
	} else {
		# Find beginning of range to be fit: below Tm - FWHM,
		# slope should be low and should go up as T goes up towards Tm.
		# Scan down from T = Tm - FWHM; find y_min, stop when either:
		# a) y > y_min + eps = 0.01 * y_max (high intensity at low T) 
		#    OR 
		# b) dy/dx > slope_min + eps_slope = 0.01 * max_deriv
		#    (2nd transition at low T).
		#	|                      +
		#	|                    ++
		#	|   -- (a)        +++
		# Fluor.|     ---     ++++
		#	|        +++++
		#	|     ---
		#	|   -- (b)
		#	|
		#	|________________________
		#                 Temp
		# OR
		# c) dy/dx stops dropping, i.e. dy/dx > eps_slope * a and
		#    dy/dx(n) - dy/dx(n-1) < eps_slope / b, a,b=2 to 10
		
		# 2) Set up eps and starting point
		
		my $tmin_nx = which( $x >= $tmin )->at(0);
		my $min_slope = $smooth_deriv->at($tmin_nx);
		my $eps_slope = 0.02 * $max_deriv;

		print "Finding Tmin: start with $tmin at $tmin_nx\n" if $debug;
		if ($min_slope < 0) {

			# If slope at Tm - FWHM < 0, something's wrong.
			# Try to fix it by finding the first non-negative slope
			# between Tm -FWHM and Tm.

			print "Slope $min_slope < 0 at $tmin; try higher T\n" 
				if $debug;
			my $slope_nxs = which( 
				$smooth_deriv->slice("$tmin_nx:$tm_nx") >= 
						- $eps_slope*10 );
			print "Found ",nelem($slope_nxs)," slopes > 0 between ".
				"$tmin and $tm\n" if $debug;
			if (nelem($slope_nxs)) {
				$tmin_nx += $slope_nxs->at(0);
				$tmin = $x->at($tmin_nx);
				$min_slope = $smooth_deriv->at($tmin_nx);
				print "  First one is $min_slope at T=$tmin, ".
				"index=$tmin_nx\n" if $debug;
			} else {

				# If there's no positive slope before tm,
				# leave tmin alone and give up.
				$min_slope = 0;
			}
		
		} else {
		
			# Scan down to find Tmin.
			#
			# Initialize y_min to y_max, to be reset in the first iteration
			my $y_min =  max( $y_raw->slice("$half_ndx_hi:-1") );
			my $eps = 0.005*abs($y_min - $imin);
			print "Find Tmin: scan down from $tmin at $tmin_nx, ",
				"slope $min_slope,",
				"eps = $eps, eps slope $eps_slope\n" if $debug;
			if ($debug > 1) {
				my $a = $tmin_nx - 5;
				my $b = $tmin_nx + 5;
				$a = 0 if $a < 0;
				$b = -1 if $b > nelem($smooth_deriv);
				print "Deriv [tmin_nx +-5= $a to $b] = ",
					$deriv->slice("$a:$b"),"\n";
				print "Smooth deriv [tmin_nx +-5= $a to $b] = ",
					$smooth_deriv->slice("$a:$b"),"\n";
			}
				
	
			# 3) Scan down from Tm - FWHM and compare derivatives
		
			my $a = $max_deriv / 10;
			my $b = 10;
			my $n_same_slope = 0;
			my $t_old = $x->at($tmin_nx+1);
			my $old_slope = $smooth_deriv->at($tmin_nx+1);
			for ($nx = $tmin_nx; $nx > 0; $nx --) {
				my $ti = $x->at($nx);
				my $yi = $y->at($nx);
				if ($bg_init > 1e-10 && $bg_exp > 1e-10) {
					$yi -= ($bg_init - $bg_min)*
						exp(-abs($bg_exp)*$ti);
				}
				# Is intensity higher than min. intensity so far?
				if ($yi > $y_min + $eps) {
					print "Stop Tmin scan at T=",$x->at($nx),
						": y $yi > ",$y_min+$eps,
						" = y_min + eps = $y_min + $eps\n" 
						if $verbose || $debug;
					$nx --; # ++; Go back an extra 2 steps
					$nx = 0 if $nx < 0;
					last;
				# } elsif ($yi < $imin - $c*$eps) {
				#	print "Stop Tmin scan at T=",$x->at($nx),
				#		": y $yi < ",$imin-$c*$eps,
				#		" = imin - $c*eps = ",
				#		"$imin - $c * $eps\n" 
				#		if $verbose || $debug;
				#	$nx ++;
				#	last;
				}
				$y_min = $yi if $yi < $y_min;
				my $slope = $smooth_deriv->at($nx);
				print "Ymin $y_min, slope $slope at $nx,(",
					$x->at($nx),", ",$y->at($nx),")  " 
					if $debug > 1;
	
				# If current slope is higher than old slope, check
				# the next slope down (nx-1) too, to avoid 
				# stopping at noise that made it through 2 smooths
				
				if ($slope > $min_slope + $eps_slope &&
				    $smooth_deriv->at($nx-1) > $min_slope+$eps_slope) { 
					print "Stop Tmin scan at T=",$x->at($nx),": ",
						"slope $slope > ",$min_slope+$eps_slope,
						" = min slope $min_slope +",
						"eps slope $eps_slope\n" if $verbose ||
										$debug;
					$nx ++;
					last;
				}

				# Stop if slope >> 0 and nearly constant.
				# For f=f=e^((Tm-T)/Tw), in theory
				# f' = df/dT = -f/Tw, so
				# I  = Imin + Idelta                  / (1+f),
				# I' =        Idelta/ Tw   * f         / (1+f)^2
				# I''=        Idelta/(Tw^2)* (f^3 - f) / (1+f)^4
				#     from
				# I''= Id/Tw*(f'*(1+f)^2-f*((1+f)^2)')/(1+f)^4
				#    = Id/Tw*((-f/Tw)*(1+f)^2-f*2(1+f)*(-f/Tw))/
				#                     (1+f)^4
				#    = Id/(Tw^2)*(-f-2f^2-f^3+2f^2+2f^3)/(1+f)^4
				# I''= I'/Tw * (f^2-1) / (1+f)^2
				#    = I'/Tw * (f-1) / (f+1)
				# so I'' / I' = (f - 1)/(1+f) / Tw
				# At T=Tm, f=1, I'max = Idelta/4Tw, I'' = 0.
				# At T=Tm-Tw, f=e, I'~0.79*I'max,
				#	Tw*I''/I'=(e-1)/(e+1) = 0.46
				# At T<<Tm, f >> 1, I'->0, Tw*I''/I' -> 1.0
				# If I' < 0.79*I'max then Tw*I''/I >= 0.46
				# I'' is (old_slope - slope) / dT so 
				# Tw*((old_slope - slope) / dT)/slope should be
				#         at least (f-1)/(1+f), i.e.
				# (min_slope-slope)/dT > slope*(f-1)/(1+f)/Tw
				# Count as "same slope" if left < 1/b right.
				
				my $dt = $t_old - $ti;
				my $dd = $dt ? ($old_slope - $slope)/$dt : 0;
				my $f = $tw ? exp(($tm - $ti)/$tw) : 1;
				my $theory = $tw ? ($f-1)/((1+$f)*$tw) : 0;
				print "dd =(old_slope - slope) / dt = ( $old_slope - $slope ) / $dt = $dd; f=$f, theory=$theory; ".
					" slope*theory / tw*dd = ".($slope * $theory)." / ".($tw*$dd).
					" = ".($tw*$dd ? ($slope * $theory)/($tw*$dd) : "div by 0")." > $b? slope > $a? ".
					" slope < ".($max_deriv*0.79)."? $dt > 0? \n"
					if $debug > 1;
				if ($slope > $a &&
				    $slope < $max_deriv*0.79 && $dt > 0. &&
				    $tw*$dd < $slope*$theory / $b) {
				    # $slope > $old_slope - $eps_slope / $b
					print "At $ti, d1=$slope, td2=$dd, ",
					    "\n\td2/d1=",($dd/$slope),
					    " theory $theory,",
					    " a, b= $a, $b\n" if $debug;
					$n_same_slope ++;
					if ($n_same_slope > 5) {
						print "Stop Tmin scan: slope ",
						    "$slope too constant\n" 
						    if $debug;
						$nx += 4;
						last;
					}
				} else {
					$n_same_slope = 0;
				}
				$t_old = $ti;
				$old_slope = $slope;
				$min_slope = $slope if $slope < $min_slope;
				
	#			if (abs($slope) > $eps) {
	#				print "Stop scanning for Tmin: |slope=$slope|",
	#					"> eps = $eps\n" if $verbose;
	#				$nx ++;
	#				last;
	#			} elsif ($slope > $old_slope + $eps/2)
	
			}
			$tmin = $x->at($nx);
			$nx_tmin = $nx;
			print "    ### Scan ends at Tmin $tmin at $nx #### \n" if $debug;
		}

		# 3) Check for discontinuity above tmin
		
		# if ($skip_ndx > $nx_min && $tmin < $t_min_skip) 
		if ($t_min_skip > $tmin) {
			$tmin = $t_min_skip;	# $x->at($skip_ndx + 1);
			print "Do not fit below $tmin to avoid discontinuity\n"
				if $verbose;
		} 

	}
	print "   &&&& Found Tmin $tmin &&&& \n" if $debug;
	

	# $debug = 2; ##########

	my $nx_tmax = $n-1;
	if ($tmax >= $x->at(-1)) {
		$tmax = $x->at(-1);			# Tmin below range?
		print "Tmax set to highest t = $tmax\n" if $debug;
	} elsif ($tmax_in && $tmax < $tmax_in) {
		# If Tm + FWHM/2 is below old Tmax, use old Tmax
		print "Tm + FWHM/2 = $tmax < old tmax $tmax_in\n" if $debug;
		$tmax = $tmax_in;
		$nx_tmax = which($x >= $tmax)->at(0) if $x->at(-1) >= $tmax;
	} else {
		# Find end of range to be fit. Fluorescence drops for unknown 
		# reasons (protein aggregation? dye disintegration?) at T's
		# not far above Tm, so stop near Tm + FWHM/2.
		
		# Options: 1) Stop at Tm + FWHM/2 
		#          2) Stop at first slope minimum above Tm + FWHM/2
		# In either case, stop at Tlim or t_skip if either is lower.
		#
		#	|             -
		#	|          --
		#	|       +++
		#	|     ++   --
		#	|    +       --
		#	|   +
		#	|__________________________
		# 
		# If y hits its upper limit at Tlim before the real Tm+FWHM/2, 
		# then the slope will drop to zero over the smoothing window so
		# the upper half max slope point will be within one window of
		# Tlim. Check the unsmoothed y values to be sure Tmax <= Tlim.
		#
		# Also, check for discontinuity in x or y just above Tm, and
		# stop before discontinuity if it's at < Tm + FWHM.

		# 1) Look for first slope minimum or zero above Tm + FWHM/2

		my $min_slope = $smooth_deriv->at($half_ndx_hi);
		my $eps_slope = 0.02 * $max_deriv;
		
		# Go up only another FWHM, to avoid wierd cases
		
		my $upper_limit = $half_ndx_hi + ($half_ndx_hi-$half_ndx_lo);
		$upper_limit = $nx_max if $upper_limit > $nx_max;
		
		if ($half_ndx_hi+1 < $upper_limit) {
		    print "Scan for Tmax between ",$x->at($half_ndx_hi + 1),
		    	" and ",$x->at($upper_limit),
		    	" eps_slope = $eps_slope, min_slope = $min_slope\n"
		    	if $debug;
		    my $old_slope = $smooth_deriv->at($half_ndx_hi);
		    for ($nx = $half_ndx_hi+1; $nx < $upper_limit; $nx ++) {
			my $slope = $smooth_deriv->at($nx);
			print "slope $slope at $nx, (",$x->at($nx),", ",
				$y->at($nx),")\n" if $debug > 1;
			if ($slope < -$eps_slope) {
				$nx += 3;	# take some extra points
						# to force reasonable fit
				$nx = List::Util::min($nx,nelem($x)-1);
				$tmax = $x->at($nx); 
					# if $slope > -($old_slope+2*$eps_slope);
				print "Stop Tmax scan at $tmax: slope $slope ",
					"< -eps_slope $eps_slope\n" if $verbose
					|| $debug;
				last;
			} elsif ($slope > $min_slope + $eps_slope) {
				print "Stop Tmax scan at $tmax: slope $slope ",
					"> ",$min_slope+$eps_slope," = ",
					"min slope $min_slope + eps_slope ",
					"$eps_slope\n" if $verbose || $debug;
				last;
			}
			$min_slope = $slope if $slope < $min_slope;
			$tmax = $x->at($nx);
			$nx_tmax = $nx;
		    }
		} else {
			$nx_tmax = $upper_limit;
			$tmax = $x->at($nx_tmax);
		}
		
		print "Found T max $tmax at $nx_tmax.\n" if $debug;
		
		# 2) Check for discontinuity below tmax
		
		if ($skip_ndx > $nx_min && $skip_ndx < $nx_tmax) {
			$tmax = $x->at($skip_ndx - 1);
			$tmax = $t_max_skip if $t_max_skip;
			print "Stop fitting at $skip_ndx = $tmax ".
				"C to avoid discontinuity\n"if $verbose;
		} 
	}

	print "Guess tm params out: tmin $tmin, tmax $tmax\n" if $debug;

	%result = (	tm	=> $tm,
			FWHM	=> $fwhm,
			i_delta	=> $idelta,
			i_min	=> $imin + $bg_min,
			bg_exp	=> $bg_exp,
			bg_init	=> $bg_init,
			bg_min_flag => $bg_min_flag,
			t_min	=> $tmin,
			t_max	=> $tmax,
			discontinuity => \%new_disc,
			Tm_avg		=> $tm_avg_orig,
			Tm_max_slope	=> $tm_max_orig,
			Tw		=> $tw_orig,
			I_tm		=> $i_tm_orig,
			I_min_calc	=> $i_min_orig,
			max_deriv	=> $mx_slope_0,
			min_deriv	=> $min_deriv,
		  );
	return \%result;
}

# Count maxima in a vector
sub count_maxima {
	my %params = validate( @_, {	x	=> { type => SCALARREF }, 
					max	=> { type => SCALAR, 
						     default => 5 },
					debug	=> { type => SCALAR, 
						     default => 0 },
				} );
	my $x	= $params{'x'};
	my $max	= $params{'max'};
	my $debug = $params{'debug'};
	my $s0 = "0:-2";
	my $s1 = "1:-1";
	# Deltas ~= first derivative of vector
	my $d = $x->slice($s1) - $x->slice($s0);
	my $d0 = $d->slice($s0);
	my $d1 = $d->slice($s1);
	my $cross = 0;
	my $n = nelem($d0);
	for (my $i=0; $i<$n-1; $i++) {
		next if ($d0->at($i) <= 0 || $d1->at($i) > 0);
		$cross ++;
		print "$cross maxima at $i, x=", $x->slice("$i:".($i+2))," d=",
			$d->slice("$i:".($i+1)), "\n" if $debug;
		last if $cross > $max;
	}	
	return $cross;
}


# Get exponential background estimate from 2 points
sub get_exp_bg_from_points {
	my %params = validate( @_, {
					x	=> { type => SCALARREF },
					y	=> { type => SCALARREF },
					nx1	 => { type => SCALAR },
					nx2	 => { type => SCALAR },
				} );
	my $x = $params{'x'};
	my $y = $params{'y'};
	my $nx1 = $params{'nx1'};
	my $nx2 = $params{'nx2'};
	my $x1 = $x->at($nx1);
	my $y1 = $y->at($nx1);
	my $x2 = $x->at($nx2);
	my $y2 = $y->at($nx2);
	return 0 if $y2 <= 0;
	
	# Fit y = bg_init * exp(-bg_exp*x)

	my $bg_exp = ( log($y1) - log($y2) ) / ($x2 - $x1);
	return 0 if $bg_exp <= 0;
	my $bg_init = $y1 * exp( $bg_exp * $x1 );
	my %result = (
			bg_exp	=> $bg_exp, 
			bg_init	=> $bg_init,
			bg_min	=> 0,
			bg_nx2	=> $nx2,
		);
	return \%result;
}


# Get exponential background estimate from 1 point and slopes
sub get_exp_bg_from_slopes {
	my %params = validate( @_, {
					x	=> { type => SCALARREF },
					y	=> { type => SCALARREF },
					deriv	=> { type => SCALARREF },
					nx1	=> { type => SCALAR },
					nx2	=> { type => SCALAR },
					# n	=> { type => SCALAR },
					debug	=> { type => SCALAR,default=>0},
				} );
	my $x = $params{'x'};
	my $y = $params{'y'};
	my $d = $params{'deriv'};
	my $nx1 = $params{'nx1'};
	my $nx2 = $params{'nx2'};
	# my $n = $params{'n'};
	my $debug = $params{'debug'};
	# my $slice1 = "$nx1:".($nx1+$n-1);
	# my $x1 = sum($x->slice($slice1)) / $n;
	# my $y1 = sum($y->slice($slice1)) / $n;
	# my $d1 = sum($d->slice($slice1)) / $n;
	# my $slice2a = $nx2-int($n/2);
	# my $slice2b = $slice2a + $n - 1;
	# my $slice2 = "$slice2a:$slice2b";
	# my $x2 = sum($x->slice($slice2)) / $n;
	# my $d2 = sum($d->slice($slice2)) / $n;

	my $x1 = $x->at($nx1);
	my $y1 = $y->at($nx1);
	my $d1 = $d->at($nx1);
	my $x2 = $x->at($nx2);
	my $d2 = $d->at($nx2);

	# $debug = 1;
	print "Get exp bg from slopes: p1=($x1, $y1, $d1), p2=($x1, , $d2)\n"
		if $debug;
	# Only give estimate from slopes from early and late negative slopes
	return 0 if $d1 >= 0 || $d2 >= 0;

	# Fit       y =   bg_min + (bg_init - bg_min) * exp(-bg_exp*x)
	# and   dy/dx = - bg_exp * (bg_init - bg_min) * exp(-bg_exp*x) 
	#	      = - bg_exp * ( y - bg_min )

	# Use ratio of initial and minimum slopes to calculate decay rate
	# If the late negative slope is steeper (higher magnitude negative)
	# than the initial slope, fake it with a ratio of 1.05 (~100:95) for 
	# initial slope : late slope.

	my $ratio = $d1 / $d2 < 1.01 ? 1.05 : $d1 / $d2;
	my $bg_exp = log($ratio) / ($x2 - $x1);
	my $bg_min  = $y1 + $d1 / $bg_exp;
	$bg_min = -$y1 if $bg_min >= 0;
	my $bg_init = $bg_min + ($y1 - $bg_min) * exp( $bg_exp * $x1 );
	
	my %result = ( 
			bg_exp	=> $bg_exp, 
			bg_init	=> $bg_init,
			bg_min	=> $bg_min,
			bg_nx2	=> $nx2,
			# x0	=> $x1,
			# y0	=> $y1,
			# d0	=> $d1, 
		);
	return \%result;
}


# call gnuplot to fit, calculate residual, and perhaps even plot the fit vs the observed
sub _boltzmann {
	print "Start boltzmann: \@\_=",Dumper @_ ;

	my %params = validate( @_, {	
#					x		=> { type => SCALARREF },
#					y		=> { type => SCALARREF },
#					pooled		=> { type => ARRAYREF },
					peak_count	=> { type => SCALAR },
					min_delta	=> { type => SCALAR },
					file_stem	=> { type => SCALAR },
					name		=> { type => SCALAR	},
					input_file	=> { type => SCALAR	},
					params_file	=> { type => SCALAR	},
					verbose		=> { type    => SCALAR, 
							     default => 0 },
					debug		=> { type    => SCALAR,  
							     default => 0 },
					fit_limit	=> { type    => SCALAR,  
							     default => "1e-5"},
					fit_maxiter	=> { type    => SCALAR, 
							     default => "0"},
					plot		=> { type    => SCALAR, 
							     default => "0"},
					init_params	=> { type => HASHREF },
					sample_name	=> { type    => SCALAR, 
							     default => ""},
					# smooth_window	=> { type => SCALAR,
					#		     default => 15 },
				} );

	# Pull arguments from hash
#	my $x		= $params{'x'};
#	my $y		= $params{'y'};
#	my $pooled	= $params{'pooled'};
	my $verbose	= $params{'verbose'};
	my $debug	= $params{'debug'};
	my $file_stem	= $params{'file_stem'};
	my $name	= $params{'name'};
	my $peak_count	= $params{'peak_count'};
	my $min_delta	= $params{'min_delta'};
	my $input_file	= $params{'input_file'};
	my $fit_limit	= $params{'fit_limit'};
	my $fit_maxiter	= $params{'fit_maxiter'};
	my $params_file	= $params{'params_file'};
	my $plot	= $params{'plot'};
	my $sample_name	= $params{sample_name};
	my $init_params	= $params{'init_params'};
	my $tmin	= $$init_params{'t_min'};
	my $tmax	= $$init_params{'t_max'};
	my $i_min	= $$init_params{'i_min'};
	my $bg_init	= $$init_params{'bg_init'};
	my $i_delta1	= $$init_params{'i_delta_init'};
	my $bg_min_flag	= $$init_params{'bg_min_flag'};
	# my $smooth_window = $params{'smooth_window'};

	print "Start Boltzmann fit, file $file_stem sample name $sample_name\n" if $debug;
	print "Look for sample name:",Dumper %params if $debug;
	print "   Boltzmann plot = '$plot', id1 $i_delta1\n" if $debug;

# 	Overwrite any existing files. 
# 	Use "cd" to get to the right directory, then use variable "base" to get
# 	file names: base=file part of file_stem = infile_samplenumber, 
# 	then use file_stem = ".base."
	
	my ($volume, $path, $filename) = File::Spec->splitpath( $file_stem );
	my $vol_path = File::Spec->catpath($volume, $path);
#	Change backslashes to forward so cd works in gnuplot
      print "   vol_path =  $vol_path\n" if $debug;
	$vol_path =~ s/\\/\//g;
      print "   vol_path => $vol_path\n" if $debug;
	my $cd_command = "cd \"$vol_path\"\n";
	my $base_command = "base=\"$filename\"\n";
	my $fit_command = $base_command;
	my $base = '".base."';
	print "   cd: |$cd_command|\nbase: |$base|\n" if $debug;

#	Get the column number = last directory in file_stem path,
#	for use in superposition plot. 
#	Write a command which can be run from one level up to plot normalized, 
#	smoothed observations from this directory and others to a file.

	my @dirs = File::Spec->splitdir( $path );
	print "Get last item of ".join(", ", @dirs)."=# $#dirs from $path\n" if $debug;
	my $sample_number = $dirs[-2];

	(my $base_command_no_num = $base_command) =~ s/_$sample_number\"$/"/g;
	print "base command no num $base_command_no_num\n" if $debug;
	print "Sample name: $sample_name Number: $sample_number\n" if $debug;
	my $one_level_up = File::Spec->catdir( @dirs[(0..($#dirs - 2)) ] );
	# my $one_up = File::Spec->abs2rel( $one_level_up, $path );
	my $superpose = File::Spec->catfile( $one_level_up, "superpose" );

	my $gp_super_cmd	  = _generate_gnuplot_datafilename( { stem => $superpose, type =>  "smooth_norm", extension =>  ".gp" } );
	my $gp_super_bg_cmd	  = _generate_gnuplot_datafilename( { stem => $superpose, type =>  "smooth_norm_bg", extension =>  ".gp" } );
	my $gp_super_bg_cmd_local = _generate_gnuplot_datafilename( { stem => $file_stem, type =>  "smooth_norm_bg", version => $peak_count, extension =>  ".gp" } );

	my $gp_fit_log		= _generate_gnuplot_datafilename( { stem => $base , type => 'fit' , extension => ".log" } );
	my $gp_graph_ps		= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, extension => ".$plot" } );
	my $gp_graph_2_ps	= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, type =>  "solution", extension =>  ".$plot" } );
	my $gp_graph_3_ps	= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, type =>  "derivative", extension =>  ".$plot" } );
	($volume, $path, my $gp_params_file) = File::Spec->splitpath( $params_file );
	my $gp_fitted		= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, type => "fitted" } );
	my $gp_fit_cmd		= _generate_gnuplot_datafilename( { stem => $file_stem , version => $peak_count, type => "fit", extension => ".gp" },  );
	my $gp_plot_cmd		= _generate_gnuplot_datafilename( { stem => $file_stem , version => $peak_count, type => "plot", extension => ".gp" },  );
	my $gp_plot_cmd2	= _generate_gnuplot_datafilename( { stem => $file_stem , version => $peak_count, type => "plot_solution", extension => ".gp" },  );
	my $gp_plot_cmd3	= _generate_gnuplot_datafilename( { stem => $file_stem , version => $peak_count, type => "plot_derivative", extension => ".gp" },  );
	my $gp_residual		= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, type => "residual" } );
	my $gp_smooth		= _generate_gnuplot_datafilename( { stem => $base , type => "smooth" } );
	my $gp_smooth_smp_num	= _generate_gnuplot_datafilename( { stem => $base , version => "$sample_number", type => "smooth" } );
	my $gp_deriv		= _generate_gnuplot_datafilename( { stem => $base , type => "derivative" } );
	my $gp_smooth_deriv	= _generate_gnuplot_datafilename( { stem => $base , type => "smooth_derivative" } );
	my $gp_residual_initial	= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, type => "residual_initial" } );
	my $gp_variables	= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, type => "variables" } );
	my $gp_data		= _generate_gnuplot_datafilename( { stem => $base } );
	my $gp_deriv_data	= _generate_gnuplot_datafilename( { stem => $file_stem , type => "derivative" } );
	my $gp_background	= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, type => "background" } );
	my $gp_smooth_minus_bg	= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, type => "smooth_minus_bg" } );
	my $gp_smooth_minus_bg_smp_num	= _generate_gnuplot_datafilename( { stem => $base."_$sample_number" , version => $peak_count, type => "smooth_minus_bg" } );

	print "gp params $gp_params_file  gp fitted $gp_fitted\n" if $debug;

	# gnuplot parameters
	my $gp_xlabel	= "Temperature (Celsius)";
	my $gp_ylabel	= "Fluoresence";
	my $gp_deriv_label = "Derivative: dF/dT";
	my $gp_image_width = 640;
	my $gp_image_height = 400;
	my $gp_function	= "b$peak_count";

	open ( GNUPLOT, "|$GNUPLOT") or die "\tCan't open $GNUPLOT, please make sure that gnuplot is in your path! $1";
	open ( FITCMD, ">$gp_fit_cmd") or warn "\tCan't open $gp_fit_cmd! $1";
	if (1) {	# make plot commands whether or not plots are made
		open ( PLOTCMD, ">$gp_plot_cmd") or warn "\tCan't open $gp_plot_cmd! $1";
		open ( PLOTCMD2,">$gp_plot_cmd2") or warn "\tCan't open $gp_plot_cmd2! $1";
		open ( PLOTCMD3,">$gp_plot_cmd3") or warn "\tCan't open $gp_plot_cmd3! $1";
	}
	
#fit b1(x) "y.dat" via "a.dat"
#plot "t_1.dat" using 1:(g1($1)-$2), f1(x), "t_1.dat" to get the residuals....

	print "Opened $GNUPLOT\n" if $debug;

	# Change to sample directory within fit directory
	print GNUPLOT $cd_command;

	# commands sent to gnuplot
	# set up the boltzmann in fit command does the actual fit
	# A single Boltzman equation is:
	#     I = Imin + (Imax-Imin) / (1 + e^((Tm - T) / Tw))
	# where Idelta = Imax - Imin and FWHM = Tw * 3.52549434807817, or:
	#     I = Imin + Idelta / (1 + e^((Tm - T) / FWHM / 3.52549...))
	# To avoid problems with small FWHM, fit (W+0.5) instead of FWHM,
	# then add 0.5 to W to get FWHM

# k = 3.52549434807817

	# if ($i_min && $bg_init) {
	# 	$fit_command = "bg(x) = i_min + bg_init * exp(-abs(bg_exp)*x)\n";
	# } elsif ($bg_init) {
	# 	$fit_command = "bg(x) = bg_init * exp(-abs(bg_exp)*x)\n";
	# } elsif ($i_min) {
	# 	$fit_command = "bg(x) = i_min\n";
	# } else {
	# 	$fit_command = "bg(x) = 0\n";
	# }
		
	$fit_command .= << "EOL";
i_delta1	= 0
bg_init		= 0
bg_exp		= 0
i_min		= 0
tm1		= 0
w1		= 0
k = 2*log(3+2*sqrt(2))
bgexp(x) = bg_init > 1e-10 ? abs(bg_init - i_min) * exp(-abs(bg_exp)*x) : 0
bg(x) = i_min + bgexp(x)
b0(x) = bg(x)

dbg(x) = -abs(bg_exp) * bgexp(x)
db0(x) = dbg(x)
EOL
	my $count = 0;
	my $n_minus_1 = 0;
	while ( $count < $peak_count ) {
		$n_minus_1 = $count;
		$count++;
		$fit_command .= << "EOL";
boltzmann_$count(x) = abs(i_delta$count) / (1.0 + exp((tm$count - x) / ((abs(w$count)+0.5)/k) ))
b$count(x) = b$n_minus_1(x) + boltzmann_$count(x)

dbolt_$count(x) = boltzmann_$count(x)*(1.0-(boltzmann_$count(x) /abs(i_delta$count))) / ((0.5+abs(w$count))/k)
db$count(x) = db$n_minus_1(x) + dbolt_$count(x)
EOL
	}
	my $function_command = $fit_command;
	# $fit_command = $init_command.$fit_command;
	print "Fit from $tmin to $tmax\n" if $debug;
	$fit_command .= << "EOL";
FIT_LIMIT = $fit_limit
FIT_MAXITER = $fit_maxiter
set xrange [*:*]
set yrange [*:*]
set table "$gp_residual_initial"
load "$gp_params_file"
plot "$gp_data" using 1:(\$2 - $gp_function(\$1)) title "$sample_number: $sample_name Initial Residuals" 
unset table

set fit logfile "$gp_fit_log"
fit [$tmin:$tmax] $gp_function(x) "$gp_data" via "$gp_params_file"
save variables "$gp_variables"
update "$gp_params_file"
EOL

#	$fit_command = $bg_command.$fit_command;

	print FITCMD "# Fit command:\n\n$fit_command\n";
	print GNUPLOT $fit_command;

	# This plot command will draw the raw inputs, the fitted curve, and the residual
	my $terminal = 'postscript color portrait';
	if ($plot && $plot !~ /^(1|ps)$/i) {
		$terminal	= "$plot font \"arial\"";
		# if ($plot !~ /^postscript/ && $plot !~ / /) {
			# $gp_graph_ps	=~ s/\.ps$/.$plot/g;
			# $gp_graph_2_ps	=~ s/\.ps$/.$plot/g;
			# $gp_graph_3_ps	=~ s/\.ps$/.$plot/g;
		# }
	}
	print "Plot = '$plot', terminal = $terminal\n" if $debug;

	# Starts of fit, transitions and deriv curve commands

	# if ($plot) 
	if (1) {		# make plot commands whether or not plotting is done
		my $x = rcols( $input_file,  0 , { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' } );
		my $y = rcols( $input_file,  1 , { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' } );
		my $deriv = rcols( $gp_deriv_data,  1 , { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' } );
		my $x_min = min($x);
		my $x_max = max($x);
		my $y_min = min($y);
		my $y_max = max($y);
		my $y_delta = $y_max - $y_min;
		my $y_zero  = $y_min;
		my $extend = 0.10*($y_max - $y_min);
		$y_min -= $extend;
		$y_max += $extend * 3.0;
		my $d_min = min($deriv);
		my $d_max = max($deriv);
		$extend = 0.10*($d_max - $d_min);
		$d_min -= $extend;
		$d_max += $extend * (nelem(which($deriv >= $d_max*0.75)) > 2 ? 4. : 2.);

		my ($values, $params) = rcols($params_file, {PERLCOLS => [0] }, 2);
		my %solution_unsorted = ();
		@solution_unsorted{@$params} = list( $values );
		print "solution: ",Dumper %solution_unsorted;
		my $i_min = exists_or_zero( \%solution_unsorted, 'i_min' );
		my $bg_init = abs(exists_or_zero( \%solution_unsorted, 'bg_init' ));
		my $bg_exp = abs(exists_or_zero( \%solution_unsorted, 'bg_exp' ));
		my $bg = $i_min + 
			($bg_init > 1e-5 ? ($bg_init - $i_min) * exp(-$x*$bg_exp ) : 0);
		my $y_minus_bg =  $y - $bg;
		my $bg_zero = min($y_minus_bg);
		my $bg_delta = max($y_minus_bg) - $bg_zero;

		# Sort solution peaks in order by Tm
		my $sort_result = sort_peaks( { solution => \%solution_unsorted, 
						npeaks	 => $peak_count } );
		my $ndx_ref = $$sort_result{'index'};
		my @ndx = @$ndx_ref;
		# ndx(1) = index of lowest Tm in solutions_unsorted, s.t.
		# solutions_unsorted{'tm$ndx(1)'} = lowest Tm.
		my @order = 1..$peak_count;
		for my $ni (1..$peak_count) { $order[$ndx[$ni]] = $ni };
		print "Peak order: ",join(",",@order),"\n" if $debug;

		
		my $plural = $peak_count > 1 ? 's' : '';
		my $gp_title	= "$sample_name fit with $peak_count Boltzmann curve".
					$plural;
		my $green = "#66CC33";
		my $blue  = "#0011DD";
		my $red   = "#CC3366";
		my $terminal_command = "set terminal $terminal\n";
		my $output_command   = "set output \"$gp_graph_ps\"\n";
		my $preplot_commands = <<"EOL";
set xlabel	"$gp_xlabel"
set border
set xrange [$x_min:$x_max]
unset yzeroaxis
unset xzeroaxis
$gnuplot_grid_command
load "$gp_params_file"
set key top left horizontal samplen 2
EOL
		my $plot_command = << "EOL";
set title	"$gp_title"
set ylabel	"$gp_ylabel"
$preplot_commands
EOL
# i_delta_min	= 0
# i_delta_sum	= 0
# slope_max	= 0
		$gp_title =  "$sample_name with $peak_count transition$plural minus bg";
		my $boltzmann_output_command = "set output \"$gp_graph_2_ps\"\n";
		my $plot_boltzmanns = <<"EOL";
set title	"$gp_title"
set ylabel	"$gp_ylabel"
$preplot_commands
EOL
		$gp_title =  "$sample_name DERIVATIVE with $peak_count transition$plural";
		my $deriv_output_command = "set output \"$gp_graph_3_ps\"\n";
		my $plot_derivs = <<"EOL";
set title	"$gp_title"
set ylabel	"$gp_deriv_label"
$preplot_commands
EOL
		# Make top of superposition commands if they don't yet exist

		print "SUPER: y delta $y_delta bg delta $bg_delta\n" if $debug;
		my $super_commands = <<"EOL";
$base_command_no_num
set xlabel	"$gp_xlabel"
set ylabel	"Normalized $gp_ylabel"
set border
unset yzeroaxis
unset xzeroaxis
$gnuplot_grid_command
set key under horizontal samplen 2
set yrange [0:1]
set pointsize 0.5
EOL
		if ($peak_count == 1 && $y_delta) {
			if (! -e $gp_super_cmd) {
				print "Make new SUPER plot command $gp_super_cmd\n" if $debug;
				$gp_title =  "Smoothed, Normalized Fluorescence";  
				# my $super_output   = "set output \"$gp_super_ps\"\n";
				open SUPER, ">$gp_super_cmd" or warn 
					"Can't open $gp_super_cmd: $!";
				print SUPER <<"EOL";
# Plot superposed smoothed, normalized curves

set title	"$gp_title"
$super_commands
EOL
				print SUPER "plot ";
			} else {
				print "Add to old SUPER plot command $gp_super_cmd\n" if $debug;
				# Reopen existing plot command for append
				open SUPER, ">>$gp_super_cmd" or warn 
					"Can't reopen $gp_super_cmd: $!";
			}
			# Append command to be used by superpostion command one level up
			my $gp_smooth_oneup = File::Spec->catfile( $sample_number,
			       	$gp_smooth_smp_num );
			# Change all \ to / for gnuplot 
			$gp_smooth_oneup =~ s/\\/\//g;
			print "SUPER: add sample number '$sample_number' name '$sample_name' plot from $gp_smooth_oneup\n" if $debug;
			print SUPER <<"EOL";
"$gp_smooth_oneup" using 1:((\$2-$y_zero)/$y_delta) with lines lw 2 title " $sample_number:$sample_name", \\
EOL
			close SUPER;
		}

		if ($bg_delta) {
			# Start superposition with bg subtracted command
			if (! -e $gp_super_bg_cmd) {
				$gp_title =  "Smoothed, Normalized, Background Subtracted Fluorescence";  
				# $super_output   = "set output \"$gp_super_bg_ps\"\n";
				print "Start SUPER smooth-bg cmd = $gp_super_bg_cmd\n" if $debug;
				open SUPER2, ">$gp_super_bg_cmd" or warn 
					"Can't open $gp_super_bg_cmd: $!";
				print SUPER2 <<"EOL";
# Plot superposed smoothed, normalized, background-subtracted curves

set title	"$gp_title"
$super_commands
EOL
				print SUPER2 "plot ";
				close SUPER2;
			}
			# Write plot cmd to superpose with this model of bg subtracted
			my $gp_bg_oneup = File::Spec->catfile( $sample_number, $gp_smooth_minus_bg_smp_num );
			# Change all \ to / for gnuplot 
			$gp_bg_oneup =~ s/\\/\//g;

			print "Plot SUPER smooth-bg local cmd = $gp_bg_oneup\n" if $debug;
			open SUPER3, ">$gp_super_bg_cmd_local" or warn 
					"Can't open $gp_super_bg_cmd_local: $!";
			print SUPER3 <<"EOL";
"$gp_bg_oneup" using 1:((\$2-$bg_zero)/$bg_delta) with lines lw 2  title " $sample_number:$sample_name", \\
EOL
			close SUPER3;
		}

		# Plot the observed and boltzmanns that make up the fitted curve
		# and draw +'s at each Tm with height delta I, arms at Itm spanning FWHM
		my $boltzmann_only = '';
		my $deriv_only = '';
		my $blank = "0 title \" \" with points ps 0";
		my $fit_blank = "$blank, $blank";
		$count = 0;
		while ( $count < $peak_count ) {
			$count++;
			$fit_blank .= ", $blank";
			my $ctext = ($peak_count == 1) ? ' ' : '_'.$order[$count].'  ';
						# chr($count+ord('a')-1)."  ";
			$boltzmann_only = $boltzmann_only . ", boltzmann_$count(x) title \"Trans. $count\" lw 2";
			$deriv_only = $deriv_only . ", dbolt_$count(x) title \"Deriv $count\"";
			my $count2 = $count + $peak_count;
			$plot_command .= << "EOL";
f_mid	= $gp_function(tm$count)
f_low	= f_mid - i_delta$count / 2
f_high	= f_mid + i_delta$count / 2
hw	= (abs(w$count)+0.5)/2
set arrow $count  from tm$count,f_low to tm$count,f_high nohead size (w$count+.5)/2,90 ls 1 lc rgbcolor "$blue" lw 3
set arrow $count2 from tm$count-hw,f_mid to tm$count+hw,f_mid nohead ls 1 lc rgbcolor "$green" lw 3
set label $count sprintf("Tm$ctext %.1f",tm$count) at tm$count,f_mid right offset character -0.25,0.5 front
f_low	= f_high
EOL
# i_delta_min = i_delta$count < i_delta_min ? i_delta$count : i_delta_min
# i_delta_sum = i_delta$count + i_delta_sum
# slope = i_delta$count / (abs(w$count)+0.5)
# slope_max = slope > slope_max ? slope : slope_max
			$plot_boltzmanns .= << "EOL";
f_mid = boltzmann_$count(tm$count) 
f_high = abs(i_delta$count)
hw	= (abs(w$count)+0.5)/2
set arrow $count  from tm$count,0 to tm$count,f_high nohead ls 1 lc rgbcolor "$blue" lw 3
set arrow $count2 from tm$count-hw,f_mid to tm$count+hw,f_mid nohead ls 1 lc rgbcolor "$green" lw 3
set label $count sprintf("Idelta $ctext %.3f",f_high) at tm$count,f_high left offset character 0.25,0.5 front
EOL
# set label $count sprintf("Idelta $ctext %.3f",i_delta$count) at tm$count+(w$count+0.5)/2,i_delta$count/2 right offset character -1,0 front
			$plot_derivs .= << "EOL";
d_high	= dbolt_$count(tm$count)
d_mid	= d_high / 2
hw	= (abs(w$count)+0.5)/2
set arrow $count  from tm$count,0 to tm$count,d_high nohead ls 1 lc rgbcolor "$blue" lw 3
set arrow $count2 from tm$count-hw,d_mid to tm$count+hw,d_mid nohead ls 1 lc rgbcolor "$green" lw 3
set label $count sprintf("FWHM$ctext %.1f",abs(w$count)+0.5) at tm$count-hw,d_mid right offset character -.25,0 front
EOL
		}

		# End of plot commands
# Old range versions:
# plot [*:*] [-i_delta_sum/5:*] "$gp_data" title "Observed" with points lc rgbcolor "gray50", "" using 1:(\$2 > bg(\$1)/2 ? bg(\$1) : 1/0) title "Background" with lines lc rgbcolor "blue", "$gp_smooth" title "Smoothed" with lines lc rgbcolor "black", "" using 1:(\$2 > $gp_function(\$1) / 2 || $gp_function(20) > $gp_function(\$1)/2 ? $gp_function(\$1) : 1/0) title "Fitted" with lines lc rgbcolor "red", "" using 1:(\$2 - $gp_function(\$1)) title "Residual" with lines lc rgbcolor "$green"
# plot [*:*] [-i_delta_sum/5:*] "$gp_data" using 1:(\$2 - bg(\$1)) title "Observed - bg" with points lc rgbcolor "gray50", "$gp_smooth" using 1:(\$2 - bg(\$1)) title "Smoothed - bg" with lines lc rgbcolor "black" $boltzmann_only, $gp_function(x) - bg(x) title "Fitted - bg" with lines lc rgbcolor "red"
# slope_max = slope_max * k / 4
# plot [*:*] [-slope_max*1.5:slope_max*1.5] "$gp_deriv" title "Derivative" with points lc rgbcolor "gray50", "$gp_smooth_deriv" title "Smoothed" with lines lc rgbcolor "black", "" using 1:(\$2-dbg(\$1)) title "Smoothed - bg" with lines lc rgbcolor "$green", d$gp_function(x) title "Fitted" with lines lc rgbcolor "red", dbg(x) with lines lc rgbcolor "blue" title "Deriv bg" $deriv_only

		$plot_command .= << "EOL";
set yrange [$y_min:$y_max] 
plot "$gp_data" title "Observed" with points lc rgbcolor "gray50",  "$gp_smooth" title "Smoothed" with lines lc rgbcolor "black" lw 2, $gp_function(x) title "Fitted" with lines lc rgbcolor "$red" lw 1, "" using 1:(\$2 - $gp_function(\$1)) title "Residual" with lines lc rgbcolor "$green", bg(x) title "Background" with lines lc rgbcolor "blue", $fit_blank
EOL
		$plot_boltzmanns .= <<"EOL";
set yrange [$y_min:$y_max] 
plot "$gp_data" using 1:(\$2 - bg(\$1)) title "Obs. - bg" with points lc rgbcolor "gray50", "$gp_smooth" using 1:(\$2 - bg(\$1)) title "Smooth - bg" with lines lc rgbcolor "black", $gp_function(x) - bg(x) title "Fitted - bg" with lines lc rgbcolor "$red" $boltzmann_only, $blank, $blank
EOL
		$plot_derivs .= <<"EOL";
set yrange [$d_min:$d_max] 
plot "$gp_deriv" title "Obs. Deriv." with points lc rgbcolor "gray50", "$gp_smooth_deriv" title "Smoothed" with lines lc rgbcolor "black" lw 2, d$gp_function(x) title "Fitted" with lines lc rgbcolor "$red" $deriv_only, dbg(x) with lines lc rgbcolor "blue" title "Deriv bg", "" using 1:(\$2-dbg(\$1)) title "Smooth - bg" with lines lc rgbcolor "$green"
EOL
		if ($plot) {
			print GNUPLOT $terminal_command;

			print GNUPLOT $output_command;
			print GNUPLOT $plot_command;
	
			print GNUPLOT $boltzmann_output_command;
			print GNUPLOT $plot_boltzmanns;

			print GNUPLOT $deriv_output_command;
			print GNUPLOT $plot_derivs;

			if ($plot =~ /png/i) {
				print GNUPLOT $svg_terminal_command;

				$output_command 	  =~ s/\.png/.svg/g;
				$boltzmann_output_command =~ s/\.png/.svg/g;
				$deriv_output_command 	  =~ s/\.png/.svg/g;
				print "output command: $output_command\n" if $debug;
				print "boltzmann cmmd: $output_command\n" if $debug;
				print GNUPLOT $output_command;
				print GNUPLOT $plot_command;
		
				print GNUPLOT $boltzmann_output_command;
				print GNUPLOT $plot_boltzmanns;
	
				print GNUPLOT $deriv_output_command;
				print GNUPLOT $plot_derivs;
			}
		}
		$plot_command	 = $function_command.$plot_command;
		$plot_boltzmanns = $function_command.$plot_boltzmanns;
		$plot_derivs	 = $function_command.$plot_derivs;
		print PLOTCMD "# Plot Observed and Fitted data:\n\n$plot_command\n";
		print PLOTCMD2 "# Plot Individual transitions:\n\n$plot_boltzmanns\n";
		print PLOTCMD3 "# Plot Derivatives:\n\n$plot_derivs\n";

		if ($debug) {
			print "Plot terminal: $terminal_command\n";
			print "Plot output: $output_command\n";
			print "Plot command:\n$plot_command";
			print "Plot fit output: $boltzmann_output_command\n";
			print "Plot fit:\n$plot_boltzmanns";
			print "Plot deriv output: $deriv_output_command\n";
			print "Plot deriv:\n$plot_derivs";
		}
	}
	# save the new y_fitted to name_n_fitted.dat
	my $save_fitted = << "EOL";
set xrange [*:*]
set yrange [*:*]
set table "$gp_fitted"
plot "$gp_data" using 1:($gp_function(\$1)) title "$sample_number: $sample_name Fitted"
EOL

	# save the residual y_residual to name_n_residual.dat
	my $save_residual = << "EOL";
set xrange [*:*]
set yrange [*:*]
set table "$gp_residual"
plot "$gp_data" using 1:((\$2 - $gp_function(\$1))) title "$sample_number: $sample_name Residual"
EOL


	# save the background to name_n_background.dat
	my $save_background = << "EOL";
set table "$gp_background"
plot "$gp_data" using 1:(bg(\$1))title "$sample_number: $sample_name Background"
set table "$gp_smooth_minus_bg"
plot "$gp_smooth" using 1:(\$2 - bg(\$1)) title "$sample_number: $sample_name Smoothed minus Background"
EOL


	print "Fit command:\n$fit_command" if $debug;
	print FITCMD "# Save fitted:\n\n$save_fitted\n";
	print FITCMD "# Save residual:\n\n$save_residual\n";
	print GNUPLOT $save_fitted;
	print GNUPLOT $save_residual;
	print GNUPLOT $save_background;

	close (GNUPLOT);
	if ($debug) {
		print "Looking for gp_variables file $gp_variables:\n";
		if (-e $gp_variables) {
			print "\t- found file\n";
		} else {
			print "\t- DID NOT find file\n"
		}
	}

}

sub plot_no_fit {
use PDL;
	my %params = validate( @_, {	
					file_stem	=> { type => SCALAR },
					input_file	=> { type => SCALAR	},
					verbose		=> { type    => SCALAR, 
							     default => 0 },
					debug		=> { type    => SCALAR,  
							     default => 0 },
					name		=> { type    => SCALAR, 
							     default => 'not given'},
					sample_name	=> { type    => SCALAR, 
							     default => ''},
					plot		=> { type    => SCALAR, 
							     default => 'png'},
				} );

	# Pull arguments from hash
	my $verbose	= $params{'verbose'};
	my $debug	= $params{'debug'};
	my $file_stem	= $params{'file_stem'};
	my $input_file	= $params{'input_file'};
	my $name	= $params{'name'};
	my $sample_name	= $params{'sample_name'};
	my $plot	= $params{'plot'};
	print "Start plot no fit, file $file_stem\n" if $debug;
	my $peak_count = 1;

	my ($volume, $path, $filename) = File::Spec->splitpath( $file_stem );
	my $vol_path = File::Spec->catpath($volume, $path);
	$vol_path =~ s/\\/\//g;
	my $cd_command = "cd \"$vol_path\"\n";
	my $base_command = "base=\"$filename\"\n";
	my $base = '".base."';
	print "   cd: |$cd_command|\nbase: |$base|\n" if $debug;

#	Get the column number = last directory in file_stem path,
#	for use in superposition plot. 
#	Write a command which can be run from one level up to plot normalized, 
#	smoothed observations from this directory and others to a file.

	my @dirs = File::Spec->splitdir( $path );
	print "Get last item of ".join(", ", @dirs)."=# $#dirs from $path\n" if $debug;
	my $sample_number = $dirs[-2];

	(my $base_command_no_num = $base_command) =~ s/_$sample_number\"$/"/g;
	print "base command no num $base_command_no_num\n" if $debug;
	print "Sample name: $sample_name Number: $sample_number\n" if $debug;
	my $one_level_up = File::Spec->catdir( @dirs[(0..($#dirs - 2)) ] );
	# my $one_up = File::Spec->abs2rel( $one_level_up, $path );
	my $superpose = File::Spec->catfile( $one_level_up, "superpose" );

	my $gp_super_cmd	  = _generate_gnuplot_datafilename( { stem => $superpose, type =>  "smooth_norm", extension =>  ".gp" } );
	my $gp_super_bg_cmd	  = _generate_gnuplot_datafilename( { stem => $superpose, type =>  "smooth_norm_bg", extension =>  ".gp" } );
	my $gp_super_bg_cmd_local = _generate_gnuplot_datafilename( { stem => $file_stem, type =>  "smooth_norm_bg", version => $peak_count, extension =>  ".gp" } );

	# my $gp_graph_ps		= _generate_gnuplot_datafilename( { stem => $file_stem , version => 1, extension => ".ps" } );
	my $gp_graph_ps		= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, extension => ".$plot" } );
	# my $gp_graph_3_ps	= _generate_gnuplot_datafilename( { stem => $file_stem , version => 1, type =>  "derivative", extension =>  ".ps" } );
	my $gp_graph_3_ps	= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, type =>  "derivative", extension =>  ".$plot" } );
	my $gp_plot_cmd		= _generate_gnuplot_datafilename( { stem => $file_stem , version => $peak_count, type => "plot", extension => ".gp" },  );
	my $gp_plot_cmd3	= _generate_gnuplot_datafilename( { stem => $file_stem , version => $peak_count, type => "plot_derivative", extension => ".gp" },  );
	# my $gp_smooth		= _generate_gnuplot_datafilename( { stem => $file_stem , type => "smooth" } );
	my $gp_smooth		= _generate_gnuplot_datafilename( { stem => $base , type => "smooth" } );
	my $gp_smooth_smp_num	= _generate_gnuplot_datafilename( { stem => $base , version => "$sample_number", type => "smooth" } );
	# my $gp_deriv		= _generate_gnuplot_datafilename( { stem => $file_stem , type => "derivative" } );
	my $gp_deriv		= _generate_gnuplot_datafilename( { stem => $base , type => "derivative" } );
	# my $gp_smooth_deriv	= _generate_gnuplot_datafilename( { stem => $file_stem , type => "smooth_derivative" } );
	my $gp_smooth_deriv	= _generate_gnuplot_datafilename( { stem => $base , type => "smooth_derivative" } );
	my $gp_data		= _generate_gnuplot_datafilename( { stem => $base } );
	my $gp_deriv_data	= _generate_gnuplot_datafilename( { stem => $file_stem , type => "derivative" } );
	my $gp_smooth_minus_bg	= _generate_gnuplot_datafilename( { stem => $base , version => $peak_count, type => "smooth_minus_bg" } );
	my $gp_smooth_minus_bg_smp_num	= _generate_gnuplot_datafilename( { stem => $base."_$sample_number" , version => $peak_count, type => "smooth_minus_bg" } );

	# my $x = rcols( $input_file,  0 , { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' } );
	my $y = rcols( $input_file,  1 , { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' } );
	my $deriv = rcols( $gp_deriv_data,  1 , { EXCLUDE => '/^#/' }, { INCLUDE => '/s*\d/' } );
	# my $x_min = min($x);
	# my $x_max = max($x);
	my $y_min = min($y);
	my $y_max = max($y);
	my $y_delta = $y_max - $y_min;
	my $y_zero  = $y_min;

	# This plot command will draw the raw input only

	my $terminal = 'postscript color portrait';
	if ($plot && $plot !~ /^(1|ps)$/i) {
		$terminal	= "$plot font \"arial\"";
		if ($plot !~ /^postscript/ && $plot !~ / /) {
			$gp_graph_ps	=~ s/\.ps$/.$plot/g;
			$gp_graph_3_ps	=~ s/\.ps$/.$plot/g;
		}
	}
	print "Plot = '$plot', terminal = $terminal\n" if $debug;
	my $gp_xlabel	= "Temperature (Celsius)";
	my $gp_ylabel	= "Fluoresence";
	my $gp_deriv_label = "Derivative: dF/dT";
	open ( GNUPLOT, "|$GNUPLOT") or die "\tCan't open $GNUPLOT, please make sure that gnuplot is in your path! $1";
	my $gp_title	= "No transition found for $sample_name in file $name";
	print GNUPLOT $cd_command;
	print GNUPLOT $base_command;
	print GNUPLOT "set terminal $terminal\n";
	my $preplot_commands = <<"EOL";
set xlabel	"$gp_xlabel"
set border
set xrange [*:*]
unset yzeroaxis
unset xzeroaxis
$gnuplot_grid_command
set key top left horizontal samplen 2
EOL
	my $output_command = "set output \"$gp_graph_ps\"\n";
	my $plot_command = << "EOL";
set title	"$gp_title"
set ylabel	"$gp_ylabel"
$preplot_commands
plot "$gp_data" title "Observed" with points lc rgbcolor "gray50", "$gp_smooth" title "Smoothed" with lines lc rgbcolor "black"
EOL
	$gp_title =  "$sample_name, DERIVATIVE with no transition";
	my $deriv_output_command = "set output \"$gp_graph_3_ps\"\n";
	my $plot_derivs = <<"EOL";
set title	"$gp_title"
set ylabel	"$gp_deriv_label"
plot "$gp_deriv" title "Derivative" with points lc rgbcolor "gray50", "$gp_smooth_deriv" title "Smoothed" with lines lc rgbcolor "black"
EOL
	print GNUPLOT $output_command;
	print GNUPLOT $plot_command;

	print GNUPLOT $deriv_output_command;
	print GNUPLOT $plot_derivs;

	if ($plot =~ /png/) {
		print GNUPLOT $svg_terminal_command;
		$output_command 	  =~ s/\.png/.svg/g;
		$deriv_output_command 	  =~ s/\.png/.svg/g;
		print GNUPLOT $output_command;
		print GNUPLOT $plot_command;

		print GNUPLOT $deriv_output_command;
		print GNUPLOT $plot_derivs;
	}

	close (GNUPLOT);

	# Make top of superposition commands if they don't yet exist

	print "SUPER: y delta $y_delta \n" if $debug;
	my $super_commands = <<"EOL";
$base_command_no_num
set xlabel	"$gp_xlabel"
set ylabel	"Normalized $gp_ylabel"
set border
unset yzeroaxis
unset xzeroaxis
$gnuplot_grid_command
set key under horizontal samplen 2
set yrange [0:1]
set pointsize 0.5
EOL
	if ($y_delta) {
		if (! -e $gp_super_cmd) {
			print "Make new SUPER plot command $gp_super_cmd\n" if $debug;
			$gp_title =  "Smoothed, Normalized Fluorescence";  
			# my $super_output   = "set output \"$gp_super_ps\"\n";
			open SUPER, ">$gp_super_cmd" or warn 
				"Can't open $gp_super_cmd: $!";
			open SUPER2, ">$gp_super_bg_cmd" or warn 
				"Can't open $gp_super_bg_cmd: $!";
			my $super_plot_start_command =<<"EOL";
# Plot superposed smoothed, normalized curves

set title	"$gp_title"
$super_commands
EOL
			$super_plot_start_command .="plot ";
			print SUPER "$super_plot_start_command";
			print SUPER2 "$super_plot_start_command";
		} else {
			print "Add to old SUPER plot command $gp_super_cmd\n" if $debug;
			# Reopen existing plot command for append
			open SUPER, ">>$gp_super_cmd" or warn 
				"Can't reopen $gp_super_cmd: $!";
			open SUPER2, ">>$gp_super_bg_cmd" or warn 
				"Can't reopen $gp_super_cmd: $!";
		}
		# Append command to be used by superpostion command one level up
		my $gp_smooth_oneup = File::Spec->catfile( $sample_number,
			       	$gp_smooth_smp_num );
		$gp_smooth_oneup =~ s/\\/\//g;
		print "SUPER: add sample number '$sample_number' name '$sample_name' plot from $gp_smooth_oneup\n" if $debug;
		my $super_plot_command =<<"EOL";
"$gp_smooth_oneup" using 1:((\$2-$y_zero)/$y_delta) with lines lw 2 title " $sample_number:$sample_name", \\
EOL
		print SUPER $super_plot_command;
		print SUPER2 $super_plot_command;
		close SUPER;
		close SUPER2;
	}

	open ( PLOTCMD, ">$gp_plot_cmd") or warn "\tCan't open $gp_plot_cmd! $1";
	open ( PLOTCMD3,">$gp_plot_cmd3") or warn "\tCan't open $gp_plot_cmd3! $1";
	print PLOTCMD "# Plot Observed data with no transition:\n\n$plot_command\n";
	print PLOTCMD3 "# Plot Derivatives with no transition:\n\n$plot_derivs\n";

	print "done with plot_no_fit\n" if $debug;
	return 0;
}



sub _generate_gnuplot_datafilename {
	my %params = validate( @_ , {
									stem		=> { type => SCALAR },
									type		=> { type => SCALAR, optional => 1, default => ''},
									version		=> { type => SCALAR, optional => 1, default => ''},
									extension	=> { type => SCALAR, optional => 1, default => '.dat' },
									verbose		=> { type => SCALAR, optional => 1, default => 0 },
								} );

	my $stem		= $params{'stem'};
	my $type		= $params{'type'};
	my $version		= $params{'version'};
	my $extension	= $params{'extension'};
	my $verbose		= $params{'verbose'};

	if (grep {defined && length} $version ) {
		$version = "_" . $version;
	}

	if (grep {defined && length} $type ) {
		$type = "_" . $type;
	}


	my $filename = $stem . $version . $type . $extension;
	if ($verbose) {
		# print "### _generate_gnuplot_datafilename() has generated filename is $filename\n";
	}
	return $filename;
}


###############################################################################
#
# sort_peaks - sort peaks by Tm
#
# In = ref. to solution hash returned by tm_fit: tm1,tm2,tm3 ... tmN
# Out = array of indeces in order by Tm
#
################################################################################

sub sort_peaks {
	my %params = validate( @_, { solution	=> HASHREF,
				     npeaks	=> SCALAR } );
	my %solution	= %{$params{'solution'}};
	my $n		= $params{'npeaks'};
#	print "sort peaks n = $n\n";
	my @ndx = (0, 1);
	my %results = ( index => \@ndx, min => 100000 );
	if ($n > 1) {
		my @start = (-100000000);
		foreach my $i (1..$n) {
			push @start, $solution{"tm$i"};
		}
		# Sort numbers from 1 to n in order by Tm 1 to n
#		print "starts: ",join(', ',@start),"\n";
		@ndx = sort {$start[$a] <=> $start[$b]} 0..$n;
#		print "index: ",join(', ',@ndx),"\n";
		$results{'index'} = \@ndx;
	}
#	print "sort peak results: ",Dumper(%results);
	return (\%results);
}
