Esempio n. 1
0
MODEL tobit_driver (const int *list, DATASET *dset, 
		    gretlopt opt, PRN *prn)
{
    MODEL model;
    double llim = -1.0e300;
    double rlim = NADBL;
    int err = 0;

    if (opt & OPT_L) {
	/* we should have an explicit lower limit */
	llim = get_optval_double(TOBIT, OPT_L);
	if (na(llim)) {
	    err = E_BADOPT;
	} 
    }

    if (!err && (opt & OPT_M)) {
	/* we should have an explicit upper limit */
	rlim = get_optval_double(TOBIT, OPT_M);
	if (na(rlim) || rlim <= llim) {
	    err = E_BADOPT; 
	}	
    }

    if (err) {
	gretl_model_init(&model, dset);
	model.errcode = err;
	return model;
    }

    if (!(opt & (OPT_L | OPT_M))) {
	/* the default: left-censoring at zero */
	llim = 0;
    }

    return tobit_model(list, llim, rlim, dset, opt, prn);
}
Esempio n. 2
0
MODEL quantreg_driver (const char *parm, const int *list, 
		       DATASET *dset, gretlopt opt, PRN *prn)
{
    gretl_vector *tau;
    MODEL mod;
    int err = 0;

    tau = generate_matrix(parm, dset, &err);

    if (!err && gretl_vector_get_length(tau) == 0) {
	err = E_DATA;
    }

    if (err) {
	gretl_model_init(&mod, dset);
	mod.errcode = err;
    } else {
	mod = quantreg(tau, list, dset, opt, prn);
    }

    gretl_matrix_free(tau);

    return mod;
}
Esempio n. 3
0
MODEL midas_model (const int *list,
		   const char *param,
		   DATASET *dset,
		   gretlopt opt,
		   PRN *prn)
{
    midas_info *minfo = NULL;
    char tmp[64];
    int *xlist = NULL;
    int i, nmidas = 0;
    int ldepvar = 0;
    int hfslopes = 0;
    int origv = dset->v;
    int save_t1 = dset->t1;
    int save_t2 = dset->t2;
    int use_ols = 0;
    MODEL mod;
    int err = 0;

    gretl_model_init(&mod, dset);

    if (param == NULL || *param == '\0') {
	err = E_DATA;
    } else {
	err = parse_midas_specs(param, dset, &minfo,
				&nmidas, &use_ols);
    }

    if (!err) {
	/* build list of regular regressors */
	xlist = make_midas_xlist(list, dset, &ldepvar, &err);
	if (xlist != NULL) {
	    err = remember_list(xlist, "XL___", NULL);
	    user_var_privatize_by_name("XL___");
	}
    }

    if (!err) {
	/* build (or just read) MIDAS lag-lists */
	err = make_midas_laglists(minfo, nmidas, dset);
    }

    if (!err && use_ols) {
	err = umidas_ols(&mod, list, dset, minfo, nmidas, opt);
#if MIDAS_DEBUG	
	fputs("*** U-MIDAS via OLS ***\n", stderr);
#endif	
	goto umidas_finish;
    }

    if (!err) {
	/* determine usable sample range */
	err = midas_set_sample(list, dset, minfo, nmidas);
    }

    if (!err) {
	/* add the required matrices */
	err = add_midas_matrices(list[1], xlist, dset, minfo,
				 nmidas, &hfslopes);
    }

#if MIDAS_DEBUG	
    fputs("*** MIDAS via NLS ***\n\n", stderr);
#endif    

    if (!err) {
	char line[MAXLEN];
	int j = 0;

	/* initial "nls" line */
	sprintf(line, "nls %s = ", dset->varname[list[1]]);
	if (xlist != NULL) {
	    strcat(line, "lincomb(XL___, bx___)");
	}
	for (i=0; i<nmidas; i++) {
	    if (takes_coeff(minfo[i].type)) {
		sprintf(tmp, " + bmlc___%d*mlc___%d", ++j, i+1);
	    } else {
		sprintf(tmp, " + mlc___%d", i+1);
	    }
	    strcat(line, tmp);
	}
	err = put_midas_nls_line(line, dset, prn);

	/* MIDAS series and gradient matrices */
	for (i=0; i<nmidas && !err; i++) {
	    if (minfo[i].type == MIDAS_U) {
		sprintf(line, "series mlc___%d = lincomb(%s, %s)",
			i+1, minfo[i].lname, minfo[i].mname);
	    } else {
		sprintf(line, "series mlc___%d = mlincomb(%s, %s, %d)",
			i+1, minfo[i].lname, minfo[i].mname,
			minfo[i].type);
	    }
	    err = put_midas_nls_line(line, dset, prn);
	    if (!err && minfo[i].type != MIDAS_U) {
		sprintf(line, "matrix mgr___%d = mgradient(%d, %s, %d)",
			i+1, minfo[i].nterms, minfo[i].mname, minfo[i].type);
		err = put_midas_nls_line(line, dset, prn);
	    }
	}

	/* derivatives */
	if (!err && xlist != NULL) {
	    strcpy(line, "deriv bx___ = MX___");
	    err = put_midas_nls_line(line, dset, prn);
	}
	for (i=0; i<nmidas && !err; i++) {
	    if (takes_coeff(minfo[i].type)) {
		sprintf(line, "deriv bmlc___%d = {mlc___%d}", i+1, i+1);
		err = put_midas_nls_line(line, dset, prn);
	    }
	    if (!err) {
		if (takes_coeff(minfo[i].type)) {
		    sprintf(line, "deriv %s = bmlc___%d * {%s} * mgr___%d",
			    minfo[i].mname, i+1, minfo[i].lname, i+1);
		} else if (minfo[i].type == MIDAS_ALMONP) {
		    sprintf(line, "deriv %s = {%s} * mgr___%d",
			    minfo[i].mname, minfo[i].lname, i+1);
		} else {
		    sprintf(line, "deriv %s = {%s}", minfo[i].mname,
			    minfo[i].lname);
		}
		err = put_midas_nls_line(line, dset, prn);
	    }
	}

	/* parameter names */
	if (!err) {
	    strcpy(line, "param_names \"");
	    if (xlist != NULL) {
		for (i=1; i<=xlist[0]; i++) {
		    strcpy(tmp, dset->varname[xlist[i]]);
		    append_pname(line, tmp);
		}
	    }
	    for (i=0; i<nmidas && !err; i++) {
		if (takes_coeff(minfo[i].type)) {
		    if (hfslopes > 1) {
			sprintf(tmp, "HF_slope%d", i+1);
		    } else {
			strcpy(tmp, "HF_slope");
		    }
		    append_pname(line, tmp);
		}
		for (j=0; j<minfo[i].nparm; j++) {
		    make_pname(tmp, &minfo[i], j, dset);
		    append_pname(line, tmp);
		}
	    }
	    strcat(line, "\"");
	    err = put_midas_nls_line(line, dset, prn);
	}
    }

#if MIDAS_DEBUG
    fputc('\n', stderr);
#endif

    if (!err) {
	mod = nl_model(dset, (opt | OPT_G | OPT_M), prn);
    }

 umidas_finish:

    dset->t1 = save_t1;
    dset->t2 = save_t2;

    for (i=0; i<nmidas; i++) {
	if (!minfo[i].prelag) {
	    user_var_delete_by_name(minfo[i].lname, NULL);
	}
	if (minfo[i].type != MIDAS_U) {
	    sprintf(tmp, "mgr___%d", i+1);
	    user_var_delete_by_name(tmp, NULL);
	}
    }

    if (err && !mod.errcode) {
	mod.errcode = err;
    }

    if (!mod.errcode) {
	finalize_midas_model(&mod, list, param, dset,
			     minfo, nmidas, xlist,
			     ldepvar, hfslopes);
    } else {
	free(xlist);
    }

    destroy_private_uvars();
    free(minfo);

    if (dset->v > origv) {
	/* or maybe not? */
	dataset_drop_last_variables(dset, dset->v - origv);
    }

    return mod;
}
Esempio n. 4
0
static int real_hr_arma_init (double *coeff, const DATASET *dset,
			      arma_info *ainfo, PRN *prn)
{
    const int *list = ainfo->alist;
    int np = ainfo->p, nq = ainfo->q;
    int nP = ainfo->P, nQ = ainfo->Q;
    int ptotal = np + nP + np * nP;
    int qtotal = nq + nQ + nq * nQ;
    int nexo = ainfo->nexo;
    int pass1lags, pass1v;
    const double *y;
    DATASET *aset = NULL;
    int *pass1list = NULL;
    int *pass2list = NULL;
    int *arlags = NULL;
    int *malags = NULL;
    MODEL armod;
    int xstart;
    int m, pos, s;
    int i, j, t;
    int err = 0;

    pass1lags = (ainfo->Q + ainfo->P) * dset->pd;
    if (pass1lags < HR_MINLAGS) {
	pass1lags = HR_MINLAGS;
    }
    pass1v = pass1lags + nexo + 2;

    /* dependent variable */
    if (arma_xdiff(ainfo)) {
	/* for initialization, use the level of y */
	y = dset->Z[ainfo->yno];
    } else { 
	y = ainfo->y;
    } 

    aset = create_auxiliary_dataset(pass1v + qtotal, ainfo->T, 0);
    if (aset == NULL) {
	return E_ALLOC;
    }

#if AINIT_DEBUG
    fprintf(stderr, "hr_arma_init: dataset allocated: %d vars, %d obs\n", 
	    pass1v + qtotal, ainfo->T);
#endif

    /* in case we bomb before estimating a model */
    gretl_model_init(&armod, dset);

    /* Start building stuff for pass 1 */

    pass1list = gretl_list_new(pass1v);
    if (pass1list == NULL) {
	err = E_ALLOC;
	goto bailout;
    }
	
    pass1list[1] = 1;
    pass1list[2] = 0;
    for (i=2; i<pass1v; i++) {
	pass1list[i+1] = i;
    }

    /* variable names */

    strcpy(aset->varname[1], "y");
    for (i=0; i<nexo; i++) { 
	/* exogenous vars */
	sprintf(aset->varname[i+1], "x%d", i);
    }
    for (i=1; i<=pass1lags; i++) { 
	/* lags */
	sprintf(aset->varname[i+1+nexo], "y_%d", i);
    }

     /* Fill the dataset with the data for pass 1 */

    /* starting position for reading exogeneous vars */
    if (ainfo->d > 0 || ainfo->D > 0) {
	xstart = (arma_has_seasonal(ainfo))? 10 : 6;
    } else {
	xstart = (arma_has_seasonal(ainfo))? 8 : 5;
    }

    for (t=0; t<ainfo->T; t++) {
	s = t + ainfo->t1;
	aset->Z[1][t] = y[s];
	for (i=0, pos=2; i<nexo; i++) {
	    m = list[xstart + i];
	    aset->Z[pos++][t] = dset->Z[m][s];
	}
	for (i=1; i<=pass1lags; i++) {
	    s = t + ainfo->t1 - i;
	    aset->Z[pos++][t] = (s >= 0)? y[s] : NADBL;
	}
    }

    /* pass 1 proper */

    armod = lsq(pass1list, aset, OLS, OPT_A);
    if (armod.errcode) {
	err = armod.errcode;
	goto bailout;
    } 

#if AINIT_DEBUG
    fprintf(stderr, "pass1 model: t1=%d, t2=%d, nobs=%d, ncoeff=%d, dfd = %d\n", 
	    armod.t1, armod.t2, armod.nobs, armod.ncoeff, armod.dfd);
#endif

    /* allocations for pass 2 */

    if (qtotal > 0) {
	malags = malloc(qtotal * sizeof *malags);
	if (malags == NULL) {
	    err = E_ALLOC;
	} else {
	    for (i=0, pos=0; i<nq; i++) {
		malags[pos++] = i+1;
	    }
	    for (i=0; i<ainfo->Q; i++) {
		for (j=0; j<=nq; j++) {
		    malags[pos++] = (i+1) * dset->pd + j;
		}
	    }
	}
    }

    if (ptotal > 0 && !err) {
	arlags = malloc(ptotal * sizeof *arlags);
	if (arlags == NULL) {
	    err = E_ALLOC;
	} else {
	    for (i=0, pos=0; i<np; i++) {
		arlags[pos++] = i+1;
	    }
	    for (i=0; i<ainfo->P; i++) {
		for (j=0; j<=np; j++) {
		    arlags[pos++] = (i+1) * dset->pd + j;
		}
	    }
	}
    }

    if (!err) {
	pass2list = gretl_list_new(2 + nexo + ptotal + qtotal);
	if (pass2list == NULL) {
	    err = E_ALLOC;
	}
    }

    /* handle error in pass2 allocations */
    if (err) {
	goto bailout;
    }

    /* stick lagged residuals into temp dataset */
    pos = pass1v;
    for (i=0; i<qtotal; i++) {
	sprintf(aset->varname[pos], "e_%d", malags[i]);
	for (t=0; t<ainfo->T; t++) {
	    s = t - malags[i];
	    aset->Z[pos][t] = (s >= 0)? armod.uhat[s] : NADBL;
	}
	pos++;
    }

    /* compose pass 2 regression list */
    for (i=1, pos=1; i<=nexo+2; i++) {
	pass2list[pos++] = pass1list[i];
    }
    for (i=0; i<ptotal; i++) {
	/* FIXME? */
	if (AR_included(ainfo,i)) {
	    pass2list[pos++] = arlags[i] + nexo + 1;
	}
    }
    for (i=0; i<qtotal; i++) {
	/* FIXME? */
	if (MA_included(ainfo,i)) {
	    pass2list[pos++] = pass1v + i;
	}
    }
    
    /* now do pass2 */
    clear_model(&armod);
    armod = lsq(pass2list, aset, OLS, OPT_A);

    if (armod.errcode) {
	err = armod.errcode;
    } else {
#if AINIT_DEBUG
	PRN *modprn = gretl_print_new(GRETL_PRINT_STDERR, NULL);

	printmodel(&armod, aset, OPT_S, modprn);
	gretl_print_destroy(modprn);
#endif
	err = hr_transcribe_coeffs(ainfo, &armod, coeff);

	if (!err && arma_exact_ml(ainfo) && 
	    ainfo->ifc && ainfo->nexo == 0) {
	    transform_arma_const(coeff, ainfo);
	}
    }

#if AINIT_DEBUG
    if (!err) {
	fprintf(stderr, "HR init:\n");
	for (i=0; i<ainfo->nc; i++) {
	    fprintf(stderr, "coeff[%d] = %g\n", i, coeff[i]);
	}
    }
#endif

 bailout:

    free(pass1list);
    free(pass2list);
    free(arlags);
    free(malags);
    destroy_dataset(aset);
    clear_model(&armod);

    if (!err && prn != NULL) {
	pprintf(prn, "\n%s: %s\n\n", _("ARMA initialization"), 
		_("Hannan-Rissanen method"));
    }

    return err;
}
Esempio n. 5
0
int ar_arma_init (double *coeff, const DATASET *dset,
		  arma_info *ainfo, MODEL *pmod)
{
    PRN *prn = ainfo->prn;
    int *list = ainfo->alist;
    int nmixed = ainfo->np * ainfo->P;
    int ptotal = ainfo->np + ainfo->P + nmixed;
    int av = ptotal + ainfo->nexo + 2;
    DATASET *aset = NULL;
    int *arlist = NULL;
    MODEL armod;
    int narmax, nonlin = 0;
    int i, err = 0;

#if AINIT_DEBUG
    fprintf(stderr, "ar_arma_init: dset->t1=%d, dset->t2=%d (dset->n=%d);\n"
	    " ainfo->t1=%d, ainfo->t2=%d, ",
	    dset->t1, dset->t2, dset->n, ainfo->t1, ainfo->t2);
    fprintf(stderr, "nmixed = %d, ptotal = %d, ifc = %d, nexo = %d\n", 
	    nmixed, ptotal, ainfo->ifc, ainfo->nexo);
#endif

    if (ptotal == 0 && ainfo->nexo == 0 && !ainfo->ifc) {
	/* special case of pure MA model */
	for (i=0; i<ainfo->nq + ainfo->Q; i++) {
	    coeff[i] = 0.0001; 
	} 
	pprintf(ainfo->prn, "\n%s: %s\n\n", _("ARMA initialization"), 
		_("small MA values"));
	return 0;
    }

    gretl_model_init(&armod, dset); 

    narmax = arma_exact_ml(ainfo) ? ainfo->nexo : 0;
    if (narmax > 0 && ptotal > 0) {
	/* ARMAX-induced lags of exog vars */
	av += ainfo->nexo * ptotal;
    } 

    if (arma_exact_ml(ainfo) && ainfo->ifc) {
	maybe_set_yscale(ainfo);
    }

    aset = create_auxiliary_dataset(av, ainfo->fullT, 0);
    if (aset == NULL) {
	return E_ALLOC;
    }

    if (ptotal > 0 && (narmax > 0 || nmixed > 0)) {
	/* we'll have to use NLS */
	nonlin = 1;
    } else {
	/* OLS: need regression list */
	arlist = make_ar_ols_list(ainfo, av);
    }

    /* build temporary dataset, dset -> aset */
    arma_init_build_dataset(ainfo, ptotal, narmax, list,
			    dset, aset, nonlin);

    if (nonlin) {
	PRN *dprn = NULL;

#if AINIT_DEBUG
	fprintf(stderr, "arma:_init_by_ls: doing NLS\n");
	dprn = prn;
#endif
	err = arma_get_nls_model(&armod, ainfo, narmax, NULL, aset,
				 dprn);
    } else {
#if AINIT_DEBUG
	printlist(arlist, "'arlist' in ar_arma_init (OLS)");
#endif
	armod = lsq(arlist, aset, OLS, OPT_A | OPT_Z);
	err = armod.errcode;
    }

#if AINIT_DEBUG
    if (!err) {
	pputs(prn, "\n*** armod, in ar_arma_init\n");
	printmodel(&armod, aset, OPT_NONE, prn);
    } else {
	fprintf(stderr, "LS init: armod.errcode = %d\n", err);
    }
#endif

    if (!err) {
	arma_init_transcribe_coeffs(ainfo, &armod, coeff);
    }

    /* handle the case where we need to translate from an
       estimate of the regression constant to the
       unconditional mean of y_t
    */
    if (!err && arma_exact_ml(ainfo) && ainfo->ifc && 
	(!nonlin || ainfo->nexo == 0)) {
	transform_arma_const(coeff, ainfo);
    }

    if (!err && prn != NULL) {
	if (nonlin) {
	    pprintf(prn, "\n%s: %s\n\n", _("ARMA initialization"),
		    _("using nonlinear AR model"));
	} else {
	    pprintf(prn, "\n%s: %s\n\n", _("ARMA initialization"),
		    _("using linear AR model"));
	}
    }

    /* clean up */
    clear_model(&armod);
    free(arlist);
    destroy_dataset(aset);

    return err;
}
Esempio n. 6
0
MODEL arma_x12_model (const int *list, const int *pqspec,
		      const DATASET *dset, int pdmax, 
		      gretlopt opt, PRN *prn)
{
    int verbose = (opt & OPT_V);
    const char *prog = gretl_x12_arima();
    const char *workdir = gretl_x12_arima_dir();
    char yname[VNAMELEN], path[MAXLEN];
    MODEL armod;
    arma_info ainfo_s, *ainfo;
    int missv = 0, misst = 0;
#ifdef WIN32
    char *cmd;
#endif
    int err = 0;

    if (dset->t2 < dset->n - 1) {
	/* FIXME this is temporary (OPT_F -> generate forecast) */
	opt |= OPT_F;
    }

    ainfo = &ainfo_s;
    arma_info_init(ainfo, opt | OPT_X, pqspec, dset);
    ainfo->prn = set_up_verbose_printer(opt, prn);
    gretl_model_init(&armod, dset); 

    ainfo->alist = gretl_list_copy(list);
    if (ainfo->alist == NULL) {
	err = E_ALLOC;
    }

    if (!err) {
	err = arma_check_list(ainfo, dset, opt);
    }

    if (err) {
	armod.errcode = err;
	goto bailout;
    }     

    /* calculate maximum lag */
    calc_max_lag(ainfo);

    x12a_maybe_allow_missvals(ainfo);

    /* adjust sample range if need be */
    armod.errcode = arma_adjust_sample(ainfo, dset, &missv, &misst);
    if (armod.errcode) {
	goto bailout;
    } else if (missv > 0) {
	set_arma_missvals(ainfo);
    }

    ainfo->y = (double *) dset->Z[ainfo->yno]; /* it's really const */
    strcpy(yname, dset->varname[ainfo->yno]);

    /* write out an .spc file */
    sprintf(path, "%s%c%s.spc", workdir, SLASH, yname);
    write_arma_spc_file(path, dset, ainfo, pdmax, opt);

    /* remove any files from an old run, in case of error */
    delete_old_files(path);

    /* run the program */
#ifdef WIN32
    cmd = g_strdup_printf("\"%s\" %s -r -p -q", prog, yname);
    err = win_run_sync(cmd, workdir);
    g_free(cmd);
#else
    err = tramo_x12a_spawn(workdir, prog, yname, "-r", "-p", "-q", "-n", NULL);
#endif

    if (!err) {
	sprintf(path, "%s%c%s", workdir, SLASH, yname); 
	populate_x12a_arma_model(&armod, path, dset, ainfo);
	if (verbose && !armod.errcode) {
	    print_iterations(path, ainfo->prn);
	}
	if (!armod.errcode) {
	    if (gretl_in_gui_mode()) {
		add_unique_output_file(&armod, path);
	    }
	    gretl_model_set_int(&armod, "arma_flags", (int) ainfo->flags);
	}	
    } else {
	armod.errcode = E_UNSPEC;
	gretl_errmsg_set(_("Failed to execute x12arima"));
    }

    if (armod.errcode && ainfo->prn != NULL) {
	sprintf(path, "%s%c%s.err", workdir, SLASH, yname);
	print_x12a_error_file(path, ainfo->prn);
    }

    if (ainfo->prn != NULL && ainfo->prn != prn) {
	iter_print_callback(0, ainfo->prn);
	close_down_verbose_printer(ainfo->prn);
    }

 bailout:

    arma_info_cleanup(ainfo);

    return armod;
}