mmath.mx

一个内存数据库的源代码这是服务器端还有客户端

@' The contents of this file are subject to the MonetDB Public License
@' Version 1.1 (the "License"); you may not use this file except in
@' compliance with the License. You may obtain a copy of the License at
@' http://monetdb.cwi.nl/Legal/MonetDBLicense-1.1.html
@'
@' Software distributed under the License is distributed on an "AS IS"
@' basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
@' License for the specific language governing rights and limitations
@' under the License.
@'
@' The Original Code is the MonetDB Database System.
@'
@' The Initial Developer of the Original Code is CWI.
@' Portions created by CWI are Copyright (C) 1997-2007 CWI.
@' All Rights Reserved.

@f mmath
@a N.J. Nes, M. Kersten
@d 07/01/1996
@+ The math module
This module contains the math commands. The implementation is very simply,
the c math library functions are called. See for documentation the
ANSI-C/POSIX manuals of the equaly named functions.

NOTE: the operand itself is being modified, rather than that we produce
a new BAT. This to save the expensive copying.
@{
@mal
module mmath;

command acos(x:flt):flt 
address MATHunary_ACOSflt;
command acos(x:dbl):dbl 
address MATHunary_ACOSdbl
comment "The acos(x) function calculates the arc cosine of x, that is the 
	value whose cosine is x. The value is returned in radians and is 
	mathematically defined to be between 0 and PI (inclusive).";

command asin(x:flt)  :flt 
address MATHunary_ASINflt;
command asin(x:dbl)  :dbl 
address MATHunary_ASINdbl
comment "The asin(x) function calculates the arc sine of x, that is the value 
	whose sine is x. The value is returned in radians and is mathematically 
	defined to be between -PI/20 and -PI/2 (inclusive).";

command atan(x:flt)     :flt 
address MATHunary_ATANflt;
command atan(x:dbl)     :dbl 
address MATHunary_ATANdbl
comment "The atan(x) function calculates the arc tangent of x, that is the value 
	whose tangent is x. The value is returned in radians and is mathematically 
	defined to be between -PI/2 and PI/2 (inclusive).";

command atan2(x:flt,y:flt):flt 
address MATHbinary_ATAN2flt;
command atan2(x:dbl,y:dbl):dbl 
address MATHbinary_ATAN2dbl
comment "The atan2(x,y) function calculates the arc tangent of the two 
        variables x and y.  It is similar to calculating the arc
	tangent of y / x, except that the signs of both arguments are 
        used to determine the quadrant of the result.  The value is 
	returned in radians and is mathematically defined to be between 
        -PI/2 and PI/2 (inclusive).";


command cos(x:flt)   	  :flt 
address MATHunary_COSflt;
command cos(x:dbl)   	  :dbl 
address MATHunary_COSdbl
comment "The cos(x) function returns the cosine of x, where x is given in 
        radians. The return value is between -1 and 1.";

command sin(x:flt)   	  :flt 
address MATHunary_SINflt;
command sin(x:dbl)   	  :dbl 
address MATHunary_SINdbl
comment "The sin(x) function returns the cosine of x, where x is given in 
        radians. The return value is between -1 and 1.";

command tan(x:flt)   	  :flt 
address MATHunary_TANflt;
command tan(x:dbl)   	  :dbl 
address MATHunary_TANdbl
comment "The tan(x) function returns the tangent of x,
        where x is given in radians";


command cosh(x:flt)     :flt 
address MATHunary_COSHflt;
command cosh(x:dbl)     :dbl 
address MATHunary_COSHdbl
comment "The cosh() function  returns the hyperbolic cosine of x, which is 
	defined mathematically as (exp(x) + exp(-x)) / 2.";

command sinh(x:flt)     :flt 
address MATHunary_SINHflt;
command sinh(x:dbl)     :dbl 
address MATHunary_SINHdbl
comment "The sinh() function  returns  the  hyperbolic sine of x, which 
        is defined mathematically as (exp(x) - exp(-x)) / 2.";

command tanh(x:flt)     :flt 
address MATHunary_TANHflt;
command tanh(x:dbl)     :dbl 
address MATHunary_TANHdbl
comment "The tanh() function returns the hyperbolic tangent of x, which is 
	defined mathematically as sinh(x) / cosh(x).";


command exp(x:flt)   	  :flt 
address MATHunary_EXPflt;
command exp(x:dbl)   	  :dbl 
address MATHunary_EXPdbl
comment "The exp(x) function returns the value of e (the base of 
        natural logarithms) raised to the power of x.";

