/*
	Ask for
		Data file, columns	a.dat,1,2
		Equation		sin(a*x)+x^2+b+c*x^3
		Initial values for a,b,c,...
		Output file name
	Write out results, fit, gle file.
*/
#include "all.h"
#include <math.h>
#include <time.h>
int load_data(char *s, int c1, int c2);
#ifdef unix
#define VAXC 1
#endif
#ifdef VAXC
#ifndef unix
#define unlink delete
#endif
#define farfree free
#define farmalloc malloc
#else
#include <alloc.h>
#endif
typedef double real;

void gets_edit(char *ques, char *rslt, char *dflt);
void trap_init(void);
int stringlower(char *s);
int build_equation(char *expr, double pms[], int naz);
int stripspace(char *ss);
int var_find_az(int v_idx[],int *naz);
int v_eval(double *v);
/*---------------------------------------------------------------------------*/
char outfile[255],inputfile[255];
double anstol=1e-4;
char equation[255];
int pnt_alloc(int size);
int col1,col2;
double xmin,xmax;
int gle_debug=0;
#define dbg if (gle_debug>0)
extern char file_name[];
main()
{
	char eqn[200],buff[200],myfile[200],lastone[200];
	char lastdat[200];
	int c1,c2;
	char *s1,*s2;

#ifdef __TURBOC__
	trap_init();
#endif
	lastone_get(lastone,lastdat);
	gets_edit("Input data file (x and y columns optional) ",myfile,lastdat);
	strcpy(lastdat,myfile);
	s1 = strchr(myfile,',');
	c1 = 1; c2 = 2;
	if (s1!=NULL) {
		s2 = strchr(s1+1,',');
		c1 = atoi(s1+1);
		if (s2!=NULL) c2 = atoi(s2+1);
		if (c1==0 || c2==0) printf("Expecting filename.dat,xcol,ycol\n");
		*s1 = 0;
	}
	printf("Loading data from file, %s,  xcolumn=%d, ycolumn=%d\n",myfile,c1,c2);
	col1 = c1; col2 = c2; strcpy(inputfile,myfile);
	load_data(myfile,c1,c2);
	printf("Valid operators: +, -, *, /, ^ (power) \n");
	printf("Valid functions:\n");
	printf("\t abs(), atn(), cos(), exp(), fix(), int()\n");
	printf("\t log(), log10(), not(), rnd(), sgn(), sin()\n");
	printf("\t sqr(), sqrt(), tan()\n");
	printf("\n Enter a function of 'x' using constants 'a'...'z' \n");
	printf(" e.g.\t a + b*x   (standard linear least squares fit) \n");
	printf("     \t sin(x)*a+b \n");
	printf("     \t a + b*x + c*x^2 + d*x^3  \n");
	printf("     \t log(a*x)+(b+x)*c+a \n");
	gets_edit("\nEquation ",eqn,lastone);
	strcpy(lastone,eqn);

	stripspace(eqn);
	strcpy(buff,myfile);
	s1 = strchr(buff,'.');
	if (s1!=NULL) *s1 = 0;
	strcat(buff,".gle");

	gets_edit("Output file name to write gle file ",outfile,buff);
	printf("Precision of fit required, [1e-4] ?"); gets(buff);
	anstol = atof(buff);
	if (anstol==0) anstol = 1e-4;
	strcpy(equation,eqn);
	lastone_save(eqn,lastdat);
	v_polish(eqn);
	dofit();
}
/*---------------------------------------------------------------------------*/
int xyz_alloc;
double *pntx;
double *pnty;
FILE *fp;
int nxy;
int32 npnts;
pnt_alloc(int size)
{
	void *d,*dd;
	if (size+10<xyz_alloc) return;
	size = size*2;
	d = farmalloc(size*sizeof(double));
	dd = farmalloc(size*sizeof(double));
	if (dd==NULL) printf("Unable to allocate storage for data %d\n",size*sizeof(double));
	if (d==NULL) printf("Unable to allocate storage for data %d\n",size*sizeof(double));
	if (d==NULL || dd==NULL) exit(1);
	if (xyz_alloc>0) memcpy(d,pntx,xyz_alloc*sizeof(double));
	if (xyz_alloc>0) memcpy(dd,pnty,xyz_alloc*sizeof(double));
	farfree(pntx); farfree(pnty);
	pnty = dd;
	pntx = d;
	xyz_alloc = size;
}
static char buff[2001];
load_data(char *fname,int c1, int c2)
{
	double v;
	char *s;
	FILE *df;
	int i,nd,nc,gotx,goty;
	int done_err;
	done_err = false;
	xmin = 10e10;
	xmax = -10e10;
	pnt_alloc(30);

	df = fopen(fname,"r");
	if (df==NULL) {
		printf("Unable to open data file %s \n",fname);
		exit(1);
	}
	nd = 0;
	for (;!feof(df);) {
	  if (fgets(buff,2000,df)!=NULL) {
		if (strchr(buff,'!')!=NULL) *strchr(buff,'!') = 0;
		gotx = goty = false;
		s = strtok(buff," \t\n,");
		for (nc=1;s!=NULL;nc++) {
		    v = atof(s);
		    pnt_alloc(nd);
		    if (isdigit(*s) || *s=='-' || *s=='+' || *s=='.') {
			if (nc==c1) {pntx[nd] = v; gotx = true;}
			if (nc==c2) {pnty[nd] = v; goty = true;}
		    } else if (*s != '*') gprint("Not a number {%s} \n",s);
		    s = strtok(NULL," \t\n,");
		}
		if (gotx && goty) {
			if (pntx[nd]>xmax) xmax = pntx[nd];
			if (pntx[nd]<xmin) xmin = pntx[nd];
			nd++;
		}
	  }
	}
	fclose(df);
	nxy = nd;
}
/*---------------------------------------------------------------------------*/
int v_idx[26], naz;
int32 cpcode[200];
v_polish(char *exp)
{
	int cp,vtype,vidx,ddok,ssok;
	int plen,i;
	vtype = 1;

	for (i=0;i<26;i++) v_idx[i] = -1;
	polish(exp,(char *) cpcode,&plen,&vtype);
	var_find_az(v_idx,&naz);
	naz = 1;
	for (i=0;i<'x'-'a'; i++) {
		if (v_idx[i]>0) naz = i+1;
	}	
}

