Mercurial > octave-nkf
diff liboctave/lo-specfun.cc @ 10391:59e34bcdff13
implement built-in erfcx
author | Jaroslav Hajek <highegg@gmail.com> |
---|---|
date | Thu, 04 Mar 2010 09:35:38 +0100 |
parents | a3635bc1ea19 |
children | 2a8b1db1e2ca |
line wrap: on
line diff
--- a/liboctave/lo-specfun.cc Wed Mar 03 13:01:44 2010 -0500 +++ b/liboctave/lo-specfun.cc Thu Mar 04 09:35:38 2010 +0100 @@ -2,6 +2,7 @@ Copyright (C) 1996, 1998, 2002, 2003, 2004, 2005, 2006, 2007, 2008 John W. Eaton +Copyright (C) 2010 Jaroslav Hajek This file is part of Octave. @@ -3170,3 +3171,103 @@ { return do_erfinv (x, false); } + +// Implementation based on the Fortran code by W.J.Cody +// see http://www.netlib.org/specfun/erf. +// Templatized and simplified workflow. + +// FIXME: Maybe this should be globally visible. +static inline float erfc (float x) { return erfcf (x); } + +template <class T> +static T +erfcx_impl (T x) +{ + static const T c[] = + { + 5.64188496988670089e-1,8.88314979438837594, + 6.61191906371416295e+1,2.98635138197400131e+2, + 8.81952221241769090e+2,1.71204761263407058e+3, + 2.05107837782607147e+3,1.23033935479799725e+3, + 2.15311535474403846e-8 + }; + + static const T d[] = + { + 1.57449261107098347e+1,1.17693950891312499e+2, + 5.37181101862009858e+2,1.62138957456669019e+3, + 3.29079923573345963e+3,4.36261909014324716e+3, + 3.43936767414372164e+3,1.23033935480374942e+3 + }; + + static const T p[] = + { + 3.05326634961232344e-1,3.60344899949804439e-1, + 1.25781726111229246e-1,1.60837851487422766e-2, + 6.58749161529837803e-4,1.63153871373020978e-2 + }; + + static const T q[] = + { + 2.56852019228982242,1.87295284992346047, + 5.27905102951428412e-1,6.05183413124413191e-2, + 2.33520497626869185e-3 + }; + + static const T sqrpi = 5.6418958354775628695e-1; + static const T xhuge = sqrt (1.0 / std::numeric_limits<T>::epsilon ()); + static const T xneg = -sqrt (log (std::numeric_limits<T>::max ()/2.0)); + + double y = fabs (x), result; + if (x < xneg) + result = octave_Inf; + else if (y <= 0.46875) + result = std::exp (x*x) * erfc (x); + else + { + if (y <= 4.0) + { + double xnum = c[8]*y, xden = y; + for (int i = 0; i < 7; i++) + { + xnum = (xnum + c[i]) * y; + xden = (xden + d[i]) * y; + } + + result = (xnum + c[7]) / (xden + d[7]); + } + else if (y <= xhuge) + { + double y2 = 1/(y*y), xnum = p[5]*y2, xden = y2; + for (int i = 0; i < 4; i++) + { + xnum = (xnum + p[i]) * y2; + xden = (xden + q[i]) * y2; + } + + result = y2 * (xnum + p[4]) / (xden + q[4]); + result = (sqrpi - result) / y; + } + else + result = sqrpi / y; + + // Fix up negative argument. + if (x < 0) + { + double y2 = ceil (x / 16.0) * 16.0, del = (x-y2)*(x+y2); + result = 2*(std::exp(y2*y2) * std::exp(del)) - result; + } + } + + return result; +} + +double erfcx (double x) +{ + return erfcx_impl (x); +} + +float erfcx (float x) +{ + return erfcx_impl (x); +}