command log(x:flt)   	  :flt 
address MATHunary_LOGflt;
command log(x:dbl)   	  :dbl 
address MATHunary_LOGdbl
comment "The log(x) function returns the natural logarithm of x.";

command log10(x:flt)    :flt 
address MATHunary_LOG10flt;
command log10(x:dbl)    :dbl 
address MATHunary_LOG10dbl
comment "The log10(x) function returns the base-10 logarithm of x.";


command pow(x:flt,y:flt)  :flt 
address MATHbinary_POWflt;
command pow(x:dbl,y:dbl)  :dbl 
address MATHbinary_POWdbl
comment "The pow(x,y) function  returns the value of x raised to the power of y.";

command sqrt(y:flt)  	  :flt 
address MATHunary_SQRTflt;
command sqrt(y:dbl)  	  :dbl 
address MATHunary_SQRTdbl
comment "The sqrt(x) function returns the non-negative square root of x.";


command ceil(y:flt)     :flt 
address MATHunary_CEILflt;
command ceil(y:dbl)     :dbl 
address MATHunary_CEILdbl
comment "The ceil(x) function rounds x upwards to the nearest integer.";

command fabs(y:dbl)     :dbl 
address MATHunary_FABSdbl
comment "The fabs(x) function  returns  the  absolute value of the 
        floating-point number x.";

command floor(y:flt)    :flt 
address MATHunary_FLOORflt;
command floor(y:dbl)    :dbl 
address MATHunary_FLOORdbl
comment "The floor(x) function rounds x downwards to the nearest integer.";

command fmod(y:flt,x:flt) :flt 
address MATHbinary_FMODflt;
command fmod(y:dbl,x:dbl) :dbl 
address MATHbinary_FMODdbl
comment "The fmod(x,y) function computes the remainder of dividing x by y.
	The return value is x - n * y, where n is the quotient of x / y,
	rounded towards zero to an integer.";

command round(x:flt,y:int)     :flt 
address MATHbinary_ROUNDflt;
command round(x:dbl,y:int)     :dbl 
address MATHbinary_ROUNDdbl
comment "The round(n, m) returns n rounded to m places to the right 
        of the decimal point; if m is omitted, to 0 places. m can be 
	negative to round off digits left of the decimal point. 
        m must be an integer.";

command isnan(d:dbl) :bit 
address math_unary_ISNAN
comment "The isnan(x) function returns true if x is 'not-a-number' 
        (NaN), and false otherwise.";
command isinf(d:dbl) :int 
address math_unary_ISINF
comment "The isinf(x) function returns -1 if x represents negative 
        infinity, 1 if x represents positive infinity, and 0 otherwise.";
command finite(d:dbl) :bit 
address math_unary_FINITE
comment "The finite(x) function returns true if x is neither infinite 
        nor a 'not-a-number' (NaN) value, and false otherwise.";

@+ Random numbers
@mal
command rand () :int 
address MATHrandint
comment "return a random number";
command srand(seed:int) :void 
address MATHsrandint
comment "initialize the rand() function with a seed";

function mmath.pi():dbl;
	pi := 3.14159265358979323846:dbl;
	return pi;
end pi;