double evalfn(double x,double p[]);
double myfunc(double p[]);
int powell(double p[],double **xi, int n,double ftol, int *iter, 
	double *fret, double (*func)());


double **matrix(int a, int b, int c, int d);
static double pms[28];	
double rr_fit;
dofit()
{
	FILE *fp;
	static double **xi;
	int i,j;
	int niter=0;
	double fret=0;

	xi = matrix(1,naz,1,naz);
	for (i=1;i<=naz;i++) for (j=1;j<=naz;j++) xi[i][j] = 0;
	for (i=1;i<=naz;i++) xi[i][i] = 1;
	for (i=1;i<=naz;i++) {
		printf("Initial value for constant %c [1.0] ? ",i+'a'-1); gets(buff);
		if (strlen(buff)==0) strcpy(buff,"1");
		pms[i] = atof(buff);	
	}
	powell(pms,xi,naz,anstol,&niter,&fret,myfunc);
	for (i=1;i<=naz;i++) printf("%c = %g ",i+'a'-1,pms[i]);
	printf("\n");

	build_equation(equation,pms,naz);
	stringlower(equation);
	printf("%d Iterations, sum of squares divided by nvalues,  %g\n",niter,(double) fret);
	test_fit();
	printf("y = %s\n",equation);

	fp = fopen(outfile,"w");
	fprintf(fp,"size 24 18\n");
	fprintf(fp,"begin graph\n");
	fprintf(fp,"\tsize 24 18\n");
	fprintf(fp,"\ttitle \"y = %s, r^2 = %4.2f%%\" hei .4\n",equation,rr_fit);
	fprintf(fp,"\tdata %s d1=c%d,c%d \n",inputfile,col1,col2);
	fprintf(fp,"\td1 marker dot \n");
	fprintf(fp,"\tlet d2 = %s from %g to %g step %g \n",equation,xmin,xmax,(xmax-xmin)/100.0);
	fprintf(fp,"\td2 line \n");
	fprintf(fp,"end graph\n");
	fclose(fp);
}
test_fit()
{
	int i,j;
	static int count;
	double v,sumy,sumy2,sumfy,sumfy2,meany,meanfy,rr,yy,fyy,sum1,sum2
		,sum3,y,fy;

	sumy = sumy2 = sumfy = sumfy2 = 0;
	for (i=0;i<nxy;i++) {
		var_set(v_idx['x'-'a'],pntx[i]);
		v_eval(&v);
		sumfy = sumfy + v;
		sumy = sumy + pnty[i];
	}
	if (nxy==0) printf("No data points \n");
	meany = sumy/nxy;
	meanfy = sumfy/nxy;
	
	sum1 = 0; sum2 = 0; sum3 = 0;
	for (i=0;i<nxy;i++) {
		var_set(v_idx['x'-'a'],pntx[i]);
		v_eval(&fy);
		y = pnty[i];
		fyy = v-meanfy;
		yy = pnty[i]-meany;
		sum1 = sum1 + (y-fy)*(y-fy);
		sum2 = sum2 + (y-meany)*(y-meany);
	}
	
	rr = 1- (sum1/sum2);
	rr = 100*rr;
	printf("r^2 = %4.2f%%\n",rr);
	rr_fit = rr;
	/* r^2=100*( 1 - (sum of (y-yf)^2)/(sum of (y-ymean)^2) ) */
}
double myfunc(double p[])
{
	int i,j;
	static int count;
	double tot=0,v;
	for (j=0;j<naz;j++) {
		if (v_idx[j]>=0) var_set(v_idx[j],p[j+1]);
	}
	for (i=0;i<nxy;i++) {
		var_set(v_idx['x'-'a'],pntx[i]);
		v_eval(&v);
		tot = tot + (fabs(pnty[i] - v))*(fabs(pnty[i] - v));
	}
	if (nxy==0) printf("No data points \n");
	tot = tot/nxy;
	if (count/20==count/20.0) {
		printf("%d evaluations, ",count);
		for (i=1;i<=naz;i++) {
			printf("%g ",pms[i]);
		}
		printf(", fit = %g \n",tot);
	}		
	count++;
	/* printf("Evaluate fit = %g\n",tot); */
	return tot;
}
v_eval(double *v)
{
	int cp,vtype,vidx,ddok,ssok,j;
	char outstr[30];
	vtype = 1;
	cp = 0;
	eval(cpcode,&cp,v,outstr,&vtype);
}
gle_abort(char *s)
{
	printf("Abort {%s} \n",s);
	exit(1);
}
getch(){}
stripspace(char *ss)
{
	char *s=ss;
	for (;*s != 0;s++) {
		if (*s != ' ') *ss++ = *s;
	}
	*ss++ = 0;
}
build_equation(char *expr, double pms[], int naz)
{
	static char inbuff[200];
	static char *tk[500];
	static char tkbuff[500],answer[300];
	static int ntk,ct,i,c;
	char *space_str=" ";
	static char buff[50];
	if (tk[400]==NULL) for (i=0;i<500;i++) tk[i] = space_str;
	answer[0] = 0;
	ntk = 0; 
	token_norm();
	token(expr,tk,&ntk,tkbuff);
	token_space();
	for (ct=1; ct<=ntk; ct++) {
		if (strlen(tk[ct])==1)  {
			c = *tk[ct] - 'A';
			if (c>=0 && c<23) {
				sprintf(buff,"%g",pms[c+1]);
				strcat(answer,buff);
				continue;
			}
		}
		if (*tk[ct] != ' ') strcat(answer,tk[ct]);
	}
	strcpy(expr,answer);
}
stringlower(char *s)
{
	for (;*s != 0;s++) *s = tolower(*s);
}

