|
Packit |
67cb25 |
/* specfunc/hyperg.c
|
|
Packit |
67cb25 |
*
|
|
Packit |
67cb25 |
* Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
|
|
Packit |
67cb25 |
*
|
|
Packit |
67cb25 |
* This program is free software; you can redistribute it and/or modify
|
|
Packit |
67cb25 |
* it under the terms of the GNU General Public License as published by
|
|
Packit |
67cb25 |
* the Free Software Foundation; either version 3 of the License, or (at
|
|
Packit |
67cb25 |
* your option) any later version.
|
|
Packit |
67cb25 |
*
|
|
Packit |
67cb25 |
* This program is distributed in the hope that it will be useful, but
|
|
Packit |
67cb25 |
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Packit |
67cb25 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
Packit |
67cb25 |
* General Public License for more details.
|
|
Packit |
67cb25 |
*
|
|
Packit |
67cb25 |
* You should have received a copy of the GNU General Public License
|
|
Packit |
67cb25 |
* along with this program; if not, write to the Free Software
|
|
Packit |
67cb25 |
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
Packit |
67cb25 |
*/
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* Author: G. Jungman */
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* Miscellaneous implementations of use
|
|
Packit |
67cb25 |
* for evaluation of hypergeometric functions.
|
|
Packit |
67cb25 |
*/
|
|
Packit |
67cb25 |
#include <config.h>
|
|
Packit |
67cb25 |
#include <gsl/gsl_math.h>
|
|
Packit |
67cb25 |
#include <gsl/gsl_errno.h>
|
|
Packit |
67cb25 |
#include <gsl/gsl_sf_exp.h>
|
|
Packit |
67cb25 |
#include <gsl/gsl_sf_gamma.h>
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
#include "error.h"
|
|
Packit |
67cb25 |
#include "hyperg.h"
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
#define SUM_LARGE (1.0e-5*GSL_DBL_MAX)
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
int
|
|
Packit |
67cb25 |
gsl_sf_hyperg_1F1_series_e(const double a, const double b, const double x,
|
|
Packit |
67cb25 |
gsl_sf_result * result
|
|
Packit |
67cb25 |
)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
double an = a;
|
|
Packit |
67cb25 |
double bn = b;
|
|
Packit |
67cb25 |
double n = 1.0;
|
|
Packit |
67cb25 |
double del = 1.0;
|
|
Packit |
67cb25 |
double abs_del = 1.0;
|
|
Packit |
67cb25 |
double max_abs_del = 1.0;
|
|
Packit |
67cb25 |
double sum_val = 1.0;
|
|
Packit |
67cb25 |
double sum_err = 0.0;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
while(abs_del/fabs(sum_val) > 0.25*GSL_DBL_EPSILON) {
|
|
Packit |
67cb25 |
double u, abs_u;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if(bn == 0.0) {
|
|
Packit |
67cb25 |
DOMAIN_ERROR(result);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if(an == 0.0) {
|
|
Packit |
67cb25 |
result->val = sum_val;
|
|
Packit |
67cb25 |
result->err = sum_err;
|
|
Packit |
67cb25 |
result->err += 2.0 * GSL_DBL_EPSILON * n * fabs(sum_val);
|
|
Packit |
67cb25 |
return GSL_SUCCESS;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if (n > 10000.0) {
|
|
Packit |
67cb25 |
result->val = sum_val;
|
|
Packit |
67cb25 |
result->err = sum_err;
|
|
Packit |
67cb25 |
GSL_ERROR ("hypergeometric series failed to converge", GSL_EFAILED);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
u = x * (an/(bn*n));
|
|
Packit |
67cb25 |
abs_u = fabs(u);
|
|
Packit |
67cb25 |
if(abs_u > 1.0 && max_abs_del > GSL_DBL_MAX/abs_u) {
|
|
Packit |
67cb25 |
result->val = sum_val;
|
|
Packit |
67cb25 |
result->err = fabs(sum_val);
|
|
Packit |
67cb25 |
GSL_ERROR ("overflow", GSL_EOVRFLW);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
del *= u;
|
|
Packit |
67cb25 |
sum_val += del;
|
|
Packit |
67cb25 |
if(fabs(sum_val) > SUM_LARGE) {
|
|
Packit |
67cb25 |
result->val = sum_val;
|
|
Packit |
67cb25 |
result->err = fabs(sum_val);
|
|
Packit |
67cb25 |
GSL_ERROR ("overflow", GSL_EOVRFLW);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
abs_del = fabs(del);
|
|
Packit |
67cb25 |
max_abs_del = GSL_MAX_DBL(abs_del, max_abs_del);
|
|
Packit |
67cb25 |
sum_err += 2.0*GSL_DBL_EPSILON*abs_del;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
an += 1.0;
|
|
Packit |
67cb25 |
bn += 1.0;
|
|
Packit |
67cb25 |
n += 1.0;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
result->val = sum_val;
|
|
Packit |
67cb25 |
result->err = sum_err;
|
|
Packit |
67cb25 |
result->err += abs_del;
|
|
Packit |
67cb25 |
result->err += 2.0 * GSL_DBL_EPSILON * n * fabs(sum_val);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
return GSL_SUCCESS;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
int
|
|
Packit |
67cb25 |
gsl_sf_hyperg_1F1_large_b_e(const double a, const double b, const double x, gsl_sf_result * result)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
if(fabs(x/b) < 1.0) {
|
|
Packit |
67cb25 |
const double u = x/b;
|
|
Packit |
67cb25 |
const double v = 1.0/(1.0-u);
|
|
Packit |
67cb25 |
const double pre = pow(v,a);
|
|
Packit |
67cb25 |
const double uv = u*v;
|
|
Packit |
67cb25 |
const double uv2 = uv*uv;
|
|
Packit |
67cb25 |
const double t1 = a*(a+1.0)/(2.0*b)*uv2;
|
|
Packit |
67cb25 |
const double t2a = a*(a+1.0)/(24.0*b*b)*uv2;
|
|
Packit |
67cb25 |
const double t2b = 12.0 + 16.0*(a+2.0)*uv + 3.0*(a+2.0)*(a+3.0)*uv2;
|
|
Packit |
67cb25 |
const double t2 = t2a*t2b;
|
|
Packit |
67cb25 |
result->val = pre * (1.0 - t1 + t2);
|
|
Packit |
67cb25 |
result->err = pre * GSL_DBL_EPSILON * (1.0 + fabs(t1) + fabs(t2));
|
|
Packit |
67cb25 |
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
|
|
Packit |
67cb25 |
return GSL_SUCCESS;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else {
|
|
Packit |
67cb25 |
DOMAIN_ERROR(result);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
int
|
|
Packit |
67cb25 |
gsl_sf_hyperg_U_large_b_e(const double a, const double b, const double x,
|
|
Packit |
67cb25 |
gsl_sf_result * result,
|
|
Packit |
67cb25 |
double * ln_multiplier
|
|
Packit |
67cb25 |
)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
double N = floor(b); /* b = N + eps */
|
|
Packit |
67cb25 |
double eps = b - N;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if(fabs(eps) < GSL_SQRT_DBL_EPSILON) {
|
|
Packit |
67cb25 |
double lnpre_val;
|
|
Packit |
67cb25 |
double lnpre_err;
|
|
Packit |
67cb25 |
gsl_sf_result M;
|
|
Packit |
67cb25 |
if(b > 1.0) {
|
|
Packit |
67cb25 |
double tmp = (1.0-b)*log(x);
|
|
Packit |
67cb25 |
gsl_sf_result lg_bm1;
|
|
Packit |
67cb25 |
gsl_sf_result lg_a;
|
|
Packit |
67cb25 |
gsl_sf_lngamma_e(b-1.0, &lg_bm1);
|
|
Packit |
67cb25 |
gsl_sf_lngamma_e(a, &lg_a);
|
|
Packit |
67cb25 |
lnpre_val = tmp + x + lg_bm1.val - lg_a.val;
|
|
Packit |
67cb25 |
lnpre_err = lg_bm1.err + lg_a.err + GSL_DBL_EPSILON * (fabs(x) + fabs(tmp));
|
|
Packit |
67cb25 |
gsl_sf_hyperg_1F1_large_b_e(1.0-a, 2.0-b, -x, &M);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else {
|
|
Packit |
67cb25 |
gsl_sf_result lg_1mb;
|
|
Packit |
67cb25 |
gsl_sf_result lg_1pamb;
|
|
Packit |
67cb25 |
gsl_sf_lngamma_e(1.0-b, &lg_1mb);
|
|
Packit |
67cb25 |
gsl_sf_lngamma_e(1.0+a-b, &lg_1pamb);
|
|
Packit |
67cb25 |
lnpre_val = lg_1mb.val - lg_1pamb.val;
|
|
Packit |
67cb25 |
lnpre_err = lg_1mb.err + lg_1pamb.err;
|
|
Packit |
67cb25 |
gsl_sf_hyperg_1F1_large_b_e(a, b, x, &M);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if(lnpre_val > GSL_LOG_DBL_MAX-10.0) {
|
|
Packit |
67cb25 |
result->val = M.val;
|
|
Packit |
67cb25 |
result->err = M.err;
|
|
Packit |
67cb25 |
*ln_multiplier = lnpre_val;
|
|
Packit |
67cb25 |
GSL_ERROR ("overflow", GSL_EOVRFLW);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else {
|
|
Packit |
67cb25 |
gsl_sf_result epre;
|
|
Packit |
67cb25 |
int stat_e = gsl_sf_exp_err_e(lnpre_val, lnpre_err, &epre);
|
|
Packit |
67cb25 |
result->val = epre.val * M.val;
|
|
Packit |
67cb25 |
result->err = epre.val * M.err + epre.err * fabs(M.val);
|
|
Packit |
67cb25 |
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
|
|
Packit |
67cb25 |
*ln_multiplier = 0.0;
|
|
Packit |
67cb25 |
return stat_e;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else {
|
|
Packit |
67cb25 |
double omb_lnx = (1.0-b)*log(x);
|
|
Packit |
67cb25 |
gsl_sf_result lg_1mb; double sgn_1mb;
|
|
Packit |
67cb25 |
gsl_sf_result lg_1pamb; double sgn_1pamb;
|
|
Packit |
67cb25 |
gsl_sf_result lg_bm1; double sgn_bm1;
|
|
Packit |
67cb25 |
gsl_sf_result lg_a; double sgn_a;
|
|
Packit |
67cb25 |
gsl_sf_result M1, M2;
|
|
Packit |
67cb25 |
double lnpre1_val, lnpre2_val;
|
|
Packit |
67cb25 |
double lnpre1_err, lnpre2_err;
|
|
Packit |
67cb25 |
double sgpre1, sgpre2;
|
|
Packit |
67cb25 |
gsl_sf_hyperg_1F1_large_b_e( a, b, x, &M1;;
|
|
Packit |
67cb25 |
gsl_sf_hyperg_1F1_large_b_e(1.0-a, 2.0-b, x, &M2;;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
gsl_sf_lngamma_sgn_e(1.0-b, &lg_1mb, &sgn_1mb);
|
|
Packit |
67cb25 |
gsl_sf_lngamma_sgn_e(1.0+a-b, &lg_1pamb, &sgn_1pamb);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
gsl_sf_lngamma_sgn_e(b-1.0, &lg_bm1, &sgn_bm1);
|
|
Packit |
67cb25 |
gsl_sf_lngamma_sgn_e(a, &lg_a, &sgn_a);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
lnpre1_val = lg_1mb.val - lg_1pamb.val;
|
|
Packit |
67cb25 |
lnpre1_err = lg_1mb.err + lg_1pamb.err;
|
|
Packit |
67cb25 |
lnpre2_val = lg_bm1.val - lg_a.val - omb_lnx - x;
|
|
Packit |
67cb25 |
lnpre2_err = lg_bm1.err + lg_a.err + GSL_DBL_EPSILON * (fabs(omb_lnx)+fabs(x));
|
|
Packit |
67cb25 |
sgpre1 = sgn_1mb * sgn_1pamb;
|
|
Packit |
67cb25 |
sgpre2 = sgn_bm1 * sgn_a;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if(lnpre1_val > GSL_LOG_DBL_MAX-10.0 || lnpre2_val > GSL_LOG_DBL_MAX-10.0) {
|
|
Packit |
67cb25 |
double max_lnpre_val = GSL_MAX(lnpre1_val,lnpre2_val);
|
|
Packit |
67cb25 |
double max_lnpre_err = GSL_MAX(lnpre1_err,lnpre2_err);
|
|
Packit |
67cb25 |
double lp1 = lnpre1_val - max_lnpre_val;
|
|
Packit |
67cb25 |
double lp2 = lnpre2_val - max_lnpre_val;
|
|
Packit |
67cb25 |
double t1 = sgpre1*exp(lp1);
|
|
Packit |
67cb25 |
double t2 = sgpre2*exp(lp2);
|
|
Packit |
67cb25 |
result->val = t1*M1.val + t2*M2.val;
|
|
Packit |
67cb25 |
result->err = fabs(t1)*M1.err + fabs(t2)*M2.err;
|
|
Packit |
67cb25 |
result->err += GSL_DBL_EPSILON * exp(max_lnpre_err) * (fabs(t1*M1.val) + fabs(t2*M2.val));
|
|
Packit |
67cb25 |
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
|
|
Packit |
67cb25 |
*ln_multiplier = max_lnpre_val;
|
|
Packit |
67cb25 |
GSL_ERROR ("overflow", GSL_EOVRFLW);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
else {
|
|
Packit |
67cb25 |
double t1 = sgpre1*exp(lnpre1_val);
|
|
Packit |
67cb25 |
double t2 = sgpre2*exp(lnpre2_val);
|
|
Packit |
67cb25 |
result->val = t1*M1.val + t2*M2.val;
|
|
Packit |
67cb25 |
result->err = fabs(t1) * M1.err + fabs(t2)*M2.err;
|
|
Packit |
67cb25 |
result->err += GSL_DBL_EPSILON * (exp(lnpre1_err)*fabs(t1*M1.val) + exp(lnpre2_err)*fabs(t2*M2.val));
|
|
Packit |
67cb25 |
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
|
|
Packit |
67cb25 |
*ln_multiplier = 0.0;
|
|
Packit |
67cb25 |
return GSL_SUCCESS;
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
/* [Carlson, p.109] says the error in truncating this asymptotic series
|
|
Packit |
67cb25 |
* is less than the absolute value of the first neglected term.
|
|
Packit |
67cb25 |
*
|
|
Packit |
67cb25 |
* A termination argument is provided, so that the series will
|
|
Packit |
67cb25 |
* be summed at most up to n=n_trunc. If n_trunc is set negative,
|
|
Packit |
67cb25 |
* then the series is summed until it appears to start diverging.
|
|
Packit |
67cb25 |
*/
|
|
Packit |
67cb25 |
int
|
|
Packit |
67cb25 |
gsl_sf_hyperg_2F0_series_e(const double a, const double b, const double x,
|
|
Packit |
67cb25 |
int n_trunc,
|
|
Packit |
67cb25 |
gsl_sf_result * result
|
|
Packit |
67cb25 |
)
|
|
Packit |
67cb25 |
{
|
|
Packit |
67cb25 |
const int maxiter = 2000;
|
|
Packit |
67cb25 |
double an = a;
|
|
Packit |
67cb25 |
double bn = b;
|
|
Packit |
67cb25 |
double n = 1.0;
|
|
Packit |
67cb25 |
double sum = 1.0;
|
|
Packit |
67cb25 |
double del = 1.0;
|
|
Packit |
67cb25 |
double abs_del = 1.0;
|
|
Packit |
67cb25 |
double max_abs_del = 1.0;
|
|
Packit |
67cb25 |
double last_abs_del = 1.0;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
while(abs_del/fabs(sum) > GSL_DBL_EPSILON && n < maxiter) {
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
double u = an * (bn/n * x);
|
|
Packit |
67cb25 |
double abs_u = fabs(u);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if(abs_u > 1.0 && (max_abs_del > GSL_DBL_MAX/abs_u)) {
|
|
Packit |
67cb25 |
result->val = sum;
|
|
Packit |
67cb25 |
result->err = fabs(sum);
|
|
Packit |
67cb25 |
GSL_ERROR ("overflow", GSL_EOVRFLW);
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
del *= u;
|
|
Packit |
67cb25 |
sum += del;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
abs_del = fabs(del);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if(abs_del > last_abs_del) break; /* series is probably starting to grow */
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
last_abs_del = abs_del;
|
|
Packit |
67cb25 |
max_abs_del = GSL_MAX(abs_del, max_abs_del);
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
an += 1.0;
|
|
Packit |
67cb25 |
bn += 1.0;
|
|
Packit |
67cb25 |
n += 1.0;
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if(an == 0.0 || bn == 0.0) break; /* series terminated */
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
if(n_trunc >= 0 && n >= n_trunc) break; /* reached requested timeout */
|
|
Packit |
67cb25 |
}
|
|
Packit |
67cb25 |
|
|
Packit |
67cb25 |
result->val = sum;
|
|
Packit |
67cb25 |
result->err = GSL_DBL_EPSILON * n + abs_del;
|
|
Packit |
67cb25 |
if(n >= maxiter)
|
|
Packit |
67cb25 |
GSL_ERROR ("error", GSL_EMAXITER);
|
|
Packit |
67cb25 |
else
|
|
Packit |
67cb25 |
return GSL_SUCCESS;
|
|
Packit |
67cb25 |
}
|