@-
The constants defined in math.h are defined in const.mx
@mil
module(mmath);
# these tests are disabled: they're in mmath2 test
setoid(oid(20000000));
#asin(sin(M_PI)).print;
#acos(cos(M_PI)).print;
#atan(tan(M_PI_2)).print;
#atan(tan(M_PI_4)).print;
#tan(atan2(dbl(0.1),dbl(1.0))).print;
#sqrt(pow(dbl(2),dbl(2))).print;

#exp(dbl(10)).print;
#log(dbl(10)).print;
#log10(dbl(10)).print;

#ceil(dbl(1.2)).print;
#fabs(dbl(1.2)).print;
#floor(dbl(1.2)).print;
#fmod(dbl(15.2),dbl(2.5)).print;

quit;
@h
#ifndef __MMATH_H__
#define __MMATH_H__

#include <gdk.h>

#endif /* __MMATH_H__ */

@+ Implementation Code
@c
#include "mal_config.h"

#include "mmath.h"
#include <math.h>

extern double sqrt(double x);
extern double cbrt(double x);
extern double sin(double x);
extern double cos(double x);
extern double fabs(double x);

#ifdef WIN32
#ifndef LIBMMATH
#define mmath_export extern __declspec(dllimport)
#else
#define mmath_export extern __declspec(dllexport)
#endif
#else
#define mmath_export extern
#endif

#define acos_unary(x, z)      *z = acos(*x)
#define asin_unary(x, z)      *z = asin(*x)
#define atan_unary(x, z)      *z = atan(*x)
#define atan2_binary(x, y, z) *z = atan2(*x,*y)
#define cos_unary(x, z)	      *z = cos(*x)
#define sin_unary(x, z)	      *z = sin(*x)
#define tan_unary(x, z)	      *z = tan(*x)

#define cosh_unary(x, z)       *z = cosh(*x)
#define sinh_unary(x, z)       *z = sinh(*x)
#define tanh_unary(x, z)       *z = tanh(*x)

#define exp_unary(x, z)	      *z = exp(*x)
#define log_unary(x, z)	      *z = log(*x)
#define log10_unary(x, z)     *z = log10(*x)

#define pow_binary(x, y, z)   *z = pow(*x,*y)
#define sqrt_unary(x, z)      *z = sqrt(*x)

#define ceil_unary(x, z)      *z = ((-1.0<*x)&&(*x<0.0))?0.0:ceil(*x)
#define fabs_unary(x, z)      *z = fabs(*x)
#define floor_unary(x, z)     *z = floor(*x)
#define fmod_binary(x, y, z)  *z = fmod(*x,*y)

#ifdef _MSC_VER
#include <float.h>
/* Windows spells these differently */
#define isnan(x)	_isnan(x)
#define finite(x)	_finite(x)
/* NOTE: HAVE_FPCLASS assumed... */
#define fpclass(x)	_fpclass(x)
#define FP_NINF		_FPCLASS_NINF
#define FP_PINF		_FPCLASS_PINF
#else /* !_MSC_VER */
#ifdef HAVE_IEEEFP_H
#include <ieeefp.h>
#endif
#endif

#if defined(HAVE_FPCLASSIFY) || defined(fpclassify)

/* C99 interface: fpclassify */
#define MNisinf(x)	(fpclassify(x) == FP_INFINITE)
#define MNisnan(x)	(fpclassify(x) == FP_NAN)
#define MNfinite(x)	(!MNisinf(x) && !MNisnan(x))

#else

#define MNisnan(x)	isnan(x)
#define MNfinite(x)	finite(x)

#ifdef HAVE_ISINF

#define MNisinf(x)	isinf(x)

#else

static int
MNisinf(double x)
{
#ifdef HAVE_FPCLASS
	int cl = fpclass(x);

	return ((cl == FP_NINF) || (cl == FP_PINF));
#else
	return 0;		/* XXX not correct if infinite */
#endif /* HAVE_FPCLASS */
}