/* dummy routines for eval and polish */
g_get_type(){}
g_get_xy(){}
g_measure(){}
tex_xend(){}
graph_xgraph(){}
tex_yend(){}
graph_ygraph(){}
pass_marker(){}
pass_font(){}
pass_color(){}

lastone_save(char *s,char *sdat)
{
	FILE *f;
	unlink("fitls.eqn");
	f = fopen("fitls.eqn","w");
	if (f==NULL) {printf("Couldn't save eqn in FITLS.EQN\n"); return;}
	fprintf(f,"%s\n",s);
	fprintf(f,"%s\n",sdat);
	fclose(f);
}
lastone_get(char *s, char *sdat)
{
	FILE *f;
	char *ss;
	f = fopen("fitls.eqn","r");
	if (f==NULL) goto dflt;
	fgets(s,200,f);
	ss = strchr(s,'\n');
	if (ss!=NULL) *ss = 0;
	if (fgets(sdat,200,f)==NULL) goto dflt2;
	ss = strchr(sdat,'\n');
	if (ss!=NULL) *ss = 0;
	fclose(f);
	if (strlen(sdat)==0) goto dflt2;
	return;
dflt:
	strcpy(s,"a+b*x");
dflt2:
	strcpy(sdat,"test.dat,1,2");
	return;
}
void gets_edit(char *ques, char *rslt, char *dflt)
{
#ifdef __TURBOC__
	strcpy(rslt,dflt);
	printf("%s? %s",ques, dflt);
	read_cmd(rslt); printf("\n");
#else
	printf("%s[%s] ? ",ques,dflt);
	gets(rslt);
	if (strlen(rslt)==0) strcpy(rslt,dflt);
#endif
}
#ifdef __TURBOC__
/*----------------------handle floating point errors ------*/
#include <assert.h>
#include <signal.h>
#include <float.h>
#include <conio.h>
#include <bios.h>

