home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS - Coast to Coast
/
simteldosarchivecoasttocoast2.iso
/
calculat
/
rpn30src.zip
/
FTNS.C
< prev
next >
Wrap
C/C++ Source or Header
|
1990-05-30
|
26KB
|
976 lines
/*
| ftns.c - implementations of the calculator functions. These are
| called in process.c, either indirectly through funct_1() or directly.
| Most of these functions have entries in one of the function tables.
| Those that do not are kept at the end of the file, after funct_1().
|
| 90.05.28 v3.0
| "The rest" of the hyberbolic trig. functions, gamma/factorial,
| conversions, linear regression added. More code moved from
| process.c; nullary-function lookup added (like unary functions).
| Lotsa code rearrangement between this and process.c
| 90.01.01, local noon
*/
#include <math.h>
#include <float.h> /* DBL_MAX definition */
#include <string.h> /* for strcmp() */
#include <stdlib.h>
#include "rpn.h"
#include "display.h" /** for prterr() prototype **/
#define FTNS
#include "ftns.h"
#include"debug.h"
#define INT_PART(x) floor( x )
#define NULL 0
/** / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / / **
**
** Okay to multiply? y*x > MAXDOUBLE ? y*x < MINDOUBLE ?
** If underflow, the math library will just generate 0.0;
** let that happen, but report it.
**/
int mul_ok(double y, double x, char *caller)
{
y = fabs(y);
x = fabs(x);
if (y > 1.0 && x > 1.0 && y > MAXDOUBLE / x) {
prterr(caller, "overflow");
return FALSE;
}
if (y < 1.0 && x < 1.0 && y < MINDOUBLE / x) {
prterr(caller, "underflow");
}
return TRUE;
}
/**\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\**/
void shift_lastx(void) /**-------------------------------------**/
{ /** Stash & alter LastX register. **/
tmpLX = lastx; /** Utility ftn., called by various **/
lastx = xreg; /** function-implementing routines. **/
} /**-------------------------------------**/
/*---------------------------------------------------------------------*\
| Convert "sexagesimal" (hh.mmssttt) formatted values to decimal-hour |
| format. This is a real ugly pain, because base-10/base-2 conversion |
| errors make the minute and second portions inexact. The `printf()' |
| routines are used to convert the floating-point value into the same |
| digits that the display shows. |
| |
| There must be a better way? |
| |
| 90.01.04 |
\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#define CVT 48
double C_DECL dec_hrs(double h_ms)
{
char hms_buf[CVT], min_buf[3], *dp;
double hrs, min, sec;
int neg;
if (h_ms < 0.0) {
neg = 1;
h_ms *= -1.0;
} else {
neg = 0;
}
sprintf( hms_buf, "%040.20f", ((double)10000.0 * h_ms) );
DBG_FPRINTF((errfile,"\ndec_hrs: h_ms: %7f hms_buf: %s\n",h_ms,hms_buf));
for (dp = hms_buf; *dp != '.'; ++dp)
;
dp -= 4;
min_buf[0] = *dp;
*dp++ = '\0';
min_buf[1] = *dp++;
min_buf[2] = '\0';
sec = atof(dp);
min = atof(min_buf);
hrs = atof(hms_buf);
DBG_FPRINTF((errfile,"hms_buf: %s, min_buf: %s, secs(*dp): %s\n"
"hrs: %f, min: %f, sec: %f\n",
hms_buf, min_buf, dp, hrs, min, sec
));
hrs += min/(double)60.0 + sec/(double)3600.0;
return ( neg ? -hrs : hrs );
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
| Format decimal-hour values in "sexagesimal" (hh.mmssttt) style.
| Problems here like in dec_hrs() above.
|
| 89.12.27
*/
#define PLACES 9 /* round to nanoseconds */
double C_DECL hms(double dec_hr)
{
unsigned long i_hr;
unsigned int i_min, i_sec;
double d_min, d_sec;
char sec_buf[5 + PLACES], buf[256], *bp;
d_min = 60.0 * frac(dec_hr);
d_sec = 60.0 * frac( d_min );
sprintf(sec_buf,"%02.*f%c", PLACES, d_sec, '\0');
for ( bp = sec_buf; *bp != '.'; ++bp )
{}
*bp++ = '\0';
i_min = INT_PART( d_min );
i_sec = (int)strtol(sec_buf, NULL, 0);
while (i_sec >= 60) {
i_sec -= 60;
++i_min;
}
i_hr = (long)INT_PART( dec_hr );
while (i_min >= 60) {
i_min -= 60;
++i_hr;
}
sprintf(buf,"%lu.%02u%02u%s%c", i_hr, i_min, i_sec, bp, '\0');
DBG_FPRINTF((errfile,"\nto-hms: dec_hr: %7f\n"
"d_min: %f, i_min: %u\nd_sec: %f, i_sec: %u\n"
"sec_buf: %s, bp: %s\nbuf: %s\n"
"value: %.20f\n",
dec_hr, d_min, i_min, d_sec, i_sec, sec_buf, bp, buf,
atof(buf)
));
return atof(buf);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
double C_DECL log2(double x) {
return (log10(x) / log_2);
}
double C_DECL p10(double x) {
return pow((double)10.0, x);
}
double C_DECL squar(double x) {
return (x * x);
}
/*
| Gamma & factorial function. This table copied from CRC Handbook,
| 55th Edition. Values between 0.0 and 2.0 are looked up in the table;
| larger values are iteratively calculated. Gamma() overflows at 171.
*/
static double gamma_table[101] = {
1.0, .99433, .98884, .98355, .97844, .97350, .96874, .96415, .95973, .95546,
.95135, .94739, .94359, .93993, .93642, .93304, .92980, .92670, .92373, .92088,
.91817, .91558, .91311, .91075, .90852, .90640, .90440, .90250, .90072, .89904,
.89747, .89600, .89464, .89338, .89222, .89115, .89018, .88931, .88854, .88785,
.88726, .88676, .88636, .88604, .88580, .88565, .88560, .88563, .88575, .88595,
.88623, .88659, .88704, .88757, .88818, .88887, .88964, .89049, .89142, .89243,
.89352, .89468, .89592, .89724, .89864, .90012, .90167, .90330, .90500, .90678,
.90864, .91057, .91258, .91466, .91683, .91906, .92137, .92376, .92623, .92877,
.93138, .93408, .93685, .93969, .94261, .94561, .94869, .95184, .95507, .95838,
.96177, .96523, .96878, .97240, .97610, .97988, .98374, .98768, .99171, .99581, 1.0
};
double C_DECL gamma(double x)
{
double gamma, g1, deltag, x1, deltax;
if (x < DBL_MIN) {
prterr("gamma", "x < 0");
return x;
}
if ( DBL_MIN <= x && x <= 1.0 ) {
x1 = (100.0 * x);
deltax = x1 - INT_PART(x1);
g1 = gamma_table[ (int)x1 ];
deltag = (gamma_table[ (int)x1+1 ] - g1);
return ( (g1 + deltag*deltax) / x );
}
gamma = (double)1.0;
while ((double)2.0 < x)
gamma *= --x;
x1 = (100.0 * --x);
deltax = x1 - INT_PART(x1);
g1 = gamma_table[ (int)x1 ];
deltag = (gamma_table[ (int)x1+1 ] - g1);
gamma *= (g1 + deltag*deltax);
return gamma;
}
double C_DECL fact(double x) {
return gamma(++x);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
double C_DECL isinh(double x) {
return log( x + sqrt( squar(x) + 1 ) );
}
double C_DECL icosh(double x) {
if (x < 1.0) {
prterr("icosh", "x < 1");
return x;
}
return log( x + sqrt( squar(x) - 1 ) );
}
double C_DECL itanh(double x) {
if (x >= 1.0) {
prterr("itanh", "x >= 1");
return x;
}
return (0.5 * log( (1.0+x) / (1.0-x) ));
}
double C_DECL csch(double x) {
return ((double)1.0 / sinh(x));
}
double C_DECL sech(double x) {
return ((double)1.0 / cosh(x));
}
double C_DECL coth(double x) {
return ((double)1.0 / tanh(x));
}
double C_DECL icsch(double x) {
return isinh((double)1.0 / x);
}
double C_DECL isech(double x) {
return icosh((double)1.0 / x);
}
double C_DECL icoth(double x) {
return itanh((double)1.0 / x);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *\
| Conversions.
*/
double C_DECL fahr(double x) {
return ( x * (double)1.8 + 32 );
}
double C_DECL celsius(double x) {
return ( (x - 32) / (double)1.8 );
}
double C_DECL kg(double x) {
return ( x * (double)0.45359237 );
}
double C_DECL pounds(double x) {
return ( x * (double)2.2046226 );
}
double C_DECL joules(double x) {
return ( x * (double)4.184 );
}
double C_DECL calories(double x) {
return ( x * (double)0.239006 );
}
double C_DECL liters(double x) {
return ( x * (double)3.7854118 );
}
double C_DECL gallons(double x) {
return ( x * (double)0.2641794 );
}
double C_DECL cuinch(double x) {
return ( x * (double)231.0 );
}
double C_DECL igal(double x) {
return ( x / (double)231.0 );
}
double C_DECL acres(double x) {
return ( x * (double)2.4710538 );
}
double C_DECL hectares(double x) {
return ( x / (double)2.4710538 );
}
double C_DECL mph(double x) {
return ( x * (double)2.2369363 );
}
double C_DECL mps(double x) {
return ( x / (double)2.2369363 );
}
/** Distance conversions **/
double C_DECL meters(double x) {
return ( x * (double)0.3048 );
}
double C_DECL feet(double x) {
return ( x / (double)0.3048 );
}
double C_DECL km(double x) {
return ( x * (double)1.609344 );
}
double C_DECL miles(double x) {
return ( x * (double)0.62137119 );
}
double C_DECL yards(double x) {
return ( x * (double)220 );
}
double C_DECL furlongs(double x) {
return ( x / (double)220 );
}
double C_DECL ly(double x) {
return ( x / (double)(9.460528347e15) );
}
double C_DECL lymeters(double x) {
return ( x * (double)(9.460528347e15) );
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
| Get fractional part of number. Share floor() ftn w/ `int' function.
*/
double C_DECL frac(double x) {
return ( x - INT_PART(x) );
}
/*--------------------------------------------------------------------*\
| Statistical and other directly-called functions. |
\*--------------------------------------------------------------------*/
void clrreg(int first, int last)
{
int i;
for (i = first; i <= last; )
memory[ i++ ] = 0.0;
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void sumplus(void)
{
long double x, y;
shift_lastx();
memory[10] += ONE;
memory[11] += (x = (long double)xreg);
memory[12] += (x * x);
memory[13] += (y = (long double)yreg);
memory[14] += (y * y);
memory[15] += (x * y);
/*
| v3.0 - harmonic and geometric means
*/
memory[16] += (0.0 != x ? ONE/x : DBL_MAX);
memory[17] += (0.0 != y ? ONE/y : DBL_MAX);
memory[18] *= x;
memory[19] *= y;
xreg = memory[10];
stacklift = FALSE;
clear_state("Sum +");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void summinus(void)
{
long double x, y;
shift_lastx();
memory[10] -= ONE;
memory[11] -= (x = (long double)xreg);
memory[12] -= (x * x);
memory[13] -= (y = (long double)yreg);
memory[14] -= (y * y);
memory[15] -= (x * y);
/*
| v3.0 - harmonic and geometric means
*/
if (0.0 != x) {
memory[16] -= ONE / x;
memory[18] /= x;
} else
memory[16] -= DBL_MAX;
if (0.0 != y) {
memory[17] -= ONE / y;
memory[19] /= y;
} else
memory[17] -= DBL_MAX;
xreg = memory[10];
stacklift = FALSE;
clear_state("Sum -");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static char n0_msg[] = "n is 0";
static char n2_msg[] = "n < 2";
void mean(void)
{
long double n = memory[10];
if (0.0 == n) {
prterr("mean", n0_msg);
} else {
shift_lastx();
xreg = memory[11] / n;
yreg = memory[13] / n;
}
clear_state("mean X & Y");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void geomean(void)
{
long double in = memory[10];
if (in == 0.0) {
prterr("geomean", n0_msg);
} else {
in = ONE / in;
shift_lastx();
xreg = pow( memory[18], in );
yreg = pow( memory[19], in );
}
clear_state("geo.mean X & Y");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void harmean(void)
{
long double n = memory[10];
if (n == 0.0) {
prterr("harmean", n0_msg);
} else {
shift_lastx();
xreg = (memory[16] == 0.0 ? DBL_MAX : n / memory[16]);
yreg = (memory[17] == 0.0 ? DBL_MAX : n / memory[17]);
}
clear_state("har.mean X & Y");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void stddev(void)
{
long double n, temp, tav;
if ((n = memory[10]) < 2.0) {
prterr("stddev", n2_msg);
} else {
shift_lastx();
temp = n - ONE;
tav = memory[11] / n;
xreg = sqrt( (memory[12] - memory[11] * tav) / temp );
tav = memory[13] / n;
yreg = sqrt( (memory[14] - memory[13] * tav) / temp );
}
clear_state("std. devs.");
}
/*---------------------------------------------------------------------*\
| v3.0 --- linear regression & related functions. |
| memory[B0] bo |
| memory[B1] b1 |
| memory[SB0] s(b0) |
| memory[TB0] t(b0) |
| memory[SB1] s(b1) |
| memory[TB1] t(b1) |
| memory[SYX] s( y|x ) |
| memory[R2] r-squared |
| memory[FR] F-ratio |
| memory[COV] covariance |
| B0, B1, ... COV are defined in ftns.h |
\* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void linreg(void)
{
long double n, xbar, ybar, c, det, nu2, t1, r1, m;
n = memory[10];
if (n < 2.0) {
prterr("linreg", n2_msg);
} else {
xbar = memory[11] / n;
ybar = memory[13] / n;
c = n * memory[15] - memory[11] * memory[13];
det = n * memory[12] - memory[11] * memory[11];
if (det == 0.0)
det = DBL_MIN;
memory[B1] = c / det; /** b1 coefficient **/
memory[B0] = ybar - memory[B1] * xbar; /** b0 coefficient **/
nu2 = n - TWO;
t1 = n * memory[14] - (memory[13] * memory[13]);
r1 = c * memory[B1];
if (t1 == r1)
m = DBL_MIN;
else
m = (t1 - r1) / (n > TWO ? nu2 : n);
memory[SB1] = m / det; /** s(b1)-squared **/
memory[TB1] = memory[B1] / sqrt( memory[SB1] ); /** t(b1) **/
memory[SB0] = memory[SB1] * memory[12] / n; /** s(b0)-squared **/
memory[TB0] = memory[B0] / sqrt( memory[SB0] ); /** t(b0) **/
memory[SYX] = m / n; /** s(y|x)-squared **/
if (t1 == 0.0)
memory[R2] = DBL_MAX; /** r-squared **/
else
memory[R2] = r1 / t1; /** r-squared **/
memory[FR] = r1 / m; /** F-ratio **/
memory[COV] = c / (n * (nu2 + ONE)); /** covariance **/
treg = memory[R2];
zreg = sqrt( memory[SYX] );
yreg = memory[B0];
xreg = memory[B1];
lastx = memory[COV];
}
clear_state("linear regr");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void linstats(void)
{
treg = memory[TB0];
zreg = sqrt( memory[SB0] );
yreg = memory[TB1];
xreg = sqrt( memory[SB1] );
lastx = memory[FR];
clear_state("linreg stats");
}
/*-------------------------------------------------------*\
| Generate & store linear-interpolation constants for use |
| by interpx() and interpy(). Use B0 and B1 registers, |
| compatibly with the linear regression function. |
\* - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void lin_coeffs(void)
{
if (yreg == treg) {
prterr("lincoeffs", "x1 = x2");
} else {
/*
| b1 = delta-y / delta-x
*/
memory[B1] = ((long double)xreg - (long double)zreg)
/ ((long double)yreg - (long double)treg);
/*
| b0 = y-low - x-low * b1
*/
memory[B0] = (long double)zreg - (long double)treg * memory[B1];
}
clear_state("linear coeffs");
}
/*-------------------------------------------------------*/
double C_DECL interpx(double y)
{
if (memory[B1] == 0.0) {
prterr("interpx","B1 is 0");
return xreg;
}
return (y - memory[B0]) / memory[B1];
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - */
double C_DECL interpy(double x)
{
return memory[B0] + (memory[B1] * x);
}
/**\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\**/
const char last_line[] = "\r\n --------\r\n";
static char stat_fmt[] =
"\r\n\r\nLINEAR REGRESSION RESULTS ( y = b0 + b1 * x )\r\n"
" b0: %.6le s(b0): %.6le t(b0): %.6le\r\n"
" b1: %.6le s(b1): %.6le t(b1): %.6le\r\n"
" n: %.0lf s( y|x ): %.6le r-squared: %.6lf\r\n"
" F-ratio (nu1=2, nu2=%u): %.6le covariance: %.6le"
"%sprtlin\r\n\r\n" ;
void prtlin(void)
{
if (savefile) {
fprintf(savefile,stat_fmt,
(double)memory[B0], sqrt( memory[SB0] ), (double)memory[TB0],
(double)memory[B1], sqrt( memory[SB1] ), (double)memory[TB1],
(double)memory[10], sqrt( memory[SYX] ), (double)memory[R2],
((unsigned)memory[10] - 2), (double)memory[FR],
(double)memory[COV], last_line);
}
clear_state("prtlin");
write_save = FALSE;
}
/*--------------------------------------------------------------------*/
static char sum_fmt1[] =
"\r\nSUMMATION REGISTERS:\r\n"
"n: %Lg\t sum(x): %8Lg sum(x*x): %8Lg\r\n"
"\t sum(y): %8Lg sum(y*y): %8Lg sum(x*y): %8Lg\r\n"
"\t sum-of-inverses(x): %8Lg sum-of-inverses(y): %8Lg\r\n"
"\t product(x): %8Lg product(y): %8Lg\r\n";
static char sum_fmt2[] =
"MEAN, SAMPLE STD. DEV.; Geometric Mean, Harmonic Mean\r\n"
"y-bar: %8Lg s(y): %8lg\r\n\tgeo.mean: %8lg harm.mean: %8lg\r\n"
"x-bar: %8Lg s(x): %8lg\r\n\tgeo.mean: %8lg harm.mean: %8lg"
"%sprtsum\r\n\r\n" ;
void prtsum(void)
{
long double n, n1, in, xbar, ybar;
double stdx, stdy, geox,geoy, harx, hary;
if (savefile) {
fprintf(savefile, sum_fmt1,
memory[10], memory[11],memory[12], memory[13],memory[14],
memory[15], memory[16],memory[17], memory[18],memory[19],
last_line);
if ((n = memory[10]) < 2) {
fprintf(savefile,
"N TOO SMALL FOR STATISTICS.\r\nprtsum\r\n\r\n");
} else {
in = ONE / n;
n1 = n - 1.0;
xbar = memory[11] / n;
ybar = memory[13] / n;
stdx = sqrt( (memory[12] - xbar*memory[11]) / n1 );
stdy = sqrt( (memory[14] - ybar*memory[13]) / n1 );
harx = (memory[16] == 0.0 ? DBL_MAX : n / memory[16]);
hary = (memory[17] == 0.0 ? DBL_MAX : n / memory[17]);
geox = pow( memory[18], in );
geoy = pow( memory[19], in );
fprintf(savefile, sum_fmt2,
ybar, stdy, geoy, hary, xbar, stdx, geox, harx );
}
}
clear_state("prtsum");
write_save = FALSE;
}
/*--------------------------------------------------------------------*/
static char stk_dump[] =
"\r\nSTACK:\r\n"
" t: %.20lg z: %.20lg\r\n"
" y: %.20lg x: %.20lg\r\n\t\t\t\tLastX: %.20lg"
"%sprtstk\r\n\r\n";
void prtstk(void)
{
if (savefile)
fprintf(savefile, stk_dump, treg, zreg, yreg, xreg, lastx, last_line);
clear_state("prtstk");
write_save = FALSE;
}
/*--------------------------------------------------------------------*/
void prtreg(void)
{
int i;
if (savefile) {
fprintf(savefile,"\r\nNon-Zero MEMORY REGISTERS:");
for (i = 0; i < MEMSIZE; ++i)
if ((long double)0.0 != memory[i])
fprintf(savefile,"\r\n memory[ %d ]: %.20Lg", i, memory[i]);
fprintf(savefile,"%sprtreg\r\n\r\n", last_line);
}
clear_state("prtreg");
write_save = FALSE;
}
/**\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\**/
void ru(void)
{
double temp;
temp = treg;
treg = zreg;
zreg = yreg;
yreg = xreg;
xreg = temp;
clear_state("rollup");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void rd(void)
{
double temp;
temp = xreg;
xreg = yreg;
yreg = zreg;
zreg = treg;
treg = temp;
clear_state("rolldown");
}
/**\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\**/
void polar(void)
{
double ty;
shift_lastx();
ty = atan2( yreg, xreg ); /** theta **/
if (trig_mode == DEGREES)
ty *= RAD_TO_DEG;
if (!math_error) {
xreg = hypot(yreg, xreg); /** R **/
yreg = ty;
}
clear_state("X,Y \x1A polar");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void rect(void)
{
double temp, tx, ty;
shift_lastx();
tx = xreg; ty = yreg;
if (trig_mode == DEGREES)
yreg *= DEG_TO_RAD;
temp = xreg * cos(yreg); /** X **/
yreg = xreg * sin(yreg); /** Y **/
xreg = temp;
if (math_error) {
xreg = tx; yreg = ty;
}
clear_state("R,\xE9 \x1A rect");
}
/**\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\**/
void atan_2(void)
{
double temp;
temp = atan2(yreg, xreg);
if (!math_error) {
if (trig_mode == DEGREES)
temp *= RAD_TO_DEG;
pop();
xreg = temp;
}
clear_state("arctan( Y/X )");
}
/*---------------------------------------------------------------------*/
void power(void)
{
pop();
xreg = pow(xreg, lastx);
clear_state("y^x");
}
/*---------------------------------------------------------------------*/
/*
| The following two functions are the original (HP29-faithful) conversions.
| Unlike all the other unary functions, these check for arith. errors.
| (sure would be nice if I could trap these.) Since they're unusual,
| they are treated as nullary functions.
*/
void rad_deg(void)
{
if (mul_ok(xreg, RAD_TO_DEG, "R->D")) {
xreg *= RAD_TO_DEG;
clear_state("rads \x1A Degs");
} else
clear_state(lastfunct);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
void deg_rad(void)
{
if (mul_ok(xreg, DEG_TO_RAD, "D->R")) {
xreg *= DEG_TO_RAD;
clear_state("degs \x1A Rads");
} else
clear_state(lastfunct);
}
/**\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\**/
/*------------------------------*\
| Nullary-function lookup table. |
\*------------------------------*/
struct ventry {
char *name;
vf_ptr func_ptr;
};
static struct ventry nullary_fn[] = { /* NULL-ARY */
"sumplus",sumplus, "summinus",summinus, "mean",mean,
"geomean",geomean, "harmean",harmean, "stddev",stddev, "sd",stddev,
"linreg",linreg, "linstats",linstats, "lincoeffs",lin_coeffs,
"prtlin",prtlin, "prtsum",prtsum, "prtstk",prtstk, "prtreg",prtreg,
"ru",ru, "rollup",ru, "rd",rd, "rolldown",rd,
"polar",polar, "rect",rect, "atan2",atan_2, "pow",power,
"deg",rad_deg, "rad",deg_rad,
"", (vf_ptr)NULL
};
/*-----------------------------------------------*\
| The generalized null-function-finder function. |
\* - - - - - - - - - - - - - - - - - - - - - - - */
vf_ptr funct_0(char *name)
{
struct ventry *ptr;
DBG_FPRINTF((errfile,
"\tfunct_0: nullary_fn: %d\n",
sizeof(nullary_fn)/sizeof(struct ventry)));
for (ptr = nullary_fn; ptr->func_ptr != (vf_ptr)NULL; ptr++) {
if (strcmp(name, ptr->name) == 0)
return ptr->func_ptr;
}
return (vf_ptr)NULL;
}
/**\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\**/
/*---------------------------------------------------------------------*\
| The generalized unary-function-finder function and its lookup table. |
| Kept at the end of this file so that the table can be initialized. |
\*---------------------------------------------------------------------*/
struct entry {
char *name;
f_ptr func_ptr;
};
/*
| Look-Up Tables for Multi-char functions --- the defined constants
| UNARY, TRIG, I_TRIG are used by do_funct() to select the correct table,
| although do_funct() doesn't know anything about the tables themselves.
*/
static struct entry unary_fn[] = { /* UNARY */
"sinh", sinh, "cosh", cosh, "tanh", tanh, "abs", fabs,
"sqrt", sqrt, "int", floor, "ln", log, "log", log10,
/* local... */
"hms", hms, "hrs", dec_hrs, "lg", log2, "exp", exp,
"p10", p10, "pow10", p10, "frac", frac, "sqr", squar,
/* v3.0 */
"gamma",gamma, "fact",fact,
"isinh",isinh, "icosh",icosh, "itanh",itanh, "csch",csch, "sech",sech,
"coth",coth, "icsch",icsch, "isech",isech, "icoth",icoth,
/** conversions **/
"fahr",fahr, "celsius",celsius, "kg",kg, "lb",pounds,
"joules",joules, "cal",calories, "liters",liters, "gal",gallons,
"igal",igal, "cuinch",cuinch, "acres",acres, "hectares",hectares,
"mph",mph, "mps",mps, "meters",meters, "feet",feet,
"miles",miles, "km",km, "yards",yards, "furlongs",furlongs,
"ly",ly, "lymeters",lymeters,
/** interpolation --- dovetails with linear regression **/
"interpx",interpx, "interpy",interpy,
"", (f_ptr)NULL
};
/*
| TRIG --- has to deal with degree/radian conversions
*/
static struct entry trig_fn[] = {
"sin", sin, "cos", cos, "tan", tan, "", (f_ptr)NULL
};
/*
| I_TRIG --- (inverse trig) has to deal with degree/radian conversions
*/
static struct entry i_trig_fn[] = {
"asin", asin, "acos", acos, "atan", atan,
"arcsin", asin, "arccos", acos, "arctan", atan, "", (f_ptr)NULL
};
/*-----------------------------------------------*\
| The generalized unary-function-finder function. |
\* - - - - - - - - - - - - - - - - - - - - - - - */
f_ptr funct_1(char *name, int type)
{
struct entry *ptr;
DBG_FPRINTF((errfile,
"\tfunct_1: unary_fn: %d; trig_fn: %d; i_trig_fn: %d\n",
sizeof(unary_fn)/sizeof(struct entry),
sizeof(trig_fn)/sizeof(struct entry),
sizeof(i_trig_fn)/sizeof(struct entry)));
switch (type) {
case UNARY:
ptr = unary_fn;
break;
case TRIG:
ptr = trig_fn;
break;
case I_TRIG:
ptr = i_trig_fn;
break;
}
for ( ; ptr->func_ptr != (f_ptr)NULL; ptr++) {
if (strcmp(name, ptr->name) == 0)
return ptr->func_ptr;
}
return (f_ptr)NULL;
}
/**\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\**/