#endif /* HAVE_ISINF */
#endif /* HAVE_FPCLASSIFY */

#include "mal.h"
#include "mal_exception.h"
mmath_export str math_unary_FINITE(bit *res, dbl *a);
mmath_export str math_unary_ISNAN(bit *res, dbl *a);
mmath_export str math_unary_ISINF(int *res, dbl *a);

@:unop(_ACOS,acos)@
@:unop(_ASIN,asin)@
@:unop(_ATAN,atan)@
@:binop(_ATAN2,atan2)@
@:unop(_COS,cos)@
@:unop(_SIN,sin)@
@:unop(_TAN,tan)@

@:unop(_COSH,cosh)@
@:unop(_SINH,sinh)@
@:unop(_TANH,tanh)@

@:unop(_EXP,exp)@
@:unop(_LOG,log)@
@:unop(_LOG10,log10)@

@:binop(_POW,pow)@
@:unop(_SQRT,sqrt)@

@:unop(_CEIL,ceil)@
@:unop(_FABS,fabs)@
@:unop(_FLOOR,floor)@
@:binop(_FMOD,fmod)@

@= unop
str
math_unary@1(dbl *res , dbl *a )
{
#ifdef DEBUG
	printf( "math_unary@1\n");
#endif
	if (*a == dbl_nil) {
		*res = dbl_nil;
	} else {
		errno = 0;
		@2_unary( a, res );
		if (errno == EDOM)
			throw(MAL, "mmath.@1","Negative argument is not allowed");
		if (errno == ERANGE)
			throw(MAL, "mmath.@1","Range error");
		if (MNisnan(*res))
			throw(MAL, "mmath.@1","Negative argument is not allowed");
		if (!MNfinite(*res))
			throw(MAL, "mmath.@1","Range error");
	}
	return MAL_SUCCEED;
}
@

@= binop
str
math_binary@1(dbl *res, dbl *a, dbl *b )
{
#ifdef DEBUG
	printf( "math_binary@1\n");
#endif
	if (*a == dbl_nil || *b == dbl_nil) {
		*res = dbl_nil;
	} else {
		@2_binary( a, b, res);
	}
	return MAL_SUCCEED;
}
@

@c
str
math_binary_ROUND(dbl *res, dbl *x, int *y)
{
	if (*x == dbl_nil || *y == int_nil) {
		*res = dbl_nil;
	} else {
		double factor = pow(10, *y), integral;
		double tmp = *y > 0 ? modf(*x, &integral) : *x;

		tmp *= factor;
		if (tmp >= 0)
			tmp = floor(tmp + 0.5);
		else
			tmp = ceil(tmp - 0.5);
		tmp /= factor;

		if (*y > 0)
			tmp += integral;

		*res = tmp;
	}

	return MAL_SUCCEED;
}

str
math_unary_ISNAN(bit *res, dbl *a)
{
#ifdef DEBUG
	printf("math_unary_ISNAN\n");
#endif
	if (*a == dbl_nil) {
		*res = bit_nil;
	} else {
		*res = MNisnan(*a);
	}
	return MAL_SUCCEED;
}

str
math_unary_ISINF(int *res, dbl *a)
{
#ifdef DEBUG
	printf("math_unary_ISINF\n");
#endif
	if (*a == dbl_nil) {
		*res = int_nil;
	} else {
		if (MNisinf(*a)) {
			*res = (*a < 0.0) ? -1 : 1;
		} else {
			*res = 0;
		}
	}
	return MAL_SUCCEED;
}

str
math_unary_FINITE(bit *res, dbl *a)
{
#ifdef DEBUG
	printf("math_unary_FINITE\n");
#endif
	if (*a == dbl_nil) {
		*res = bit_nil;
	} else {
		*res = MNfinite(*a);
	}
	return MAL_SUCCEED;
}