#define false 0
#define true (!false)

void exitcode(int i,int j);
void exitcode_c(int i,int j);
void exitcodef(int i, int j);
void trap_init(void)
{
	signal(SIGFPE,exitcodef);
/*	signal(SIGABRT,exitcode);
	signal(SIGILL,exitcode);
	signal(SIGINT,exitcode);
	signal(SIGSEGV,exitcode);
	signal(SIGTERM,exitcode);
*/

}
void exitcode(int i, int j)
{
	printf("Normal error \n");
	abort();
}
void exitcodef(int i, int j)
{
	if (j==FPE_ZERODIVIDE) printf("Floating Divide by zero \n");
	else if (j==FPE_INTDIV0) printf("Interger Divide by zero \n");
	else if (j==FPE_OVERFLOW) printf("Numeric overflow \n");
	else if (j==FPE_UNDERFLOW) printf("Numeric underflow \n");
	else if (j==FPE_INEXACT) printf("Numeric inexact \n");
	else printf("Floating point Exit handler called\n");
	trap_init();
	return 0;
}

/*-------------------------------------- input line with editing -----*/
enum {eup=200,edown,eleft,eright,epagedown,epageup,edelline
	,edeleol,eescape,eendoffile,etopoffile,edelright
	,eselect,ecut,ecopy,emark,epaste,emove
	,eeol,ebol,eword,ebword,ereturn,etrace
	,eblockread,eblockwrite
	,ehelp,edelete,eundelline,esearch,esearchreplace,efindnext
	,esaveas,esave,eload,equit,edrawit,egraphmenu,eshowerror,egold
	,eundeleol,eexitnow,eshell,eedt,efast};

int read_cmd(char *s)
{
	int c,cx=0,i;
	char mbuff[80];
	cx = strlen(s);
	for (;;) {
	 c = text_inkey();
	 if (c==' ' && cx == strlen(s)) {
		scr_left(cx);
		for (i=0;i<cx;i++) putch(' ');
		scr_left(cx);
		*s = 0; cx = 0;
	 } else
	 switch (c) {
	   case eescape: /* ESCAPE */
	   case equit: /* control c */
		return true;
	   case epageup:
		return epageup;
	   case epagedown:
		return epagedown;
	   case eleft: /* left */
		if (cx <= 0) break;
		cx--;
		scr_left(1);
		break;
	   case eright: /* right */
		if (cx >= strlen(s)) break;
		cx++;
		scr_right(1);
		break;
	   case eup: /* arrow up */
	   case edown: /* arrow down */
	  case ehelp: /* f1 help */
		break;
	  case ereturn: /* carriage return */
		return false;
	  case edelete: /* delete */
		if (strlen(s)==0) break;
		if (cx<1) break;
		ncpy(mbuff,s,cx-1);
		strcat(mbuff,s + cx);
		strcpy(s,mbuff);
		cx--;
		scr_left(1);
		cputs(s + cx);
		putch(' ');
		scr_left(strlen(s+cx)+1);
		break;
	  case eshowerror:
	  case edrawit:
		break;
	  default: /* normal key */
		if (c<26  && c!=9) {fner("Key has no affect"); break;}
		if (c>200)  fner("Unimplemented command");
		else {
			ncpy(mbuff,s,cx);
			mbuff[cx] = c; mbuff[cx+1] = 0;
			strcat(mbuff,s + cx);
			strcpy(s,mbuff);
			cputs(s + cx);
			cx++;
			scr_left(strlen(s+cx));
		}
		break;
	   }
	 }
}





