pspline 5.0.5 → 5.1.0

data/ext/pspline/include/basis/real.h

@@ -0,0 +1,526 @@
+#ifndef _REAL_H_
+#define _REAL_H_
+
+#include <math.h>
+#include "basis/gabs.h"
+#include "basis/util.h"
+#include "basis/marray_ext.h"
+#include "basis/real_inline.h"
+#include "basis/marray_class_ext.h"
+
+namespace rios {
+	typedef unsigned int fmtflags;
+	extern unsigned int fixed;
+	extern unsigned int scientific;
+};
+
+#define MAXN 1
+#define LMTN 4
+
+template <typename T> class real : public varray<T>
+{
+public:
+// default construtor
+real() : varray<T>(1) { this->w[0] = 0.0; }
+// general constructor
+explicit real(size_t n) : varray<T>(size_t(1), n)
+{
+	for (size_t i = 0; i <= n; ++i) this->w[i] = 0.0;
+}
+real(size_t n, const T *a, int f = 1) : varray<T>(const_cast<T*>(a), 1, n, 1, f) {}
+
+real(const T *a, size_t s, size_t n, int t = 1, int f = 1) : varray<T>(const_cast<T*>(a), s, n, t, f) {}
+
+real(T a, size_t n = 0) : varray<T>(size_t(1), n)
+{
+	this->w[0] = a; for (size_t i = 1; i <= this->N; ++i) this->w[i] = 0.0;
+}
+explicit real(const char *s, size_t n = MAXN) : varray<T>(size_t(1), n)
+{
+	if (read(s, *this)) throw "(real::qd_real): INPUT ERROR.";
+}
+real(const varray<T>& v) : varray<T>((T*)v, v.size(), v.atom(), v.stride()) {}
+// copy constructor
+real(const real& p) : varray<T>(size_t(1), p.N)
+{
+	for (size_t i = 0; i <= this->N; ++i) this->w[i] = p.w[i];
+}
+// destructor
+~real() = default;
+// assignment operator
+real& operator = (const real&);
+real& operator = (const varray<T>&);
+real& operator = (const char*);
+real& operator = (T);
+// Renormalization
+void normalize() { renorm(this->N, this->w); }
+void normalize(T e) { renorm(this->N, this->w, e); }
+
+/************ Additions *************/
+/* real<T,N> = T + T */
+static real add(T a, T b)
+{
+	T s[2];
+	s[0] = two_sum(a, b, s[1]);
+	return real(size_t(1), s);
+}
+/* real<T,N> + T */
+friend real operator + (const real& a, T b)
+{
+	size_t N = a.N; double s[N+1];
+	qd_add(N, s, a.w, b);
+	return real(N, s);
+}
+/* T + real<T,N> */
+friend real operator + (T a, const real& b)
+{
+	return (b + a);
+}
+
+/* real<T,N> + real<T,M> */
+friend real operator + <> (const real& a, const real& b);
+
+/*********** Self-Additions ************/
+/* real<T,N> += T */
+real& operator += (T a)
+{
+	qd_add(this->N, this->w, this->w, a);
+	return *this;
+}
+
+/* real<T,N> += real<T,M> */
+real& operator += (const real& a)
+{
+	size_t M = a.N;
+	if (this->N <= M) { qd_add(this->N, this->w, this->w, a.w); } else
+	{
+		T u[this->N+1];
+		for (size_t i = 0; i <= this->N; ++i) u[i] = (i <= M) ? a.w[i] : 0.0;
+		qd_add(this->N, this->w, this->w, u);
+	}
+	return *this;
+}
+/********** Unary Minus **********/
+real operator - () const
+{
+	T s[this->N+1];
+	qd_minus(this->N, s, this->w);
+	return real(this->N, s);
+}
+/********** Subtractions ***********/
+/* real<T,N> = T - T */
+static real sub(T a, T b)
+{
+	T s[2];
+	s[0] = two_diff(a, b, s[1]);
+	return real(size_t(1), s);
+}
+
+friend real operator - (const real& a, T b)
+{
+	return (a + (-b));
+}
+
+friend real operator - (T a, const real& b)
+{
+	return (a + (-b));
+}
+
+friend real operator - (const real& a, const real& b)
+{
+	return (a + (-b));
+}
+/********** Self-Subtractions **********/
+real& operator -= (T a)
+{
+	qd_sub(this->N, this->w, this->w, a);
+	return *this;
+}
+
+real& operator -= (const real<T>& a)
+{
+	size_t M = a.N;
+	if (this->N <= M) { qd_sub(this->N, this->w, this->w, a.w); } else
+	{
+		T u[this->N+1];
+		for (size_t i = 0; i <= this->N; ++i) u[i] = (i <= M) ? a.w[i] : 0.0;
+		qd_sub(this->N, this->w, this->w, u);
+	}
+	return *this;
+}
+/********** Multiplications ***********/
+friend real mul_pwr2(const real& a, T b)
+{
+	const size_t N = a.N;
+	real s(N);
+	for (size_t i = 0; i <= N; ++i) s.w[i] = a.w[i] * b;
+	return s;
+}
+/* T-T * (2.0 ^ exp) */
+friend real ldexp(const real& a, int n)
+{
+	const size_t N = a.N;
+	real s(N);
+	for (size_t i = 0; i <= N; ++i) s.w[i] = _ldexp(a.w[i], n);
+	return s;
+}
+/* real<T,N> = T * T */
+static real mul(T a, T b)
+{
+	T p[2];
+	p[0] = two_prod(a, b, p[1]);
+	return real(size_t(1), p);
+}
+/* real<T,N> * T */
+friend real operator * (const real& a, T b)
+{
+	size_t N = a.N; double s[N+1];
+	qd_mul(N, s, a.w, b);
+	return real(N, s);
+}
+/* T * real<T,N> */
+friend real operator * (T a, const real& b)
+{
+  return (b * a);
+}
+/* real<T,N> * real<T,N> */
+friend real operator * <> (const real& a, const real& b);
+/********** Self-Multiplication **********/
+/* real<T,N> *= T */
+real& operator *= (T a)
+{
+	qd_mul(this->N, this->w, this->w, a);
+	return *this;
+}
+/* real<T,N> *= real<T,N> */
+real& operator *= (const real& a)
+{
+	size_t M = a.N;
+	if (this->N <= M) { qd_mul(this->N, this->w, this->w, a.w); } else
+	{
+		T u[this->N+1];
+		for (size_t i = 0; i <= this->N; ++i) u[i] = (i <= M) ? a.w[i] : 0.0;
+		qd_mul(this->N, this->w, this->w, u);
+	}
+	return *this;
+}
+/********** Divisions ***********/
+static real div(T a, T b)
+{
+	T q1, q2, p1, p2, s[2];
+
+	q1 = a / b;
+	/* Compute  a - q1 * b */
+	p1 = two_prod(q1, b, p2);
+	 s[0] = two_diff(a, p1,  s[1]);
+	s[1] -= p2;
+	/* get next approximation */
+	q2 = (s[0] + s[1]) / b;
+	s[0] = quick_two_sum(q1, q2, s[1]);
+	return real(size_t(1), s);
+}
+/* real<T,N> / T */
+friend real operator / (const real& a, T b)
+{
+	const size_t N = a.N; double q[N+1];
+	qd_div(N, q, a.w, b);
+	return real(N, q);
+}
+/* real<T,N> / real<T,M> */
+friend real operator / <> (const real& a, const real& b);
+/* T / real<T,N> */
+friend real operator / (T a, const real& b)
+{
+	real s(b.N); s.w[0] = a;
+	return s / b;
+}
+
+friend real inv(const real& b)
+{
+	real s(b.N); s.w[0] = 1.0;
+	return s / b;
+}
+/********** Self-Divisions **********/
+/* real<T,N> /= T */
+real& operator /= (T a)
+{
+	qd_div(this->N, this->w, this->w, a);
+	return *this;
+}
+/* real<T,N> /= real<T,N> */
+real& operator /= (const real& a)
+{
+	size_t M = a.N;
+	if (this->N <= M) { qd_div(this->N, this->w, this->w, a.w); } else
+	{
+		T u[this->N+1];
+		for (size_t i = 0; i <= this->N; ++i) u[i] = (i <= M) ? a.w[i] : 0.0;
+		qd_div(this->N, this->w, this->w, u);
+	}
+	return *this;
+}
+/*********** Squaring **********/
+friend real sqr <> (const real& a);
+
+static real sqr(T a)
+{
+	T p[2];
+	p[0] = two_sqr(a, p[1]);
+	return real(size_t(1), p);
+}
+/********** Exponentiation **********/
+friend real pow(const real& a, int n)
+{
+	return npwr(a, n);
+}
+
+real operator ^ (int n) const
+{
+	return pow(*this, n);
+}
+/********** Miscellaneous **********/
+friend real abs(const real& a)
+{
+	return (a.w[0] < 0.0) ? -a : a;
+}
+/********** Equality Comparison **********/
+friend bool operator == (const real& a, T b)
+{
+	return qd_eq(a.N, a.w, b);
+}
+friend bool operator == (T a, const real& b)
+{
+	return (b == a);
+}
+friend bool operator == <> (const real& a, const real& b);
+
+/********** Less-Than Comparison ***********/
+friend bool operator < (const real& a, T b)
+{
+	return qd_lt(a.N, a.w, b);
+}
+friend bool operator < (T a, const real& b)
+{
+	return (b > a);
+}
+friend bool operator < <> (const real& a, const real& b);
+
+/********** Greater-Than Comparison ***********/
+friend bool operator > (const real& a, T b)
+{
+	return qd_gt(a.N, a.w, b);
+}
+friend bool operator > (T a, const real& b)
+{
+	return (b < a);
+}
+friend bool operator > <> (const real& a, const real& b);
+
+/********** Less-Than-Or-Equal-To Comparison **********/
+friend bool operator <= (const real& a, T b)
+{
+	return qd_le(a.N, a.w, b);
+}
+friend bool operator <= (T a, const real& b)
+{
+	return (b >= a);
+}
+friend bool operator <= <> (const real& a, const real& b);
+
+/********** Greater-Than-Or-Equal-To Comparison **********/
+friend bool operator >= (const real& a, T b)
+{
+	return qd_ge(a.N, a.w, b);
+}
+friend bool operator >= (T a, const real& b)
+{
+	return (b <= a);
+}
+friend bool operator >= <> (const real& a, const real& b);
+
+/********** Not-Equal-To Comparison **********/
+friend bool operator != (const real& a, T b)
+{
+	return !(a == b);
+}
+friend bool operator != (T a, const real& b)
+{
+	return !(a == b);
+}
+friend bool operator != (const real& a, const real& b)
+{
+	return !(a == b);
+}
+/********** Multiplications **********/
+friend real nint(const real& a)
+{
+	const size_t N = a.N;
+	real x(N);
+	x.w[0] = _nint(a.w[0]);
+	for (size_t i = 0; i < N; ++i) {
+		if (x.w[i] != a.w[i]) {
+			if (fabs(x.w[i] - a.w[i]) == 0.5 && a.w[i+1] < 0.0)
+				x.w[i] -= 1.0;
+			break;
+		}
+		x.w[i+1] = _nint(a.w[i+1]);
+	}
+	renorm(N, x.w);
+	return x;
+}
+friend real floor(const real& a)
+{
+	const size_t N = a.N;
+	real x(N);
+	for (size_t i = 0; i <= N; ++i) {
+		x.w[i] = _floor(a.w[i]);
+		if (x.w[i] != a.w[i]) break;
+    }
+	renorm(N, x.w);
+    return x;
+}
+friend real ceil(const real& a)
+{
+	const size_t N = a.N;
+	real x(N);
+	for (size_t i = 0; i <= N; ++i) {
+		x.w[i] = _ceil(a.w[i]);
+		if (x.w[i] != a.w[i]) break;
+    }
+	renorm(N, x.w);
+    return x;
+}
+friend real max(const real& a, const real& b) { return (a > b) ? a : b; }
+friend real max(const real& a, const real& b, const real& c)
+{
+	return (a > b) ? ((a > c) ? a : c) : ((b > c) ? b : c);
+}
+friend real min(const real& a, const real& b) { return (a < b) ? a : b; }
+friend real min(const real& a, const real& b, const real& c)
+{
+	return (a < b) ? ((a < c) ? a : c) : ((b < c) ? b : c);
+}
+friend int sgn(const real& a) { return (a > 0.0) ? 1 : (a < 0.0) ? -1 : 0; }
+
+bool is_zero() const { return (this->w[0] == 0.0); }
+bool is_one() const
+{
+	size_t i; bool f = (this->w[0] == 1.0);
+	if (f) for (i = 0; i <= this->N; ++i) if (this->w[i] == 0.0) break;
+	return (f && i > this->N);
+}
+bool is_positive() const { return (this->w[0] > 0.0); }
+bool is_negative() const { return (this->w[0] < 0.0); }
+bool is_inf() const
+{
+	size_t i = 0;
+	if (this->w) for (; i <= this->N; ++i) if (isinf(this->w[i])) break;
+	return (!(this->w == NULL) && i <= this->N);
+}
+bool is_nan() const
+{
+	size_t i = 0;
+	if (this->w) for (; i <= this->N; ++i) if (isnan(this->w[i])) break;
+	return (i <= this->N);
+}
+#ifdef USE_RANDOM
+/* Random number generator */
+static real rand(size_t N) { return qdrand(N); }
+static real qdrand(size_t);
+static real debug_rand(size_t);
+static real uniform_rand(size_t, T, T);
+static real normal_rand(size_t, T, T);
+#endif
+operator T* () const {return this->w;}
+varray<T>* operator & () { return (varray<T>*)this; }
+real operator[](int n) const { const varray<T>& v = *this; assert(this->_size > size_t(n)); return v[n]; }
+T  operator()(int n) const {return (this->w == NULL) ? 0.0 : this->w[n];}
+T& operator()(int i) {assert(this->w != NULL); return this->w[i];}
+
+size_t atom() const {return this->N;}
+T to_d() const {return this->w[0];}
+int to_i() const {return static_cast<int>(this->w[0]);}
+char *to_a(const char *f = "%g") const;
+char *to_s(const char *f = "%g", char fill = ' ') const;
+void fprint(FILE *f, const char *fmt = "%g\n") const { gprint(*this, f, fmt); }
+void print(const char *fmt = "%g\n") const { this->fprint(stdout, fmt); }
+int read(const char *s, real& qd);
+int write(char *s, int len, int precision,
+	rios::fmtflags fmt, bool showpos = false, bool uppercase = false, char fill = '0') const;
+char *to_string(int precision, int width,
+	rios::fmtflags fmt, bool showpos = false, bool uppercase = false, char fill = '0') const;
+
+}; // end of real<T>;
+
+using Real =  real<double>;
+
+typedef enum { md, dd, hd, qd, pd, de, he, qe, pe } real_precision;
+
+template <typename T> class real_const
+{
+	const T *data;
+public:
+	real_const(const T* d) : data(d) {}
+	const real<T> operator[](size_t n) const { return real<T>(n, data); }
+	const real<T> operator[](real_precision n) const { return real<T>(static_cast<size_t>(n), data); }
+	T operator()(size_t n) const { return data[n]; }
+	T operator()(real_precision n) const { return data[static_cast<size_t>(n)]; }
+};
+
+/* Some useful constants. */
+extern real_const<double> _2pi           ;
+extern real_const<double> _pi            ;
+extern real_const<double> _pi2           ;
+extern real_const<double> _pi4           ;
+extern real_const<double> _3pi4          ;
+extern real_const<double> _e             ;
+extern real_const<double> _log2          ;
+extern real_const<double> _log10         ;
+extern real_const<double> _nan           ;
+extern real_const<double> _inf           ;
+extern real_const<double> _eps           ; // = 2^-209
+extern real_const<double> _min_normalized; // = 2^(-1022 + 3*53)
+extern real_const<double> _max           ;
+extern real_const<double> _safe_max      ;
+extern real_const<int>    _ndigits       ;
+extern real_const<double> _pi1024        ;
+extern const double real_const_table[15][5];
+extern const int real_const_ndigits[5];
+#define n_inv_fact 15
+extern const double real_inv_data[n_inv_fact][5];
+extern const double real_sin_data[256][5];	/* Table of sin(k * pi/1024)*/
+extern const double real_cos_data[256][5];	/* Table of cos(k * pi/1024). */
+
+template <> inline Real gabs(Real p) { return abs(p); }
+
+Real sqrt(const Real&);
+Real nroot(const Real&, int);
+Real exp(const Real&);
+Real log(const Real&);
+Real log10(const Real&);
+Real sin(const Real&);
+Real cos(const Real&);
+void sincos(const Real&, Real&, Real&);
+Real atan(const Real&);
+Real atan2(const Real&, const Real&);
+Real drem(const Real&, const Real&);
+Real divrem(const Real&, const Real&, Real&);
+Real tan(const Real&);
+Real asin(const Real&);
+Real acos(const Real&);
+Real sinh(const Real&);
+Real cosh(const Real&);
+Real tanh(const Real&);
+void sincosh(const Real&, Real&, Real&);
+Real asinh(const Real&);
+Real acosh(const Real&);
+Real atanh(const Real&);
+Real fmod(const Real&, const Real&);
+Real polyeval(const Real*, int, const Real &);
+Real polyroot(const Real*, int, const Real &, int = 64, double = 0.0);
+
+void debug_sin_table(real_precision);
+void debug_cos_table(real_precision);
+void debug_inv_fact(real_precision);
+
+#endif