/********************************************************************
This file is part of the abs 0.907 distribution. abs is a spreadsheet
with graphical user interface.
Copyright (C) 1998-2001 André Bertin (Andre.Bertin@ping.be)
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 if in the same spirit as version 2.
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.
Concact: abs@pi.be
http://home.pi.be/bertin/abs.shtml
*********************************************************************/
#include "mathfct.h"
#include "y.tab.h"
#include "string.h"
#include "math.h"
#include "cell_vb.h"
#include "typedef.h"
#include "application.h"
#include "interpret.h"
#include "gram_ext.h"
#include "abv.h"
#include "parser_ext.h"
Fct matharrayfct[] =
{
{"ABS", &vb_ABS, 1, 1, "ABS(number)", "Returns the absolute value of a number"},
{"ACOS", &vb_ACOS, 1, 1, NULL, NULL},
{"ACOSH", &vb_ACOSH, 1, 1, NULL, NULL},
{"ASIN", &vb_ASIN, 1, 1, NULL, NULL},
{"ASINH", &vb_ASINH, 1, 1, NULL, NULL},
{"ATAN", &vb_ATAN, 1, 1, NULL, NULL},
{"ATAN2", &vb_ATAN2, 1, 1, NULL, NULL},
{"ATANH", &vb_ATANH, 1, 1, NULL, NULL},
{"CEILING", &vb_CEILING, 1, 1, NULL, NULL},
{"COMBIN", &vb_COMBIN, 1, 1, NULL, NULL},
{"COS", &vb_COS, 1, 1, NULL, NULL},
{"COSH", &vb_COSH, 1, 1, NULL, NULL},
{"COUNTIF", &vb_COUNTIF, 1, 1, NULL, NULL},
{"DEGREES", &vb_DEGREES, 1, 1, NULL, NULL},
{"EVEN", &vb_EVEN, 1, 1, NULL, NULL},
{"EXP", &vb_EXP, 1, 1, NULL, NULL},
{"FACT", &vb_FACT, 1, 1, NULL, NULL},
{"FACTDOUBLE", &vb_FACTDOUBLE, 1, 1, NULL, NULL},
{"FLOOR", &vb_FLOOR, 1, 1, NULL, NULL},
{"GCD", &vb_GCD, 1, 1, NULL, NULL},
{"INT", &vb_INT, 1, 1, NULL, NULL},
{"LCM", &vb_LCM, 1, 1, NULL, NULL},
{"LN", &vb_LN, 1, 1, NULL, NULL},
{"LOG10", &vb_LOG10, 1, 1, NULL, NULL},
{"LOG", &vb_LOG, 1, 1, NULL, NULL},
{"MDETERM", &vb_MDETERM, 1, 1, NULL, NULL},
{"MINVERSE", &vb_MINVERSE, 1, 1, NULL, NULL},
{"MMULT", &vb_MMULT, 1, 1, NULL, NULL},
{"MOD", &vb_MOD, 1, 1, NULL, NULL},
{"MROUND", &vb_MROUND, 1, 1, NULL, NULL},
{"MULTINOMIAL", &vb_MULTINOMIAL, 1, 1, NULL, NULL},
{"ODD", &vb_ODD, 1, 1, NULL, NULL},
{"PI", &vb_PI, 1, 1, NULL, NULL},
{"POWER", &vb_POWER, 1, 1, NULL, NULL},
{"PRODUCT", &vb_PRODUCT, 1, 1, NULL, NULL},
{"QUOTIENT", &vb_QUOTIENT, 1, 1, NULL, NULL},
{"RADIANS", &vb_RADIANS, 1, 1, NULL, NULL},
{"RAND", &vb_RAND, 1, 1, NULL, NULL},
{"RANDBETWEEN", &vb_RANDBETWEEN, 1, 1, NULL, NULL},
{"ROMAN", &vb_ROMAN, 1, 1, NULL, NULL},
{"ROUND", &vb_ROUND, 1, 1, NULL, NULL},
{"ROUNDDOWN", &vb_ROUNDDOWN, 1, 1, NULL, NULL},
{"ROUNDUP", &vb_ROUNDUP, 1, 1, NULL, NULL},
{"SERIESSUM", &vb_SERIESSUM, 1, 1, NULL, NULL},
{"SIGN", &vb_SIGN, 1, 1, NULL, NULL},
{"SIN", &vb_SIN, 1, 1, NULL, NULL},
{"SINH", &vb_SINH, 1, 1, NULL, NULL},
{"SQRT", &vb_SQRT, 1, 1, NULL, NULL},
{"SQRTPI", &vb_SQRTPI, 1, 1, NULL, NULL},
{"SUM", &vb_SUM, 1, 1, NULL, NULL},
{"SUMIF", &vb_SUMIF, 1, 1, NULL, NULL},
{"SUMPRODUCT", &vb_SUMPRODUCT, 1, 1, NULL, NULL},
{"SUMSQ", &vb_SUMSQ, 1, 1, NULL, NULL},
{"SUMX2MY2", &vb_SUMX2MY2, 1, 1, NULL, NULL},
{"SUMX2PY2", &vb_SUMX2PY2, 1, 1, NULL, NULL},
{"SUMXMY2", &vb_SUMXMY2, 1, 1, NULL, NULL},
{"TAN", &vb_TAN, 1, 1, NULL, NULL},
{"TANH", &vb_TANH, 1, 1, NULL, NULL},
{"TRUNC", &vb_TRUNC, 1, 1, NULL, NULL},
{NULL, NULL, 0, 0, NULL, NULL},
};
#ifndef PI
#define PI 3.14159265359
#endif
int
makeif (obj value, char *criteria)
{
obj val;
int doit = 0;
char *formula = NULL;
int len = 0;
int ret = 0;
if (criteria == NULL)
return 0;
len = strlen (criteria);
switch (value.type)
{
case INTEGER:
formula = (char *) absmalloc ((len + 20) * sizeof (char), "makeif:formula");
sprintf (formula, "%d%s", value.rec.i, criteria);
doit = 1;
break;
case DOUBLE:
formula = (char *) absmalloc ((len + 32) * sizeof (char), "makeif:formula");
sprintf (formula, "%f%s", value.rec.d, criteria);
doit = 1;
break;
case STRING_CONSTANT:
if (value.rec.s == NULL)
break;
formula = (char *) absmalloc ((len + strlen (value.rec.s) + 8) * sizeof (char), "makeif:formula");
sprintf (formula, "\"%s\"=\"%s\"", value.rec.s, criteria);
doit = 1;
break;
}
if (doit)
{
seteqboolean ();
val = exint (parseexpression (formula));
unseteqboolean ();
if (obj2int (val))
ret = 1;
absfree (formula, "makeif:formula");
}
return ret;
}
obj
vb_ABS (int narg, obj * arg)
{
obj o;
o.rec.d = abs (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_ACOS (int narg, obj * arg)
{
obj o;
o.rec.d = acos (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_ACOSH (int narg, obj * arg)
{
obj o;
o.rec.d = acosh (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_ASIN (int narg, obj * arg)
{
obj o;
o.rec.d = asin (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_ASINH (int narg, obj * arg)
{
obj o;
o.rec.d = asinh (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_ATAN (int narg, obj * arg)
{
obj o;
o.rec.d = atan (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_ATAN2 (int narg, obj * arg)
{
obj o;
o.rec.d = atan2 (obj2double (arg[0]), obj2double (arg[1]));
o.type = DOUBLE;
return o;
}
obj
vb_ATANH (int narg, obj * arg)
{
obj o;
o.rec.d = atanh (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_CEILING (int narg, obj * arg)
{
obj o;
double nombre = obj2double (arg[0]);
double multiple = obj2double (arg[1]);
double tmp = 0.0;
int n = 0;
if (nombre * multiple > 0)
{
tmp = multiple;
while (fabs (tmp) < fabs (nombre) && n < 1000)
{
tmp *= fabs (multiple);
n++;
}
tmp /= multiple;
}
o.rec.d = tmp;
o.type = DOUBLE;
return o;
}
int
fact (int n)
{
int i;
int val = 1.0;
for (i = 2; i <= n && i < 200; i++)
val *= i;
return val;
}
obj
vb_COMBIN (int narg, obj * arg)
{
obj o;
int n;
int k;
double a, b;
k = obj2int (arg[1]);
n = obj2int (arg[0]);
if (n > 0 && k > 0 && n > k)
{
a = fact (n);
b = fact (k) * fact (n - k);
o.rec.d = a / b;
}
else
{
o.rec.d = 0;
}
o.type = DOUBLE;
return o;
}
obj
vb_COS (int narg, obj * arg)
{
obj o;
o.rec.d = cos (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_COSH (int narg, obj * arg)
{
obj o;
o.rec.d = cosh (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_COUNTIF (int narg, obj * arg)
{
obj o;
obj tmp;
int i, r, c;
int ret = 0;
tmpRange *ran;
o.type = INTEGER;
o.rec.i = 0;
if (narg < 2)
return o;
if (arg[0].type != STRING_CONSTANT && arg[0].type != STRING)
return o;
if (arg[0].rec.s == NULL)
return o;
for (i = 1; i < narg; i++)
{
if (arg[i].type == RANGE)
{
ran = (tmpRange *) arg[i].rec.s;
if (ran->wks == NULL)
{
for (r = ran->r1; r <= ran->r2; r++)
for (c = ran->c1; c <= ran->c2; c++)
{
tmp = get_ovalue (r, c);
ret += makeif (tmp, arg[0].rec.s);
}
}
else
{
for (r = ran->r1; r <= ran->r2; r++)
for (c = ran->c1; c <= ran->c2; c++)
{
tmp = get_ovalue_wks (ran->wks, r, c);
ret += makeif (tmp, arg[0].rec.s);
}
}
}
else
{
tmp = id2val (arg[i]);
ret += makeif (tmp, arg[0].rec.s);
}
}
o.rec.i = ret;
return o;
}
obj
vb_DEGREES (int narg, obj * arg)
{
obj o;
o.rec.d = 180.0 / PI * (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_EVEN (int narg, obj * arg)
{
obj o;
ABVInform ("EVEN not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_EXP (int narg, obj * arg)
{
obj o;
double x, y;
x = obj2double (arg[0]);
y = obj2double (arg[1]);
o.rec.d = pow (x, y);
o.type = DOUBLE;
return o;
}
obj
vb_FACT (int narg, obj * arg)
{
obj o;
o.rec.d = fact (obj2int (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_FACTDOUBLE (int narg, obj * arg)
{
obj o;
o.rec.d = fact (obj2int (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_FLOOR (int narg, obj * arg)
{
obj o;
o.rec.d = floor (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_GCD (int narg, obj * arg)
{
obj o;
int i;
int f = 1;
double div = 2;
while (f)
{
for (i = 0; i < narg; i++)
{
if (fmod (obj2double (arg[0]), div) != 0)
f = 0;
}
div++;
}
div--;
o.rec.d = div;
o.type = DOUBLE;
return o;
}
obj
vb_INT (int narg, obj * arg)
{
obj o;
double val = obj2double (arg[0]);
o.rec.d = rint (val);
o.type = DOUBLE;
return o;
}
obj
vb_LCM (int narg, obj * arg)
{
obj o;
ABVInform ("LCM not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_LN (int narg, obj * arg)
{
obj o;
o.rec.d = log (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_LOG (int narg, obj * arg)
{
obj o;
o.rec.d = log10 (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_LOG10 (int narg, obj * arg)
{
obj o;
o.rec.d = log10 (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_MDETERM (int narg, obj * arg)
{
obj o;
ABVInform ("MDETERM not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_MINVERSE (int narg, obj * arg)
{
obj o;
ABVInform ("MINVERSE not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_MMULT (int narg, obj * arg)
{
obj o;
ABVInform ("MMULT not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_MOD (int narg, obj * arg)
{
obj o;
o.rec.d = fmod (obj2double (arg[0]), obj2double (arg[1]));
o.type = DOUBLE;
return o;
}
obj
vb_MROUND (int narg, obj * arg)
{
obj o;
ABVInform (" MROUND not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_MULTINOMIAL (int narg, obj * arg)
{
obj o;
ABVInform ("MULTINOMIAL not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_ODD (int narg, obj * arg)
{
obj o;
ABVInform ("ODD not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_PI (int narg, obj * arg)
{
obj o;
o.rec.d = PI;
o.type = DOUBLE;
return o;
}
obj
vb_POWER (int narg, obj * arg)
{
obj o;
o.rec.d = pow (obj2double (arg[0]), obj2double (arg[1]));
o.type = DOUBLE;
return o;
}
obj
vb_PRODUCT (int narg, obj * arg)
{
obj o;
int r, c;
tmpRange *ran;
double val = 1;
int i;
for (i = 0; i < narg; i++)
{
if (arg[i].type == RANGE)
{
ran = (tmpRange *) arg[i].rec.s;
if (ran->wks == NULL)
{
for (r = ran->r1; r <= ran->r2; r++)
for (c = ran->c1; c <= ran->c2; c++)
val *= get_value (r, c);
}
else
{
for (r = ran->r1; r <= ran->r2; r++)
for (c = ran->c1; c <= ran->c2; c++)
val *= get_value_wks (ran->wks, r, c);
}
}
else
val *= obj2double (arg[i]);
}
o.rec.d = val;
o.type = DOUBLE;
return o;
}
obj
vb_QUOTIENT (int narg, obj * arg)
{
obj o;
o.rec.d = 0.0;
o.type = DOUBLE;
return o;
}
obj
vb_RADIANS (int narg, obj * arg)
{
obj o;
o.rec.d = PI / 180.0 * (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_RAND (int narg, obj * arg)
{
obj o;
o.rec.d = 0.0 + (1.0 * rand () / (RAND_MAX + 1.0));
o.type = DOUBLE;
return o;
}
obj
vb_RANDBETWEEN (int narg, obj * arg)
{
obj o;
double low = obj2double (arg[0]);
double up = obj2double (arg[1]);
o.rec.d = low + (up * rand () / (RAND_MAX + 1.0));
o.type = DOUBLE;
return o;
}
obj
vb_ROMAN (int narg, obj * arg)
{
obj o;
ABVInform ("ROMAN not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_ROUND (int narg, obj * arg)
{
obj o;
double val = obj2double (arg[0]);
double ndeci = 0;
int valint;
if (narg > 1)
ndeci = obj2double (arg[1]);
if (ndeci >= 0)
{
valint = rint (val * pow (10, ndeci));
val = valint * pow (10, -ndeci);
}
o.rec.d = val;
o.type = DOUBLE;
return o;
}
obj
vb_ROUNDDOWN (int narg, obj * arg)
{
obj o;
double val = obj2double (arg[0]);
double ndeci = 0;
if (narg > 1)
ndeci = obj2double (arg[1]);
if (ndeci >= 0)
{
val *= pow (10, ndeci);
val = floor (val);
val *= pow (10, -ndeci);
}
o.rec.d = val;
o.type = DOUBLE;
return o;
}
obj
vb_ROUNDUP (int narg, obj * arg)
{
obj o;
double val = obj2double (arg[0]);
double ndeci = 0;
if (narg > 1)
ndeci = obj2double (arg[1]);
if (ndeci >= 0)
{
val *= pow (10, ndeci);
val = ceil (val);
val *= pow (10, -ndeci);
}
o.rec.d = val;
o.type = DOUBLE;
return o;
}
obj
vb_SERIESSUM (int narg, obj * arg)
{
obj o;
ABVInform ("SERIESSUM not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_SIGN (int narg, obj * arg)
{
obj o;
double val = obj2double (arg[0]);
if (val > 0)
o.rec.d = 1;
else if (val < 0)
o.rec.d = -1;
else
o.rec.d = 0;
o.type = DOUBLE;
return o;
}
obj
vb_SIN (int narg, obj * arg)
{
obj o;
o.rec.d = sin (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_SINH (int narg, obj * arg)
{
obj o;
o.rec.d = sinh (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_SQRT (int narg, obj * arg)
{
obj o;
o.rec.d = sqrt (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_SQRTPI (int narg, obj * arg)
{
obj o;
o.rec.d = sqrt (PI * obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_SUM (int narg, obj * arg)
{
obj o;
int r, c;
tmpRange *ran;
double val = 0;
int i;
for (i = 0; i < narg; i++)
{
if (arg[i].type == RANGE)
{
ran = (tmpRange *) arg[i].rec.s;
if (ran->wks == NULL)
{
for (r = ran->r1; r <= ran->r2; r++)
for (c = ran->c1; c <= ran->c2; c++)
val += get_value (r, c);
}
else
{
for (r = ran->r1; r <= ran->r2; r++)
for (c = ran->c1; c <= ran->c2; c++)
val += get_value_wks (ran->wks, r, c);
}
}
else
val += obj2double (arg[i]);
}
o.rec.d = val;
o.type = DOUBLE;
return o;
}
obj
vb_SUMIF (int narg, obj * arg)
{
obj o;
obj tmp;
int i, r, c;
double ret = 0;
tmpRange *ran;
o.type = DOUBLE;
o.rec.d = 0;
if (narg < 2)
return o;
if (arg[0].type != STRING_CONSTANT && arg[0].type != STRING)
return o;
if (arg[0].rec.s == NULL)
return o;
for (i = 1; i < narg; i++)
{
if (arg[i].type == RANGE)
{
ran = (tmpRange *) arg[i].rec.s;
if (ran->wks == NULL)
{
for (r = ran->r1; r <= ran->r2; r++)
for (c = ran->c1; c <= ran->c2; c++)
{
tmp = get_ovalue (r, c);
if (makeif (tmp, arg[0].rec.s))
ret += obj2double (tmp);
}
}
else
{
for (r = ran->r1; r <= ran->r2; r++)
for (c = ran->c1; c <= ran->c2; c++)
{
tmp = get_ovalue_wks (ran->wks, r, c);
if (makeif (tmp, arg[0].rec.s))
ret += obj2double (tmp);
}
}
}
else
{
tmp = id2val (arg[i]);
if (makeif (tmp, arg[0].rec.s))
ret += obj2double (tmp);
}
}
o.rec.d = ret;
return o;
}
obj
vb_SUMPRODUCT (int narg, obj * arg)
{
obj o;
ABVInform ("SUMPRODUCT not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_SUMSQ (int narg, obj * arg)
{
obj o;
int r, c;
tmpRange *ran;
double val = 0;
int i;
double tmp;
for (i = 0; i < narg; i++)
{
if (arg[i].type == RANGE)
{
ran = (tmpRange *) arg[i].rec.s;
if (ran->wks == NULL)
{
for (r = ran->r1; r <= ran->r2; r++)
for (c = ran->c1; c <= ran->c2; c++)
{
tmp = get_value (r, c);
val += tmp * tmp;
}
}
else
{
for (r = ran->r1; r <= ran->r2; r++)
for (c = ran->c1; c <= ran->c2; c++)
{
tmp = get_value_wks (ran->wks, r, c);
val += tmp * tmp;
}
}
}
else
{
tmp = obj2double (arg[i]);
val += tmp * tmp;
}
}
o.rec.d = val;
o.type = DOUBLE;
return o;
}
obj
vb_SUMX2MY2 (int narg, obj * arg)
{
obj o;
ABVInform ("SUMX2MY2 not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_SUMX2PY2 (int narg, obj * arg)
{
obj o;
ABVInform ("SUMX2PY2 not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_SUMXMY2 (int narg, obj * arg)
{
obj o;
ABVInform ("SUMXMY2 not yet implemented");
o.type = DOUBLE;
return o;
}
obj
vb_TAN (int narg, obj * arg)
{
obj o;
o.rec.d = tan (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_TANH (int narg, obj * arg)
{
obj o;
o.rec.d = tanh (obj2double (arg[0]));
o.type = DOUBLE;
return o;
}
obj
vb_TRUNC (int narg, obj * arg)
{
obj o;
double val = obj2double (arg[0]);
double ndeci = 0;
int valint;
if (narg > 1)
ndeci = obj2double (arg[1]);
if (ndeci >= 0)
{
valint = val * pow (10, ndeci);
val = valint * pow (10, -ndeci);
}
o.rec.d = val;
o.type = DOUBLE;
return o;
}
syntax highlighted by Code2HTML, v. 0.9.1