Example #1
0
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;
}
Example #2
0
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;
    }
}