/************************************************************************* * * * TOOLS TO COMPILE AND EVALUATE USER DEFINED FUNCTIONS * * (by their equation - Example "2*sin(x)/x -7*x") * * * * By Alain Reverchon, 1989, France [BIBLI 14] * * ---------------------------------------------------------------------- * * * * English version adapted to Visual C++ by J-P Moreau, Paris, * * june 1997. * * (www.jpmoreau.fr) * *************************************************************************/ #include "armath.h" // header to compile a function f(x) or f(t) // with optional use of polymorphe type ar_nombre // (integer, rational p/q or real). #include #include int ar_glob_dim = 3; static char mem_f [2000]; static char mem_g [2000]; ar_fonction ar_glob_f = {mem_f, 2000}; ar_fonction ar_glob_g = {mem_g, 2000}; double ar_glob_x, ar_glob_y; double ar_glob_tab_y [10]; /************************************************************************ * EVALUATE A PREANALYZED FUNCTION * * --------------------------------------------------------------------- * * INPUTS : f : Current pointer to formula to be analyzed * * ar_val_var : Function giving the value of a variable from * * its number * * --------------------------------------------------------------------- * * OUTPUTS : Valeur fn: Double corresponding to value of function. * * --------------------------------------------------------------------- * * EXPLANATION: The core of this analyze is the RECURSIVE function * * evalue(), with void parameter, AND only two local variables. * * The main variable used by this function is form_cur, current pointer * * to the formula to evaluate. * * This pointer always goes from left to right in the formula, * * it never goes backward, to improve rapidity. * * This is made possible by the form of the analyzed function. * ************************************************************************/ /**************************************************************** * LOCAL VARIABLES (TO FUNCTION, BUT DECLARED STATIC) * ****************************************************************/ double (*ar_val_fn) (int); // Function value of the variable char *ar_form_cur; // Current pointer in formula to analyze static int i, j; static double s; /*----------------------------------------------------------------------- CAUTION: The use of global variables in a recursive function allows to increase the recursivity deepness for a given stack size, but user must be very cautious: After each call to the function, one must not forget that every variable might have been modified. ------------------------------------------------------------------------*/ /*************************************************************** * MAIN RECURSIVE EVALUATION FUNCTION * ***************************************************************/ double ar_evalue (void) { double r; // these two variables (r and oper) MUST char oper; // be local ones. switch (*(ar_form_cur++)) { //------------------------------------- Case constants case 'C' : r = * (double *) ar_form_cur; ar_form_cur += sizeof (double); return (r); //-------------------------------------- Case variables case 'V' : r = (* ar_val_fn) (* (int *) ar_form_cur); if (errno) return (0); ar_form_cur += sizeof (int); return (r); //---------------------------- Case binary operations case 'B' : oper = * (ar_form_cur ++); r = ar_evalue (); if (errno) return (0); switch (oper) { case '+' : return (r + ar_evalue ()); case '-' : return (r - ar_evalue ()); case '*' : return (r * ar_evalue ()); case '/' : s = ar_evalue (); if (fabs (s) < 1e-20) errno = AR_OUI; if (errno) return (0); return (r / s); case '^' : s = ar_evalue (); if (errno) return (0); return (pow (r, s)); default : errno = AR_OUI; // Operation NOT valid return (0); } //----------------------------- Case unary operations case 'U' : oper = * (ar_form_cur ++); r = ar_evalue (); if (errno) return (0); switch (oper) { case FMOINS : return (- r); case FPLUS : return (r); case FABS : return (fabs (r)); case FINT : return (floor (r)); case FFRAC : return (r - floor (r)); case FSQRT : return (sqrt (r)); case FEXP : return (exp (r)); case FLOG : return (log (r)); case FSIN : return (sin (r)); case FCOS : return (cos (r)); case FTAN : return (tan (r)); case FSH : return (sinh (r)); case FCH : return (cosh (r)); case FTH : return (tanh (r)); case FARCSIN : return (asin (r)); case FARCCOS : return (acos (r)); case FARCTAN : return (atan (r)); case FARGSH : return (log (r + sqrt (1 + r * r))); case FARGCH : return (log (r + sqrt (-1 + r * r))); case FARGTH : return (log ((1 + r) / (1 - r)) / 2); case FFACT : if (fabs (r) < 32) { for (s=1, i=1; i<=r; i++) s *= i; return (s); } default : errno = AR_OUI; // Operation NOT valid return (0); } /* switch oper */ //-------------------------------------- Operation NOT valid case '\0' : return (0); default : errno = AR_OUI; return (0); } // switch } // ar_evalue() /**************************************************************** * EVALUATION CALLING FUNCTION * ****************************************************************/ double ar_evalue_fonction (ar_fonction *f,double (* val) (int)) { ar_form_cur = f->debut; ar_val_fn = val; return (ar_evalue ()); } double ar_val_var (int i) { errno = 0; switch (i) { case 1 : return (ar_glob_x); case 2 : return (ar_glob_y); default : errno = AR_OUI; return (0); } } double ar_eval_f (double x) { ar_glob_x = x; ar_form_cur = ar_glob_f.debut; ar_val_fn = ar_val_var; return (ar_evalue ()); } double ar_eval_g (double x) { ar_glob_x = x; ar_form_cur = ar_glob_g.debut; ar_val_fn = ar_val_var; return (ar_evalue ()); } double ar_eval_fxy (double x, double y) { ar_glob_x = x; ar_glob_y = y; ar_form_cur = ar_glob_f.debut; ar_val_fn = ar_val_var; return (ar_evalue ()); } double ar_eval_gxy (double x, double y) { ar_glob_x = x; ar_glob_y = y; ar_form_cur = ar_glob_g.debut; ar_val_fn = ar_val_var; return (ar_evalue ()); } double ar_val_tab (int i) { errno = 0; if (i == 0) return (ar_glob_x); if (i <= ar_glob_dim) return (ar_glob_tab_y [i - 1]); else { errno = AR_OUI; return (0); } } double ar_eval_fyi (double x, double *y) { int i; ar_glob_x = x; for (i = 0; i < ar_glob_dim; i++) ar_glob_tab_y [i] = y [i]; ar_form_cur = ar_glob_f.debut; ar_val_fn = ar_val_tab; return (ar_evalue ()); } /***************************************************************** * RECURSIVELY PROGRESS TO THE VERY END OF THE FORMULA TO ANALYZE * *****************************************************************/ static void progresse (void) { switch (*(ar_form_cur++)) { case 'C' : ar_form_cur += sizeof (double); break; case 'V' : ar_form_cur += sizeof (int); break; case 'U' : ar_form_cur++; progresse (); break; case 'B' : ar_form_cur++; progresse (); progresse (); break; default : break; } /* switch */ } /* progresse () */ /**************************************************************** * CALCULATE THE LENGTH OF THE FORMULA * ****************************************************************/ unsigned int ar_fonclen (char *f) { ar_form_cur = f; progresse (); return ((unsigned int) (ar_form_cur - f)); } /************************************************************************ * ANALYZE A USER DEFINED FUNCTION ENTERED AS A STRING * * --------------------------------------------------------------------- * * INPUTS: *f : Current pointer to function to be analyzed * * lm : Maximum length of the formula to analyze * * (*isvar) () : Function to know if a string is a valid * * variable * * --------------------------------------------------------------------- * * OUTPUTS: *form_ana: Pointer to the analyzed formula * * lr : Real length of analyzed function * * Value fn: 0 if there is a syntax error * * --------------------------------------------------------------------- * * EXPLANATION: The core of this analyze is the RECURSIVE function * * analyse_chaine(), with only two parameters, a string ch * * and its length lc. The other parameters are global to * * avoid unnecessary use of stack storage. * * The function analyse_fonction does the following tasks: * * - clean formula (spaces, lower case, etc.) * * - Initialize the global variables (see above) * * - Call recursive function with the full formula. * ************************************************************************/ /**************************************************************** * LOCAL VARIABLES (TO FUNCTION, BUT DECLARED GLOBAL) * ****************************************************************/ static char ar_nom_op_unaire [21] [7] = {"-", "+", "SIN","COS","TAN","ARCSIN","ARCCOS","ARCTAN", "SH", "CH", "TH", "ARGSH", "ARGCH", "ARGTH", "ABS","INT","FRAC", "FACT", "EXP","LOG","SQRT"}; static int (*isv) (char*, int); // Function to check if a string is a valid variable static unsigned int lmax; // Maximum length of the formula to ANALYZE static char *f_ana; // Analyzed formula (result) static unsigned int ana_cur; // Current index in ANALYZED formula static double r; static int res; static char pourcte [30]; // CAUTION: GLOBAL VARIABLES IN A RECURSIVE FUNCTION // SEE REMARK ABOVE /**************************************************************** * HEADERS OF LOCAL FUNCTIONS * ****************************************************************/ static avance_parentheses (char*, int*); static ins_unaire (int); static recherche (char*, int, char, char); static analyse_chaine (char*, int); /**************************************************************** * AVANCE_PARENTHESES * * ------------------------------------------------------------- * º The pointer to the formula points to an opening parenthesis * º Move the pointer to the next closing parenthesis or the end * * of the string. len indicates in input the max. number of * * chars to examine, in output the number of skipped chars. * ****************************************************************/ static avance_parentheses (char *f, int *len) { int i = 0, np = 0; do { switch (*f++) { case '(' : np++; break; case ')' : np--; break; } i++; } while ((np) && (i < *len)); f--; *len = i; return (! np); } /**************************************************************** * INS_UNAIRE * * ------------------------------------------------------------- * * Write to result formula the detected unary operation. The * * result indicates if there was enough room to do so. * ****************************************************************/ static ins_unaire (int i) { if (ana_cur + 2 >= lmax) return (0); f_ana [ana_cur++] = 'U'; f_ana [ana_cur++] = (char) i; return (1); } /**************************************************************** * RECHERCHE * * ------------------------------------------------------------- * * In output: res indicates if the search was successful or not.* * The value <> 0 (yes) indicates that something has * * been made, so exit is required. * ****************************************************************/ static recherche (char *ch, int len, char c1, char c2) { int np, i = len-1; do { if (ch [i] == ')') { np = 0; do switch (ch [i--]) { case '(' : np--; break; case ')' : np++; break; } while ((np) && (i >= 0)); i++; if (np) { res = 0; return (1); } } else if (((ch [i] == c1) || (ch [i] == c2)) && (i > 0) && (i < len-1)) switch (ch [i-1]) { case '(': case 'E': case '+': case '-': case '*': case '/': case '^': break; default : if (ana_cur + 2 < lmax) { f_ana [ana_cur++] = 'B'; f_ana [ana_cur++] = ch [i]; if (analyse_chaine (&ch [0], i)) res = analyse_chaine (&ch[i+1], len-i-1); else res = 0; } else res = 0; return (1); } /* switch ch[i-1] */ } while (--i >= 0); return (0); } /**************************************************************** * MAIN RECURSIVE FUNCTION TO ANALYZE THE STRING * ****************************************************************/ static analyse_chaine (char *ch, int lc) { // CAUTION - NO LOCAL VARIABLES - See remarks above. //------------------------------------- 1 : Initializations if (lc == 0) return (1); //------------------------------ 2 : Seek binary operations if (recherche (ch, lc, '-', '+')) return (res); if (recherche (ch, lc, '/', '*')) return (res); //----------------------------------- 3 : Seek unary - and + if (ch [0] == '-') { ins_unaire (FMOINS); return (analyse_chaine (&ch[1], lc-1)); } if (ch [0] == '+') return (analyse_chaine (&ch[1], lc-1)); //---------------------------------- 4 : Seek power function if (recherche (ch, lc, '^', '^')) return (res); //------------------------------------- 5 : Seek parentheses if (ch [0] == '(') { i = lc; if ((avance_parentheses (ch, &i)) && (i == lc)) return (analyse_chaine (&ch[1], lc-2)); else return (0); } //---------------------------------------- 6 : Seek factorial if (ch [lc - 1] == '!') { ins_unaire (FFACT); return (analyse_chaine (&ch[0], lc-1)); } //---------------------------------- 7 : Seek unary functions for (i = (int) FSIN; i <= (int) FSQRT; i++) { j = strlen (ar_nom_op_unaire [i]); if (strncmp(ar_nom_op_unaire [i], ch, j) == 0) { res = 0; if (ch [j] == '(') if (ins_unaire (i)) res = analyse_chaine (&ch[j], lc-j); return (res); } } //------------------------------------------ 8 : Seek unknowns i = (*isv)(ch, lc); if (i >= 0) { if (ana_cur + 1 + sizeof (int) >= lmax) return (0); f_ana [ana_cur++] = 'V'; memcpy (&f_ana [ana_cur], (char *) &i, sizeof (int)); ana_cur += sizeof(int); return (1); } //------------------------------------------ 9 : Seek constants if (ana_cur + sizeof (double) + 1 >= lmax) return (0); i = AR_NON; strncpy (pourcte, ch, lc); pourcte [lc] = 0; if ((i = (strcmp (pourcte, "0") == 0)) == AR_OUI) r = 0; if (i == AR_NON) i = ((r = atof (pourcte)) != 0); if (i == AR_NON) if ((i = (strcmp (pourcte, "PI") == 0)) == AR_OUI) r = AR_PI; if (i) { f_ana [ana_cur++] = 'C'; memcpy (&f_ana [ana_cur], (char *) &r, sizeof (double)); ana_cur += sizeof (double); return (1); } return (0); // unknown sign or operator: analyze failed ! ... } /*************************************************************** * ANALYZE A FUNCTION: CALLING FUNCTION * ***************************************************************/ int ar_analyse_fonction (char *f, int lm, int (*isvar)(char *,int), char *form_ana, int *lr) { unsigned int i, j; char *fb; //******************* Initialize static global variables isv = isvar; lmax = lm; f_ana = form_ana; ana_cur = 0; //******************* clean formula fb = (char *) malloc (strlen (f)); if (fb == 0) return (0); for (i = 0, j = 0; i < strlen(f); i++) if (f[i] != ' ') fb [j++] = toupper (f[i]); //******************* call recursive function i = analyse_chaine (fb, j); *lr = ana_cur; free (fb); return (i); } static int num_var (char *ch, int lc) { if (lc != 1) return (-1); switch (ch [0]) { case 'X': case 'T': return (1); case 'Y': return (2); } return (-1); } int ar_anal_fonction (char *cc, ar_fonction *fon) { int lr; return (ar_analyse_fonction (cc, fon->maxlen, num_var, fon->debut, &lr)); } static int num_var_xyi (char *ch, int lc) { int i; if (strncmp (ch, "X", lc) == 0) return (0); if (strncmp (ch, "Y", 1) != 0) return (-1); if (lc == 1) return (1); if ((lc == 2) && (ch [1] > '0') && (ch [1] <= '9')) return (ch [1] - '0'); for (i = 1; i < lc; i++) if (ch [i] != '\'') return (-1); return (lc); } int ar_anal_fonc_xyi (char *cc, ar_fonction *fon) { int lr; return (ar_analyse_fonction (cc, fon->maxlen, num_var_xyi, fon->debut, &lr)); } /************************************************* * "UNCOMPILE" A FUNCTION * * ---------------------------------------------- * * Input : pointer to an analyzed function * * Output: string storing the decompiled function * * (with possibility to display it). * *************************************************/ static char ar_nom_op [] [7] = {"-", "+", "SIN","COS","TAN","ARCSIN","ARCCOS","ARCTAN", "SH", "CH", "TH", "ARGSH", "ARGCH", "ARGTH", "ABS","INT","FRAC", "FACT", "EXP","LN","SQRT"}; void ar_decompile_fonction (char *f, char *ch) { char ch1 [255], ch2 [255], *pv; switch (f [0]) { case 'C' : sprintf (ch2, "%30.15lf", * (double *) & f[1]); pv = ch2; while (*(pv++) == ' '); /* Elimine les espaces */ strcpy (ch, pv - 1); pv = ch + strlen (ch); while (*(--pv) == '0') *pv = 0; if (*pv == '.') *pv = 0; break; case 'V' : strcpy (ch, "X"); break; case 'U' : ar_decompile_fonction (&f [2], ch1); if (strlen (ch1) > 245) return; switch (f [1]) { case FMOINS : strcpy (ch, "- "); strcat (ch, ch1); break; case FPLUS : strcpy (ch, ch1); break; default : strcpy (ch, ar_nom_op [f [1]]); if (ch1 [0] == '(') { strcat (ch, " "); strcat (ch, ch1); } else { strcat (ch, " ("); strcat (ch, ch1); strcat (ch, ")"); } break; } break; case 'B' : pv = &f [2 + ar_fonclen (&f [2])]; ar_decompile_fonction (&f [2], ch1); ar_decompile_fonction (pv, ch2); if (strlen (ch1) + strlen (ch2) > 245) return; strcpy (ch, ch1); switch (f [1]) { case '+' : strcat (ch, " + "); strcat (ch, ch2); break; case '-' : strcat (ch, " - "); strcat (ch, ch2); break; case '*' : strcat (ch, " * "); strcat (ch, ch2); break; case '/' : strcat (ch, " / "); strcat (ch, ch2); break; case '^' : strcat (ch, " ^ "); strcat (ch, ch2); break; } strcpy (ch2, "("); strcat (ch2, ch); strcat (ch2, ")"); strcpy (ch, ch2); break; } } // end of file fonction.cpp