static int
catch_setobs_errors (const char *stobs, int pd, int min, int structure)
{
int panel = structure == STACKED_TIME_SERIES ||
structure == STACKED_CROSS_SECTION;
int err = 0;
if (pd == 1) {
if (min > 0) {
gretl_errmsg_set(_("no ':' allowed in starting obs with "
"frequency 1"));
err = 1;
} else if (panel) {
gretl_errmsg_set(_("panel data must have frequency > 1"));
err = 1;
}
} else {
if (min == 0) {
gretl_errmsg_set(_("starting obs must contain a ':' with "
"frequency > 1"));
err = 1;
} else if (min > pd) {
gretl_errmsg_sprintf(_("starting obs '%s' is incompatible with frequency"),
stobs);
err = 1;
} else if (structure == CROSS_SECTION) {
gretl_errmsg_set(_("cross-sectional data: frequency must be 1"));
err = 1;
}
}
return err;
}
static int anova_make_value_vecs (struct anova *v)
{
int err = 0;
v->tvals = gretl_matrix_values(v->tvec, v->n, OPT_S, &err);
if (!err && v->tvals->rows < 2) {
gretl_errmsg_set("Insufficient observations");
err = E_DATA;
}
if (!err && v->bvec != NULL) {
v->bvals = gretl_matrix_values(v->bvec, v->n, OPT_S, &err);
if (!err && v->bvals->rows < 2) {
gretl_errmsg_set("Insufficient observations");
err = E_DATA;
}
}
if (!err) {
v->nt = v->tvals->rows;
if (v->bvals != NULL) {
v->nb = v->bvals->rows;
}
}
return err;
}
static int if_eval (const char *s, DATASET *dset, void *ptr, int *err)
{
GENERATOR *ifgen = NULL;
double val = NADBL;
int ret = -1;
#if IFDEBUG
fprintf(stderr, "if_eval: s = '%s'\n", s);
#endif
while (*s == ' ') s++;
if (ptr != NULL) {
/* We're being called from a loop, with the implicit
request that the if-condition be "compiled" (if
that's not already done) and subsequently executed
without having to be evaluated from scratch.
*/
ifgen = *(GENERATOR **) ptr;
if (ifgen == NULL) {
/* Generator not compiled yet: do it now. The
flags OPT_P and OPT_S indicate that we're
generating a "private" scalar.
*/
GENERATOR **pgen = (GENERATOR **) ptr;
*pgen = ifgen = genr_compile(s, dset, OPT_P | OPT_S, err);
}
}
if (ifgen != NULL) {
val = evaluate_if_cond(ifgen, dset, err);
} else {
*err = 0;
val = generate_scalar(s, dset, err);
}
#if IFDEBUG
fprintf(stderr, "if_eval: generate returned %d\n", *err);
#endif
if (*err) {
gretl_errmsg_set(_("error evaluating 'if'"));
} else if (na(val)) {
*err = 1;
gretl_errmsg_set(_("indeterminate condition for 'if'"));
} else {
ret = (int) val;
}
#if IFDEBUG
fprintf(stderr, "if_eval: returning %d\n", ret);
#endif
return ret;
}
int gretl_spawn (char *cmdline)
{
GError *error = NULL;
gchar *errout = NULL;
gchar *sout = NULL;
int ok, status;
int ret = 0;
gretl_error_clear();
ok = g_spawn_command_line_sync(cmdline,
&sout, /* standard output */
&errout, /* standard error */
&status, /* exit status */
&error);
if (!ok) {
gretl_errmsg_set(error->message);
fprintf(stderr, "gretl_spawn: '%s'\n", error->message);
g_error_free(error);
ret = 1;
} else if (errout && *errout) {
fprintf(stderr, "stderr: '%s'\n", errout);
if (!non_fatal(errout)) {
gretl_errmsg_set(errout);
fprintf(stderr, "gretl_errmsg: '%s'\n", gretl_errmsg_get());
ret = 1;
}
} else if (status != 0) {
if (sout != NULL && *sout) {
gretl_errmsg_set(sout);
fprintf(stderr, "gretl_spawn: status = %d: '%s'\n", status, sout);
} else {
gretl_errmsg_set(_("Command failed"));
fprintf(stderr, "gretl_spawn: status = %d\n", status);
}
ret = 1;
}
if (errout != NULL) g_free(errout);
if (sout != NULL) g_free(sout);
if (ret) {
fprintf(stderr, "Failed command: '%s'\n", cmdline);
}
return ret;
}
static int file_set_content (const char *fname,
const gchar *buf,
gsize buflen)
{
GError *gerr = NULL;
int ok = 0;
int err = 0;
#ifdef WIN32
gchar *tmp = NULL;
err = maybe_recode_path(fname, &tmp, 1);
if (!err) {
if (tmp != NULL) {
ok = g_file_set_contents(tmp, buf, buflen, &gerr);
g_free(tmp);
} else {
ok = g_file_set_contents(fname, buf, buflen, &gerr);
}
}
#else
ok = g_file_set_contents(fname, buf, buflen, &gerr);
#endif
if (!ok) {
err = E_FOPEN;
if (gerr != NULL) {
gretl_errmsg_set(gerr->message);
g_error_free(gerr);
}
}
return err;
}
int gretl_read_foreign_data (const char *fname, GretlFileType file_type,
DATASET *dset, PRN *prn)
{
int err = 0;
if (fname == NULL || dset == NULL) {
err = E_INVARG;
} else if (dset->Z != NULL) {
fprintf(stderr, "gretl_read_foreign_data: Z must be NULL on entry\n");
err = E_INVARG;
} if (file_type == GRETL_CSV) {
err = import_csv(fname, dset, OPT_NONE, prn);
} else if (SPREADSHEET_IMPORT(file_type)) {
err = import_spreadsheet(fname, file_type, NULL, NULL,
dset, OPT_NONE, prn);
} else if (OTHER_IMPORT(file_type)) {
err = import_spreadsheet(fname, file_type, NULL, NULL,
dset, OPT_NONE, prn);
} else {
gretl_errmsg_set("Unknown data import type");
err = E_INVARG;
}
return err;
}
static int import_prune_columns (DATASET *dset)
{
int allmiss = 1, ndel = 0;
int i, t, err = 0;
for (i=dset->v-1; i>0 && allmiss; i--) {
for (t=0; t<dset->n; t++) {
if (!na(dset->Z[i][t])) {
allmiss = 0;
break;
}
}
if (allmiss) ndel++;
}
if (ndel == dset->v - 1) {
gretl_errmsg_set(_("No numeric data were found"));
err = E_DATA;
} else if (ndel > 0) {
fprintf(stderr, "Sheet has %d trailing empty variables\n", ndel);
err = dataset_drop_last_variables(dset, ndel);
}
return err;
}
char *retrieve_remote_pkg_filename (const char *pkgname,
int *err)
{
char *fname = NULL;
char *buf = NULL;
*err = retrieve_url(gretlhost, FUNC_FULLNAME, pkgname, NULL,
NULL, 0, &buf);
if (!*err) {
if (buf == NULL) {
*err = E_DATA;
} else {
if (strstr(buf, "not found")) {
gretl_errmsg_set(buf);
*err = E_DATA;
} else {
char tmp[64];
sscanf(buf, "%63s", tmp);
fname = gretl_strdup(tmp);
}
free(buf);
}
}
return fname;
}
static int shell_grab (const char *arg, char **sout)
{
int err = 0;
if (arg == NULL || *arg == '\0') {
return E_PARSE;
}
if (!libset_get_bool(SHELL_OK)) {
gretl_errmsg_set(_("The shell command is not activated."));
return 1;
}
gretl_shell_grab(arg, sout);
if (sout != NULL && *sout != NULL) {
char *content = *sout;
if (!g_utf8_validate(content, -1, NULL)) {
content = recode_content(content, NULL, &err);
*sout = content;
}
if (content != NULL) {
/* trim trailing newline */
int n = strlen(content);
if (content[n-1] == '\n') {
content[n-1] = '\0';
}
}
}
return err;
}
static void gpage_errmsg (char *msg, int gui)
{
if (gui) {
errbox(msg);
} else {
gretl_errmsg_set(msg);
}
}
char *retrieve_file_content (const char *fname, const char *codeset,
int *err)
{
char *content = NULL;
size_t len = 0;
if (fname == NULL || *fname == '\0') {
*err = E_DATA;
} else if (is_web_resource(fname)) {
#ifdef USE_CURL
content = retrieve_public_file_as_buffer(fname, &len, err);
#else
gretl_errmsg_set(_("Internet access not supported"));
*err = E_DATA;
#endif
} else {
char fullname[FILENAME_MAX];
GError *gerr = NULL;
*fullname = '\0';
strncat(fullname, fname, FILENAME_MAX - 1);
gretl_addpath(fullname, 0);
g_file_get_contents(fullname, &content, &len, &gerr);
if (gerr != NULL) {
gretl_errmsg_set(gerr->message);
*err = E_FOPEN;
g_error_free(gerr);
}
}
if (content != NULL && !g_utf8_validate(content, len, NULL)) {
content = recode_content(content, codeset, err);
}
if (*err && content != NULL) {
free(content);
content = NULL;
}
return content;
}
static int worksheet_start_dataset (DATASET *newinfo)
{
if (newinfo->v == 1) {
/* only the constant is present! */
gretl_errmsg_set(_("No numeric data were found"));
return E_DATA;
} else {
/* create import dataset */
return start_new_Z(newinfo, 0);
}
}
char *json_get (const char *data, const char *path, int *n_objects,
int *err)
{
GError *gerr = NULL;
JsonParser *parser;
char *ret = NULL;
int n = 0;
if (data == NULL || path == NULL) {
if (n_objects != NULL) {
*n_objects = 0;
}
return NULL;
}
parser = json_parser_new();
if (parser == NULL) {
gretl_errmsg_set("json_parser_new returned NULL!\n");
*err = 1;
return NULL;
}
json_parser_load_from_data(parser, data, -1, &gerr);
if (gerr != NULL) {
gretl_errmsg_sprintf("Couldn't parse JSON input: %s",
gerr->message);
g_error_free(gerr);
*err = E_DATA;
} else {
PRN *prn = gretl_print_new(GRETL_PRINT_BUFFER, err);
if (!*err) {
*err = real_json_get(parser, path, &n, prn);
if (!*err) {
ret = gretl_print_steal_buffer(prn);
}
gretl_print_destroy(prn);
}
}
if (*err) {
fprintf(stderr, "json_get: err = %d\n", *err);
}
if (n_objects != NULL) {
*n_objects = n;
}
g_object_unref(parser);
return ret;
}
gretl_bundle *gretl_bundle_read_from_buffer (const char *buf, int len,
int *err)
{
xmlDocPtr doc = NULL;
gretl_bundle *b;
b = gretl_bundle_new();
if (b == NULL) {
*err = E_ALLOC;
return NULL;
}
xmlKeepBlanksDefault(0);
doc = xmlParseMemory(buf, len);
if (doc == NULL) {
gretl_errmsg_set(_("xmlParseMemory failed"));
*err = 1;
} else {
xmlNodePtr cur = xmlDocGetRootElement(doc);
if (cur == NULL) {
gretl_errmsg_set(_("xmlDocGetRootElement failed"));
*err = 1;
} else {
gretl_push_c_numeric_locale();
cur = cur->xmlChildrenNode;
*err = load_bundled_items(b, cur, doc);
gretl_pop_c_numeric_locale();
}
xmlFreeDoc(doc);
}
if (*err) {
gretl_bundle_destroy(b);
b = NULL;
}
return b;
}
static int umidas_check (midas_info *m, int nmidas,
int nu, int *use_ols)
{
int ntheta = 0;
int i, err = 0;
/* how many U-MIDAS coeff initializers do we have? */
for (i=0; i<nmidas; i++) {
if (m[i].type == MIDAS_U) {
if (m[i].mname[0] != '\0') {
ntheta++;
}
}
}
if (nu < nmidas) {
/* mixing U-MIDAS spec(s) with others */
if (ntheta != nu) {
gretl_errmsg_set("In mixed specifications, U-MIDAS terms "
"must have an initializer");
err = E_INVARG;
}
} else {
/* all specs U-MIDAS */
if (ntheta == 0) {
/* OK, no initializers */
*use_ols = 1;
} else if (ntheta != nu) {
gretl_errmsg_set("U-MIDAS: initializers must be given for "
"either all or no terms");
err = E_INVARG;
}
}
return err;
}
void win_copy_last_error (void)
{
DWORD dw = GetLastError();
LPVOID buf;
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER |
FORMAT_MESSAGE_FROM_SYSTEM |
FORMAT_MESSAGE_IGNORE_INSERTS,
NULL,
dw,
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
(LPTSTR) &buf,
0,
NULL);
gretl_errmsg_set((const char *) buf);
LocalFree(buf);
}
static int cli_try_http (const char *s, char *fname, int *http)
{
int err = 0;
if (strncmp(s, "http://", 7) == 0) {
#ifdef USE_CURL
err = retrieve_public_file(s, fname);
if (!err) {
*http = 1;
}
#else
gretl_errmsg_set(_("Internet access not supported"));
err = E_DATA;
#endif
}
return err;
}
char *utf8_to_latin (const char *s)
{
char to_set[12];
gsize read, wrote;
GError *err = NULL;
char *ret = NULL;
get_gp_encoding_set(to_set, ENC_ISO_LATIN);
ret = g_convert(s, -1, to_set, "UTF-8",
&read, &wrote, &err);
if (err != NULL) {
gretl_errmsg_set(err->message);
g_error_free(err);
}
return ret;
}
static int output_json_node_value (JsonNode *node,
PRN *prn)
{
GType type = 0;
int err = 0;
if (null_node(node)) {
gretl_errmsg_set("jsonget: got a null node");
return E_DATA;
}
type = json_node_get_value_type(node);
#if 0
fprintf(stderr, "jsonget: node type %s\n", g_type_name(type));
#endif
if (!handled_type(type)) {
gretl_errmsg_sprintf("jsonget: unhandled object type '%s'",
g_type_name(type));
err = E_DATA;
} else if (type == G_TYPE_STRING) {
const gchar *s = json_node_get_string(node);
if (s != NULL) {
pputs(prn, s);
} else {
err = E_DATA;
}
} else if (type == G_TYPE_DOUBLE) {
double x = json_node_get_double(node);
pprintf(prn, "%.15g", x);
} else {
gint64 k = json_node_get_int(node);
double x = (double) k;
pprintf(prn, "%.15g", x);
}
return err;
}
static gchar *recode_content (gchar *orig, const char *codeset,
int *err)
{
const gchar *charset = NULL;
GError *gerr = NULL;
gsize wrote = 0;
gchar *tr;
if (codeset != NULL) {
/* the user specified the source encoding */
tr = g_convert(orig, -1, "UTF-8", codeset,
NULL, &wrote, &gerr);
} else if (g_get_charset(&charset)) {
/* we're in a UTF-8 locale, so we know that
g_locale_to_utf8 won't do the job; so guess
the content is iso-8859-something?
*/
tr = g_convert(orig, -1, "UTF-8", "ISO-8859-15",
NULL, &wrote, &gerr);
} else {
/* try assuming the material is in the locale
encoding */
tr = g_locale_to_utf8(orig, -1, NULL, &wrote, &gerr);
if (gerr != NULL) {
/* failed: try iso-8859-15? */
g_error_free(gerr);
gerr = NULL;
tr = g_convert(orig, -1, "UTF-8", "ISO-8859-15",
NULL, &wrote, &gerr);
}
}
if (gerr != NULL) {
gretl_errmsg_set(gerr->message);
*err = E_DATA;
g_error_free(gerr);
}
g_free(orig);
return tr;
}
static int set_xlsx_offsets_from_cli (xlsx_info *xinfo,
const int *list)
{
int err = 0;
if (list != NULL && list[0] == 3) {
int xoff = list[2];
int yoff = list[3];
if (xoff < 0 || yoff < 0) {
gretl_errmsg_set(_("Invalid argument for worksheet import"));
err = E_DATA;
} else{
xinfo->xoffset = xoff;
xinfo->yoffset = yoff;
}
}
return err;
}
static int gretl_curl_toggle (int on)
{
static int init_done;
if (on) {
if (!init_done) {
CURLcode err = curl_global_init(CURL_GLOBAL_DEFAULT);
if (err) {
gretl_errmsg_set("Failed to initialize libcurl");
return 1;
} else {
init_done = 1;
}
}
} else if (init_done) {
curl_global_cleanup();
}
return 0;
}
static int check_downloaded_file (const char *fname,
const char *dl)
{
int err = 0;
if (has_suffix(fname, ".zip") &&
!gretl_is_pkzip_file(fname)) {
err = E_DATA;
} else if (has_suffix(fname, ".gfn") &&
!gretl_is_xml_file(fname)) {
err = E_DATA;
}
if (err) {
/* let's see what we got */
FILE *fp = gretl_fopen(fname, "rb");
int msg_done = 0;
if (fp != NULL) {
char buf[128] = {0};
size_t n;
n = fread(buf, 1, 127, fp);
if (n > 8 && g_utf8_validate(buf, -1, NULL)) {
gretl_errmsg_set(g_strchomp(buf));
msg_done = 1;
}
fclose(fp);
gretl_remove(fname);
}
if (!msg_done) {
gretl_errmsg_sprintf("%s\ndownload failed", dl);
}
}
return err;
}
int gretl_shell (const char *arg, PRN *prn)
{
UINT winret;
int async = 0;
int err = 0;
if (arg == NULL || *arg == '\0') {
return 0;
}
if (!libset_get_bool(SHELL_OK)) {
gretl_errmsg_set(_("The shell command is not activated."));
return 1;
}
if (!strncmp(arg, "launch ", 7)) {
async = 1;
arg += 7;
} else if (*arg == '!') {
arg++;
}
arg += strspn(arg, " \t");
if (async) {
winret = WinExec(arg, SW_SHOWNORMAL);
if (winret <= 31) {
err = 1;
}
} else if (getenv("GRETL_SHELL_NEW")) {
err = run_cmd_with_pipes(arg, NULL, prn, SHELL_RUN);
} else {
err = run_cmd_wait(arg, prn);
}
return err;
}
static gchar *file_get_content (const char *fname,
gsize *bytes,
PRN *prn,
int *err)
{
GError *gerr = NULL;
gchar *buf = NULL;
int ok = 0;
#ifdef WIN32
gchar *tmp = NULL;
*err = maybe_recode_path(fname, &tmp, 1);
if (!*err) {
if (tmp != NULL) {
ok = g_file_get_contents(tmp, &buf, bytes, &gerr);
g_free(tmp);
} else {
ok = g_file_get_contents(fname, &buf, bytes, &gerr);
}
}
#else
ok = g_file_get_contents(fname, &buf, bytes, &gerr);
#endif
if (ok) {
pprintf(prn, "got content, %" G_GSIZE_FORMAT " bytes\n", *bytes);
} else {
*err = E_FOPEN;
if (gerr != NULL) {
gretl_errmsg_set(gerr->message);
g_error_free(gerr);
}
}
return buf;
}
int gretl_recode_file (const char *path1, const char *path2,
const char *from_set, const char *to_set,
PRN *prn)
{
gchar *buf = NULL;
gsize bytes = 0;
int err = 0;
/* get entire content of original file */
buf = file_get_content(path1, &bytes, prn, &err);
if (!err) {
GError *gerr = NULL;
gchar *trbuf = NULL;
gsize written = 0;
/* recode the buffer */
trbuf = g_convert(buf, bytes, to_set, from_set,
NULL, &written, &gerr);
if (gerr != NULL) {
err = E_DATA;
gretl_errmsg_set(gerr->message);
g_error_free(gerr);
} else {
/* write recoded text to file */
pprintf(prn, "recoded: %" G_GSIZE_FORMAT " bytes\n", written);
err = file_set_content(path2, trbuf, written);
}
g_free(trbuf);
}
g_free(buf);
return err;
}
int gretl_rand_set_dcmt (int s)
{
int err = 0;
if (s == use_dcmt) {
/* no-op */
return 0;
}
if (s) {
/* sfmt in use, dcmt requested */
if (dcmt == NULL) {
/* dcmt not set up already */
#ifdef HAVE_MPI
err = dcmt_late_start();
#else
err = E_DATA;
#endif
} else {
/* reset seed and octet */
dcmt_seed = time(NULL);
sgenrand_mt(dcmt_seed, dcmt);
gretl_rand_octet(NULL);
}
} else {
/* dcmt in use, sfmt requested */
gretl_rand_init();
}
if (err) {
gretl_errmsg_set("dcmt: not available");
} else {
use_dcmt = s;
}
return err;
}
static gretl_matrix *cluster_vcv_calc (MODEL *pmod,
int cvar,
gretl_matrix *cvals,
gretl_matrix *XX,
const DATASET *dset,
int *err)
{
gretl_matrix *V = NULL;
gretl_matrix *W = NULL;
gretl_matrix *XXW = NULL;
gretl_vector *ei = NULL;
gretl_matrix *Xi = NULL;
gretl_vector *eXi = NULL;
const double *cZ;
int n_c, M, N, k = pmod->ncoeff;
int total_obs = 0;
int i, j, v, t;
cZ = dset->Z[cvar];
N = cval_count_max(pmod, cvals, cZ);
#if CDEBUG
fprintf(stderr, "max cval count = %d\n", N);
#endif
V = gretl_matrix_alloc(k, k);
W = gretl_zero_matrix_new(k, k);
XXW = gretl_zero_matrix_new(k, k);
ei = gretl_column_vector_alloc(N);
Xi = gretl_matrix_alloc(N, k);
eXi = gretl_vector_alloc(k);
if (V == NULL || W == NULL || XXW == NULL ||
ei == NULL || Xi == NULL || eXi == NULL) {
*err = E_ALLOC;
goto bailout;
}
M = gretl_vector_get_length(cvals);
n_c = 0;
for (i=0; i<M; i++) {
double cvi = cvals->val[i];
int Ni = cval_count(pmod, cvi, cZ);
int s = 0;
if (Ni == 0) {
continue;
}
#if CDEBUG
fprintf(stderr, "i=%d, cvi=%g, Ni=%d\n", i, cvi, Ni);
#endif
ei = gretl_matrix_reuse(ei, Ni, -1);
Xi = gretl_matrix_reuse(Xi, Ni, -1);
for (t=pmod->t1; t<=pmod->t2; t++) {
if (!na(pmod->uhat[t]) && cZ[t] == cvi) {
gretl_vector_set(ei, s, pmod->uhat[t]);
for (j=0; j<k; j++) {
v = pmod->list[j+2];
gretl_matrix_set(Xi, s, j, dset->Z[v][t]);
}
s++;
}
if (s == Ni) {
/* we've filled this matrix */
break;
}
}
gretl_matrix_multiply_mod(ei, GRETL_MOD_TRANSPOSE,
Xi, GRETL_MOD_NONE,
eXi, GRETL_MOD_NONE);
gretl_matrix_multiply_mod(eXi, GRETL_MOD_TRANSPOSE,
eXi, GRETL_MOD_NONE,
W, GRETL_MOD_CUMULATE);
#if CDEBUG > 1
gretl_matrix_print(ei, "e(i)");
gretl_matrix_print(Xi, "X(i)");
gretl_matrix_print(W, "W");
#endif
n_c++;
total_obs += s;
}
if (n_c < 2) {
gretl_errmsg_set("Invalid clustering variable");
*err = E_DATA;
goto bailout;
} else if (total_obs < pmod->nobs) {
*err = E_MISSDATA;
goto bailout;
}
/* form V(W) = (X'X)^{-1} W (X'X)^{-1} */
gretl_matrix_multiply(XX, W, XXW);
gretl_matrix_multiply(XXW, XX, V);
gretl_matrix_xtr_symmetric(V);
#if CDEBUG
gretl_matrix_print(XX, "X'X^{-1}");
gretl_matrix_print(W, "W");
gretl_matrix_print(V, "V");
#endif
if (!(pmod->opt & OPT_N)) {
/* apply df adjustment a la Stata */
double dfadj;
N = pmod->nobs;
dfadj = (M/(M-1.0)) * (N-1.0)/(N-k);
gretl_matrix_multiply_by_scalar(V, dfadj);
#if CDEBUG > 1
gretl_matrix_print(V, "V(adjusted)");
#endif
}
bailout:
gretl_matrix_free(W);
gretl_matrix_free(XXW);
gretl_matrix_free(ei);
gretl_matrix_free(Xi);
gretl_matrix_free(eXi);
if (*err) {
gretl_matrix_free(V);
V = NULL;
}
return V;
}
static int parse_midas_info (const char *s,
midas_info *minfo, int i,
const DATASET *dset)
{
midas_info *m = &minfo[i];
char lname[VNAMELEN];
char mname[VNAMELEN];
char fmt[48];
int n, m1, m2, p;
int umidas = 0;
int err = 0;
midas_info_init(m);
if (!strncmp(s, "mds(", 4)) {
/* calling for auto-generated lags */
s += 4;
sprintf(fmt, "%%%d[^, ] , %%d , %%d , %%d, %%%d[^) ])",
VNAMELEN-1, VNAMELEN-1);
n = sscanf(s, fmt, lname, &m1, &m2, &p, mname);
if (n == 4 && p == MIDAS_U) {
umidas = 1;
} else if (n != 5) {
err = E_PARSE;
}
} else if (!strncmp(s, "mdsl(", 5)) {
/* list already hold lags */
m->prelag = 1;
s += 5;
sprintf(fmt, "%%%d[^, ] , %%d, %%%d[^) ])",
VNAMELEN-1, VNAMELEN-1);
n = sscanf(s, fmt, lname, &p, mname);
if (n == 2 && p == MIDAS_U) {
umidas = 1;
} else if (n != 3) {
err = E_PARSE;
}
m1 = m2 = 0; /* got no min/max info */
} else {
err = E_INVARG;
}
if (!err) {
gretl_matrix *theta = NULL;
int *list = get_list_by_name(lname);
int k = 0;
if (!umidas) {
theta = get_matrix_by_name(mname);
if (theta == NULL) {
theta = maybe_make_auto_theta(mname, i, p, m1, m2);
}
}
if (m->prelag && list == NULL) {
err = E_INVARG;
} else if (!m->prelag && !gretl_is_midas_list(list, dset)) {
gretl_errmsg_set("mds(): the first term must be a MIDAS list");
err = E_INVARG;
} else if (m1 > m2) {
err = E_INVARG;
} else if (p < 0 || p >= MIDAS_MAX) {
err = E_INVARG;
} else if (umidas) {
if (m->prelag) {
k = list[0];
} else {
k = m2 - m1 + 1;
}
} else {
k = gretl_vector_get_length(theta);
if (k < 1 || (p == MIDAS_BETA0 && k != 2) ||
(p == MIDAS_BETAN && k != 3)) {
err = E_INVARG;
}
}
if (!err) {
strcpy(m->lnam0, lname);
strcpy(m->lname, lname);
if (!umidas) {
strcpy(m->mname, mname);
}
if (m->prelag) {
/* scrounge lag info from incoming list */
lag_info_from_prelag_list(m, list, dset);
} else {
m->minlag = m1;
m->maxlag = m2;
}
m->type = p;
m->nparm = k;
}
}
return err;
}
int gretl_anova (const int *list, const DATASET *dset,
gretlopt opt, PRN *prn)
{
struct anova v;
const double *y, *xt, *xb;
double ybar, dev;
int i, t, t1, t2;
int missvals = 0;
int err = 0;
if (list[0] < 2 || list[0] > 3) {
return E_DATA;
}
anova_init(&v);
t1 = dset->t1;
t2 = dset->t2;
list_adjust_sample(list, &t1, &t2, dset, &missvals);
v.n = t2 - t1 + 1 - missvals;
if (v.n < 2) {
return E_TOOFEW;
}
y = dset->Z[list[1]];
xt = dset->Z[list[2]];
xb = (list[0] == 3)? dset->Z[list[3]] : NULL;
/* check that treatment (and block, if present) are discrete */
if (!series_is_discrete(dset, list[2]) &&
!gretl_isdiscrete(t1, t2, xt)) {
gretl_errmsg_set(_("anova: the treatment variable must be discrete"));
return E_DATA;
}
if (xb != NULL && !series_is_discrete(dset, list[3]) &&
!gretl_isdiscrete(t1, t2, xb)) {
gretl_errmsg_set(_("anova: the block variable must be discrete"));
return E_DATA;
}
v.n = 0;
for (t=t1; t<=t2; t++) {
if (anova_obs_ok(y, xt, xb, t)) {
v.n += 1;
}
}
if (v.n < 2) {
return E_TOOFEW;
}
err = anova_make_arrays(xb, &v);
if (err) {
return err;
}
/* fill tvec and bvec; calculate grand mean */
ybar = 0.0;
i = 0;
for (t=t1; t<=t2; t++) {
if (anova_obs_ok(y, xt, xb, t)) {
v.tvec[i] = xt[t];
ybar += y[t];
if (v.bvec != NULL) {
v.bvec[i] = xb[t];
}
i++;
}
}
ybar /= v.n;
err = anova_make_value_vecs(&v);
if (err) {
goto bailout;
}
err = anova_accounting_arrays(&v);
if (err) {
goto bailout;
}
/* find column (treatment) means */
for (t=t1; t<=t2; t++) {
if (anova_obs_ok(y, xt, xb, t)) {
dev = y[t] - ybar;
v.SST += dev * dev;
for (i=0; i<v.nt; i++) {
if (xt[t] == v.tvals->val[i]) {
v.cmeans[i] += y[t];
v.ccount[i] += 1;
break;
}
}
}
}
for (i=0; i<v.nt; i++) {
v.cmeans[i] /= v.ccount[i];
}
/* sums of squares */
if (v.nb > 0) {
/* two-way ANOVA */
for (t=t1; t<=t2; t++) {
if (anova_obs_ok(y, xt, xb, t)) {
for (i=0; i<v.nb; i++) {
if (xb[t] == v.bvals->val[i]) {
v.rmeans[i] += y[t];
v.rcount[i] += 1;
break;
}
}
}
}
for (i=0; i<v.nb; i++) {
v.rmeans[i] /= v.rcount[i];
dev = v.rmeans[i] - ybar;
v.SSB += dev * dev * v.rcount[i];
}
for (i=0; i<v.nt; i++) {
dev = v.cmeans[i] - ybar;
v.SSTr += dev * dev * v.ccount[i];
}
v.SSE = v.SST - v.SSTr - v.SSB;
} else {
/* one-way ANOVA */
for (t=t1; t<=t2; t++) {
if (!na(xt[t]) && !na(y[t])) {
for (i=0; i<v.nt; i++) {
if (xt[t] == v.tvals->val[i]) {
dev = y[t] - v.cmeans[i];
v.SSE += dev * dev;
break;
}
}
}
}
v.SSTr = v.SST - v.SSE;
}
anova_add_F_stat(&v);
if (!(opt & OPT_Q)) {
const char *yname = dset->varname[list[1]];
const char *tname = dset->varname[list[2]];
pputc(prn, '\n');
pprintf(prn, _("%s, response = %s, treatment = %s:"),
_("Analysis of Variance"), yname, tname);
err = print_anova(&v, prn);
if (!err && v.nb == 0) {
anova_print_means(&v, xt, y, ybar, t1, t2, prn);
}
}
bailout:
anova_free(&v);
return err;
}
