static int geomline (int ng, FILE *fp)
{
double width = 7.0, height = 10.0;
double tmarg = 0.5, lmarg = 0.75;
char unit[3];
if (in_usa()) {
strcpy(unit, "in");
} else {
strcpy(unit, "mm");
width = 190;
height = 277.0;
tmarg = lmarg = 10.0;
}
gretl_push_c_numeric_locale();
fprintf(fp, "\\usepackage[body={%g%s,%g%s},"
"top=%g%s,left=%g%s,nohead]{geometry}\n\n",
width, unit, height, unit,
tmarg, unit, lmarg, unit);
gretl_pop_c_numeric_locale();
return 0;
}
static void do_fix_xrange (char *line, int fix, FILE *fp)
{
double xmin, xmax;
int n;
gretl_push_c_numeric_locale();
n = sscanf(line, "set xrange [%lf:%lf]", &xmin, &xmax);
/* note: if we fail here, we'll suppress the printing of
the xrange specification */
if (n == 2) {
double offset = 946684800;
if (fix == 1) {
/* old gnuplot to new */
xmin += offset;
xmax += offset;
} else {
/* new gnuplot to old */
xmin -= offset;
xmax -= offset;
}
fprintf(fp, "set xrange [%.12g:%.12g]\n", xmin, xmax);
}
gretl_pop_c_numeric_locale();
}
static int get_roots (const char *fname, MODEL *pmod,
arma_info *ainfo)
{
FILE *fp;
char line[132];
int i, nr, err = 0;
cmplx *roots;
nr = ainfo->p + ainfo->q + ainfo->P + ainfo->Q;
if (nr == 0) {
return 0;
}
roots = malloc(nr * sizeof *roots);
if (roots == NULL) {
return E_ALLOC;
}
fp = gretl_fopen(fname, "r");
if (fp == NULL) {
fprintf(stderr, "Couldn't read from '%s'\n", fname);
free(roots);
return E_FOPEN;
}
gretl_push_c_numeric_locale();
i = 0;
while (fgets(line, sizeof line, fp) && i < nr) {
double re, im;
if (!strncmp(line, "AR", 2) || !strncmp(line, "MA", 2)) {
if (sscanf(line, "%*s %*s %*s %lf %lf", &re, &im) == 2) {
roots[i].r = re;
roots[i].i = im;
i++;
}
}
}
gretl_pop_c_numeric_locale();
fclose(fp);
if (i != nr) {
fprintf(stderr, "Error reading '%s'\n", fname);
free(roots);
roots = NULL;
err = E_DATA;
}
if (roots != NULL) {
gretl_model_set_data(pmod, "roots", roots, GRETL_TYPE_CMPLX_ARRAY,
nr * sizeof *roots);
}
return err;
}
static int get_x12a_vcv (const char *fname, MODEL *pmod, int nc)
{
FILE *fp;
char line[1024], valstr[24];
double x;
int i, j, k, nt = (nc * nc + nc) / 2;
int err = 0;
fp = gretl_fopen(fname, "r");
if (fp == NULL) return 1;
pmod->vcv = malloc(nt * sizeof *pmod->vcv);
if (pmod->vcv == NULL) {
fclose(fp);
return 1;
}
for (i=0; i<nt; i++) {
pmod->vcv[i] = NADBL;
}
gretl_push_c_numeric_locale();
j = 1;
while (fgets(line, sizeof line, fp)) {
if (!strncmp(line, "Nonseas", 7)) {
char *p = line + strcspn(line, "+-");
for (i=1; i<nc; i++) {
sscanf(p, "%22s", valstr);
p += 22;
if (i >= j) {
x = atof(valstr);
k = ijton(i, j, nc);
pmod->vcv[k] = x;
}
}
j++;
}
}
gretl_pop_c_numeric_locale();
fclose(fp);
return err;
}
static int
get_uhat (const char *fname, MODEL *pmod, const DATASET *dset)
{
FILE *fp;
char line[64], date[9];
double x;
int t, start = 0, nobs = 0;
int err = 0;
fp = gretl_fopen(fname, "r");
if (fp == NULL) {
fprintf(stderr, "Couldn't read from '%s'\n", fname);
return E_FOPEN;
}
gretl_push_c_numeric_locale();
while (fgets(line, sizeof line, fp)) {
if (*line == '-') {
start = 1;
continue;
}
if (start && sscanf(line, "%s %lf", date, &x) == 2) {
t = x12_date_to_n(date, dset);
if (t >= 0 && t < dset->n) {
pmod->uhat[t] = x;
nobs++;
}
}
}
gretl_pop_c_numeric_locale();
fclose(fp);
if (nobs == 0) {
fprintf(stderr, "Error reading '%s'\n", fname);
err = E_DATA;
}
return err;
}
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 get_ll_stats (const char *fname, MODEL *pmod)
{
FILE *fp;
char line[80], statname[12];
int nefobs = 0;
double x;
fp = gretl_fopen(fname, "r");
if (fp == NULL) {
fprintf(stderr, "Couldn't read from '%s'\n", fname);
return E_FOPEN;
}
pmod->sigma = NADBL;
gretl_push_c_numeric_locale();
while (fgets(line, sizeof line, fp)) {
if (sscanf(line, "%11s %lf", statname, &x) == 2) {
if (!strcmp(statname, "nefobs")) nefobs = (int) x;
else if (!strcmp(statname, "var")) pmod->sigma = sqrt(x);
else if (!strcmp(statname, "lnlkhd")) pmod->lnL = x;
else if (!strcmp(statname, "aic")) pmod->criterion[C_AIC] = x;
else if (!strcmp(statname, "bic")) pmod->criterion[C_BIC] = x;
else if (!strcmp(statname, "hnquin")) pmod->criterion[C_HQC] = x;
}
}
gretl_pop_c_numeric_locale();
fclose(fp);
if (nefobs > 0) {
pmod->nobs = nefobs;
pmod->t1 = pmod->t2 - nefobs + 1;
}
return 0;
}
gretl_bundle *gretl_bundle_read_from_file (const char *fname,
int from_dotdir,
int *err)
{
xmlDocPtr doc = NULL;
xmlNodePtr cur = NULL;
char fullname[FILENAME_MAX];
gretl_bundle *b;
b = gretl_bundle_new();
if (b == NULL) {
*err = E_ALLOC;
return NULL;
}
if (from_dotdir) {
build_path(fullname, gretl_dotdir(), fname, NULL);
} else {
strcpy(fullname, fname);
}
*err = gretl_xml_open_doc_root(fullname, "gretl-bundle", &doc, &cur);
if (!*err) {
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 real_json_get (JsonParser *parser, const char *pathstr,
int *n_objects, PRN *prn)
{
GError *gerr = NULL;
JsonNode *match, *node;
JsonPath *path;
GType ntype;
int err = 0;
*n_objects = 0;
node = json_parser_get_root(parser);
if (node == NULL || json_node_is_null(node)) {
gretl_errmsg_set("jsonget: got null root node");
return E_DATA;
}
path = json_path_new();
if (!json_path_compile(path, pathstr, &gerr)) {
if (gerr != NULL) {
gretl_errmsg_sprintf("jsonget: failed to compile JsonPath: %s",
gerr->message);
g_error_free(gerr);
} else {
gretl_errmsg_set("jsonget: failed to compile JsonPath");
}
g_object_unref(path);
return E_DATA;
}
match = json_path_match(path, node);
if (null_node(match)) {
/* FIXME : maybe return empty string? */
g_object_unref(path);
return E_DATA;
}
/* in case we get floating-point output */
gretl_push_c_numeric_locale();
if (JSON_NODE_HOLDS_ARRAY(match)) {
JsonArray *array = json_node_get_array(match);
int len = 0, index = 0;
if (non_empty_array(array)) {
len = json_array_get_length(array);
node = json_array_get_element(array, index);
} else {
node = NULL;
}
repeat:
if (null_node(node)) {
gretl_errmsg_set("jsonget: failed to match JsonPath");
ntype = 0;
err = E_DATA;
goto bailout;
} else {
ntype = json_node_get_value_type(node);
}
if (node != NULL && !handled_type(ntype)) {
if (JSON_NODE_HOLDS_ARRAY(node)) {
/* recurse on array type */
array = json_node_get_array(node);
if (non_empty_array(array)) {
node = json_array_get_element(array, 0);
goto repeat;
}
} else if (json_node_get_node_type(node) == JSON_NODE_OBJECT) {
err = excavate_json_object(node, n_objects, prn);
if (!err) {
if (index < len - 1) {
node = json_array_get_element(array, ++index);
goto repeat;
}
}
} else {
gretl_errmsg_sprintf("jsonget: unhandled array type '%s'",
g_type_name(ntype));
err = E_DATA;
}
} else if (array != NULL) {
int i, n = json_array_get_length(array);
for (i=0; i<n && !err; i++) {
node = json_array_get_element(array, i);
err = output_json_node_value(node, prn);
if (!err) {
*n_objects += 1;
if (n > 1) {
pputc(prn, '\n');
}
}
}
}
} else {
/* not an array-holding node */
err = output_json_node_value(match, prn);
if (!err) {
*n_objects += 1;
}
}
bailout:
gretl_pop_c_numeric_locale();
json_node_free(match);
g_object_unref(path);
return err;
}
static int gp_make_outfile (const char *gfname, int i, double scale)
{
char *fname;
FILE *fp, *fq;
int err = 0;
fp = gretl_fopen(gfname, "r");
if (fp == NULL) {
file_read_errbox(gfname);
return E_FOPEN;
}
fname = gpage_fname(".plt", 0);
fq = gretl_fopen(fname, "w");
if (fq == NULL) {
file_write_errbox(fname);
fclose(fp);
return E_FOPEN;
}
gretl_push_c_numeric_locale();
/* FIXME: is "dashed" wanted when "mono" is given below? */
if (gpage.term == GP_TERM_PDF) {
/* PDF output */
int fontsize = gp_cairo_fontsize();
fprintf(fq, "set term pdfcairo font \"sans,%d\"%s", fontsize,
(gpage.mono)? " mono dashed" : " ");
fname = gpage_fname(".pdf", i);
} else {
/* EPS output variants */
int fontsize = gp_cairo_fontsize();
fprintf(fq, "set term epscairo font \"sans,%d\"%s", fontsize,
(gpage.mono)? " mono dashed" : " ");
fname = gpage_fname(".ps", i);
}
if (scale != 1.0) {
fprintf(fq, " size %g,%g\n", scale * 5.0, scale * 3.5);
} else {
fputc('\n', fq);
}
gretl_pop_c_numeric_locale();
fprintf(fq, "set output '%s'\n", fname);
filter_gnuplot_file(0, gpage.mono, fp, fq);
fclose(fp);
fclose(fq);
fname = gpage_fname(".plt", 0);
err = gnuplot_compile(fname);
return err;
}
static int tex_graph_setup (int ng, FILE *fp)
{
char fname[FILENAME_MAX];
double scale[] = { 1.2, 1.0, 0.9, 0.85 };
double s, vspace = 1.0;
int i;
if (ng > GRAPHS_MAX) {
fprintf(stderr, "ng (%d) out of range\n", ng);
return 1;
}
gretl_push_c_numeric_locale();
if (ng == 1) {
s = scale[SCALE_LARGE];
sprintf(fname, "%s_1", gpage_tex_base);
fprintf(fp, "\\includegraphics[scale=%g]{%s}\n", s, fname);
} else if (ng == 2) {
s = scale[SCALE_REGULAR];
sprintf(fname, "%s_%d", gpage_tex_base, 1);
fprintf(fp, "\\includegraphics[scale=%g]{%s}\n\n", s, fname);
fprintf(fp, "\\vspace{%gin}\n\n", vspace);
sprintf(fname, "%s_%d", gpage_tex_base, 2);
fprintf(fp, "\\includegraphics{%s}\n\n", fname);
} else if (ng == 3) {
s = scale[SCALE_MEDIUM];
vspace = 0.25;
for (i=0; i<3; i++) {
sprintf(fname, "%s_%d", gpage_tex_base, i + 1);
fprintf(fp, "\\includegraphics[scale=%g]{%s}\n\n", s, fname);
fprintf(fp, "\\vspace{%gin}\n", vspace);
}
} else {
if (ng > 6) {
s = scale[SCALE_SMALL];
vspace = 0.20;
} else {
s = scale[SCALE_MEDIUM];
vspace = 0.25;
}
fputs("\\begin{tabular}{cc}\n", fp);
for (i=0; i<ng; i++) {
sprintf(fname, "%s_%d", gpage_tex_base, i + 1);
if (oddgraph(ng, i)) {
fprintf(fp, "\\multicolumn{2}{c}{\\includegraphics[scale=%g]{%s}}",
s, fname);
} else {
fprintf(fp, "\\includegraphics[scale=%g]{%s}", s, fname);
if (i % 2 == 0) {
fputs(" &\n ", fp);
} else if (i < ng - 1) {
fprintf(fp, " \\\\ [%gin]\n", vspace);
}
}
}
fputs("\\end{tabular}\n", fp);
}
gretl_pop_c_numeric_locale();
return 0;
}
static int xlsx_read_worksheet (xlsx_info *xinfo, PRN *prn)
{
xmlDocPtr doc = NULL;
xmlNodePtr data_node = NULL;
xmlNodePtr cur = NULL;
xmlNodePtr c1;
int gotdata = 0;
int err = 0;
sprintf(xinfo->sheetfile, "xl%c%s", SLASH,
xinfo->filenames[xinfo->selsheet]);
#if XDEBUG
fprintf(stderr, "xlsx_read_worksheet: sheetnum=%d, name='%s'\n",
xinfo->selsheet, xinfo->filenames[xinfo->selsheet]);
#endif
sprintf(xinfo->stringsfile, "xl%csharedStrings.xml", SLASH);
err = gretl_xml_open_doc_root(xinfo->sheetfile, "worksheet",
&doc, &cur);
if (err) {
pprintf(prn, "didn't get worksheet\n");
pprintf(prn, "%s", gretl_errmsg_get());
return err;
}
/* walk the tree, first pass */
cur = cur->xmlChildrenNode;
while (cur != NULL && !err && !gotdata) {
if (!xmlStrcmp(cur->name, (XUC) "sheetData")) {
data_node = c1 = cur->xmlChildrenNode;
while (c1 != NULL && !err) {
if (!xmlStrcmp(c1->name, (XUC) "row")) {
err = xlsx_read_row(c1, xinfo, prn);
}
c1 = c1->next;
}
gotdata = 1;
}
cur = cur->next;
}
#if XDEBUG
if (!err) {
pprintf(prn, "Max row = %d, max col = %d\n", xinfo->maxrow,
xinfo->maxcol);
pprintf(prn, "Accessed %d shared strings\n", xinfo->n_strings);
}
#endif
if (!err && xinfo->dset == NULL) {
err = xlsx_check_dimensions(xinfo, prn);
if (!err) {
gretl_push_c_numeric_locale();
c1 = data_node;
while (c1 != NULL && !err) {
if (!xmlStrcmp(c1->name, (XUC) "row")) {
err = xlsx_read_row(c1, xinfo, prn);
}
c1 = c1->next;
}
gretl_pop_c_numeric_locale();
}
}
xmlFreeDoc(doc);
return err;
}
static int leverage_plot (const MODEL *pmod, gretl_matrix *S,
DATASET *dset)
{
FILE *fp;
const double *obs = NULL;
int t, err = 0;
fp = open_plot_input_file(PLOT_LEVERAGE, 0, &err);
if (err) {
return err;
}
if (dataset_is_time_series(dset)) {
obs = gretl_plotx(dset, OPT_NONE);
if (obs == NULL) {
if (fp != NULL) {
fclose(fp);
}
return 1;
}
}
gretl_push_c_numeric_locale();
fputs("set size 1.0,1.0\nset multiplot\nset size 1.0,0.48\n", fp);
fputs("set xzeroaxis\n", fp);
fputs("set nokey\n", fp);
if (obs != NULL) {
leverage_x_range(pmod->t1, pmod->t2, obs, fp);
} else {
fprintf(fp, "set xrange [%g:%g]\n",
pmod->t1 + 0.5, pmod->t2 + 1.5);
}
/* upper plot: leverage factor */
fputs("set origin 0.0,0.50\n", fp);
gnuplot_missval_string(fp);
fputs("set yrange [0:1]\n", fp);
fprintf(fp, "set title '%s'\n", _("leverage"));
fputs("plot \\\n'-' using 1:2 w impulses\n", fp);
for (t=pmod->t1; t<=pmod->t2; t++) {
double h = gretl_matrix_get(S, t - pmod->t1, 0);
if (na(h)) {
if (obs != NULL) {
fprintf(fp, "%g ?\n", obs[t]);
} else {
fprintf(fp, "%d ?\n", t + 1);
}
} else {
if (obs != NULL) {
fprintf(fp, "%g %g\n", obs[t], h);
} else {
fprintf(fp, "%d %g\n", t + 1, h);
}
}
}
fputs("e\n", fp);
/* lower plot: influence factor */
fputs("set origin 0.0,0.0\n", fp);
gnuplot_missval_string(fp);
fputs("set yrange [*:*]\n", fp);
fprintf(fp, "set title '%s'\n", _("influence"));
fputs("plot \\\n'-' using 1:2 w impulses\n", fp);
for (t=pmod->t1; t<=pmod->t2; t++) {
double f = gretl_matrix_get(S, t - pmod->t1, 1);
if (na(f)) {
if (obs != NULL) {
fprintf(fp, "%g ?\n", obs[t]);
} else {
fprintf(fp, "%d ?\n", t + 1);
}
} else {
if (obs != NULL) {
fprintf(fp, "%g %g\n", obs[t], f);
} else {
fprintf(fp, "%d %g\n", t + 1, f);
}
}
}
fputs("e\n", fp);
fputs("unset multiplot\n", fp);
gretl_pop_c_numeric_locale();
return finalize_plot_input_file(fp);
}
static int write_arma_spc_file (const char *fname,
const DATASET *dset,
arma_info *ainfo, int pdmax,
gretlopt opt)
{
int maxobs = pdmax * 50;
int maxfcast = pdmax * 5;
int ylist[2];
int *xlist = NULL;
FILE *fp;
char datestr[12];
int nfcast = 0;
int t1 = ainfo->t1;
int tmax;
int i;
if (ainfo->nexo > 0) {
xlist = arma_info_get_x_list(ainfo);
if (xlist == NULL) {
return E_ALLOC;
}
}
fp = gretl_fopen(fname, "w");
if (fp == NULL) {
fprintf(stderr, "Couldn't write to '%s'\n", fname);
return 1;
}
gretl_push_c_numeric_locale();
fprintf(fp, "series{\n title=\"%s\"\n period=%d\n",
dset->varname[ainfo->yno], dset->pd);
t1 -= ainfo->maxlag;
make_x12a_date_string(t1, dset, datestr);
fprintf(fp, " start=%s\n", datestr);
ylist[0] = 1;
ylist[1] = ainfo->yno;
tmax = ainfo->t2;
if ((opt & OPT_F) && ainfo->t2 < dset->n - 1) {
int nobs;
tmax = dset->n - 1;
nobs = tmax - ainfo->t1 + 1; /* t1? */
if (nobs > maxobs) {
tmax -= nobs - maxobs;
}
nfcast = tmax - ainfo->t2;
if (nfcast > maxfcast) {
tmax -= nfcast - maxfcast;
nfcast -= nfcast - maxfcast;
}
#if 0
fprintf(stderr, "x12a: doing forecast: nfcast = %d\n", nfcast);
#endif
}
output_series_to_spc(ylist, dset, t1, tmax, fp);
if (tmax > ainfo->t2) {
make_x12a_date_string(ainfo->t2, dset, datestr);
fprintf(fp, " span = ( , %s)\n", datestr);
}
fputs("}\n", fp);
/* regression specification */
fputs("Regression {\n", fp);
if (ainfo->ifc) {
fputs(" variables = (const)\n", fp);
}
if (ainfo->nexo > 0) {
fputs(" user = ( ", fp);
for (i=1; i<=xlist[0]; i++) {
fprintf(fp, "%s ", dset->varname[xlist[i]]);
}
fputs(")\n", fp);
output_series_to_spc(xlist, dset, t1, tmax, fp);
free(xlist);
}
fputs("}\n", fp);
/* arima specification */
fputs("arima {\n model = ", fp);
x12_pdq_string(ainfo, fp);
if (ainfo->P > 0 || ainfo->Q > 0) {
fprintf(fp, "(%d %d %d)\n}\n", ainfo->P, ainfo->D, ainfo->Q);
} else {
fputs("\n}\n", fp);
}
fputs("estimate {\n", fp);
/* could enable here: "tol = XX, maxiter = NN"
the default is tol = 1.0e-5, maxiter = 200
*/
if (opt & OPT_V) {
fputs(" print = (acm itr lkf lks mdl est rts rcm)\n", fp);
} else {
fputs(" print = (acm lkf lks mdl est rts rcm)\n", fp);
}
fputs(" save = (rsd est lks acm rts rcm)\n", fp);
if (opt & OPT_C) {
fputs(" exact = none\n", fp);
}
fputs("}\n", fp);
if (nfcast > 0) {
fputs("forecast {\n save = (ftr)\n", fp);
fprintf(fp, " maxlead = %d\n}\n", nfcast);
}
gretl_pop_c_numeric_locale();
fclose(fp);
return 0;
}
static int
get_estimates (const char *fname, MODEL *pmod, arma_info *ainfo)
{
double *ar_coeff = pmod->coeff + ainfo->ifc;
double *ma_coeff = ar_coeff + ainfo->np + ainfo->P;
double *x_coeff = ma_coeff + ainfo->nq + ainfo->Q;
double *ar_sderr = pmod->sderr + ainfo->ifc;
double *ma_sderr = ar_sderr + ainfo->np + ainfo->P;
double *x_sderr = ma_sderr + ainfo->nq + ainfo->Q;
FILE *fp;
char line[128], word[16];
double b, se;
int i, j, k;
int err = 0;
fp = gretl_fopen(fname, "r");
if (fp == NULL) {
fprintf(stderr, "Couldn't read from '%s'\n", fname);
return E_FOPEN;
}
for (i=0; i<ainfo->nc; i++) {
pmod->coeff[i] = pmod->sderr[i] = NADBL;
}
gretl_push_c_numeric_locale();
i = j = k = 0;
while (fgets(line, sizeof line, fp) && i < ainfo->nc) {
if (sscanf(line, "%15s", word) == 1) {
if (!strcmp(word, "Constant")) {
if (sscanf(line, "%*s %*s %lf %lf", &b, &se) == 2) {
pmod->coeff[0] = b;
pmod->sderr[0] = se;
}
} else if (!strcmp(word, "User-defined")) {
if (sscanf(line, "%*s %*s %lf %lf", &b, &se) == 2) {
x_coeff[i] = b;
x_sderr[i] = se;
i++;
}
} else if (!strcmp(word, "AR")) {
if (sscanf(line, "%*s %*s %*s %*s %lf %lf", &b, &se) == 2) {
ar_coeff[j] = b;
ar_sderr[j] = se;
j++;
}
} else if (!strcmp(word, "MA")) {
if (sscanf(line, "%*s %*s %*s %*s %lf %lf", &b, &se) == 2) {
ma_coeff[k] = -b; /* MA sign conventions */
ma_sderr[k] = se;
k++;
}
}
}
}
gretl_pop_c_numeric_locale();
fclose(fp);
for (i=0; i<ainfo->nc; i++) {
if (na(pmod->coeff[i]) || na(pmod->sderr[i])) {
fprintf(stderr, "Error reading '%s'\n", fname);
err = E_DATA;
break;
}
}
return err;
}
int gnumeric_get_data (const char *fname, int *list, char *sheetname,
DATASET *dset, gretlopt opt, PRN *prn)
{
int gui = (opt & OPT_G);
wbook gbook;
wbook *book = &gbook;
wsheet gsheet;
wsheet *sheet = &gsheet;
int sheetnum = -1;
int obscol = 0;
DATASET *newset;
int err = 0;
newset = datainfo_new();
if (newset == NULL) {
pputs(prn, _("Out of memory\n"));
return 1;
}
wsheet_init(sheet);
gretl_push_c_numeric_locale();
if (wbook_get_info(fname, list, sheetname, book, prn)) {
pputs(prn, _("Failed to get workbook info"));
err = 1;
goto getout;
}
wbook_print_info(book);
if (book->nsheets == 0) {
pputs(prn, _("No worksheets found"));
err = 1;
goto getout;
}
if (gui) {
if (book->nsheets > 1) {
wsheet_menu(book, 1);
sheetnum = book->selected;
} else {
wsheet_menu(book, 0);
sheetnum = 0;
}
} else {
err = wbook_check_params(book);
if (err) {
gretl_errmsg_set(_("Invalid argument for worksheet import"));
} else if (book->selected >= 0) {
sheetnum = book->selected;
} else {
sheetnum = 0;
}
}
if (book->selected == -1) {
/* canceled */
err = -1;
}
if (!err && sheetnum >= 0) {
fprintf(stderr, "Getting data...\n");
err = wsheet_setup(sheet, book, sheetnum);
if (!err) {
err = wsheet_get_data(fname, sheet, &obscol, prn);
if (err) {
fprintf(stderr, "wsheet_get_data returned %d\n", err);
} else {
wsheet_print_info(sheet);
book->flags |= sheet->flags;
}
}
}
if (err) {
goto getout;
} else {
int r0 = 1; /* the first data row */
int i, j, t;
int ts_markers = 0;
int merge = (dset->Z != NULL);
char **ts_S = NULL;
int blank_cols = 0;
int missvals = 0;
int pd = 0;
if (obscol) {
book_set_obs_labels(book);
if (sheet->text_cols == 0) {
sheet->text_cols = 1;
}
} else if (sheet->text_cols > 0) {
/* string-valued variable? */
fprintf(stderr, "Problem: sheet->text_cols = %d\n", sheet->text_cols);
}
if (sheet->colheads == 0) {
book_set_auto_varnames(book);
r0 = 0;
}
if (book_numeric_dates(book)) {
fputs("found calendar dates in first imported column\n", stderr);
} else if (obscol) {
fprintf(stderr, "found label strings in first imported column (text_cols = %d)\n",
sheet->text_cols);
} else if (sheet->text_cols > 0) {
fputs("found string-valued variable in first imported column?\n", stderr);
} else {
fputs("check for label strings in first imported column: not found\n", stderr);
}
newset->n = sheet->maxrow - sheet->row_offset;
if (!sheet->colheads) {
pputs(prn, _("it seems there are no variable names\n"));
newset->n += 1;
}
if (book_numeric_dates(book) || obscol) {
pd = importer_dates_check(sheet->label + r0, &book->flags,
newset, prn, &err);
if (pd > 0) {
/* got time-series info from dates/labels */
sheet_time_series_setup(sheet, book, newset, pd);
ts_markers = newset->markers;
ts_S = newset->S;
} else if (!book_numeric_dates(book)) {
if (labels_are_index(sheet->label, newset->n)) {
/* trash the labels */
book_unset_obs_labels(book);
}
}
}
newset->v = sheet->maxcol + 2 - sheet->col_offset - sheet->text_cols;
fprintf(stderr, "newset->v = %d, newset->n = %d\n",
newset->v, newset->n);
/* create import dataset */
err = worksheet_start_dataset(newset);
if (err) {
goto getout;
}
if (book_time_series(book)) {
newset->markers = ts_markers;
newset->S = ts_S;
} else {
dataset_obs_info_default(newset);
}
j = 1;
for (i=1; i<newset->v; i++) {
int s = (sheet->colheads)? 1 : 0;
int k = i - 1 + sheet->text_cols;
double zkt;
if (column_is_blank(sheet, k, newset->n)) {
blank_cols++;
continue;
}
if (sheet->colheads && *sheet->varname[k] != '\0') {
strcpy(newset->varname[j], sheet->varname[k]);
} else {
sprintf(newset->varname[j], "v%d", j);
}
for (t=0; t<newset->n; t++) {
zkt = sheet->Z[k][s++];
if (zkt == -999 || zkt == -9999) {
newset->Z[j][t] = NADBL;
} else {
newset->Z[j][t] = zkt;
}
if (na(newset->Z[j][t])) {
missvals = 1;
}
}
j++;
}
if (blank_cols > 0) {
fprintf(stderr, "Dropping %d apparently blank column(s)\n",
blank_cols);
dataset_drop_last_variables(newset, blank_cols);
}
if (missvals) {
pputs(prn, _("Warning: there were missing values\n"));
}
if (fix_varname_duplicates(newset)) {
pputs(prn, _("warning: some variable names were duplicated\n"));
}
if (book_obs_labels(book) && wsheet_labels_complete(sheet)) {
int offset = (sheet->colheads)? 1 : 0;
dataset_allocate_obs_markers(newset);
if (newset->S != NULL) {
for (t=0; t<newset->n; t++) {
strcpy(newset->S[t], sheet->label[t+offset]);
}
}
}
if (book->flags & BOOK_DATA_REVERSED) {
reverse_data(newset, prn);
}
if (!err && !dataset_is_time_series(newset) && newset->S != NULL) {
/* we didn't time series info above, but it's possible
the observation strings carry such info
*/
import_ts_check(newset);
}
err = merge_or_replace_data(dset, &newset, opt, prn);
if (!err && !merge) {
dataset_add_import_info(dset, fname, GRETL_GNUMERIC);
}
if (!err && gui) {
wbook_record_params(book, list);
}
}
getout:
wbook_free(book);
wsheet_free(sheet);
gretl_pop_c_numeric_locale();
if (err && newset != NULL) {
destroy_dataset(newset);
}
return err;
}
int midas_forecast_setup (const MODEL *pmod,
DATASET *dset,
ForecastMethod method,
char **pformula)
{
gretl_array *mA;
midas_info *minfo = NULL;
int *xlist = NULL;
int *hflist = NULL;
int nmidas = 0;
int err = 0;
mA = gretl_model_get_data(pmod, "midas_info");
xlist = gretl_model_get_data(pmod, "lfxlist");
if (mA == NULL || xlist == NULL) {
err = E_DATA;
} else {
minfo = minfo_from_array(mA, &nmidas, &err);
}
if (!err) {
/* reconstitute MIDAS lag-lists */
err = make_midas_laglists(minfo, nmidas, dset);
}
if (!err) {
/* build and push list of all MIDAS terms */
hflist = make_midas_biglist(NULL, minfo, nmidas);
if (hflist == NULL) {
err = E_ALLOC;
} else {
/* note: remember_list() copies its argument */
err = remember_list(hflist, "HFLFC___", NULL);
user_var_privatize_by_name("HFLFC___");
free(hflist);
}
}
if (!err) {
/* build and push vector of all MIDAS coeffs */
err = push_midas_coeff_array(pmod, xlist,
minfo, nmidas);
}
if (!err) {
/* build a string that can be passed to "genr" to
calculate fitted values */
char tmp[64], line[MAXLEN];
double *b = pmod->coeff;
int p, yno = pmod->list[1];
int i, xi, j = 0;
*line = '\0';
gretl_push_c_numeric_locale();
for (i=1; i<=xlist[0]; i++) {
xi = xlist[i];
if (xi == 0) {
sprintf(tmp, "%+.15g", b[j++]);
} else {
/* allow for dynamic formula? */
p = (method == FC_STATIC)? 0 :
standard_lag_of(xi, yno, dset);
if (p > 0) {
sprintf(tmp, "%+.15g*%s(-%d)", b[j++],
dset->varname[yno], p);
} else {
sprintf(tmp, "%+.15g*%s", b[j++],
dset->varname[xi]);
}
}
strcat(line, tmp);
}
strcat(line, "+lincomb(HFLFC___,hfb___)");
gretl_pop_c_numeric_locale();
#if FC_DEBUG
fprintf(stderr, "formula='%s'\n", line);
#endif
*pformula = gretl_strdup(line);
}
free(minfo);
return err;
}
static int real_json_get (JsonParser *parser, const char *pathstr,
int *n_objects, PRN *prn)
{
GError *gerr = NULL;
JsonNode *match, *node;
JsonPath *path;
GType ntype;
double x;
int err = 0;
*n_objects = 0;
node = json_parser_get_root(parser);
path = json_path_new();
if (!json_path_compile(path, pathstr, &gerr)) {
if (gerr != NULL) {
gretl_errmsg_sprintf("Failed to compile JsonPath: %s",
gerr->message);
g_error_free(gerr);
} else {
gretl_errmsg_set("Failed to compile JsonPath");
}
g_object_unref(path);
return E_DATA;
}
match = json_path_match(path, node);
if (match == NULL) {
/* FIXME : maybe return empty string? */
g_object_unref(path);
return E_DATA;
}
/* in case we get floating-point output */
gretl_push_c_numeric_locale();
if (JSON_NODE_HOLDS_ARRAY(match)) {
JsonArray *array;
array = json_node_get_array(match);
node = json_array_get_element(array, 0);
repeat:
if (node == NULL) {
gretl_errmsg_set("Failed to match JsonPath");
ntype = 0;
} else {
ntype = json_node_get_value_type(node);
}
if (!handled_type(ntype)) {
if (JSON_NODE_HOLDS_ARRAY(node)) {
array = json_node_get_array(node);
node = json_array_get_element(array, 0);
goto repeat;
} else {
gretl_errmsg_sprintf("Unhandled array type '%s'",
g_type_name(ntype));
err = E_DATA;
}
} else {
int i, n = json_array_get_length(array);
for (i=0; i<n; i++) {
node = json_array_get_element(array, i);
if (ntype == G_TYPE_STRING) {
pputs(prn, json_node_get_string(node));
} else {
x = json_node_get_double(node);
pprintf(prn, "%.15g", x);
}
if (n > 1) {
pputc(prn, '\n');
}
}
*n_objects = n;
}
} else {
ntype = json_node_get_value_type(match);
if (!handled_type(ntype)) {
gretl_errmsg_sprintf("Unhandled object type '%s'",
g_type_name(ntype));
err = E_DATA;
} else {
if (ntype == G_TYPE_STRING) {
pputs(prn, json_node_get_string(match));
} else {
x = json_node_get_double(match);
pprintf(prn, "%.15g", x);
}
*n_objects = 1;
}
}
gretl_pop_c_numeric_locale();
json_node_free(match);
g_object_unref(path);
return err;
}
