static double f_zinb_reg(const gsl_vector *v, void *params){
int i, binnum;
double p, n, m, p0, r, fxy=0;
ParStr *par = (ParStr *)params;
p = gsl_vector_get(v, 0);
n = gsl_vector_get(v, 1);
m = gsl_vector_get(v, 2);
printf("zinb_reg p=%f, n=%f, m=%f\n",p, n, m);
binnum = par->binnum;
TYPE_WIGARRAY *wig = par->wig;
TYPE_WIGARRAY *mp = par->mp;
for(i=0; i<binnum; i++){ /* wig[i]が得られる確率を最大化 */
if(!mp[i]) p0=1; else p0 = gsl_sf_beta(WIGARRAY2VALUE(mp[i]), m);
printf("%d p0=%f\n", i, p0);
if(!wig[i]){
r = p0 + (1 - p0) * gsl_ran_negative_binomial_pdf(0, p, n);
}else{
r = (1 - p0) * gsl_ran_negative_binomial_pdf(WIGARRAY2VALUE(wig[i]), p, n);
}
fxy += log(r);
}
printf("fxy=%f\n",fxy);
return fxy;
}
scalar sasfit_peak_PearsonIVArea(scalar x, sasfit_param * param)
{
scalar z,u;
scalar bckgr, a0, area, center, width, shape1, shape2;
scalar a1,a2,a3,a4;
scalar a_temp, l_temp, m_temp, nu_temp;
gsl_sf_result lnr, carg;
SASFIT_ASSERT_PTR( param );
sasfit_get_param(param, 6, &area, ¢er, &width, &shape1, &shape2, &bckgr);
// a0 = area;
a1 = center;
a2 = width; a_temp = width;
a3 = shape1; m_temp = shape1;
a4 = shape2; nu_temp= shape2;
SASFIT_CHECK_COND1((width <= 0), param, "width(%lg) <= 0",width);
SASFIT_CHECK_COND1((shape1 <= 0.5), param, "shape1(%lg) <= 1/2",shape1);
u = a4/(2.*a3);
l_temp = center+a2*u;
z = (x-l_temp)/a_temp;
gsl_sf_lngamma_complex_e (m_temp, 0.5*nu_temp, &lnr, &carg);
a0 = area*pow(exp(lnr.val-gsl_sf_lngamma(m_temp)),2.0)/(a_temp*gsl_sf_beta(m_temp-0.5,0.5));
return bckgr+a0*pow(1.0+z*z,-m_temp)*exp(-nu_temp*atan(z));
}
scalar sasfit_peak_beta_area(scalar x, sasfit_param * param)
{
scalar z, xmin, xmax;
SASFIT_CHECK_COND2((XMIN == XMAX), param, "xmin(%lg) == xmax(%lg)",XMIN,XMAX);
SASFIT_CHECK_COND1((BALPHA <= 0.0), param, "alpha(%lg) <= 0",BALPHA);
SASFIT_CHECK_COND1((BBETA <= 0.0), param, "beta(%lg) <= 0",BBETA);
if (XMIN>XMAX) {
xmin = XMAX;
xmax = XMIN;
} else {
xmin = XMIN;
xmax = XMAX;
}
if (x<=xmin) return BCKGR;
if (x>=xmax) return BCKGR;
z = (x-xmin)/(xmax-xmin);
return BCKGR+AREA*pow(z,BALPHA-1.0)*pow(1.0-z,BBETA-1.0)/gsl_sf_beta(BALPHA,BBETA)/(xmax-xmin);
}
double
gsl_cdf_tdist_Pinv (const double P, const double nu)
{
double x, ptail;
if (P == 1.0)
{
return GSL_POSINF;
}
else if (P == 0.0)
{
return GSL_NEGINF;
}
if (nu == 1.0)
{
x = tan (M_PI * (P - 0.5));
return x;
}
else if (nu == 2.0)
{
x = (2 * P - 1) / sqrt (2 * P * (1 - P));
return x;
}
ptail = (P < 0.5) ? P : 1 - P;
if (sqrt (M_PI * nu / 2) * ptail > pow (0.05, nu / 2))
{
double xg = gsl_cdf_ugaussian_Pinv (P);
x = inv_cornish_fisher (xg, nu);
}
else
{
/* Use an asymptotic expansion of the tail of integral */
double beta = gsl_sf_beta (0.5, nu / 2);
if (P < 0.5)
{
x = -sqrt (nu) * pow (beta * nu * P, -1.0 / nu);
}
else
{
x = sqrt (nu) * pow (beta * nu * (1 - P), -1.0 / nu);
}
/* Correct nu -> nu/(1+nu/x^2) in the leading term to account
for higher order terms. This avoids overestimating x, which
makes the iteration unstable due to the rapidly decreasing
tails of the distribution. */
x /= sqrt (1 + nu / (x * x));
}
{
double dP, phi;
unsigned int n = 0;
start:
dP = P - gsl_cdf_tdist_P (x, nu);
phi = gsl_ran_tdist_pdf (x, nu);
if (dP == 0.0 || n++ > 32)
goto end;
{
double lambda = dP / phi;
double step0 = lambda;
double step1 = ((nu + 1) * x / (x * x + nu)) * (lambda * lambda / 4.0);
double step = step0;
if (fabs (step1) < fabs (step0))
{
step += step1;
}
if (P > 0.5 && x + step < 0)
x /= 2;
else if (P < 0.5 && x + step > 0)
x /= 2;
else
x += step;
if (fabs (step) > 1e-10 * fabs (x))
goto start;
}
end:
if (fabs(dP) > GSL_SQRT_DBL_EPSILON * P)
{
GSL_ERROR_VAL("inverse failed to converge", GSL_EFAILED, GSL_NAN);
}
return x;
}
}
double
gsl_cdf_tdist_Qinv (const double Q, const double nu)
{
double x, qtail;
if (Q == 0.0)
{
return GSL_POSINF;
}
else if (Q == 1.0)
{
return GSL_NEGINF;
}
if (nu == 1.0)
{
x = tan (M_PI * (0.5 - Q));
return x;
}
else if (nu == 2.0)
{
x = (1 - 2 * Q) / sqrt (2 * Q * (1 - Q));
return x;
}
qtail = (Q < 0.5) ? Q : 1 - Q;
if (sqrt (M_PI * nu / 2) * qtail > pow (0.05, nu / 2))
{
double xg = gsl_cdf_ugaussian_Qinv (Q);
x = inv_cornish_fisher (xg, nu);
}
else
{
/* Use an asymptotic expansion of the tail of integral */
double beta = gsl_sf_beta (0.5, nu / 2);
if (Q < 0.5)
{
x = sqrt (nu) * pow (beta * nu * Q, -1.0 / nu);
}
else
{
x = -sqrt (nu) * pow (beta * nu * (1 - Q), -1.0 / nu);
}
/* Correct nu -> nu/(1+nu/x^2) in the leading term to account
for higher order terms. This avoids overestimating x, which
makes the iteration unstable due to the rapidly decreasing
tails of the distribution. */
x /= sqrt (1 + nu / (x * x));
}
{
double dQ, phi;
unsigned int n = 0;
start:
dQ = Q - gsl_cdf_tdist_Q (x, nu);
phi = gsl_ran_tdist_pdf (x, nu);
if (dQ == 0.0 || n++ > 32)
goto end;
{
double lambda = - dQ / phi;
double step0 = lambda;
double step1 = ((nu + 1) * x / (x * x + nu)) * (lambda * lambda / 4.0);
double step = step0;
if (fabs (step1) < fabs (step0))
{
step += step1;
}
if (Q < 0.5 && x + step < 0)
x /= 2;
else if (Q > 0.5 && x + step > 0)
x /= 2;
else
x += step;
if (fabs (step) > 1e-10 * fabs (x))
goto start;
}
}
end:
return x;
}
inline long double beta(long double a, long double b)
{ return gsl_sf_beta(a, b); }
inline double beta(double a, double b)
{ return gsl_sf_beta(a, b); }
inline float beta(float a, float b)
{ return (float)gsl_sf_beta(a, b); }
static VALUE rb_gsl_sf_beta(VALUE obj, VALUE a, VALUE b)
{
return rb_float_new(gsl_sf_beta(NUM2DBL(a), NUM2DBL(b)));
}
