int gretl_rand_GED (double *a, int t1, int t2, double nu)
{
int err, t;
double p, scale;
if (nu < 0) {
return E_INVARG;
}
p = 1.0/nu;
scale = pow(0.5, p) * sqrt(gamma_function(p) / gamma_function(3.0*p));
err = gretl_rand_gamma(a, t1, t2, p, 2);
if (!err) {
for (t=t1; t<=t2; t++) {
a[t] = scale * pow(a[t], p);
if (gretl_rand_01() < 0.5) {
a[t] = -a[t];
}
}
}
return err;
}
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;
}
}
