/* (-infty --- b) */
static VALUE rb_gsl_integration_qagil(int argc, VALUE *argv, VALUE obj)
{
double b, epsabs, epsrel;
double result, abserr;
size_t limit;
gsl_function *F = NULL;
gsl_integration_workspace *w = NULL;
int status, intervals, flag = 0, itmp;
switch (TYPE(obj)) {
case T_MODULE: case T_CLASS: case T_OBJECT:
CHECK_FUNCTION(argv[0]);
Data_Get_Struct(argv[0], gsl_function, F);
itmp = 1;
break;
default:
Data_Get_Struct(obj, gsl_function, F);
itmp = 0;
break;
}
Need_Float(argv[itmp]);
b = NUM2DBL(argv[itmp]);
flag = get_epsabs_epsrel_limit_workspace(argc, argv, itmp+1, &epsabs, &epsrel,
&limit, &w);
Data_Get_Struct(obj, gsl_function, F);
status = gsl_integration_qagil(F, b, epsabs, epsrel, limit, w,
&result, &abserr);
intervals = w->size;
if (flag == 1) gsl_integration_workspace_free(w);
return rb_ary_new3(4, rb_float_new(result), rb_float_new(abserr),
INT2FIX(intervals), INT2FIX(status));
}
//----------------------------------------------------------------------------
int int_sd2p(REAL alpha,REAL a,REAL (*fp)(REAL, void*),REAL * result,REAL * error){
gsl_integration_workspace * w
= gsl_integration_workspace_alloc (1000);
gsl_function F;
F.function = fp;
F.params = α
gsl_integration_qagil (&F, a, 0, 1e-7, 1000,w, result, error);
gsl_integration_workspace_free (w);
return 0;
}
//----------------------------------------------------------------------------
int int_sd4p(REAL p1,REAL p2,REAL p3,REAL a,REAL (*fp)(REAL, void*),
REAL * result,REAL * error){
gsl_integration_workspace * w
= gsl_integration_workspace_alloc (1000);
struct f_params_3 alpha = {p1,p2,p3};
gsl_function F;
F.function = fp;
F.params = α
gsl_integration_qagil (&F, a, 0, 1e-7, 1000,w, result, error);
gsl_integration_workspace_free (w);
return 0;
}
// ========================================================================
// adaptive integration on infinite interval
// ========================================================================
double NumericalDefiniteIntegral::QAGI ( _Function* F ) const
{
// check the argument
if ( 0 == F ) { Exception("::QAGI: invalid function"); }
// allocate workspace
if ( 0 == ws() ) { allocate() ; }
int ierror = 0 ;
if ( m_ia && m_ib )
{
ierror = gsl_integration_qagi ( F->fn ,
m_epsabs , m_epsrel ,
size () , ws()->ws ,
&m_result , &m_error ) ;
}
else if ( m_ia )
{
ierror = gsl_integration_qagil ( F->fn , m_b ,
m_epsabs , m_epsrel ,
size () , ws()->ws ,
&m_result , &m_error ) ;
}
else if ( m_ib )
{
ierror = gsl_integration_qagiu ( F->fn , m_a ,
m_epsabs , m_epsrel ,
size () , ws()->ws ,
&m_result , &m_error ) ;
}
else
{ Exception ( "::QAGI: invalid mode" ) ; };
if( ierror ) { gsl_error( "NumericalDefiniteIntegral::QAGI" ,
__FILE__ , __LINE__ , ierror ) ;}
return m_result ;
}
double GSLIntegrator::compute()
{
int status;
double phi_min, phi_X_unity, phi_max, integral, aerr, error;
size_t neval;
// Note. We are solving for x = sqrt(1 - 2 * tau). tau below is thus really x and not tau as given in the papers
//aerr = 5.e-8 / (SQRT2PI);
aerr = 1.e-12 / (SQRT2PI);
// Limits of the integration
phi_max = 12;
phi_min = FMAX(((*alfa) + sqrt(1 - (*tau) * (*tau)) * NIM9) / (*tau), -8);
phi_X_unity = ((*alfa) + sqrt(1 - (*tau) * (*tau)) * (-NIM16)) / (*tau); // above this X in integrand is > 1-1e-16 and can be set to unity, which makes the integral analytical
double phi_mid = (*alfa) / (*tau);
if (phi_X_unity > phi_max)
{
//status = gsl_integration_qng (&F, phi_min, phi_max, aerr * (phi_max - phi_min) / 2., 0., &integral, &error, &neval) ;
//status = gsl_integration_qag (&F, phi_min, phi_max, aerr * (phi_max - phi_min) / 2., 0., w->limit, 2, w, &integral, &error) ;
status = gsl_integration_qagi (&F, aerr * (phi_max - phi_min) / 2., 0., w->limit, w, &integral, &error) ;
//integral = gsl_integration_glfixed (&F, phi_min, phi_max, table);
//integral = gsl_integration_glfixed (&F, phi_min, phi_mid, table);
//integral += gsl_integration_glfixed (&F, phi_mid, phi_max, table);
}
else
{
//status = gsl_integration_qng (&F, phi_min, phi_X_unity, aerr * (phi_max - phi_min) / 2., 0., &integral, &error, &neval) ;
status = gsl_integration_qagil (&F, phi_X_unity, aerr * (phi_max - phi_min) / 2., 0., w->limit, w, &integral, &error) ;
//integral = gsl_integration_glfixed (&F, phi_min, phi_X_unity, table);
//integral = gsl_integration_glfixed (&F, phi_min, phi_mid, table);
//integral += gsl_integration_glfixed (&F, phi_mid, phi_X_unity, table);
integral += SQRT2PI * (1 - erf(phi_X_unity)); // Analytical
}
return integral / (*im);
//return integral;
}
int lua_integration_integrate(lua_State * L) {
double a=0.0;
double b=1.0;
double c=0.5;
double epsabs=0.0;
double epsrel=0.0000001;
double alpha=0.0;
double beta=0.0;
int mu=0;
int nu=0;
size_t limit=100;
size_t n=0;
int key=1;
double result=0;
double abserr=0;
size_t neval=0;
gsl_integration_workspace * w=0;
multi_param mp;
mp.L=L;
lua_pushstring(L,"f");
lua_gettable(L,-2);
if(lua_isfunction(L,-1)) {
mp.f_index=luaL_ref(L, LUA_REGISTRYINDEX);
} else {
luaL_error(L,"%s\n","missing function");
}
gsl_function F;
F.function = &int_f_cb;
F.params = ∓
lua_pushstring(L,"epsabs");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
epsabs=lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"epsrel");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
epsrel=lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"a");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
a=lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"b");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
b=lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"c");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
c=lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"limit");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
limit=(size_t)lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"n");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
n=(size_t)lua_tonumber(L,-1);
}
lua_pop(L,1);
if(limit>n) n=limit;
lua_pushstring(L,"key");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
key=(int)lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"alpha");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
alpha=(double)lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"beta");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
beta=(double)lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"mu");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
mu=(int)lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"nu");
lua_gettable(L,-2);
if(lua_isnumber(L,-1)) {
nu=(int)lua_tonumber(L,-1);
}
lua_pop(L,1);
lua_pushstring(L,"algorithm");
lua_gettable(L,-2);
if(lua_isstring(L,-1)) {
if(!strcmp(lua_tostring(L,-1),"qng")) {
gsl_integration_qng(&F,a,b,epsabs,epsrel,&result,&abserr,&neval);
} else if(!strcmp(lua_tostring(L,-1),"qag")) {
w=gsl_integration_workspace_alloc(n);
gsl_integration_qag(&F,a,b,epsabs,epsrel,limit,key,w,&result,&abserr);
} else if(!strcmp(lua_tostring(L,-1),"qags")) {
w=gsl_integration_workspace_alloc(n);
gsl_integration_qags(&F,a,b,epsabs,epsrel,limit,w,&result,&abserr);
} else if(!strcmp(lua_tostring(L,-1),"qagi")) {
w=gsl_integration_workspace_alloc(n);
gsl_integration_qagi(&F,epsabs,epsrel,limit,w,&result,&abserr);
} else if(!strcmp(lua_tostring(L,-1),"qagiu")) {
w=gsl_integration_workspace_alloc(n);
gsl_integration_qagiu(&F,a,epsabs,epsrel,limit,w,&result,&abserr);
} else if(!strcmp(lua_tostring(L,-1),"qagil")) {
w=gsl_integration_workspace_alloc(n);
gsl_integration_qagil(&F,b,epsabs,epsrel,limit,w,&result,&abserr);
} else if(!strcmp(lua_tostring(L,-1),"qawc")) {
w=gsl_integration_workspace_alloc(n);
gsl_integration_qawc(&F,a,b,c,epsabs,epsrel,limit,w,&result,&abserr);
} else if(!strcmp(lua_tostring(L,-1),"qaws")) {
w=gsl_integration_workspace_alloc(n);
gsl_integration_qaws_table * table=gsl_integration_qaws_table_alloc(alpha,beta,mu,nu);
gsl_integration_qaws(&F,a,b,table,epsabs,epsrel,limit,w,&result,&abserr);
gsl_integration_qaws_table_free(table);
} else if(!strcmp(lua_tostring(L,-1),"cquad")) {
gsl_integration_cquad_workspace * w=gsl_integration_cquad_workspace_alloc(n);
gsl_integration_cquad(&F,a,b,epsabs,epsrel,w,&result,&abserr,&neval);
gsl_integration_cquad_workspace_free(w);
} else {
luaL_error(L,"%s\n","invalid algorithm");
}
} else {
gsl_integration_cquad_workspace * w=gsl_integration_cquad_workspace_alloc(n);
gsl_integration_cquad(&F,a,b,epsabs,epsrel,w,&result,&abserr,&neval);
gsl_integration_cquad_workspace_free(w);
}
lua_pop(L,1);
lua_pop(L,1);
lua_pushnumber(L,result);
lua_pushnumber(L,abserr);
lua_pushnumber(L,neval);
if(mp.fdf_index>=0) luaL_unref(L, LUA_REGISTRYINDEX, mp.fdf_index);
if(w) gsl_integration_workspace_free(w);
return 3;
}
