/* Copyright (C) 1998-2003 XIAO, Gang of Universite de Nice - Sophia Antipolis
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#include "libwims.h"
/* log(-1) does not make sense in real */
#ifndef NAN
#define NAN log(-1)
#endif
/* Only two decimal points, less than 1 million.
* No check of buffer length which should be at least 12.
* returns the end of buffer. */
char *moneyprint(char *p, double s)
{
char *p1, *p2, buf[16];
int t, t1, t2;
if(s<0) {*p++='-'; s=-s;}
if(s>999999) s=999999;
t
=floor(s
*100+0.5); if(t
>99999999) t
=99999999; if(t
<0) t
=0;
if(t==0) {*p++='0'; *p=0; return p;}
t1=t/100; t2=t%100; p1=buf+10;
for(*p1--=t1%10+'0',t1/=10;t1>0;*p1--=t1%10+'0',t1/=10);
p2=buf+11;
if(t2) {
*p2++='.';
*p2++=t2/10+'0'; t2%=10;
if(t2) *p2++=t2+'0';
}
p1
++; *p2
=0; memmove(p
,p1
,p2
-p1
+1); p
+=p2
-p1
;
return p;
}
/* #define RAND_BUF_SIZE 4096
static char rand_buf[RAND_BUF_SIZE];
*/
/* The trouble here is that httpd does not initialize
* the variable RANDOM.
* So I use time (microseconds) to get a quick solution. */
void init_random(void)
{
int r;
struct timeval t;
/* initstate(1,rand_buf,RAND_BUF_SIZE); */
gettimeofday(&t,NULL);
r=t.tv_usec+t.tv_sec*1000;
if(r<0) r=-r; if(r==0) r=1;
srandom(r);
}
/* gives a double random number between 0 and m */
double drand(double m)
{
double r;
r=((double) random()+(double) random()/(double) RAND_MAX);
return (r/(double) RAND_MAX)*m;
}
/* gives a random integer between 0 and n.
* n maybe floating, but will be rounded */
double irand(double n)
{
int end,r;
if(n==0) return 0;
if(n>0) end=n; else end=-n;
r=(double) random()*end/RAND_MAX;
if(r==n) r--;
if(n>0) return r; else return -r;
}
/* sign of d */
double sign(double d)
{
if(d==0) return 0;
if(d<0) return -1;
else return 1;
}
/* rounding to integer: problem with half-way rounding */
double myround(double d)
{
long int t;
if(d<0) t=d-0.5; else t=d+0.5;
return t;
}
/* log of base 2 */
double mylog2(double d)
{
}
/* sec */
double sec(double d)
/* csc */
double csc(double d)
/* cotangent function */
double cotan(double d)
{
}
/* hyperbolic cotangent */
double cotanh(double d)
{
}
/* factorial of an integer */
double factorial(double d)
{
int i,n; double t;
n=d;
if(n<0 || n!=d) return NAN;
if(n>1000) return HUGE_VAL;
t=1; for(i=1;i<=n;i++) t=t*i;
return t;
}
/* binomial coefficient */
double binomial(double d1,double d2)
{
return factorial(d1)/(factorial(d2)*factorial(d1-d2));
}
/* max and min */
double max(double d1, double d2)
{
if(!isfinite(d1) || !isfinite(d2)) return NAN;
if(d1<d2) return d2; else return d1;
}
double min(double d1, double d2)
{
if(!isfinite(d1) || !isfinite(d2)) return NAN;
if(d1<d2) return d1; else return d2;
}
/* gcd and lcm, not really checking errors. */
double gcd(double n1, double n2)
{
unsigned long long int l1, l2, ll;
if(!isfinite(n1) || !isfinite(n2) || n1<0 || n2<0 ||
n1>1E18 || n2>1E18) return NAN;
l1=n1; l2=n2;
if(l1<l2) {
ll=l1;l1=l2;l2=ll;
}
if(l1==0) return NAN;
while(l2>0) {
ll=l2;l2=l1%l2;l1=ll;
}
return l1;
}
double lcm(double n1, double n2)
{
return n1*n2/gcd(n1,n2);
}
struct {
char *name;
int type;
double val;
double (*f1) (double parm);
double (*f2) (double parm1, double parm2);
} evalname[]={
{"Argch", 1, 0, acosh, NULL},
{"Argsh", 1, 0, asinh, NULL},
{"Argth", 1, 0, atanh, NULL},
{"E", 0, M_E, NULL, NULL},
{"EULER", 0, 0.57721566490153286, NULL, NULL},
{EV_S, 0, 0, NULL, NULL},
{EV_T, 0, 0, NULL, NULL},
{EV_X, 0, 0, NULL, NULL},
{EV_Y, 0, 0, NULL, NULL},
{"Euler", 0, 0.57721566490153286, NULL, NULL},
{"Inf", 0, 1, log, NULL
},
{"NaN", 0, 0, log, NULL
},
{"PI", 0, M_PI, NULL, NULL},
{"Pi", 0, M_PI, NULL, NULL},
{"abs", 1, 0, fabs, NULL
},
{"acos", 1, 0, acos, NULL
},
{"acosh", 1, 0, acosh, NULL},
{"arccos",1, 0, acos, NULL
},
{"arcsin",1, 0, asin, NULL
},
{"arctan",1, 0, atan, NULL
},
{"arctg", 1, 0, atan, NULL
},
{"argch", 1, 0, acosh, NULL},
{"argsh", 1, 0, asinh, NULL},
{"argth", 1, 0, atanh, NULL},
{"asin", 1, 0, asin, NULL
},
{"asinh", 1, 0, asinh, NULL},
{"atan", 1, 0, atan, NULL
},
{"atanh", 1, 0, atanh, NULL},
{"binomial",2, 0, NULL, binomial},
{"ceil", 1, 0, ceil, NULL
}, /* round-up integer */
{"ch", 1, 0, cosh, NULL
},
{"cos", 1, 0, cos, NULL
},
{"cosh", 1, 0, cosh, NULL
},
{"cot", 1, 0, cotan, NULL},
{"cotan", 1, 0, cotan, NULL},
{"cotanh",1, 0, cotanh, NULL},
{"coth", 1, 0, cotanh, NULL},
{"csc", 1, 0, csc, NULL},
{"ctg", 1, 0, cotan, NULL},
{"cth", 1, 0, cotanh, NULL},
{"drand", 1, 0, drand, NULL},
{"e", 0, M_E, NULL, NULL},
{"erf", 1, 0, erf, NULL},
{"erfc", 1, 0, erfc, NULL},
{"euler", 0, 0.57721566490153286, NULL, NULL},
{"exp", 1, 0, exp, NULL
},
{"factorial",1, 0, factorial, NULL},
{"floor", 1, 0, floor, NULL
},
{"gcd", 2, 0, NULL, gcd},
{"irand", 1, 0, irand, NULL},
/* {"j0", 1, 0, j0, NULL}, */ /* Bessel functions */
/* {"j1", 1, 0, j1, NULL}, */
{"lcm", 2, 0, NULL, lcm},
{"lg", 1, 0, log10, NULL
},
{"lgamma",1, 0, lgamma, NULL}, /* log of Gamma function */
{"log", 1, 0, log, NULL
},
{"log10", 1, 0, log10, NULL
},
{"log2", 1, 0, mylog2, NULL},
{"max", 2, 0, NULL, max},
{"min", 2, 0, NULL, min},
{"pi", 0, M_PI, NULL, NULL},
{"pow", 2, 0, NULL
, pow},
{"rand", 1, 0, drand, NULL},
{"randdouble",1, 0, drand, NULL},
{"randfloat",1, 0, drand, NULL},
{"randint",1, 0, irand, NULL},
{"random",1, 0, drand, NULL},
{"randreal",1, 0, drand, NULL},
{"rint", 1, 0, myround, NULL}, /* closest integer */
{"round", 1, 0, myround, NULL}, /* closest integer */
{"sec", 1, 0, sec, NULL},
{"sgn", 1, 0, sign, NULL}, /* sign of the value */
{"sh", 1, 0, sinh, NULL
},
{"sign", 1, 0, sign, NULL}, /* sign of the value */
{"sin", 1, 0, sin, NULL
},
{"sinh", 1, 0, sinh, NULL
},
{"sqrt", 1, 0, sqrt, NULL
},
{"tan", 1, 0, tan, NULL
},
{"tanh", 1, 0, tanh, NULL
},
{"th", 1, 0, tanh, NULL
},
/* {"y0", 1, 0, y0, NULL}, */
/* {"y1", 1, 0, y1, NULL}, */
};
#define evalname_no (sizeof(evalname)/sizeof(evalname[0]))
int get_evalcnt(void) {return evalname_no;}
char *get_evalname(int i) {return evalname[i].name;}
int get_evaltype(int i) {return evalname[i].type;}
int evaltab_verify(void) {return verify_order(evalname,evalname_no,sizeof(evalname[0]));}
int search_evaltab(char *p) {
return search_list(evalname,evalname_no,sizeof(evalname[0]),p);
}
static char *evalue_pt;
int evalue_error;
int get_evalue_error(void) { return evalue_error; }
void set_evalue_error(int e) {evalue_error=e; return;}
/* prepare pointer for evaluation */
void set_evalue_pointer(char *p)
{
evalue_pt=p;
}
/* get position of name in nametable */
int eval_getpos(char *name)
{
return search_list(evalname,evalname_no,sizeof(evalname[0]),name);
}
/* set value to name */
void eval_setval(int pos, double v)
{
if(pos>=0 && pos<evalname_no) evalname[pos].val=v;
}
/* get string pointer (after evaluation) */
char *get_evalue_pointer(void)
{
return evalue_pt;
}
double _evalue(int ord)
{
double d,dd;
int i,k;
char buf[32];
if(evalue_error) return NAN;
d=0;
while(*evalue_pt=='+') evalue_pt++;
if(*evalue_pt==0) return 0; /* empty string */
switch(*evalue_pt) {
case '(':
evalue_pt++; d=_evalue(')');goto vld;
case '|':
if(ord=='|') {
evalue_pt++; return 0;
}
evalue_pt
++; d
=fabs(_evalue
('|'));goto vld
;
case '-':
evalue_pt++; d=-_evalue(6);goto vld;
}
if((128&*evalue_pt)!=0) {/* special character */
k=(*evalue_pt)&255; evalue_pt++;
if(k>=130 && k<140) {
i=(k-130)*200; k=(*evalue_pt)&255; evalue_pt++;
if(k<33 || k>=233) goto badeval;
i+=k-33; if(i<0 || i>=evalname_no) goto badeval;
goto ename;
}
if(k>=140 && k<150) {
i=(k-140)*200; k=(*evalue_pt)&255; evalue_pt++;
if(k<33 || k>=233) goto badeval;
if(ev_var==NULL || ev_varcnt==NULL) goto badeval;
i+=k-33; if(i<0 || i>=*ev_varcnt) goto badeval;
goto vname;
}
evalue_pt++; goto badeval;
}
if(*evalue_pt=='.' || myisdigit(*evalue_pt))
{d
=strtod(evalue_pt
,&evalue_pt
);goto binary
;}
for(i=0;myisalnum(*(evalue_pt+i)) && i<16; i++)
buf[i]=*(evalue_pt+i);
buf[i]=0; evalue_pt+=i;
if(i==0) goto badeval;
if(ev_varcnt!=NULL && ev_var!=NULL && *ev_varcnt>0)
for(i=0;i<*ev_varcnt;i++) {
if(strcmp(buf
,ev_var
[i
].
name)==0) {
vname: d=ev_var[i].value; goto vld;
}
}
i=search_list(evalname,evalname_no,sizeof(evalname[0]),buf);
ename: if(i>=0) switch(evalname[i].type) { /* evaluation of expressions */
case 0: {
d=evalname[i].val;
if(evalname[i].f1!=NULL) {
if(d==0) d=NAN; if(d==1) d=HUGE_VAL;
}
break;
}
case 1: {
if(*evalue_pt!='(') return NAN;
evalue_pt++;
d=evalname[i].f1(_evalue(')')); break;/* evaluation of function */
}
case 2: {
double parm1,parm2;
if(*evalue_pt!='(') return NAN;
evalue_pt++;
parm1=_evalue(',');parm2=_evalue(')');
d=evalname[i].f2(parm1,parm2); break;
}
default: { /* This is impossible. */
return NAN;
}
}
else {
badeval: evalue_error=-1; return NAN;
}
vld:
if(evalue_error) return NAN;
binary: /*evaluation des expressions */
if(*evalue_pt=='!') {
evalue_pt++; d=factorial(d);
}
if(*evalue_pt==ord) {evalue_pt++;goto ok;}/* */
if(*evalue_pt==0 || /* chaine de caractere finie*/
(ord<10 && (*evalue_pt==',' || *evalue_pt==';' || *evalue_pt==')'
|| *evalue_pt=='|')))
goto ok;
switch(*evalue_pt) {
case '+':
if(ord<=8) break;
evalue_pt++; d+=_evalue(8);goto vld;
case '-':
if(ord<=8) break;
evalue_pt++; d-=_evalue(8);goto vld;
case '*':
if(ord<=6) break;
evalue_pt++; d*=_evalue(6);goto vld;
case '/':
if(ord<=6) break;
evalue_pt++; dd=_evalue(6);
if(dd==0) {evalue_error=10;return NAN;}
d/=dd;goto vld;
case '%': {
int di, ddi;
if(ord<=6) break;
evalue_pt++; dd=_evalue(6);
if(dd==0) {evalue_error=10;return NAN;}
di=d; ddi=dd; d=di%ddi;goto vld;
}
case '^': {
if(ord<5) break;
evalue_pt
++; d
=pow(d
,_evalue
(5));goto vld
;
}
default : {
return NAN;
}
}
ok: return d;
}
/* substitute variable names by their environment strings
* The buffer pointed to by p must have enough space
* (defined by MAX_LINELEN). */
char *_substit(char *p)
{
return p;
}
char *(*substitute) (char *p)=_substit;
double checked_eval( char* p)
{
set_evalue_error(0);
set_evalue_pointer(p);
return _evalue(10);
}
/* evalue a string to double */
double strevalue(char *p)
{
char buf[MAX_LINELEN+1];
if(p==NULL) return 0;
mystrncpy(buf,p,sizeof(buf));
substitute(buf); nospace(buf);
if(check_parentheses(buf,0)) {return NAN;}
return checked_eval(buf);
}
/* compile an expression for faster evaluation
* returns -1 if cannot be compiled.
* else returns the number of compilations.
*/
int evalue_compile(char *p)
{
char *p1, *p2, *pe, name[256], buf[8];
int i,k;
k=0;
for(p1=p; *p1; p1++) if((128&*p1)!=0) return -1;
nospace(p);
for(p1=find_mathvar_start(p); *p1; p1=find_mathvar_start(pe)) {
pe=find_mathvar_end(p1);
if(!myisalpha(*p1)) continue;
p2=pe; if(p2-p1>16) continue;
memmove(name
,p1
,p2
-p1
); name
[p2
-p1
]=0;
/* replace the variables by a number
* at most 2000 variables on two characters :
* variable: 140 <= integer <150, number between 33 and 233
* function: 130 <= integer < 140, number between 33 and 233
*/
if(ev_varcnt!=NULL && ev_var!=NULL && *ev_varcnt>0) {
for(i
=0;i
<*ev_varcnt
&& strcmp(name
,ev_var
[i
].
name)!=0;i
++);
if(i<*ev_varcnt && i<2000) {
buf[0]=i/200+140; buf[1]=i%200+33; buf[2]=0;
string_modify(p,p1,p2,"%s",buf);
pe=p1+2; k++; continue;
}
}
i=search_list(evalname,evalname_no,sizeof(evalname[0]),name);
if(i>=0 && i<2000) {
buf[0]=i/200+130; buf[1]=i%200+33; buf[2]=0;
string_modify(p,p1,p2,"%s",buf);
pe=p1+2; k++; continue;
}
}
return k;
}
/* add evaluator (Dominique Bernardi june 2014)
In addition to the general evaluation functions, there is a simple mean
to evaluate standard functions with at most four variables
named "x", "y", "s" and "t". The simplest one is
double eval_simple (char *p, double x, double y, double s, double t);
which does exactly that. In case of multiple evaluation of the same function
for different values of the variable(s), it is possible to speed up a bit
the evaluation by "precompiling" the string to be evaluated.
This precompilation is done by
eval_struct* eval_create (char *p);
which returns a newly allocated pointer to something. One can use
this pointer in functions like
eval_x, eval_t, eval_x_y
When the struct is no longer useful, one can reclaim the memory it used with
void eval_destroy (eval_struct *q);
*/
void _aux (char *q, char *varn, char *subst, int *v)
{
char *pp;
for(pp=varchr(q,varn); pp; pp=varchr(pp,varn))
{
string_modify
(q
,pp
,pp
+strlen(varn
),"%s",subst
);
}
*v = eval_getpos(subst);
}
eval_struct * eval_create (char *in_p)
{
eval_struct
*p
= malloc (sizeof(eval_struct
));
char *q
= malloc(MAX_LINELEN
+1);
_aux (q, "x", EV_X, &p->x);
_aux (q, "y", EV_Y, &p->y);
_aux (q, "s", EV_S, &p->s);
_aux (q, "t", EV_T, &p->t);
evalue_compile(q);
p->texte = q;
return p;
}
double eval_multiple (eval_struct *p, double x, double y, double s, double t)
{
eval_setval(p->x,x);
eval_setval(p->y,y);
eval_setval(p->s,s);
eval_setval(p->t,t);
return checked_eval(p->texte);
}
/* non yet useful
double eval_simple (char *p, double x, double y, double s, double t)
{
eval_struct *q = eval_create (p);
double r = eval (q, x, y, s, t);
eval_destroy(q);
return r;
}
*/
double eval_x (eval_struct *p, double x)
{
eval_setval(p->x,x);
return checked_eval(p->texte);
}
double eval_t (eval_struct *p, double t)
{
eval_setval(p->t,t);
return checked_eval(p->texte);
}
double eval_x_y (eval_struct *p, double x, double y)
{
eval_setval(p->x,x);
eval_setval(p->y,y);
return checked_eval(p->texte);
}
void eval_destroy
(eval_struct
*q
) {free (q
->texte
); free (q
);}