/*------------ inkey stuff */

struct keymatch {int m; int val;};
/* commands using hi 8 bits of bios, e.g. arrow keys */
struct keymatch kmatch1[] = {
	0x0e, edelete,
	0x4d, eright,
	0x4b, eleft,
	0x48, eup,
	0x53, edelright,
	0x50, edown,
	0x4a, edelline,
	0x3b, ehelp,
	0x3c, esave,
	0x3d, eload,
	0x3e, esaveas,
	0x3f, eshowerror,
	0x43, egraphmenu,
	0x44, edrawit,
	0x49, epageup,
	0x51, epagedown,
	0x47, ebol,
	0x4f, eeol,
	0,0
};
/* Normal key and ^ commands  commands */
struct keymatch kmatch2[] = {
	13, ereturn,
	3, equit,
	4, eword,
	5, eshowerror,
	8, ehelp,
	19, eshell,
	20, etrace,
	12, efindnext,
	21, eundelline,
	25, edelline,
	26, eescape,
	27, eescape,
	0,0
};
/* Control K commands */
struct keymatch kmatch3[] = {
	'b', eselect,
	'v', emove,
	'k', emark,
	'c', ecopy,
	'y', ecut,
	'u', epaste,
	'p', epaste,
	'r', eblockread,
	'w', eblockwrite,
	'm', egraphmenu,
	'l', eload,
	'd', edrawit,
	's', esave,
	'x', equit,
	0,0
};
/* Control Q commands */
struct keymatch kmatch4[] = {
	'f', esearch,
	'c', eendoffile,
	'r', etopoffile,
	0,0
};

text_inkey()
{
	int cc,i,c1,c2,ff;
loop1:	cc = bioskey(0);
	ff = bioskey(2);
	c1 = (cc & 0xff00)>>8;
	c2 = (cc & 0xff);
	if (c1==45 && ((ff & 8)>0) ) return eexitnow;
	for (i=0;kmatch1[i].m!=0;i++)
		if (kmatch1[i].m==c1) return kmatch1[i].val;

	switch(c2) {
	  default:
	    for (i=0;kmatch2[i].m!=0;i++)
		if (kmatch2[i].m==c2) return kmatch2[i].val;
	    break;
	  case 17:
	    fner("^Q  F=Find string,  R=Top of file,  C=End of file");
	    cc = bioskey(0);
	    c2 = (cc & 0xff);
	    if (c2<32) c2 = c2 + 'a' - 1;
	    c2 = tolower(c2);
	    for (i=0;kmatch4[i].m!=0;i++)
		if (kmatch4[i].m==c2) return kmatch4[i].val;
	    fner("Unrecognized Quick movement command");
	    goto loop1;
	  case 11:
	    fner("^K  B=begin block,  P=Paste,  Y=Cut,  K=End block");
	    cc = bioskey(0);
	    c2 = (cc & 0xff);
	    if (c2<32) c2 = c2 + 'a' - 1;
	    c2 = tolower(c2);
	    for (i=0;kmatch3[i].m!=0;i++)
		if (kmatch3[i].m==c2) return kmatch3[i].val;
	    fner("Unrecognized block command");
	    goto loop1;
	}
	return c2;
}

scr_left(int i)
{
	gotoxy(wherex()-i,wherey());
}
scr_right(int i)
{
	gotoxy(wherex()+i,wherey());
}
void fner(char *s)
{
	printf("%s\n",s);
}

#endif
