static VALUE rb_gsl_integration_qawc(int argc, VALUE *argv, VALUE obj)
{
double a, b, c, epsabs, epsrel;
double result, abserr;
size_t limit;
gsl_function *F = NULL;
gsl_integration_workspace *w = NULL;
int status, intervals, itmp, flag = 0;
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;
}
itmp = get_a_b(argc, argv, itmp, &a, &b);
if (argc-itmp <= 0) rb_raise(rb_eArgError, "The pole is not given");
Need_Float(argv[itmp]);
c = NUM2DBL(argv[itmp]);
flag = get_epsabs_epsrel_limit_workspace(argc, argv, itmp+1, &epsabs, &epsrel,
&limit, &w);
status = gsl_integration_qawc(F, a, b, c, 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));
}
void KKtransform::transform() {
double result, error;
double omegaMax = 0.9*inOut.dataIn[0][inOut.NpointsIn - 1];
int status = 0;
omega = 0.0;
wspace = gsl_integration_workspace_alloc (wlimit);
gsl_function F;
F.function = &func;
for (int i = 1; i < inOut.NpointsOut; ++i) {
omega = inOut.dataOut[0][i];
F.params = this;
status = gsl_integration_qawc (&F, -omegaMax, omegaMax, omega, 0, inOut.eps,
wlimit, wspace, &result, &error);
if (status == GSL_EROUND) {
std::cout << "error: " << status << std::endl;
inOut.dataOut[1][i] = -1;
}
else {
result = -1.0/M_PI*result;
inOut.dataOut[1][i] = result;
// std::cout << "w = " << omega << ", sigma = " << result << std::endl;
}
}
for (int i = 1; i < inOut.NpointsOut - 1; ++i) {
if (inOut.dataOut[1][i] < 0) {
inOut.dataOut[1][i] = 0.5*(log10(inOut.dataOut[1][i - 1]) +
log10(inOut.dataOut[1][i + 1]) );
inOut.dataOut[1][i] = pow(10, inOut.dataOut[1][i]);
}
}
return;
}
void KKtransform::check() {
int status = 0;
double result, error;
gsl_spline_free(spline);
gsl_interp_accel_free(acc);
// spline interpolation for transformed data
acc = gsl_interp_accel_alloc();
spline = gsl_spline_alloc (gsl_interp_cspline, inOut.NpointsOut);
gsl_spline_init(spline, inOut.dataOut[0], inOut.dataOut[1], inOut.NpointsOut);
// setup
double omegaMax = 0.9*inOut.dataOut[0][inOut.NpointsOut - 1];
double dW = inOut.dataOut[0][1];
int NpointsCheck = ((int) omegaMax/dW) + 1;
double** dataCheck = new double*[2];
dataCheck[0] = new double[NpointsCheck];
dataCheck[1] = new double[NpointsCheck];
dataCheck[0][0] = 0;
dataCheck[1][0] = inOut.dataIn[1][0];
for (int i = 1; i < NpointsCheck; ++i) {
dataCheck[0][i] = dataCheck[0][i - 1] + dW;
dataCheck[1][i] = 0;
}
// integrate
gsl_function F;
F.function = &checkFunc;
for (int i = 1; i < NpointsCheck; ++i) {
omega = dataCheck[0][i];
F.params = this;
status = gsl_integration_qawc (&F, -omegaMax, omegaMax, omega, 0, inOut.eps,
wlimit, wspace, &result, &error);
if (status == GSL_EROUND) {
std::cout << "error: " << status << std::endl;
result = -1;
}
else {
result = -1.0/M_PI*result;
}
dataCheck[1][i] = result;
std::cout << omega << " " << result << std::endl;
}
// remove improper values
for (int i = 1; i < NpointsCheck - 1; ++i) {
if (dataCheck[1][i] < 0) {
dataCheck[1][i] = 0.5*(log10(dataCheck[1][i - 1]) +
log10(dataCheck[1][i + 1]) );
dataCheck[1][i] = pow(10, dataCheck[1][i]);
}
}
double sigma = 0;
for (int i = 1; i < NpointsCheck; ++i) {
sigma = sigma + (dataCheck[1][i] - inOut.dataIn[1][i])
* (dataCheck[1][i] - inOut.dataIn[1][i]);
}
sigma = sigma/NpointsCheck;
sigma = sqrt(sigma);
std::cout << "check: sigma = " << sigma << std::endl;
return;
}
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;
}
