int nls_estimate (DATASET *dset, PRN *prn)
{
MODEL *model = NULL;
nlspec *spec;
const char *nls_function;
char *pnames[] = {"alpha", "beta"}; /* parameter names */
double parms[] = {-20.0, 3.0}; /* and initial values */
int err = 0;
spec = nlspec_new(NLS, dset);
if (spec == NULL) {
return E_ALLOC;
}
/* specify the function: we're assuming the dataset contains
variables named x and y
*/
nls_function = "y = alpha + beta*x1 + (1/beta)*x2";
err = nlspec_set_regression_function(spec, nls_function, dset);
if (!err) {
err = nlspec_add_param_list(spec, 2, parms, pnames);
}
if (!err) {
model = gretl_model_new();
*model = model_from_nlspec(spec, dset, OPT_NONE, prn);
err = model->errcode;
}
if (!err) {
printmodel(model, dset, OPT_NONE, prn);
}
gretl_model_free(model);
nlspec_destroy(spec);
return err;
}
int
main(int argc, char** argv)
{
/**
* fprintf(stdout) | ./block l d x y
* option:
* -x [gpu, cpu]
* -m [lin, sph, exp, gau]
* -l [1..13]
*/
features f;
model m;
/* Stdin -> features */
readfeatures(&f);
/* Fit model and predict */
variogram(&m, &f, argc>1 ? atoi(argv[1]) : DEFAULT_MDL);
/* Print model */
printmodel(&m);
return 0;
}
static int real_run_check (int round, PRN *prn)
{
int coeff_acc = 0, sderr_acc = 0, err = 0;
char line[512];
MODEL *pmod = NULL;
pmod = gretl_model_new();
if (pmod == NULL) {
fputs("Out of memory\n", stderr);
return 1;
}
set_tolerance();
catch_arctan();
if (!err) {
err = generate_params(line, round, prn);
}
if (!err) {
catch_log_depvar();
err = nl_parse_line(NLS, tester.model_spec, (const double **) Z,
datainfo, prn);
if (verbose) {
printf("%s\n", tester.model_spec);
}
if (err) {
fprintf(stderr, "%s: ERROR: in nl_parse_line\n '%s'\n",
tester.datname, tester.model_spec);
errmsg(err, prn);
return err;
}
}
if (!err) {
if (use_derivs) {
err = print_derivs(line, prn);
} else {
err = print_params(line, prn);
}
}
if (!err) {
*pmod = nl_model(&Z, datainfo, OPT_NONE, prn);
if (pmod->errcode) {
err = pmod->errcode;
fprintf(stderr, "%s: ERROR: model error %d\n", tester.datname, err);
errmsg(err, prn);
} else {
if (verbose) {
pmod->ID = 0;
printmodel(pmod, datainfo, OPT_NONE, prn);
}
print_tol = gretl_model_get_double(pmod, "tol");
total_iters += gretl_model_get_int(pmod, "iters");
get_accuracy(pmod, &coeff_acc, &sderr_acc);
if (coeff_acc < worst_coeff_acc) {
worst_coeff_acc = coeff_acc;
strcpy(worst_coeff_name, tester.datname);
}
/* Lanczos1 is weird */
if (strcmp(tester.datname, "Lanczos1") &&
sderr_acc < worst_sderr_acc) {
worst_sderr_acc = sderr_acc;
strcpy(worst_sderr_name, tester.datname);
}
}
gretl_model_free(pmod);
pmod = NULL;
}
if (err && !verbose) {
printf(" Estimation failed\n");
}
if (err) {
n_fail++;
} else {
avg_coeff_min += coeff_acc;
avg_sd_min += sderr_acc;
n_ok++;
}
if (!err) {
if (verbose) printf("\n ***\n");
if (coeff_acc >= 6) {
printf(" coefficient accuracy >= %d digits\n", coeff_acc);
} else if (coeff_acc >= MIN_DIGITS) {
printf(" coefficient accuracy >= %d digits\n", coeff_acc);
} else {
printf(" min. coefficient accuracy < %d digits\n", MIN_DIGITS);
}
if (sderr_acc >= 6) {
printf(" stderr accuracy >= %d digits\n", sderr_acc);
} else if (sderr_acc >= MIN_DIGITS) {
printf(" stderr accuracy >= %d digits\n", sderr_acc);
} else {
printf(" min. stderr accuracy < %d digits\n", MIN_DIGITS);
}
}
if (verbose)
printf("Round %d, error code = %d\n", round, err);
return err;
}
static int arma_get_nls_model (MODEL *amod, arma_info *ainfo,
int narmax, const double *coeff,
DATASET *dset, PRN *prn)
{
gretlopt nlsopt = OPT_A;
char fnstr[MAXLINE];
char term[32];
nlspec *spec;
double *parms = NULL;
char **pnames = NULL;
double *b0 = NULL, *by1 = NULL;
int nparam, lag;
int i, j, k, err = 0;
spec = nlspec_new(NLS, dset);
if (spec == NULL) {
return E_ALLOC;
}
if (arma_least_squares(ainfo)) {
/* respect verbose option */
if (prn != NULL) {
nlsopt |= OPT_V;
}
} else {
#if AINIT_DEBUG
nlsopt |= OPT_V;
#else
/* don't bother with standard errors */
nlsopt |= OPT_C;
#endif
}
nlspec_set_t1_t2(spec, 0, ainfo->T - 1);
nparam = ainfo->ifc + ainfo->np + ainfo->P + ainfo->nexo;
if (ainfo->misslist != NULL) {
nparam += ainfo->misslist[0];
}
parms = malloc(nparam * sizeof *parms);
if (parms == NULL) {
err = E_ALLOC;
goto bailout;
}
pnames = strings_array_new_with_length(nparam, VNAMELEN);
if (pnames == NULL) {
err = E_ALLOC;
goto bailout;
}
/* make names for the parameters; construct the param list;
and do some rudimentary fall-back initialization */
for (i=0; i<nparam; i++) {
parms[i] = 0.0;
}
k = 0;
if (ainfo->ifc) {
if (coeff != NULL) {
parms[k] = coeff[k];
} else {
parms[k] = gretl_mean(0, dset->n - 1, dset->Z[1]);
}
b0 = &parms[k];
strcpy(pnames[k++], "_b0");
}
for (i=0; i<ainfo->p; i++) {
if (AR_included(ainfo, i)) {
if (by1 == NULL) {
by1 = &parms[k];
if (coeff == NULL) {
parms[k] = 0.1;
}
}
if (coeff != NULL) {
parms[k] = coeff[k];
}
sprintf(pnames[k++], "_phi%d", i+1);
}
}
for (i=0; i<ainfo->P; i++) {
if (by1 == NULL) {
by1 = &parms[k];
if (coeff == NULL) {
parms[k] = 0.1;
}
}
if (coeff != NULL) {
parms[k] = coeff[k];
}
sprintf(pnames[k++], "_Phi%d", i+1);
}
for (i=0; i<ainfo->nexo; i++) {
if (coeff != NULL) {
parms[k] = coeff[k];
}
sprintf(pnames[k++], "_b%d", i+1);
}
if (ainfo->misslist != NULL) {
for (i=1; i<=ainfo->misslist[0]; i++) {
j = ainfo->misslist[i];
parms[k] = dset->Z[1][j];
sprintf(pnames[k++], "_c%d", i);
}
}
/* construct NLS specification string */
strcpy(fnstr, "y=");
if (ainfo->ifc) {
strcat(fnstr, "_b0");
} else {
strcat(fnstr, "0");
}
for (i=0; i<ainfo->p && !err; i++) {
if (AR_included(ainfo, i)) {
lag = i + 1;
sprintf(term, "+_phi%d*", lag);
err = add_to_spec(fnstr, term);
if (!err) {
err = y_Xb_at_lag(fnstr, ainfo, narmax, lag);
}
}
}
for (j=0; j<ainfo->P && !err; j++) {
sprintf(term, "+_Phi%d*", j+1);
strcat(fnstr, term);
lag = (j + 1) * ainfo->pd;
y_Xb_at_lag(fnstr, ainfo, narmax, lag);
for (i=0; i<ainfo->p; i++) {
if (AR_included(ainfo, i)) {
sprintf(term, "-_phi%d*_Phi%d*", i+1, j+1);
err = add_to_spec(fnstr, term);
if (!err) {
lag = (j+1) * ainfo->pd + (i+1);
y_Xb_at_lag(fnstr, ainfo, narmax, lag);
}
}
}
}
for (i=0; i<ainfo->nexo && !err; i++) {
sprintf(term, "+_b%d*x%d", i+1, i+1);
err = add_to_spec(fnstr, term);
}
if (!err && ainfo->misslist != NULL) {
for (i=1; i<=ainfo->misslist[0]; i++) {
sprintf(term, "+_c%d*d%d", i, i);
err = add_to_spec(fnstr, term);
}
}
if (!err) {
if (coeff == NULL) {
nls_kickstart(amod, dset, b0, by1);
}
#if AINIT_DEBUG
fprintf(stderr, "initting using NLS spec:\n %s\n", fnstr);
for (i=0; i<nparam; i++) {
fprintf(stderr, "initial NLS b[%d] = %g (%s)\n",
i, parms[i], pnames[i]);
}
#endif
err = nlspec_set_regression_function(spec, fnstr, dset);
}
if (!err) {
set_auxiliary_scalars();
err = aux_nlspec_add_param_list(spec, nparam, parms, pnames);
if (!err) {
*amod = model_from_nlspec(spec, dset, nlsopt, prn);
err = amod->errcode;
#if AINIT_DEBUG
if (!err) {
printmodel(amod, dset, OPT_NONE, prn);
}
#endif
}
unset_auxiliary_scalars();
}
bailout:
nlspec_destroy(spec);
free(parms);
strings_array_free(pnames, nparam);
return err;
}
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;
}
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;
}
int main (void)
{
DATASET *dataset; /* pointer to dataset struct */
int *list; /* list of regressors etc. */
MODEL *model; /* pointer to model struct */
PRN *prn; /* pointer to struct for printing */
int model_count = 0; /* keep a tally of models estimated */
int i; /* index variable */
/* the first data series to load */
double z1[] = {
199.9, 228, 235, 285, 239, 293, 285,
365, 295, 290, 385, 505, 425, 415
};
/* and the second series */
double z2[] = {
1065, 1254, 1300, 1577, 1600, 1750, 1800,
1870, 1935, 1948, 2254, 2600, 2800, 3000
};
/* basic initialization of library */
libgretl_init();
prn = gretl_print_new(GRETL_PRINT_STDOUT, NULL); /* simple printing */
/* allocate the dataset struct: the parameters are the number of
variables (here 3, allowing for the constant in position 0),
the number of observations on each variable (here 14), and
a 0/1 flag indicating whether we want to supply "case marker"
strings for the observations (here we don't).
*/
dataset = create_new_dataset(3, 14, 0);
if (dataset == NULL) noalloc();
/* copy in the names of the variables (starting at [1]
because [0] refers to the constant) */
strcpy(dataset->varname[1], "price");
strcpy(dataset->varname[2], "sqft");
/* Fill in the data array, starting at variable 1. Note that
this array may be a superset of the data actually used in
the regression equation. Note that dataset->n records the
number of observations.
*/
for (i=0; i<dataset->n; i++) {
dset_set_data(dataset, 1, i, z1[i]);
dset_set_data(dataset, 2, i, z2[i]);
}
/* Set up the "list", which is fed to the regression function.
The first element of list represents the length of the list
vector itself, counting from zero. The second entry is the ID
number of the dependent variable (i.e. its place in the data
set Z) counting from one (zero being reserved for the
constant). The third entry (and there can be more) is the ID
number of the first independent variable.
*/
list = gretl_list_new(3); /* number of terms will be 3 */
list[1] = 1; /* the dependent variable is the one with ID# 1 */
list[2] = 0; /* we include a constant (ID# 0) */
list[3] = 2; /* the independent variable has ID# 2 */
/* Now we call the lsq function from libgretl to get least squares
estimates and associated statistics. */
model = gretl_model_new();
if (model == NULL) noalloc();
*model = lsq(list, /* regressand and regressors */
dataset, /* the dataset */
OLS, /* use Ordinary Least Squares */
OPT_NONE /* no special options */
);
/* Handle case where lsq bombed */
if (model->errcode) {
printf("model->errcode: %d\n", model->errcode);
printf("error message: %s\n", gretl_errmsg_get());
return 1;
}
/* Otherwise give this model an ID number for reference */
model->ID = ++model_count;
/* and print the regression results */
printmodel(model, dataset, OPT_NONE, prn);
/* memory management check -- try explicitly freeing all allocated
memory */
gretl_model_free(model);
free(list);
destroy_dataset(dataset);
gretl_print_destroy(prn);
libgretl_cleanup();
return 0;
}