@- Wrapping
Wrapping around the M4 code base
@-
@= unopbaseM5
mmath_export str MATHunary@1@3(@3 *res , @3 *a );
str MATHunary@1@3(@3 *res , @3 *a ) {
#ifdef DEBUG
		printf( "MATHunary@1@3\n");
#endif
	dbl tmp1,tmp2;
	str msg= MAL_SUCCEED;
	if (*a == @3_nil) {
		*res = @3_nil;
	} else {
		tmp1= *a;
		@2_unary( &tmp1, &tmp2 );
		*res = (@3) tmp2;
	}
   return msg;
}

@-
@= unopM5
  @:unopbaseM5(@1,@2,dbl)@
  @:unopbaseM5(@1,@2,flt)@

@= binopbaseM5
mmath_export str MATHbinary@1@3(@3 *res, @3 *a, @3 *b );
str MATHbinary@1@3(@3 *res, @3 *a, @3 *b ) {
#ifdef DEBUG
		printf( "MATHbinary@1\n");
#endif
   if (*a == @3_nil || *b == @3_nil) {
		*res = @3_nil;
   } else {
		dbl r1 ,a1 = *a, b1 = *b;
		@2_binary( &a1, &b1, &r1);
		*res= (@3) r1;
   }
   return MAL_SUCCEED;
}
@= binopM5
  @:binopbaseM5(@1,@2,dbl)@
  @:binopbaseM5(@1,@2,flt)@
@
@= roundM5
mmath_export str MATHbinary_ROUND@1(@1 *res, @1 *x, int *y);
str MATHbinary_ROUND@1(@1 *res, @1 *x, int *y) {
  if(*x == @1_nil || *y == int_nil) {
	*res = @1_nil;
  } else {
	dbl factor = pow(10,*y), integral;
	dbl tmp = *y>0?modf(*x,&integral):*x;

	tmp *= factor;
	if(tmp>=0)
	  tmp = floor(tmp+0.5);
	else
	  tmp = ceil(tmp-0.5);
	tmp /= factor;

	if(*y>0)
	  tmp += integral;

	*res = (@1) tmp;
  }
  return MAL_SUCCEED;
}
@c
@:unopM5(_ACOS,acos)@
@:unopM5(_ASIN,asin)@
@:unopM5(_ATAN,atan)@
@:binopM5(_ATAN2,atan2)@
@:unopM5(_COS,cos)@
@:unopM5(_SIN,sin)@
@:unopM5(_TAN,tan)@

@:unopM5(_COSH,cosh)@
@:unopM5(_SINH,sinh)@
@:unopM5(_TANH,tanh)@

@:unopM5(_EXP,exp)@
@:unopM5(_LOG,log)@
@:unopM5(_LOG10,log10)@

@:binopM5(_POW,pow)@
@:unopM5(_SQRT,sqrt)@

@:unopM5(_CEIL,ceil)@
@:unopbaseM5(_FABS,fabs,dbl)@
@:unopM5(_FLOOR,floor)@
@:binopM5(_FMOD,fmod)@

@:roundM5(dbl)@
@:roundM5(flt)@

mmath_export str MATHunary_ISNAN(bit *res, dbl *a);
str
MATHunary_ISNAN(bit *res, dbl *a)
{
	return math_unary_ISNAN(res, a);
}

mmath_export str MATHunary_ISINF(int *res, dbl *a);
str
MATHunary_ISINF(int *res, dbl *a)
{
	return math_unary_ISINF(res, a);
}

mmath_export str MATHunary_FINITE(bit *res, dbl *a);
str
MATHunary_FINITE(bit *res, dbl *a)
{
	return math_unary_FINITE(res, a);
}

mmath_export str MATHrandint(int *res);
str
MATHrandint(int *res)
{
	*res = rand();
	return MAL_SUCCEED;
}

mmath_export str MATHsrandint(int *seed);
str
MATHsrandint(int *seed)
{
	srand(*seed);
	return MAL_SUCCEED;
}

@}