/* SIMPSTEST.C */
/*-
front end for testing the S interface to the simplex minimizer:
calls <simpS()> and passes input information by use of pointers,
in a form matching call of a C function from S;
*/

#include "simpStest.h"
#include <malloc.h>

/*-
READ_DATA
	READ TITLE, CONTROL VARIABLES, STARTING SIMPLEX, AND DATA FROM INPUT
	MANIPULATION OF INPUT PRIOR TO FITTING SHOULD BE DONE HERE
	INPUT IS FREE-FORM (IE, WITHOUT FIELD WIDTHS),
		BUT THE SEQUENCE OF ENTRIES MUST BE EXACTLY AS BELOW
	MNEMONIC IDENTIFIERS IN THE INPUT ARE DISCARDED BUT MUST BE PRESENT
	THE TITLE SHOULD BE ONE-LINE
*/

int
main(argc, argv)
	int             argc;
	char          **argv;
{
	FILE           *fptr;
	FILE           *fp_out;

	int             i, j;
	int             input_count;
	char            dummy[200];

	extern void     enditall();
	extern void     fmatprint();
	extern void     fqprint();
	extern void     fpprint();
	extern void     fvprint();

	extern double   func();

	int             nvert, nparm, iter, maxquad_skip, prt_cycle, verbose;
	int             ndata, ndatval;
	int             nfree;
	double          exit_test, quad_test;

	char            (*x_ff) ();
	double         *x_p;
	long           *x_nparm, *x_nvert, *x_ndata, *x_ndatval, *x_iter, *x_verbose, *x_prt_cycle, *x_maxquad_skip, *x_q_parmndx;
	double         *x_exit_test, *x_quad_test;
	double         *x_qmat, *x_rms_data, *x_pcent, *x_pcentval, *x_std_dev;
	double         *x_hessian;

	double          pcentval, rmsd;

	double          qmat[NPARM][NPARM];

	fptr = stdin;
	fp_out = stdout;

	/*
	 * read title, nvert, nparm, ndata, ndatval, iter, maxquad_skip,
	 * exit_test, prt_cycle, quad_test
	 */
	fgets(title, sizeof(title) - 1, fptr);
	input_count = 0;
	input_count += fscanf(fptr, "%*s %d", &nvert);
	input_count += fscanf(fptr, "%*s %d", &nparm);
	input_count += fscanf(fptr, "%*s %d", &ndata);
	input_count += fscanf(fptr, "%*s %d", &ndatval);
	input_count += fscanf(fptr, "%*s %d", &iter);
	input_count += fscanf(fptr, "%*s %d", &maxquad_skip);
	input_count += fscanf(fptr, "%*s %lg", &exit_test);
	input_count += fscanf(fptr, "%*s %d", &prt_cycle);
	input_count += fscanf(fptr, "%*s %lg", &quad_test);

	if (input_count != 9) {
		fprintf(fp_out, "simpinput: error in format of input file control values\n");
		enditall();
	}
	if ((nvert <= 0) || (nvert > (NPARM + 1)) ||
	    (nparm <= 0) || (nparm > NPARM) ||
	    (ndata <= 0) || (ndata > NDATA) ||
	    (ndatval <= 0) || (ndatval > NDATVAL) ||
	    (iter < 0) ||
	    (maxquad_skip < 0) ||
	    (exit_test = 0) ||
	    (prt_cycle < 0) ||
	    (quad_test < 0)) {
		fprintf(fp_out, "simpinput: error in value of input file control variable\n");
		enditall();
	}
	nfree = nvert - 1;

	x_p = (double *) calloc((nparm + 1) * (nparm + 1), sizeof(double));
	x_qmat = (double *) calloc(nfree * nfree, sizeof(double));
	x_pcent = (double *) calloc(nparm, sizeof(double));
	x_q_parmndx = (long *) calloc(nfree, sizeof(long));
	x_std_dev = (double *) calloc(nfree, sizeof(double));

	/*
	 * read simplex
	 */
	input_count = 0;
	fscanf(fptr, "%*s");
	for (j = 0; j < nvert; j++) {
		for (i = 0; i < nparm; i++) {
			input_count += fscanf(fptr, "%lg",
					      &(x_p[i * nvert + j]));
		}
	}

	if (input_count != nvert * nparm) {
		fprintf(fp_out, "simpinput: error in format of input file simplex values\n");
		enditall();
	}
	/*
	 * read bounds, if present
	 */
	input_count = 0;
	fscanf(fptr, "%s", dummy);
	if (strncmp(dummy, "parm-bounds", 11) == 0) {
		for (j = 0; j < 2; j++) {
			for (i = 0; i < nparm; i++) {
				input_count += fscanf(fptr, "%lg", &(bounds[j][i]));
			}
		}
		fscanf(fptr, "%*s");
		if (input_count != 2 * nparm) {
			fprintf(fp_out, "simpinput: error in format of input file bounds values\n");
			enditall();
		}
	}
	/*
	 * read data array
	 */
	input_count = 0;
	for (j = 0; j < ndata; j++) {
		for (i = 0; i < ndatval; i++) {
			input_count += fscanf(fptr, "%lg", &(data[j].datval[i]));
		}
	}


	if (input_count != ndata * ndatval) {
		fprintf(fp_out, "simpinput: error in format of input file bounds values\n");
		enditall();
	}
	input_count = 0;
	fscanf(fptr, "%s", dummy);
	if (strncmp(dummy, "verbose", 7) == 0) {
		fscanf(fptr, "%d", &verbose);
	} else {
		verbose = 3;
	}

	nfree = nvert - 1;

	x_ff = (char *) func;
	x_nparm = (long *) &nparm;
	x_nvert = (long *) &nvert;
	x_ndata = (long *) &ndata;
	x_ndatval = (long *) &ndatval;
	x_iter = (long *) &iter;
	x_verbose = (long *) &verbose;
	x_prt_cycle = (long *) &prt_cycle;
	x_maxquad_skip = (long *) &maxquad_skip;
	x_exit_test = (double *) &exit_test;
	x_quad_test = (double *) &quad_test;
	x_pcentval = (double *) &pcentval;
	x_rms_data = (double *) &rmsd;

	simpS(&x_ff, x_p,
	      x_nparm, x_nvert, x_ndata, x_ndatval, x_iter, x_verbose,
	      x_prt_cycle, x_maxquad_skip,
	      x_q_parmndx,
	      x_exit_test, x_quad_test,
	      x_qmat, x_pcent, x_std_dev, x_pcentval, x_rms_data,
	      x_hessian);

	/*
	 * print or set up arrays and vectors with returned data
	 */

	fprintf(fp_out, "\n\npcent.val = %g  rms_data = %g\n", *x_pcentval, *x_rms_data);

	fprintf(fp_out, "\n\nparm array\n");
	for (j = 0; j < nvert; j++) {
		fvprint(fp_out, nparm, &x_p[j * nvert]);
	}

	fprintf(fp_out, "\n\nqmat array\n");
	for (j = 0; j < nfree; j++) {
		for (i = 0; i < nfree; i++) {
			qmat[j][i] = x_qmat[i * nfree + j];
		}
	}
	fmatprint(fp_out, qmat);

	fprintf(fp_out, "\n\nparmndx\n");
	for (i = 0; i < nfree; i++) {
		fprintf(fp_out, "%ld ", x_q_parmndx[i]);
	}
	fprintf(fp_out, "\n");

	fprintf(fp_out, "\n\nstd_dev\n");
	fqprint(fp_out, x_std_dev);

	fprintf(fp_out, "\n\npcent\n");
	fvprint(fp_out, nparm, x_pcent);

	enditall();
	/* NOT REACHED				 */
	return (0);
}				/* END OF READ_DATA			 */



void
fvprint(fptr, nparm, g)
	FILE           *fptr;
	int             nparm;
	double         *g;
{
	int             i;

	for (i = 0; i < nparm; i++) {
		if (i > 0 && (i % 4) == 0)
			fprintf(fptr, "\n  ");
		fprintf(fptr, "%19.10e", g[i]);
	}
	fprintf(fptr, "\n");
}				/* END OF FPPRINT			 */