mfcalc.cpp

Linux/windows 环境下跨平台开发程序

		d_quartile(sr->a_count, sr->a_data, 0L, 0L, &sr->val);
		close_arr_func(sr);
		}
	return sr->val;
}

static double variance(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
	if(sr->a_data && sr->a_count){
		sr->val = calc_variance(sr->a_data, sr->a_count);
		close_arr_func(sr);
		}
	return sr->val;
}

static double stdev(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
	if(sr->a_data && sr->a_count){
		sr->val = sqrt(calc_variance(sr->a_data, sr->a_count));
		close_arr_func(sr);
		}
	return sr->val;
}

static double sterr(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
	if(sr->a_data && sr->a_count){
		sr->val = sqrt(calc_variance(sr->a_data, sr->a_count))/sqrt(sr->a_count);
		close_arr_func(sr);
		}
	return sr->val;
}

static double beta(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
        if(sr->a_data && sr->a_count == 2){
		sr->val = betaf(sr->a_data[0], sr->a_data[1]);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  beta(u, v).");
	return sr->val;
}

static double _gammp(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
        if(sr->a_data && sr->a_count == 2){
		sr->val = gammp(sr->a_data[0], sr->a_data[1]);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  gammp(a, x).");
	return sr->val;
}

static double _gammq(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
        if(sr->a_data && sr->a_count == 2){
		sr->val = gammq(sr->a_data[0], sr->a_data[1]);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  gammq(a, x).");
	return sr->val;
}

static double _betai(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
        if(sr->a_data && sr->a_count == 3){
		sr->val = betai(sr->a_data[0], sr->a_data[1], sr->a_data[2]);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  betai(x, a, b).");
	return sr->val;
}

static double _bincof(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
        if(sr->a_data && sr->a_count == 2){
		sr->val = bincof(sr->a_data[0], sr->a_data[1]);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  bincof(n, k).");
	return sr->val;
}

static double binomdist(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
        if(sr->a_data && sr->a_count == 3){
		sr->val = binomdistf(sr->a_data[0], sr->a_data[1], sr->a_data[2]);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  binomdist(s, n, p).");
	return sr->val;
}

static double normdist(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
	if(sr->a_data && sr->a_count == 3){
		sr->val = norm_dist(sr->a_data[0], sr->a_data[1], sr->a_data[2]);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  normdist(x, mean, SD).");
	return sr->val;
}

static double norminv(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
        if(sr->a_data && sr->a_count == 3) {
		sr->val = distinv(norm_dist,sr->a_data[1], sr->a_data[2], sr->a_data[0], 2.0);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  norminv(p, mean, SD).");
	return sr->val;
}

static double chidist(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
	if(sr->a_data && sr->a_count == 2){
		sr->val = chi_dist(sr->a_data[0], sr->a_data[1], 1.0);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  chidist(x, df).");
	return sr->val;
}

static double chiinv(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
        if(sr->a_data && sr->a_count == 2) {
		sr->val = distinv(chi_dist,sr->a_data[1], 1.0, sr->a_data[0], 2.0);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  chiinv(p, df).");
	return sr->val;
}

static double tdist(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
	if(sr->a_data && sr->a_count == 2){
		sr->val = t_dist(sr->a_data[0], sr->a_data[1], 1.0);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  tdist(x, df).");
	return sr->val;
}

static double tinv(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
        if(sr->a_data && sr->a_count == 2) {
		sr->val = distinv(t_dist,sr->a_data[1], 1.0, sr->a_data[0], 2.0);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  tinv(p, df).");
	return sr->val;
}

static double poisdist(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0.0;
	if(sr->a_data && sr->a_count == 2){
		sr->val = pois_dist(sr->a_data[0], sr->a_data[1], 1.0);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  poisdist(x, mean).");
	return sr->val;
}

static double fdist(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0;
	if(sr->a_data && sr->a_count == 3){
		sr->val = f_dist(sr->a_data[0], sr->a_data[1], sr->a_data[2]);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  fdist(x, df1, df2).");
	return sr->val;
}

static double finv(YYSTYPE *sr)
{
	if(!sr) return 0.0;
	sr->val = 0;
	if(sr->a_data && sr->a_count == 3){
		sr->val = distinv(f_dist,sr->a_data[1], sr->a_data[2], sr->a_data[0], 2.0);
		close_arr_func(sr);
		}
	else yyargserr("Wrong number of arguments\nin call to  finv(p, df1, df2).");
	return sr->val;
}

static double pearson(YYSTYPE *sr1, YYSTYPE *sr2, char *dest)
{
	if(!sr1 || !sr2) return 0.0;
	sr1->val = 0.0;
        if(sr1->a_data && sr1->a_count > 1 && sr2->a_data && sr1->a_count == sr2->a_count){
		sr1->val = sr2->val = d_pearson(sr1->a_data, sr2->a_data, sr1->a_count, dest, curr_data);
		close_arr_func(sr1);		close_arr_func(sr2);
		}
	else yyargserr("Bad arguments in call to function\npearson(range1; range2 [;\"dest\"]).");
	return sr1->val;
}

static double spearman(YYSTYPE *sr1, YYSTYPE *sr2, char *dest)
{
	if(!sr1 || !sr2) return 0.0;
	sr1->val = 0.0;
        if(sr1->a_data && sr1->a_count > 1 && sr2->a_data && sr1->a_count == sr2->a_count){
		sr1->val = sr2->val = d_spearman(sr1->a_data, sr2->a_data, sr1->a_count, dest, curr_data);
		close_arr_func(sr1);		close_arr_func(sr2);
		}
	else yyargserr("Bad arguments in call to function\nspearman(range1; range2 [;\"dest\"]).");
	return sr1->val;
}

static double regression(YYSTYPE *sr1, YYSTYPE *sr2, char *dest)
{
	if(!sr1 || !sr2) return 0.0;
	sr1->val = 0.0;
	if(!(dest)) yyargserr("No destination range in call to function\nregression(range1; range2; \"dest\").");
        if(sr1->a_data && sr1->a_count > 1 && sr2->a_data && sr1->a_count == sr2->a_count){
		sr1->val = sr2->val = d_regression(sr1->a_data, sr2->a_data, sr1->a_count, dest, curr_data);
		close_arr_func(sr1);		close_arr_func(sr2);
		}
	else yyargserr("Bad arguments in call to function\nregression(range1; range2; \"dest\").");
	return sr1->val;
}

static double ttest(YYSTYPE *sr1, YYSTYPE *sr2, char *dest)
{
	if(!sr1 || !sr2) return 0.0;
	sr1->val = 0.0;
        if(sr1->a_data && sr1->a_count > 1 && sr2->a_data && sr2->a_count > 1){
		sr1->val = sr2->val = d_ttest(sr1->a_data, sr2->a_data, sr1->a_count, sr2->a_count, dest, curr_data);
		close_arr_func(sr1);		close_arr_func(sr2);
		}
	else yyargserr("Bad arguments in call to function\nttest(range1; range2[;\"dest\"]).");
	return sr1->val;
}

static double ftest(YYSTYPE *sr1, YYSTYPE *sr2, char *dest)
{
	if(!sr1 || !sr2) return 0.0;
	sr1->val = 0.0;
        if(sr1->a_data && sr1->a_count > 1 && sr2->a_data && sr1->a_count > 1){
		sr1->val = sr2->val = d_ftest(sr1->a_data, sr2->a_data, sr1->a_count, sr2->a_count, dest, curr_data);
		close_arr_func(sr1);		close_arr_func(sr2);
		}
	else yyargserr("Bad arguments in call to function\nftest(range1; range2[;\"dest\"]).");
	return sr1->val;
}

struct init
{
	int f_type;
	unsigned int h_name;
	double (*fnct)(double);
};

static struct init arith_fncts[] = {
	{FUNC2, HashValue((unsigned char*)"pearson"), (double(*)(double))&pearson},
	{FUNC2, HashValue((unsigned char*)"spearman"), (double(*)(double))&spearman},
	{FUNC2, HashValue((unsigned char*)"regression"), (double(*)(double))&regression},
	{FUNC2, HashValue((unsigned char*)"ttest"), (double(*)(double))&ttest},
	{FUNC2, HashValue((unsigned char*)"ftest"), (double(*)(double))&ftest},
	{AFNCT, HashValue((unsigned char*)"variance"), (double(*)(double))&variance},
	{AFNCT, HashValue((unsigned char*)"stdev"), (double(*)(double))&stdev},
	{AFNCT, HashValue((unsigned char*)"sterr"), (double(*)(double))&sterr},
	{AFNCT, HashValue((unsigned char*)"min"), (double(*)(double))&min},
	{AFNCT, HashValue((unsigned char*)"max"), (double(*)(double))&max},
	{AFNCT, HashValue((unsigned char*)"count"), (double(*)(double))&count},
	{AFNCT, HashValue((unsigned char*)"sum"), (double(*)(double))&sum},
	{AFNCT, HashValue((unsigned char*)"mean"), (double(*)(double))&mean},
	{AFNCT, HashValue((unsigned char*)"median"), (double(*)(double))&quartile2},
	{AFNCT, HashValue((unsigned char*)"quartile1"), (double(*)(double))&quartile1},
	{AFNCT, HashValue((unsigned char*)"quartile2"), (double(*)(double))&quartile2},
	{AFNCT, HashValue((unsigned char*)"quartile3"), (double(*)(double))&quartile3},
	{AFNCT, HashValue((unsigned char*)"gmean"), (double(*)(double))&gmean},
	{AFNCT, HashValue((unsigned char*)"hmean"), (double(*)(double))&hmean},
	{AFNCT, HashValue((unsigned char*)"tdist"), (double(*)(double))&tdist},
	{AFNCT, HashValue((unsigned char*)"tinv"), (double(*)(double))&tinv},
	{AFNCT, HashValue((unsigned char*)"poisdist"), (double(*)(double))&poisdist},
	{AFNCT, HashValue((unsigned char*)"fdist"), (double(*)(double))&fdist},
	{AFNCT, HashValue((unsigned char*)"finv"), (double(*)(double))&finv},
	{AFNCT, HashValue((unsigned char*)"gammp"), (double(*)(double))&_gammp},
	{AFNCT, HashValue((unsigned char*)"gammq"), (double(*)(double))&_gammq},
	{AFNCT, HashValue((unsigned char*)"beta"), (double(*)(double))&beta},
	{AFNCT, HashValue((unsigned char*)"betai"), (double(*)(double))&_betai},
	{AFNCT, HashValue((unsigned char*)"bincof"), (double(*)(double))&_bincof},
	{AFNCT, HashValue((unsigned char*)"binomdist"), (double(*)(double))&binomdist},
	{AFNCT, HashValue((unsigned char*)"normdist"), (double(*)(double))&normdist},
	{AFNCT, HashValue((unsigned char*)"norminv"), (double(*)(double))&norminv},
	{AFNCT, HashValue((unsigned char*)"chidist"), (double(*)(double))&chidist},
	{AFNCT, HashValue((unsigned char*)"chiinv"), (double(*)(double))&chiinv},
	{SFNCT, HashValue((unsigned char*)"strlen"), (double(*)(double))&_strlen},
	{SFNCT, HashValue((unsigned char*)"eval"), (double(*)(double))&eval},
	{FNCT, HashValue((unsigned char*)"erf"), errf},
	{FNCT, HashValue((unsigned char*)"erfc"), errfc},
	{FNCT, HashValue((unsigned char*)"sign"), sign},
	{FNCT, HashValue((unsigned char*)"gammaln"), gammln},
	{FNCT, HashValue((unsigned char*)"factorial"), factorial},
	{FNCT, HashValue((unsigned char*)"rand"), rand},
	{FNCT, HashValue((unsigned char*)"srand"), srand},
	{FNCT, HashValue((unsigned char*)"floor"), floor},
	{FNCT, HashValue((unsigned char*)"abs"), fabs},
	{FNCT, HashValue((unsigned char*)"asin"), asin},
	{FNCT, HashValue((unsigned char*)"acos"), acos},
	{FNCT, HashValue((unsigned char*)"atan"), atan},
	{FNCT, HashValue((unsigned char*)"sinh"), sinh},
	{FNCT, HashValue((unsigned char*)"cosh"), cosh},
	{FNCT, HashValue((unsigned char*)"tanh"), tanh},
	{FNCT, HashValue((unsigned char*)"sin"),  sin},
	{FNCT, HashValue((unsigned char*)"cos"),  cos},
	{FNCT, HashValue((unsigned char*)"atan"), atan},
	{FNCT, HashValue((unsigned char*)"log10"), log10},
	{FNCT, HashValue((unsigned char*)"ln"),   log},
	{FNCT, HashValue((unsigned char*)"log"),   log},
	{FNCT, HashValue((unsigned char*)"exp"),  exp},
	{FNCT, HashValue((unsigned char*)"sqrt"), sqrt},
	{0, 0, 0}};

// Store strings in a list
static char **str_list = 0L;
static int n_str = 0;

static char *PushString(char *text)
{
	if(text && text[0]) {
		if(str_list = (char**)realloc(str_list, sizeof(char*)*(n_str+1)))
			str_list[n_str] = strdup(text);
		return str_list[n_str++];
		}
	return 0L;
}

//The symbol table: a chain of `struct symrec'
static symrec *sym_table, *sym_tab_first;

//Rearrange function table with previously used functions in front
void ArrangeFunctions()
{
	symrec *ptr, *ptr1, *ptr2, *next;

	for(ptr = sym_table, ptr1 = ptr2 = 0L; (ptr); ) {
		next = ptr->next;
		if(ptr->name) {
			ptr->next = ptr1;
			ptr1 = ptr;
			}
		else {
			ptr->next = ptr2;
			ptr2 = ptr;
			}
		ptr = next;
		}
	for(sym_table = 0L, ptr = ptr2; (ptr); ){
		next = ptr->next;
		ptr->next = sym_table;
		sym_table = ptr;
		ptr = next;
		}
	for(ptr = ptr1; (ptr); ){
		next = ptr->next;
		ptr->next = sym_table;
		sym_table = ptr;
		ptr = next;
		}
	sym_tab_first = sym_table;
	bRecent = false;
}

// Put arithmetic functions and predifened variables in table
void InitArithFuncs(DataObj *d)
{
	int i;
	symrec *ptr, *next;

	if(d) curr_data = d;
	if(sym_table) {
		for (ptr = sym_table; ptr != (symrec *) 0;){
			if(ptr) {
				next = ptr->next;
				delete (ptr);
				}
			ptr = next;
			}
		sym_table = sym_tab_first = (symrec *) 0;
		}
	for (i = 0; arith_fncts[i].h_name; i++) {
		ptr = putsym (arith_fncts[i].h_name, arith_fncts[i].f_type);
		ptr->fnctptr = (double (*)(...))arith_fncts[i].fnct;
		}
	ptr = putsym(HashValue((unsigned char*)"zdiv"), VAR);		ptr->SetValue(1.0);
	sym_tab_first = sym_table;
}

static void init_table (void)
{
	str_list = 0L;		n_str = 0;
	push_syntax();
}

static void clear_table()
{
	int i;

	if(str_list) {
		for(i = 0; i < n_str; i++) if(str_list[i]) free(str_list[i]);
		free(str_list);		str_list = 0L;		n_str = 0;
		}
	pop_syntax();
}

static symrec *
putsym (unsigned int h_name, int sym_type)
{
	sym_table = new symrec(h_n