include "ffit.h"

define	NHPAR	4	# number of parameters for a hyperbolic function

# fhyper -- fit a hyperbolic function
#
# Phil Hodge, 10-Apr-90  Task created.
# Phil Hodge, 13-Jan-92  Include options to set X range and give title.
# Phil Hodge,  9-Jul-92  Include option to set X label.

procedure fhyper()

pointer infile		# scr for name of input ascii file
pointer logfile		# scr for name of output log file
pointer device		# scr for name of graphics device
pointer sinit		# string which specifies how to get initial estimates
pointer soption		# specifies what to minimize (squares or abs val)
pointer title		# scr for plot title
pointer xlabel		# scr for X label
pointer ylabel		# scr for Y label
real	ftol		# fractional tolerance for fit
real	xmin, xmax	# range of X values to plot
#--
pointer sp
pointer fnl		# pointer to fitting struct
real	range[NHPAR]	# some measure of the range of the parameters
int	iinit		# get estimates of param values from par file or data
int	ioption		# least squares or minsum
int	tlen		# length of title string
pointer f_fit_init()
real	clgetr()
int	clgwrd(), open(), strlen()
bool	clgetb()
real	f_hyp_funk()	# function to be minimized, e.g. (hyper - values)**2
extern	f_hyp_funk()
real	fcs_hyper()	# function to be plotted (hyperbolic function)
extern	fcs_hyper()

begin
	call smark (sp)
	call salloc (infile, SZ_FNAME, TY_CHAR)
	call salloc (logfile, SZ_FNAME, TY_CHAR)
	call salloc (device, SZ_FNAME, TY_CHAR)
	call salloc (sinit, SZ_FNAME, TY_CHAR)
	call salloc (soption, SZ_FNAME, TY_CHAR)
	call salloc (title, SZ_FNAME, TY_CHAR)
	call salloc (xlabel, SZ_FNAME, TY_CHAR)
	call salloc (ylabel, SZ_FNAME, TY_CHAR)

	# Initialize the curve-fitting struct.
	fnl = f_fit_init (NHPAR)

	call clgstr ("infile", Memc[infile], SZ_FNAME)
	iinit = clgwrd ("init", Memc[sinit], SZ_FNAME, "|par|data|")
	if (iinit < 1)
	    call error (1, "init must be 'par' or 'data'")

	# Find out which parameters are to be fit.
	F_VAR(fnl,1) = clgetb ("fitlocn")
	F_VAR(fnl,2) = clgetb ("fityscale")
	F_VAR(fnl,3) = clgetb ("fitxscale")
	F_VAR(fnl,4) = clgetb ("fitbase")

	ioption = clgwrd ("option", Memc[soption], SZ_FNAME, "|lsq|minsum|")
	if (ioption < 1)
	    call error (1, "option must be 'lsq' or 'minsum'")
	F_OPTION(fnl) = ioption

	ftol = clgetr ("ftol")
	call clgstr ("logfile", Memc[logfile], SZ_FNAME)
	call clgstr ("title", Memc[title], SZ_FNAME)
	call clgstr ("xlabel", Memc[xlabel], SZ_FNAME)
	call clgstr ("ylabel", Memc[ylabel], SZ_FNAME)
	xmin = clgetr ("xmin")
	xmax = clgetr ("xmax")
	call clgstr ("device", Memc[device], SZ_FNAME)

	if (Memc[title] == EOS) {
	    # Default title if none was given.
	    call strcpy ("fhyper ", Memc[title], SZ_FNAME)
	    call strcat (Memc[infile], Memc[title], SZ_FNAME)
	}

	# Create a log file for intermediate values of parameters, etc.
	if (Memc[logfile] == EOS || Memc[logfile] == ' ') {
	    F_LOGFILE(fnl) = NULL
	} else {
	    F_LOGFILE(fnl) = open (Memc[logfile], NEW_FILE, TEXT_FILE)
	    call fprintf (F_LOGFILE(fnl), "%s\n")
		call pargstr (Memc[title])
	}

	# Read the input file to get refoc positions and observed
	# measures of sharpness (or blurriness).  This routine allocates
	# the pointers to the X & Y arrays and fills in values.
	call f_rd_sharp (fnl, Memc[infile])

	# Get initial estimates of parameter values.  This will read values
	# from the par file for parameters that are not to be varied, and
	# the others will either be estimated from the data or gotten from
	# the par file, depending on the value of iinit.
	call f_3h_init (fnl, iinit)

	# Get an estimate of the range of the parameters.
	call f_3h_range (fnl, range)

	# Fit the curve.
	call fcs_fit (fnl, range, ftol, f_hyp_funk)

	# Save the values of the variable parameters in the par file.
	call f_3h_save (fnl)

	# Append the refoc position of center of curve to title,
	# then evaluate the function and plot the curve and data.
	if (Memc[device] != EOS) {
	    call strcat (" --> ", Memc[title], SZ_FNAME)
	    tlen = strlen (Memc[title])
	    call sprintf (Memc[title+tlen], SZ_FNAME, "%0.1f")
		call pargr (F_PAR(fnl,1))
	    call fcs_plot (fnl, Memc[device], Memc[title],
			Memc[xlabel], Memc[ylabel], xmin, xmax, fcs_hyper)
	}

	if (F_LOGFILE(fnl) != NULL)
	    call close (F_LOGFILE(fnl))

	# Free memory.
	call f_fit_free (fnl)
	call sfree (sp)
end

# f_3h_save -- save values in par file
# This routine put the values of variable parameters into the par file.
# The values of fixed parameters were gotten from the par file in the
# first place, and they were not changed, so there would be no point in
# putting them back.

procedure f_3h_save (fnl)

pointer fnl		# i: pointer to fit struct
#--

begin
	if (F_VAR(fnl,1))
	    call clputr ("locn", F_PAR(fnl,1))

	if (F_VAR(fnl,2))
	    call clputr ("yscale", F_PAR(fnl,2))

	if (F_VAR(fnl,3))
	    call clputr ("xscale", F_PAR(fnl,3))

	if (F_VAR(fnl,4))
	    call clputr ("baseline", F_PAR(fnl,4))
end