float8 studentT_cdf(int64 nu, float8 t) {
float8 z,
t_by_sqrt_nu;
float8 A, /* contains A(t|nu) */
prod = 1.,
sum = 1.;
/* Handle extreme cases. See above. */
if (nu <= 0)
return NAN;
else if (nu >= 1000000)
return normal_cdf(t);
else if (nu >= 200)
return studentT_cdf_approx(nu, t);
/* Handle main case (nu < 200) in the rest of the function. */
z = 1. + t * t / nu;
t_by_sqrt_nu = fabs(t) / sqrt(nu);
if (nu == 1)
{
A = 2. / M_PI * atan(t_by_sqrt_nu);
}
else if (nu & 1) /* odd nu > 1 */
{
for (int j = 2; j <= nu - 3; j += 2)
{
prod = prod * j / ((j + 1) * z);
sum = sum + prod;
}
A = 2 / M_PI * ( atan(t_by_sqrt_nu) + t_by_sqrt_nu / z * sum );
}
else /* even nu */
{
for (int j = 2; j <= nu - 2; j += 2)
{
prod = prod * (j - 1) / (j * z);
sum = sum + prod;
}
A = t_by_sqrt_nu / sqrt(z) * sum;
}
/* A should obviously lie withing the interval [0,1] plus minus (hopefully
* small) rounding errors. */
if (A > 1.)
A = 1.;
else if (A < 0.)
A = 0.;
/* The Student-T distribution is obviously symmetric around t=0... */
if (t < 0)
return .5 * (1. - A);
else
return 1. - .5 * (1. - A);
}
static double duration_loglik (const double *theta, void *data)
{
duration_info *dinfo = (duration_info *) data;
double *ll = dinfo->llt->val;
double *Xb = dinfo->Xb->val;
double *logt = dinfo->logt->val;
double wi, s = 1.0, lns = 0.0;
double l1ew = 0.0;
int i, di;
if (dinfo->dist != DUR_EXPON) {
s = theta[dinfo->k];
if (s <= 0) {
return NADBL;
}
lns = log(s);
}
duration_update_Xb(dinfo, theta);
dinfo->ll = 0.0;
errno = 0;
for (i=0; i<dinfo->n; i++) {
di = uncensored(dinfo, i);
wi = (logt[i] - Xb[i]) / s;
if (dinfo->dist == DUR_LOGLOG) {
l1ew = log(1 + exp(wi));
ll[i] = -l1ew;
if (di) {
ll[i] += wi - l1ew - lns;
}
} else if (dinfo->dist == DUR_LOGNORM) {
if (di) {
/* density */
ll[i] = -lns + log_normal_pdf(wi);
} else {
/* survivor */
ll[i] = log(normal_cdf(-wi));
}
} else {
/* Weibull, exponential */
ll[i] = -exp(wi);
if (di) {
ll[i] += wi - lns;
}
}
dinfo->ll += ll[i];
}
if (errno) {
dinfo->ll = NADBL;
}
return dinfo->ll;
}
/**
* Approximate Student-T distribution using a formula suggested in
* [9], which goes back to an approximation suggested in [10].
*
* Compared to the series expansion, this approximation satisfies
* rel_error < 0.0001 || abs_error < 0.00000001
* for all nu >= 200. (Tested on Mac OS X 10.6, gcc-4.2.)
*/
static float8 studentT_cdf_approx(int64 nu, float8 t)
{
float8 g = (nu - 1.5) / ((nu - 1) * (nu - 1)),
z = sqrt( log(1. + t * t / nu) / g );
if (t < 0)
z *= -1.;
return normal_cdf(z);
}
/**
* Approximate Student-T distribution using a formula suggested in
* [9], which goes back to an approximation suggested in [10].
*
* Compared to the series expansion, this approximation satisfies
* rel_error < 0.0001 || abs_error < 0.00000001
* for all nu >= 200. (Tested on Mac OS X 10.6, gcc-4.2.)
*/
static double studentT_cdf_approx(int64_t nu, double t)
{
double g = (nu - 1.5) / ((nu - 1) * (nu - 1)),
z = std::sqrt( std::log(1. + t * t / nu) / g );
if (t < 0)
z *= -1.;
return normal_cdf(z);
}
SCM
scm_cdf_normal(SCM sm, SCM ssd, SCM sx)
{
SCM_ASSERT(gh_number_p(sm), sm, SCM_ARG1, "cdf-normal");
SCM_ASSERT(gh_number_p(ssd), ssd, SCM_ARG2, "cdf-normal");
SCM_ASSERT(gh_number_p(sx), sx, SCM_ARG3, "cdf-normal");
double m = gh_scm2double(sm);
double sd = gh_scm2double(ssd);
double x = gh_scm2double(sx);
double p = normal_cdf(m,sd,x);
return gh_double2scm(p);
}
/*
* Quantile function of the standard normal distribution.
*
* Author: Peter John Acklam <*****@*****.**>
* URL: http://home.online.no/~pjacklam
*
* This function is based on the MATLAB code from the address above,
* translated to C, and adapted for our purposes.
*/
template <typename Scalar> Scalar normal_quantile(Scalar p) {
const Scalar a[6] = {
-3.969683028665376e+01, 2.209460984245205e+02,
-2.759285104469687e+02, 1.383577518672690e+02,
-3.066479806614716e+01, 2.506628277459239e+00
};
const Scalar b[5] = {
-5.447609879822406e+01, 1.615858368580409e+02,
-1.556989798598866e+02, 6.680131188771972e+01,
-1.328068155288572e+01
};
const Scalar c[6] = {
-7.784894002430293e-03, -3.223964580411365e-01,
-2.400758277161838e+00, -2.549732539343734e+00,
4.374664141464968e+00, 2.938163982698783e+00
};
const Scalar d[4] = {
7.784695709041462e-03, 3.224671290700398e-01,
2.445134137142996e+00, 3.754408661907416e+00
};
if (p <= 0)
return -std::numeric_limits<Scalar>::infinity();
else if (p >= 1)
return -std::numeric_limits<Scalar>::infinity();
Scalar q = std::min(p,1-p);
Scalar t, u;
if (q > (Scalar) 0.02425) {
/* Rational approximation for central region. */
u = q - (Scalar) 0.5;
t = u*u;
u = u*(((((a[0]*t+a[1])*t+a[2])*t+a[3])*t+a[4])*t+a[5])
/(((((b[0]*t+b[1])*t+b[2])*t+b[3])*t+b[4])*t+1);
} else {
/* Rational approximation for tail region. */
t = std::sqrt(-2*std::log(q));
u = (((((c[0]*t+c[1])*t+c[2])*t+c[3])*t+c[4])*t+c[5])
/((((d[0]*t+d[1])*t+d[2])*t+d[3])*t+1);
}
/* The relative error of the approximation has absolute value less
than 1.15e-9. One iteration of Halley's rational method (third
order) gives full machine precision... */
t = normal_cdf(u)-q; /* error */
t = t*(Scalar) math::SqrtTwoPi_d*std::exp(u*u/2); /* f(u)/df(u) */
u = u-t/(1+u*t/2); /* Halley's method */
return p > 0.5 ? -u : u;
};
Num put(Num S, Num X, Num T, Num r, Num b, Num v)
{
Num Sss = aux::solve_Sss(X, T, r, b, v);
Num N = 2 * b / (v * v);
Num M = 2 * r / (v * v);
Num K = 1 - exp(-r * T);
Num q1 = aux::q1(N, M, K);
Num d1 = bsm_general::d1(Sss, X, T, b, v);
Num A1 = -(Sss / q1) * (1 - exp((b - r) * T) * normal_cdf(-d1));
if (S > Sss)
return bsm_general::put(S, X, T, r, b, v) + A1 * pow(S / Sss, q1);
else
return X - S;
}
Num call(Num S, Num X, Num T, Num r, Num b, Num v)
{
if (b >= r)
return bsm_general::call(S, X, T, r, b, v);
Num Ss = aux::solve_Ss(X, T, r, b, v);
Num N = 2 * b / (v * v);
Num M = 2 * r / (v * v);
Num K = 1 - exp(-r * T);
Num q2 = aux::q2(N, M, K);
Num d1 = bsm_general::d1(Ss, X, T, b, v);
Num A2 = (Ss / q2) * (1 - exp((b - r) * T) * normal_cdf(d1));
if (S < Ss)
return bsm_general::call(S, X, T, r, b, v) + A2 * pow(S / Ss, q2);
else
return S - X;
}
int main(){
Gaussian_cdf normal_cdf(0,1);
typedef Non_param_cdf<> non_parametric_cdf;
std::vector<double> uniform_values;
non_parametric_cdf from;
for(int i=1; i<=1000; i++)
uniform_values.push_back( uniform_random() );
std::vector<double> tmp(uniform_values);
// add two extreme values
tmp.push_back(-4.0);
tmp.push_back(4.0);
build_cdf(tmp.begin(), tmp.end(), from, 100);
// don't transform the extremes of the data set tmp
cdf_transform(tmp.begin()+1, tmp.end()-1,
from, normal_cdf);
// second method
std::vector<double> tmp2(uniform_values);
uniform_cdf reference_cdf;
cdf_transform(tmp2.begin(), tmp2.end(),
reference_cdf, normal_cdf);
std::cout << "transform\n3\nunif\nnormal1\nnormal2" << std::endl;
for(int i=1; i<=1000; i++)
std::cout << uniform_values[i-1] << " " << tmp[i-1] << " " << tmp2[i-1] << std::endl;
}
vector<double> gen_trunc_poisson(double lambda, int min, int max) {
vector<double> dist(max + 1, 0.0);//initializes distribution to all 0
double sum = 0.0;
if (lambda < 500) {
for (int k = (int) lambda; k >= min; k--) {
dist[k] = poisson_pmf(lambda, k);
sum += dist[k];
if ( dist[k]/sum < EPSILON) break;
}
for (int k = (int) lambda + 1; k <= max; k++) {
dist[k] = poisson_pmf(lambda, k);
sum += dist[k];
if ( dist[k]/sum < EPSILON) {
dist.resize(k + 1);
break;
}
}
} else { // use a normal approximation, avoiding the factorial and pow calculations
// by starting 9 SD's above lambda, we should capture all densities greater than EPSILON
int prob_max = (int) (lambda + 9.0 * sqrt(lambda));
max = MIN(max, prob_max);
dist.resize(max + 1);
for (int k = max; k >= min; k--) {
dist[k] = normal_cdf(k + 0.5, lambda, lambda); // 0.5 is a continuity correction
if ( k < max ) {
dist[k+1] -= dist[k];
sum += dist[k+1];
}
if ( k < lambda and dist[k+1] < EPSILON) {
dist[k] = 0;
break;
}
}
}
return normalize_dist(dist, sum);
}
inline Num rhs(Num d1, Num Si, Num X, Num T, Num r, Num b, Num v, Num q2)
{
auto d = std::make_pair(d1, d1 - v * sqrt(T));
auto C = bsm_general::aux::call(d, Si, X, T, r, b);
return C + (1 - exp((b - r) * T) * normal_cdf(d1)) * Si / q2;
}
static double normal_h (double w)
{
return normal_pdf(w) / normal_cdf(-w);
}
static void duration_set_predictions (MODEL *pmod, duration_info *dinfo,
const DATASET *dset, gretlopt opt)
{
const double *y = dset->Z[pmod->list[1]];
const double *logt = dinfo->logt->val;
int medians = (opt & OPT_M);
double St, G = 1.0;
double s = 1.0, p = 1.0;
double s22 = 0.0;
double pi_alpha = NADBL;
double wi, Xbi, expXbi;
int i, t;
if (dinfo->dist != DUR_EXPON) {
/* scale factor */
s = dinfo->theta[dinfo->npar-1];
p = 1 / s;
}
/* observation-invariant auxiliary quantities */
if (dinfo->dist == DUR_WEIBULL) {
/* agrees with Stata; R's "survreg" has this wrong? */
if (medians) {
G = pow(log(2.0), s);
} else {
G = gamma_function(1 + s);
}
} else if (dinfo->dist == DUR_EXPON) {
if (medians) {
G = log(2.0);
} else {
G = gamma_function(2.0);
}
} else if (dinfo->dist == DUR_LOGNORM) {
s22 = s * s / 2;
} else if (dinfo->dist == DUR_LOGLOG) {
if (!medians && s < 1) {
pi_alpha = M_PI * s / sin(M_PI * s);
}
}
i = 0;
for (t=pmod->t1; t<=pmod->t2; t++) {
if (na(pmod->yhat[t])) {
continue;
}
Xbi = dinfo->Xb->val[i];
wi = (logt[i] - Xbi) / s;
expXbi = exp(Xbi);
if (dinfo->dist == DUR_WEIBULL || dinfo->dist == DUR_EXPON) {
pmod->yhat[t] = expXbi * G;
St = exp(-exp(wi));
} else if (dinfo->dist == DUR_LOGNORM) {
if (medians) {
pmod->yhat[t] = expXbi;
} else {
pmod->yhat[t] = exp(Xbi + s22);
}
St = normal_cdf(-wi);
} else {
/* log-logistic */
if (medians) {
pmod->yhat[t] = expXbi;
} else if (s < 1) {
pmod->yhat[t] = expXbi * pi_alpha;
} else {
/* the expectation is undefined */
pmod->yhat[t] = NADBL;
}
St = 1.0 / (1 + pow(y[t] / expXbi, p));
}
/* generalized (Cox-Snell) residual */
pmod->uhat[t] = -log(St);
i++;
}
if (medians) {
pmod->opt |= OPT_M;
}
}
static double u01_from_normal (void)
{
double x = gretl_one_snormal();
return normal_cdf(x);
}
int real_levin_lin (int vnum, const int *plist, DATASET *dset,
gretlopt opt, PRN *prn)
{
int u0 = dset->t1 / dset->pd;
int uN = dset->t2 / dset->pd;
int N = uN - u0 + 1; /* units in sample range */
gretl_matrix_block *B;
gretl_matrix *y, *yavg, *b;
gretl_matrix *dy, *X, *ui;
gretl_matrix *e, *ei, *v, *vi;
gretl_matrix *eps;
double pbar, SN = 0;
int t, t1, t2, T, NT;
int s, pt1, pt2, dyT;
int i, j, k, K, m;
int p, pmax, pmin;
int bigrow, p_varies = 0;
int err;
err = LLC_check_plist(plist, N, &pmax, &pmin, &pbar);
if (err) {
return err;
}
/* the 'case' (1 = no const, 2 = const, 3 = const + trend */
m = 2; /* the default */
if (opt & OPT_N) {
/* --nc */
m = 1;
} else if (opt & OPT_T) {
/* --ct */
m = 3;
}
/* does p vary by individual? */
if (pmax > pmin) {
p_varies = 1;
}
p = pmax;
/* the max number of regressors */
k = m + pmax;
t1 = t2 = 0;
/* check that we have a useable common sample */
for (i=0; i<N && !err; i++) {
int pt1 = (i + u0) * dset->pd;
int t1i, t2i;
dset->t1 = pt1;
dset->t2 = dset->t1 + dset->pd - 1;
err = series_adjust_sample(dset->Z[vnum], &dset->t1, &dset->t2);
t1i = dset->t1 - pt1;
t2i = dset->t2 - pt1;
if (i == 0) {
t1 = t1i;
t2 = t2i;
} else if (t1i != t1 || t2i != t2) {
err = E_MISSDATA;
break;
}
}
if (!err) {
err = LLC_sample_check(N, t1, t2, m, plist, &NT);
}
if (!err) {
int Tbar = NT / N;
/* the biggest T we'll need for regressions */
T = t2 - t1 + 1 - (1 + pmin);
/* Bartlett lag truncation (Andrews, 1991) */
K = (int) floor(3.21 * pow(Tbar, 1.0/3));
if (K > Tbar - 3) {
K = Tbar - 3;
}
/* full length of dy vector */
dyT = t2 - t1;
B = gretl_matrix_block_new(&y, T, 1,
&yavg, T+1+p, 1,
&dy, dyT, 1,
&X, T, k,
&b, k, 1,
&ui, T, 1,
&ei, T, 1,
&vi, T, 1,
&e, NT, 1,
&v, NT, 1,
&eps, NT, 1,
NULL);
if (B == NULL) {
err = E_ALLOC;
}
}
if (err) {
return err;
}
if (m > 1) {
/* constant in first column, if wanted */
for (t=0; t<T; t++) {
gretl_matrix_set(X, t, 0, 1.0);
}
}
if (m == 3) {
/* trend in second column, if wanted */
for (t=0; t<T; t++) {
gretl_matrix_set(X, t, 1, t+1);
}
}
gretl_matrix_zero(yavg);
/* compute period sums of y for time-demeaning */
for (i=0; i<N; i++) {
pt1 = t1 + (i + u0) * dset->pd;
pt2 = t2 + (i + u0) * dset->pd;
s = 0;
for (t=pt1; t<=pt2; t++) {
yavg->val[s++] += dset->Z[vnum][t];
}
}
gretl_matrix_divide_by_scalar(yavg, N);
bigrow = 0;
for (i=0; i<N && !err; i++) {
double yti, yti_1;
int p_i, T_i, k_i;
int pt0, ss;
if (p_varies) {
p_i = plist[i+1];
T_i = t2 - t1 + 1 - (1 + p_i);
k_i = m + p_i;
gretl_matrix_reuse(y, T_i, 1);
gretl_matrix_reuse(X, T_i, k_i);
gretl_matrix_reuse(b, k_i, 1);
gretl_matrix_reuse(ei, T_i, 1);
gretl_matrix_reuse(vi, T_i, 1);
} else {
p_i = p;
T_i = T;
k_i = k;
}
/* indices into Z array */
pt1 = t1 + (i + u0) * dset->pd;
pt2 = t2 + (i + u0) * dset->pd;
pt0 = pt1 + 1 + p_i;
/* build (full length) \delta y_t in dy */
s = 0;
for (t=pt1+1; t<=pt2; t++) {
ss = t - pt1;
yti = dset->Z[vnum][t] - gretl_vector_get(yavg, ss);
yti_1 = dset->Z[vnum][t-1] - gretl_vector_get(yavg, ss-1);
gretl_vector_set(dy, s++, yti - yti_1);
}
/* build y_{t-1} in y */
s = 0;
for (t=pt0; t<=pt2; t++) {
yti_1 = dset->Z[vnum][t-1] - gretl_vector_get(yavg, t - pt1 - 1);
gretl_vector_set(y, s++, yti_1);
}
/* augmented case: write lags of dy into X */
for (j=1; j<=p_i; j++) {
int col = m + j - 2;
double dylag;
s = 0;
for (t=pt0; t<=pt2; t++) {
dylag = gretl_vector_get(dy, t - pt1 - 1 - j);
gretl_matrix_set(X, s++, col, dylag);
}
}
/* set lagged y as last regressor */
for (t=0; t<T_i; t++) {
gretl_matrix_set(X, t, k_i - 1, y->val[t]);
}
#if LLC_DEBUG > 1
gretl_matrix_print(dy, "dy");
gretl_matrix_print(y, "y1");
gretl_matrix_print(X, "X");
#endif
if (p_i > 0) {
/* "virtual trimming" of dy for regressions */
dy->val += p_i;
dy->rows -= p_i;
}
/* run (A)DF regression */
err = gretl_matrix_ols(dy, X, b, NULL, ui, NULL);
if (err) {
break;
}
if (k_i > 1) {
/* reduced regressor matrix for auxiliary regressions:
omit the last column containing the lagged level of y
*/
gretl_matrix_reuse(X, T_i, k_i - 1);
gretl_matrix_reuse(b, k_i - 1, 1);
err = gretl_matrix_ols(dy, X, b, NULL, ei, NULL);
if (!err) {
err = gretl_matrix_ols(y, X, b, NULL, vi, NULL);
}
gretl_matrix_reuse(X, T, k);
gretl_matrix_reuse(b, k, 1);
} else {
/* no auxiliary regressions required */
gretl_matrix_copy_values(ei, dy);
gretl_matrix_copy_values(vi, y);
}
if (p_i > 0) {
/* restore dy to full length */
dy->val -= p_i;
dy->rows += p_i;
}
if (!err) {
double sui, s2yi, s2ui = 0.0;
for (t=0; t<T_i; t++) {
s2ui += ui->val[t] * ui->val[t];
}
s2ui /= (T_i - 1);
sui = sqrt(s2ui);
/* write normalized per-unit ei and vi into big matrices */
gretl_matrix_divide_by_scalar(ei, sui);
gretl_matrix_divide_by_scalar(vi, sui);
gretl_matrix_inscribe_matrix(e, ei, bigrow, 0, GRETL_MOD_NONE);
gretl_matrix_inscribe_matrix(v, vi, bigrow, 0, GRETL_MOD_NONE);
bigrow += T_i;
s2yi = LLC_lrvar(dy, K, m, &err);
if (!err) {
/* cumulate ratio of LR std dev to innovation std dev */
SN += sqrt(s2yi) / sui;
}
#if LLC_DEBUG
pprintf(prn, "s2ui = %.8f, s2yi = %.8f\n", s2ui, s2yi);
#endif
}
if (p_varies) {
gretl_matrix_reuse(y, T, 1);
gretl_matrix_reuse(X, T, k);
gretl_matrix_reuse(b, k, 1);
gretl_matrix_reuse(ei, T, 1);
gretl_matrix_reuse(vi, T, 1);
}
}
if (!err) {
/* the final step: full-length regression of e on v */
double ee = 0, vv = 0;
double delta, s2e, STD, td;
double mstar, sstar;
gretl_matrix_reuse(b, 1, 1);
err = gretl_matrix_ols(e, v, b, NULL, eps, NULL);
if (!err) {
for (t=0; t<NT; t++) {
ee += eps->val[t] * eps->val[t];
vv += v->val[t] * v->val[t];
}
SN /= N;
delta = b->val[0];
s2e = ee / NT;
STD = sqrt(s2e) / sqrt(vv);
td = delta / STD;
/* fetch the Levin-Lin-Chu corrections factors */
err = get_LLC_corrections(T, m, &mstar, &sstar);
}
if (!err) {
double z = (td - NT * (SN / s2e) * STD * mstar) / sstar;
double pval = normal_cdf(z);
#if LLC_DEBUG
pprintf(prn, "mustar = %g, sigstar = %g\n", mstar, sstar);
pprintf(prn, "SN = %g, se = %g, STD = %g\n", SN, sqrt(s2e), STD);
#endif
if (!(opt & OPT_Q)) {
const char *heads[] = {
N_("coefficient"),
N_("t-ratio"),
N_("z-score")
};
const char *s = dset->varname[vnum];
char NTstr[32];
int sp[3] = {0, 3, 5};
int w[3] = {4, 6, 0};
pputc(prn, '\n');
pprintf(prn, _("Levin-Lin-Chu pooled ADF test for %s\n"), s);
pprintf(prn, "%s ", _(DF_test_spec(m)));
if (p_varies) {
pprintf(prn, _("including %.2f lags of (1-L)%s (average)"), pbar, s);
} else if (p == 1) {
pprintf(prn, _("including one lag of (1-L)%s"), s);
} else {
pprintf(prn, _("including %d lags of (1-L)%s"), p, s);
}
pputc(prn, '\n');
pprintf(prn, _("Bartlett truncation at %d lags\n"), K);
sprintf(NTstr, "N,T = (%d,%d)", N, dyT + 1);
pprintf(prn, _("%s, using %d observations"), NTstr, NT);
pputs(prn, "\n\n");
for (i=0; i<3; i++) {
pputs(prn, _(heads[i]));
bufspace(w[i], prn);
w[i] = sp[i] + g_utf8_strlen(_(heads[i]), -1);
}
pputc(prn, '\n');
pprintf(prn, "%*.5g %*.3f %*.6g [%.4f]\n\n",
w[0], delta, w[1], td, w[2], z, pval);
}
record_test_result(z, pval, "Levin-Lin-Chu");
}
}
gretl_matrix_block_destroy(B);
return err;
}
double studentT_CDF(int64_t nu, double t) {
double z,
t_by_sqrt_nu;
double A, /* contains A(t|nu) */
prod = 1.,
sum = 1.;
/* Handle extreme cases. See above. */
if (nu <= 0)
return std::numeric_limits<double>::quiet_NaN();
else if (t == std::numeric_limits<double>::infinity())
return 1;
else if (t == -std::numeric_limits<double>::infinity())
return 0;
else if (nu >= 1000000)
return normal_cdf(t);
else if (nu >= 200)
return studentT_cdf_approx(nu, t);
/* Handle main case (nu < 200) in the rest of the function. */
z = 1. + t * t / nu;
t_by_sqrt_nu = std::fabs(t) / std::sqrt(static_cast<double>(nu));
if (nu == 1)
{
A = 2. / M_PI * std::atan(t_by_sqrt_nu);
}
else if (nu & 1) /* odd nu > 1 */
{
for (int j = 2; j <= nu - 3; j += 2)
{
prod = prod * j / ((j + 1) * z);
sum = sum + prod;
}
A = 2 / M_PI * ( std::atan(t_by_sqrt_nu) + t_by_sqrt_nu / z * sum );
}
else /* even nu */
{
for (int j = 2; j <= nu - 2; j += 2)
{
prod = prod * (j - 1) / (j * z);
sum = sum + prod;
}
A = t_by_sqrt_nu / std::sqrt(z) * sum;
}
/* A should obviously be within the interval [0,1] plus minus (hopefully
* small) rounding errors. */
if (A > 1.)
A = 1.;
else if (A < 0.)
A = 0.;
/* The Student-T distribution is obviously symmetric around t=0... */
if (t < 0)
return .5 * (1. - A);
else
return 1. - .5 * (1. - A);
}
inline Num bj(Num d1, Num T, Num r, Num b, Num v, Num q1)
{
auto N = normal_cdf(-d1), n = normal_pdf(-d1);
return -exp((b - r) * T) * N * (1 - 1 / q1) - (1 + exp((b - r) * T) * n / (v * sqrt(T))) / q1;
}
inline Num bi(Num d1, Num T, Num r, Num b, Num v, Num q2)
{
auto N = normal_cdf(d1), n = normal_pdf(d1);
return exp((b - r) * T) * N * (1 - 1 / q2) + (1 - exp((b - r) * T) * n / (v * sqrt(T))) / q2;
}
inline Num hs(Num d1, Num Sj, Num X, Num T, Num r, Num b, Num v, Num q1)
{
auto d = std::make_pair(d1, d1 - v * sqrt(T));
auto P = bsm_general::aux::put(d, Sj, X, T, r, b);
return P - (1 - exp((b - r) * T) * normal_cdf(-d1)) * Sj / q1;
}
