static int print_var_lags (const int *laglist, int gotsep,
PRN *prn)
{
char tmp[32];
int lag, lsign;
int lstart, lmax;
int i, n, ret = 0;
get_lstart_lmax(laglist, gotsep, &lstart, &lmax);
n = lmax - lstart + 1;
if (n < 1) {
/* no actual lags, this sublist */
return 0;
} else if (n == 1) {
/* just one lag */
lsign = laglist[lstart];
lag = abs(laglist[lstart]);
sprintf(tmp, "(%s%d)", lag_sign_str(lsign), lag);
ret += pputs(prn, tmp);
} else if (var_lags_contiguous(laglist, lstart, lmax)) {
/* first lag */
lsign = laglist[lstart];
lag = abs(laglist[lstart]);
sprintf(tmp, "(%s%d to ", lag_sign_str(lsign), lag);
ret += pputs(prn, tmp);
/* last lag */
lsign = laglist[lmax];
lag = abs(laglist[lmax]);
sprintf(tmp, "%s%d)", lag_sign_str(lsign), lag);
ret += pputs(prn, tmp);
} else {
pputc(prn, '(');
ret++;
for (i=lstart; i<=lmax; i++) {
lsign = laglist[i];
lag = fabs(laglist[i]);
sprintf(tmp, "%s%d", lag_sign_str(lsign), lag);
ret += pputs(prn, tmp);
if (i < lmax) {
ret += pputs(prn, ", ");
} else {
pputc(prn, ')');
ret++;
}
}
}
return ret;
}
char *utf8_to_rtf (const char *s)
{
const char *nextp, *p = s;
short int k;
PRN *prn;
char *ret = NULL;
int err = 0;
prn = gretl_print_new(GRETL_PRINT_BUFFER, &err);
if (prn == NULL) {
return NULL;
}
while (*p) {
nextp = g_utf8_next_char(p);
if (nextp - p > 1) {
k = (short) g_utf8_get_char(p);
pprintf(prn, "\\u%d?", k);
} else {
pputc(prn, *p);
}
p = nextp;
}
ret = gretl_print_steal_buffer(prn);
gretl_print_destroy(prn);
return ret;
}
int
putstr(int d)
{
addbufspc(1);
pputc(d);
return 0;
}
int gretl_bundle_print (gretl_bundle *bundle, PRN *prn)
{
if (bundle == NULL) {
return E_DATA;
} else {
int n_items = g_hash_table_size(bundle->ht);
user_var *u = get_user_var_by_data(bundle);
const char *name = NULL;
if (u != NULL) {
name = user_var_get_name(u);
} else {
name = "anonymous";
}
if (n_items == 0) {
pprintf(prn, "bundle %s: empty\n", name);
} else {
if (bundle->creator != NULL) {
pprintf(prn, "bundle %s, created by %s:\n",
name, bundle->creator);
} else {
pprintf(prn, "bundle %s:\n", name);
}
g_hash_table_foreach(bundle->ht, print_bundled_item, prn);
pputc(prn, '\n');
}
return 0;
}
}
static void single_series_view_print (windata_t *vwin)
{
series_view *sview = (series_view *) vwin->data;
char num_format[32];
double x;
PRN *prn;
int i, t, obslen;
int err = 0;
if (bufopen(&prn)) {
return;
}
if (sview->view == VIEW_STANDARD) {
int list[2] = { 1, sview->varnum };
/* regular printout: unsort if need be */
if (sview->sorted) {
series_view_unsort(sview);
}
err = printdata(list, NULL, dataset, OPT_O, prn);
if (err) {
gui_errmsg(err);
}
goto finalize;
}
obslen = max_obs_marker_length(dataset);
if (sview->format == 'g') {
sprintf(num_format, "%%#13.%dg\n", sview->digits);
} else {
sprintf(num_format, "%%13.%df\n", sview->digits);
}
pprintf(prn, "\n%*s ", obslen, " ");
pprintf(prn, "%13s\n\n", dataset->varname[sview->varnum]);
for (i=0; i<sview->npoints; i++) {
t = sview->points[i].obsnum;
x = sview->points[i].val;
print_obs_marker(t, dataset, obslen, prn);
if (na(x)) {
pputc(prn, '\n');
} else {
pprintf(prn, num_format, x);
}
}
finalize:
if (!err) {
textview_set_text(vwin->text, gretl_print_get_buffer(prn));
}
gretl_print_destroy(prn);
}
void gretl_prn_newline (PRN *prn)
{
if (tex_format(prn)) {
pputs(prn, "\\\\\n");
} else if (rtf_format(prn)) {
pputs(prn, "\\par\n");
} else {
pputc(prn, '\n');
}
}
static void function_noargs_error (const char *s, parser *p)
{
parser_print_input(p);
pprintf(p->prn, _("'%s': no argument was given"), s);
pputc(p->prn, '\n');
gretl_errmsg_sprintf(_("'%s': no argument was given"), s);
p->err = E_ARGS;
}
static void show_obj_value (gpointer data, gpointer p)
{
JsonNode *node = data;
struct jsdata *jsd = p;
if (JSON_NODE_HOLDS_ARRAY(node)) {
fprintf(stderr, " show_obj_value: got array!\n");
}
if (node != NULL && !*jsd->err) {
*jsd->err = output_json_node_value(node, jsd->prn);
if (!*jsd->err) {
*jsd->n_objects += 1;
pputc(jsd->prn, '\n');
}
}
}
static void write_string(struct oport *p, prt_level level, struct string *print)
{
uvalue l = string_len(print);
if (level == prt_display)
pswrite(p, print, 0, l);
else
{
unsigned char *str = (unsigned char *)alloca(l + 1);
unsigned char *endstr;
memcpy((char *)str, print->str, l + 1);
GCPRO1(p);
/* The NULL byte at the end doesn't count */
endstr = str + l;
pputc('"', p);
while (str < endstr)
{
unsigned char *pos = str;
while (pos < endstr && writable(*pos)) pos++;
opwrite(p, (char *)str, pos - str);
if (pos < endstr) /* We stopped for a \ */
{
pputc('\\', p);
switch (*pos)
{
case '\\': case '"': pputc(*pos, p); break;
case '\n': pputc('n', p); break;
case '\r': pputc('r', p); break;
case '\t': pputc('t', p); break;
case '\f': pputc('f', p); break;
default: pprintf(p, "%o", *pos); break;
}
str = pos + 1;
}
else str = pos;
}
pputc('"', p);
GCPOP(1);
}
}
static int gui_parse_object_request (const char *line,
char *objname, char **param,
void **pptr, GretlObjType *type,
PRN *prn)
{
char word[MAXSAVENAME] = {0};
int action;
/* get object name (if any) and dot param */
parse_object_command(line, word, param);
/* if no dot param, nothing doing, pass through */
if (*param == NULL) {
return OBJ_ACTION_NONE;
}
if (gretl_is_bundle(word)) {
return OBJ_ACTION_NONE;
}
/* see if there's an object associated with the name */
*pptr = get_session_object_by_name(word, type);
if (*pptr == NULL) {
/* no matching object */
if (*param) {
pprintf(prn, _("%s: no such object\n"), word);
}
return OBJ_ACTION_INVALID;
}
action = match_object_command(*param);
if (action == OBJ_ACTION_INVALID) {
pprintf(prn, _("command '%s' not recognized"), *param);
pputc(prn, '\n');
} else {
strcpy(objname, word);
}
return action;
}
static int
print_lags_by_varnum (int v, const Laginfo *linfo,
const DATASET *dset,
int gotsep, PRN *prn)
{
const int *laglist = NULL;
int ret = 0;
#if LLDEBUG
fprintf(stderr, "print_lags_by_varnum: v = %d, gotsep = %d\n",
v, gotsep);
#endif
laglist = get_lag_list_by_varnum(v, linfo);
if (laglist != NULL) {
pputc(prn, ' ');
ret = 1 + pputs(prn, dset->varname[v]);
ret += print_var_lags(laglist, gotsep, prn);
}
return ret;
}
static void pca_print (VMatrix *cmat, gretl_matrix *E,
gretl_matrix *C, PRN *prn)
{
double cum, esum;
char pcname[8];
int nl, namelen = 8;
int n = cmat->dim;
int done, todo;
int i, j;
pprintf(prn, "%s\n\n", _("Principal Components Analysis"));
if (cmat->ci == CORR) {
pprintf(prn, "%s\n\n", _("Eigenanalysis of the Correlation Matrix"));
} else {
pprintf(prn, "%s\n\n", _("Eigenanalysis of the Covariance Matrix"));
}
pputs(prn, _("Component Eigenvalue Proportion Cumulative\n"));
if (cmat->ci == CORR) {
esum = n;
} else {
esum = 0.0;
for (i=0; i<n; i++) {
esum += E->val[i];
}
}
cum = 0.0;
for (i=0; i<n; i++) {
cum += E->val[i] / esum;
pprintf(prn, "%5d%13.4f%13.4f%13.4f\n", i + 1,
E->val[i], E->val[i] / esum, cum);
nl = strlen(cmat->names[i]);
if (nl > namelen) {
namelen = nl;
}
}
pputc(prn, '\n');
pprintf(prn, "%s\n\n", _("Eigenvectors (component loadings)"));
done = 0;
todo = n;
while (todo > 0) {
int ncols = todo > PCA_COLS ? PCA_COLS : todo;
pprintf(prn, "%-*s", namelen + 1, " ");
for (j=0; j<ncols; j++) {
sprintf(pcname, "PC%d", done + j + 1);
pprintf(prn, "%9s", pcname);
}
pputc(prn, '\n');
for (i=0; i<n; i++) {
pprintf(prn, "%-*s", namelen + 1, cmat->names[i]);
for (j=0; j<ncols; j++) {
pprintf(prn, "%9.3f", gretl_matrix_get(C, i, done + j));
}
pputc(prn, '\n');
}
pputc(prn, '\n');
todo -= ncols;
done += ncols;
}
}
static void print_bundled_item (gpointer key, gpointer value, gpointer p)
{
bundled_item *item = value;
const gchar *kstr = key;
gretl_array *a;
gretl_matrix *m;
double x;
char *s;
PRN *prn = p;
switch (item->type) {
case GRETL_TYPE_DOUBLE:
x = *(double *) item->data;
if (na(x)) {
pprintf(prn, " %s = NA", kstr);
} else {
pprintf(prn, " %s = %g", kstr, x);
}
break;
case GRETL_TYPE_STRING:
s = (char *) item->data;
if (strlen(s) < 64) {
pprintf(prn, " %s = %s", kstr, s);
} else {
pprintf(prn, " %s (%s)", kstr,
gretl_type_get_name(item->type));
}
break;
case GRETL_TYPE_BUNDLE:
pprintf(prn, " %s (%s)", kstr,
gretl_type_get_name(item->type));
break;
case GRETL_TYPE_MATRIX:
case GRETL_TYPE_MATRIX_REF:
m = item->data;
if (m->rows == 1 && m->cols == 1) {
pprintf(prn, " %s = %g", kstr, m->val[0]);
} else {
pprintf(prn, " %s (%s: %d x %d)", kstr,
gretl_type_get_name(item->type),
m->rows, m->cols);
}
break;
case GRETL_TYPE_SERIES:
pprintf(prn, " %s (%s: length %d)", kstr,
gretl_type_get_name(item->type), item->size);
break;
case GRETL_TYPE_ARRAY:
a = item->data;
{
GretlType t = gretl_array_get_type(a);
int n = gretl_array_get_length(a);
pprintf(prn, " %s = array of %s, length %d", kstr,
gretl_type_get_name(t), n);
}
break;
default:
break;
}
if (item->note != NULL) {
pprintf(prn, " %s\n", item->note);
} else {
pputc(prn, '\n');
}
}
static int xlsx_read_row (xmlNodePtr cur, xlsx_info *xinfo, PRN *prn)
{
PRN *myprn = NULL;
xmlNodePtr val;
char *tmp;
int row = -1, col = -1;
int pass, empty = 1;
int err = 0;
pass = xinfo->dset == NULL ? 1 : 2;
#if XDEBUG
myprn = prn;
pprintf(myprn, "*** Reading row (pass %d)...\n", pass);
#endif
cur = cur->xmlChildrenNode;
/* loop across cells in row */
while (cur != NULL && !err) {
if (!xmlStrcmp(cur->name, (XUC) "c")) {
/* we got a cell in the given row */
char *cref = NULL;
char *formula = NULL;
const char *strval = NULL;
double xval = NADBL;
int stringcell = 0;
int gotv = 0, gotf = 0;
pprintf(myprn, " cell");
cref = (char *) xmlGetProp(cur, (XUC) "r");
if (cref == NULL) {
pprintf(myprn, ": couldn't find 'r' property\n");
err = E_DATA;
break;
}
err = xlsx_cell_get_coordinates(cref, &row, &col);
if (err) {
pprintf(myprn, ": couldn't find coordinates\n", row, col);
} else {
pprintf(myprn, "(%d, %d)", row, col);
}
if (pass == 2 && row > xinfo->maxrow) {
goto skipit;
}
tmp = (char *) xmlGetProp(cur, (XUC) "t");
if (tmp != NULL) {
if (!strcmp(tmp, "s")) {
/* string from string table */
stringcell = 1;
} else if (!strcmp(tmp, "str")) {
/* "inline" string literal? */
stringcell = 2;
}
free(tmp);
}
val = cur->xmlChildrenNode;
/* find a value in the current row/cell */
while (val && !err && !gotv) {
if (!xmlStrcmp(val->name, (XUC) "v")) {
tmp = (char *) xmlNodeGetContent(val);
if (tmp != NULL) {
if (stringcell) {
if (stringcell == 1) {
strval = xlsx_string_value(tmp, xinfo, prn);
} else {
strval = gretl_strdup(tmp);
}
if (strval == NULL) {
pputs(myprn, " value = ?\n");
err = E_DATA;
} else {
pprintf(myprn, " value = '%s'\n", strval);
}
} else {
pprintf(myprn, " value = %s\n", tmp);
if (*tmp != '\0' && check_atof(tmp) == 0) {
xval = atof(tmp);
}
}
free(tmp);
gotv = 1;
}
} else if (!gotf && !xmlStrcmp(val->name, (XUC) "f")) {
formula = (char *) xmlNodeGetContent(val);
gotf = 1;
}
val = val->next;
}
if (gotf && formula == NULL) {
gotf = 0;
}
if (!err && xinfo->dset == NULL) {
/* on the first pass, check for obs column, varname status */
xlsx_check_top_left(xinfo, row, col, stringcell,
strval, xval);
}
if (err) {
pprintf(myprn, ": (%s) error", cref);
} else if (!gotv) {
pprintf(myprn, ": (%s) no data value", cref);
if (gotf) {
pprintf(myprn, "; formula = '%s'\n", formula);
} else {
pputc(myprn, '\n');
}
}
if (!err && xinfo->dset != NULL &&
col > xinfo->xoffset &&
row > xinfo->yoffset) {
int i = xlsx_var_index(xinfo, col);
int t = xlsx_obs_index(xinfo, row);
/* here we're on the second pass, with a dataset allocated */
if (stringcell) {
if (row == xinfo->namerow) {
err = xlsx_set_varname(xinfo, i, strval, row, col, prn);
} else if (col == xinfo->obscol) {
err = xlsx_set_obs_string(xinfo, row, col, t, strval, prn);
} else if (strval != NULL) {
err = xlsx_handle_stringval(strval, row, col, prn);
}
if (stringcell == 2) {
/* finished with copy of string literal */
free((char *) strval);
}
} else if (gotv) {
err = xlsx_set_value(xinfo, i, t, xval);
} else if (gotf) {
xlsx_maybe_handle_formula(xinfo, formula, i, t);
}
} else if (stringcell == 2 && strval != NULL) {
free((char *) strval);
}
if (gotv || gotf) {
empty = 0;
}
skipit:
free(cref);
free(formula);
}
/* move onto next cell in row */
cur = cur->next;
} /* end loop across cells in row */
if (!err) {
if (empty) {
pputs(myprn, " xlsx_read_row: empty row!\n");
} else if (pass == 1) {
xlsx_set_dims(xinfo, row, col);
}
}
if (err) {
fprintf(stderr, "xlsx_read_row: returning %d\n", err);
}
return err;
}
static int
putpromptchar(int doprint, int endchar, unsigned int *txtchangep)
{
char *ss, *hostnam;
int t0, arg, test, sep, j, numjobs;
struct tm *tm;
struct timezone dummy_tz;
struct timeval tv;
time_t timet;
Nameddir nd;
for (; *bv->fm && *bv->fm != endchar; bv->fm++) {
arg = 0;
if (*bv->fm == '%' && isset(PROMPTPERCENT)) {
int minus = 0;
bv->fm++;
if (*bv->fm == '-') {
minus = 1;
bv->fm++;
}
if (idigit(*bv->fm)) {
arg = zstrtol(bv->fm, &bv->fm, 10);
if (minus)
arg *= -1;
} else if (minus)
arg = -1;
if (*bv->fm == '(') {
int tc, otruncwidth;
if (idigit(*++bv->fm)) {
arg = zstrtol(bv->fm, &bv->fm, 10);
} else if (arg < 0) {
/* negative numbers don't make sense here */
arg *= -1;
}
test = 0;
ss = pwd;
switch (tc = *bv->fm) {
case 'c':
case '.':
case '~':
if ((nd = finddir(ss))) {
arg--;
ss += strlen(nd->dir);
} /*FALLTHROUGH*/
case '/':
case 'C':
/* `/' gives 0, `/any' gives 1, etc. */
if (*ss++ == '/' && *ss)
arg--;
for (; *ss; ss++)
if (*ss == '/')
arg--;
if (arg <= 0)
test = 1;
break;
case 't':
case 'T':
case 'd':
case 'D':
case 'w':
timet = time(NULL);
tm = localtime(&timet);
switch (tc) {
case 't':
test = (arg == tm->tm_min);
break;
case 'T':
test = (arg == tm->tm_hour);
break;
case 'd':
test = (arg == tm->tm_mday);
break;
case 'D':
test = (arg == tm->tm_mon);
break;
case 'w':
test = (arg == tm->tm_wday);
break;
}
break;
case '?':
if (lastval == arg)
test = 1;
break;
case '#':
if (geteuid() == (uid_t)arg)
test = 1;
break;
case 'g':
if (getegid() == (gid_t)arg)
test = 1;
break;
case 'j':
for (numjobs = 0, j = 1; j <= maxjob; j++)
if (jobtab[j].stat && jobtab[j].procs &&
!(jobtab[j].stat & STAT_NOPRINT)) numjobs++;
if (numjobs >= arg)
test = 1;
break;
case 'l':
*bv->bp = '\0';
countprompt(bv->bufline, &t0, 0, 0);
if (minus)
t0 = zterm_columns - t0;
if (t0 >= arg)
test = 1;
break;
case 'e':
{
Funcstack fsptr = funcstack;
test = arg;
while (fsptr && test > 0) {
test--;
fsptr = fsptr->prev;
}
test = !test;
}
break;
case 'L':
if (shlvl >= arg)
test = 1;
break;
case 'S':
if (time(NULL) - shtimer.tv_sec >= arg)
test = 1;
break;
case 'v':
if (arrlen(psvar) >= arg)
test = 1;
break;
case 'V':
if (arrlen(psvar) >= arg) {
if (*psvar[(arg ? arg : 1) - 1])
test = 1;
}
break;
case '_':
test = (cmdsp >= arg);
break;
case '!':
test = privasserted();
break;
default:
test = -1;
break;
}
if (!*bv->fm || !(sep = *++bv->fm))
return 0;
bv->fm++;
/* Don't do the current truncation until we get back */
otruncwidth = bv->truncwidth;
bv->truncwidth = 0;
if (!putpromptchar(test == 1 && doprint, sep,
txtchangep) || !*++bv->fm ||
!putpromptchar(test == 0 && doprint, ')',
txtchangep)) {
bv->truncwidth = otruncwidth;
return 0;
}
bv->truncwidth = otruncwidth;
continue;
}
if (!doprint)
switch(*bv->fm) {
case '[':
while(idigit(*++bv->fm));
while(*++bv->fm != ']');
continue;
case '<':
while(*++bv->fm != '<');
continue;
case '>':
while(*++bv->fm != '>');
continue;
case 'D':
if(bv->fm[1]=='{')
while(*++bv->fm != '}');
continue;
default:
continue;
}
switch (*bv->fm) {
case '~':
promptpath(pwd, arg, 1);
break;
case 'd':
case '/':
promptpath(pwd, arg, 0);
break;
case 'c':
case '.':
promptpath(pwd, arg ? arg : 1, 1);
break;
case 'C':
promptpath(pwd, arg ? arg : 1, 0);
break;
case 'N':
promptpath(scriptname ? scriptname : argzero, arg, 0);
break;
case 'h':
case '!':
addbufspc(DIGBUFSIZE);
convbase(bv->bp, curhist, 10);
bv->bp += strlen(bv->bp);
break;
case 'j':
for (numjobs = 0, j = 1; j <= maxjob; j++)
if (jobtab[j].stat && jobtab[j].procs &&
!(jobtab[j].stat & STAT_NOPRINT)) numjobs++;
addbufspc(DIGBUFSIZE);
sprintf(bv->bp, "%d", numjobs);
bv->bp += strlen(bv->bp);
break;
case 'M':
queue_signals();
if ((hostnam = getsparam("HOST")))
stradd(hostnam);
unqueue_signals();
break;
case 'm':
if (!arg)
arg++;
queue_signals();
if (!(hostnam = getsparam("HOST")))
break;
if (arg < 0) {
for (ss = hostnam + strlen(hostnam); ss > hostnam; ss--)
if (ss[-1] == '.' && !++arg)
break;
stradd(ss);
} else {
for (ss = hostnam; *ss; ss++)
if (*ss == '.' && !--arg)
break;
stradd(*ss ? dupstrpfx(hostnam, ss - hostnam) : hostnam);
}
unqueue_signals();
break;
case 'S':
txtchangeset(txtchangep, TXTSTANDOUT, TXTNOSTANDOUT);
txtset(TXTSTANDOUT);
tsetcap(TCSTANDOUTBEG, TSC_PROMPT);
break;
case 's':
txtchangeset(txtchangep, TXTNOSTANDOUT, TXTSTANDOUT);
txtunset(TXTSTANDOUT);
tsetcap(TCSTANDOUTEND, TSC_PROMPT|TSC_DIRTY);
break;
case 'B':
txtchangeset(txtchangep, TXTBOLDFACE, TXTNOBOLDFACE);
txtset(TXTBOLDFACE);
tsetcap(TCBOLDFACEBEG, TSC_PROMPT|TSC_DIRTY);
break;
case 'b':
txtchangeset(txtchangep, TXTNOBOLDFACE, TXTBOLDFACE);
txtchangeset(txtchangep, TXTNOSTANDOUT, TXTSTANDOUT);
txtchangeset(txtchangep, TXTNOUNDERLINE, TXTUNDERLINE);
txtunset(TXTBOLDFACE);
tsetcap(TCALLATTRSOFF, TSC_PROMPT|TSC_DIRTY);
break;
case 'U':
txtchangeset(txtchangep, TXTUNDERLINE, TXTNOUNDERLINE);
txtset(TXTUNDERLINE);
tsetcap(TCUNDERLINEBEG, TSC_PROMPT);
break;
case 'u':
txtchangeset(txtchangep, TXTNOUNDERLINE, TXTUNDERLINE);
txtunset(TXTUNDERLINE);
tsetcap(TCUNDERLINEEND, TSC_PROMPT|TSC_DIRTY);
break;
case 'F':
arg = parsecolorchar(arg, 1);
if (arg >= 0 && !(arg & TXTNOFGCOLOUR)) {
txtchangeset(txtchangep, arg & TXT_ATTR_FG_ON_MASK,
TXTNOFGCOLOUR);
txtset(arg & TXT_ATTR_FG_ON_MASK);
set_colour_attribute(arg, COL_SEQ_FG, TSC_PROMPT);
break;
}
/* else FALLTHROUGH */
case 'f':
txtchangeset(txtchangep, TXTNOFGCOLOUR, TXT_ATTR_FG_ON_MASK);
txtunset(TXT_ATTR_FG_ON_MASK);
set_colour_attribute(TXTNOFGCOLOUR, COL_SEQ_FG, TSC_PROMPT);
break;
case 'K':
arg = parsecolorchar(arg, 0);
if (arg >= 0 && !(arg & TXTNOBGCOLOUR)) {
txtchangeset(txtchangep, arg & TXT_ATTR_BG_ON_MASK,
TXTNOBGCOLOUR);
txtset(arg & TXT_ATTR_BG_ON_MASK);
set_colour_attribute(arg, COL_SEQ_BG, TSC_PROMPT);
break;
}
/* else FALLTHROUGH */
case 'k':
txtchangeset(txtchangep, TXTNOBGCOLOUR, TXT_ATTR_BG_ON_MASK);
txtunset(TXT_ATTR_BG_ON_MASK);
set_colour_attribute(TXTNOBGCOLOUR, COL_SEQ_BG, TSC_PROMPT);
break;
case '[':
if (idigit(*++bv->fm))
arg = zstrtol(bv->fm, &bv->fm, 10);
if (!prompttrunc(arg, ']', doprint, endchar, txtchangep))
return *bv->fm;
break;
case '<':
case '>':
/* Test (minus) here so -0 means "at the right margin" */
if (minus) {
*bv->bp = '\0';
countprompt(bv->bufline, &t0, 0, 0);
arg = zterm_columns - t0 + arg;
if (arg <= 0)
arg = 1;
}
if (!prompttrunc(arg, *bv->fm, doprint, endchar, txtchangep))
return *bv->fm;
break;
case '{': /*}*/
if (!bv->dontcount++) {
addbufspc(1);
*bv->bp++ = Inpar;
}
if (arg <= 0)
break;
/* else */
/* FALLTHROUGH */
case 'G':
if (arg > 0) {
addbufspc(arg);
while (arg--)
*bv->bp++ = Nularg;
} else {
addbufspc(1);
*bv->bp++ = Nularg;
}
break;
case /*{*/ '}':
if (bv->trunccount && bv->trunccount >= bv->dontcount)
return *bv->fm;
if (bv->dontcount && !--bv->dontcount) {
addbufspc(1);
*bv->bp++ = Outpar;
}
break;
case 't':
case '@':
case 'T':
case '*':
case 'w':
case 'W':
case 'D':
{
char *tmfmt, *dd, *tmbuf = NULL;
switch (*bv->fm) {
case 'T':
tmfmt = "%K:%M";
break;
case '*':
tmfmt = "%K:%M:%S";
break;
case 'w':
tmfmt = "%a %f";
break;
case 'W':
tmfmt = "%m/%d/%y";
break;
case 'D':
if (bv->fm[1] == '{' /*}*/) {
for (ss = bv->fm + 2; *ss && *ss != /*{*/ '}'; ss++)
if(*ss == '\\' && ss[1])
ss++;
dd = tmfmt = tmbuf = zalloc(ss - bv->fm);
for (ss = bv->fm + 2; *ss && *ss != /*{*/ '}';
ss++) {
if(*ss == '\\' && ss[1])
ss++;
*dd++ = *ss;
}
*dd = 0;
bv->fm = ss - !*ss;
if (!*tmfmt) {
free(tmbuf);
continue;
}
} else
tmfmt = "%y-%m-%d";
break;
default:
tmfmt = "%l:%M%p";
break;
}
gettimeofday(&tv, &dummy_tz);
tm = localtime(&tv.tv_sec);
/*
* Hack because strftime won't say how
* much space it actually needs. Try to add it
* a few times until it works. Some formats don't
* actually have a length, so we could go on for
* ever.
*/
for(j = 0, t0 = strlen(tmfmt)*8; j < 3; j++, t0*=2) {
addbufspc(t0);
if (ztrftime(bv->bp, t0, tmfmt, tm, tv.tv_usec) >= 0)
break;
}
/* There is enough room for this because addbufspc(t0)
* allocates room for t0 * 2 bytes. */
metafy(bv->bp, -1, META_NOALLOC);
bv->bp += strlen(bv->bp);
zsfree(tmbuf);
break;
}
case 'n':
stradd(get_username());
break;
case 'l':
if (*ttystrname) {
ss = (strncmp(ttystrname, "/dev/tty", 8) ?
ttystrname + 5 : ttystrname + 8);
stradd(ss);
} else
stradd("()");
break;
case 'y':
if (*ttystrname) {
ss = (strncmp(ttystrname, "/dev/", 5) ?
ttystrname : ttystrname + 5);
stradd(ss);
} else
stradd("()");
break;
case 'L':
addbufspc(DIGBUFSIZE);
#if defined(ZLONG_IS_LONG_LONG) && defined(PRINTF_HAS_LLD)
sprintf(bv->bp, "%lld", shlvl);
#else
sprintf(bv->bp, "%ld", (long)shlvl);
#endif
bv->bp += strlen(bv->bp);
break;
case '?':
addbufspc(DIGBUFSIZE);
#if defined(ZLONG_IS_LONG_LONG) && defined(PRINTF_HAS_LLD)
sprintf(bv->bp, "%lld", lastval);
#else
sprintf(bv->bp, "%ld", (long)lastval);
#endif
bv->bp += strlen(bv->bp);
break;
case '%':
case ')':
addbufspc(1);
*bv->bp++ = *bv->fm;
break;
case '#':
addbufspc(1);
*bv->bp++ = privasserted() ? '#' : '%';
break;
case 'v':
if (!arg)
arg = 1;
else if (arg < 0)
arg += arrlen(psvar) + 1;
if (arg > 0 && arrlen(psvar) >= arg)
stradd(psvar[arg - 1]);
break;
case 'E':
tsetcap(TCCLEAREOL, TSC_PROMPT);
break;
case '^':
if (cmdsp) {
if (arg >= 0) {
if (arg > cmdsp || arg == 0)
arg = cmdsp;
for (t0 = cmdsp - 1; arg--; t0--) {
stradd(cmdnames[cmdstack[t0]]);
if (arg) {
addbufspc(1);
*bv->bp++=' ';
}
}
} else {
arg = -arg;
if (arg > cmdsp)
arg = cmdsp;
for (t0 = arg - 1; arg--; t0--) {
stradd(cmdnames[cmdstack[t0]]);
if (arg) {
addbufspc(1);
*bv->bp++=' ';
}
}
}
}
break;
case '_':
if (cmdsp) {
if (arg >= 0) {
if (arg > cmdsp || arg == 0)
arg = cmdsp;
for (t0 = cmdsp - arg; arg--; t0++) {
stradd(cmdnames[cmdstack[t0]]);
if (arg) {
addbufspc(1);
*bv->bp++=' ';
}
}
} else {
arg = -arg;
if (arg > cmdsp)
arg = cmdsp;
for (t0 = 0; arg--; t0++) {
stradd(cmdnames[cmdstack[t0]]);
if (arg) {
addbufspc(1);
*bv->bp++=' ';
}
}
}
}
break;
case 'r':
if(bv->rstring)
stradd(bv->rstring);
break;
case 'R':
if(bv->Rstring)
stradd(bv->Rstring);
break;
case 'e':
{
int depth = 0;
Funcstack fsptr = funcstack;
while (fsptr) {
depth++;
fsptr = fsptr->prev;
}
addbufspc(DIGBUFSIZE);
sprintf(bv->bp, "%d", depth);
bv->bp += strlen(bv->bp);
break;
}
case 'I':
if (funcstack && funcstack->tp != FS_SOURCE &&
!IN_EVAL_TRAP()) {
/*
* We're in a function or an eval with
* EVALLINENO. Calculate the line number in
* the file.
*/
zlong flineno = lineno + funcstack->flineno;
/* take account of eval line nos. starting at 1 */
if (funcstack->tp == FS_EVAL)
lineno--;
addbufspc(DIGBUFSIZE);
#if defined(ZLONG_IS_LONG_LONG) && defined(PRINTF_HAS_LLD)
sprintf(bv->bp, "%lld", flineno);
#else
sprintf(bv->bp, "%ld", (long)flineno);
#endif
bv->bp += strlen(bv->bp);
break;
}
/* else we're in a file and lineno is already correct */
/* FALLTHROUGH */
case 'i':
addbufspc(DIGBUFSIZE);
#if defined(ZLONG_IS_LONG_LONG) && defined(PRINTF_HAS_LLD)
sprintf(bv->bp, "%lld", lineno);
#else
sprintf(bv->bp, "%ld", (long)lineno);
#endif
bv->bp += strlen(bv->bp);
break;
case 'x':
if (funcstack && funcstack->tp != FS_SOURCE &&
!IN_EVAL_TRAP())
promptpath(funcstack->filename ? funcstack->filename : "",
arg, 0);
else
promptpath(scriptfilename ? scriptfilename : argzero,
arg, 0);
break;
case '\0':
return 0;
case Meta:
bv->fm++;
break;
}
} else if(*bv->fm == '!' && isset(PROMPTBANG)) {
if(doprint) {
if(bv->fm[1] == '!') {
bv->fm++;
addbufspc(1);
pputc('!');
} else {
addbufspc(DIGBUFSIZE);
convbase(bv->bp, curhist, 10);
bv->bp += strlen(bv->bp);
}
}
} else {
char c = *bv->fm == Meta ? *++bv->fm ^ 32 : *bv->fm;
if (doprint) {
addbufspc(1);
pputc(c);
}
}
}
return *bv->fm;
}
int
#endif // SPRINTF
#define pputc(c) ((*sp++ = (c))INCR_CNT)
vsprintf(char * sp, register const char * f, register va_list ap)
{
#endif // VSPRINTF
#if !defined(PRINTF) && defined(SPRINTF) && !defined(VSPRINTF)
#define pputc(c) ((*sp++ = (c))INCR_CNT)
sprintf(char * sp, const char * f, ...)
{
va_list ap;
#define NEED_START
#endif
#endif // HOSTED
signed char c;
#if defined(WIDTH) || defined(__FLOAT)
int width;
#endif
#ifdef __LONG
int prec;
#else
signed char prec;
#endif
FLAG_SIZE flag;
#ifdef RETVALUE
int ccnt = 0;
#else
#define ccnt 0
#endif
#ifdef __FLOAT
char d;
double fval, integ;
int exp;
double ival;
union {
unsigned value _val;
struct {
CONST char * _cp;
unsigned _len;
} _str;
} _val;
#else // __FLOAT
union {
unsigned value _val;
struct {
CONST char * _cp;
unsigned _len;
} _str;
} _val;
#endif // __FLOAT
#define val _val._val
#define cp _val._str._cp
#define len _val._str._len
#ifdef NEED_START
va_start(ap, f);
#endif
while(c = *f++) {
#ifdef ANYFORMAT
if(c != '%')
#endif //ANYFORMAT
{
pputc(c);
continue;
}
#ifdef ANYFORMAT
#ifdef WIDTH
width = 0;
#endif
flag = 0;
#if defined(LEFT) || defined(SPCSIGN) || defined(MANSIGN) || defined(ALTERN) || defined(FILL)
for(;;) {
switch(*f) {
#ifdef LEFT
case '-':
flag |= LEFT;
f++;
continue;
#endif
#ifdef SPCSIGN
case ' ':
flag |= SPCSIGN;
f++;
continue;
#endif
#ifdef MANSIGN
case '+':
flag |= MANSIGN;
f++;
continue;
#endif
#ifdef ALTERN
case '#':
flag |= ALTERN;
f++;
continue;
#endif
#ifdef FILL
case '0':
flag |= FILL;
f++;
continue;
#endif
}
break;
}
#endif
#if defined(MANSIGN) && defined(SPCSIGN)
if(flag & MANSIGN)
flag &= ~SPCSIGN;
#endif
#if defined(LEFT) && defined(FILL)
if(flag & LEFT)
flag &= ~FILL;
#endif
#ifdef WIDTH
if(isdigit((unsigned)*f)) {
width = 0;
do
width = width*10 + *f++ - '0';
while(isdigit((unsigned)*f));
#ifdef STAR
} else if(*f == '*') {
width = va_arg(ap, int);
f++;
#endif
}
#endif
#ifdef PRECISION
if(*f == '.') {
flag |= PRECISION;
f++;
#ifdef STAR
if(*f == '*') {
prec = va_arg(ap, int);
f++;
} else
static int print_anova (struct anova *v, PRN *prn)
{
int dftotal, dftreat, dfblock, dferr;
double mst, msr, mse;
int n, c1, c2, c3;
dftotal = v->n - 1;
dftreat = v->nt - 1;
dfblock = (v->nb > 0)? v->nb - 1 : 0;
dferr = dftotal - dftreat - dfblock;
pputs(prn, "\n\n");
c1 = g_utf8_strlen(_("Sum of squares"), -1);
c2 = g_utf8_strlen(_("df"), -1);
c3 = g_utf8_strlen(_("Mean square"), -1);
c1 = (c1 < 35)? 35 : c1;
c2 = (c2 > 8)? c2 + 1 : (c2 < 8)? 8 : c2;
c3 = (c3 > 16)? c3 + 1 : (c3 < 16)? 16 : c3;
/* header strings are right-aligned */
n = g_utf8_strlen(_("Sum of squares"), -1);
bufspace(c1 - n, prn);
pputs(prn, _("Sum of squares"));
n = g_utf8_strlen(_("df"), -1);
bufspace(c2 + 1 - n, prn);
pputs(prn, _("df"));
n = g_utf8_strlen(_("Mean square"), -1);
bufspace(c3 + 1 - n, prn);
pputs(prn, _("Mean square"));
pputs(prn, "\n\n");
c1 = 16;
/* Mean Square, treatment */
msr = v->SSTr / dftreat;
/* string left-aligned with initial offset of 2 */
n = g_utf8_strlen(_("Treatment"), -1);
bufspace(2, prn);
pputs(prn, _("Treatment"));
bufspace(16 - n, prn);
pprintf(prn, " %*g %*d %*g\n", c1, v->SSTr, c2, dftreat, c3, msr);
if (dfblock > 0) {
/* Mean Square, block */
double msb = v->SSB / dfblock;
/* string left-aligned with initial offset of 2 */
n = g_utf8_strlen(_("Block"), -1);
bufspace(2, prn);
pputs(prn, _("Block"));
bufspace(16 - n, prn);
pprintf(prn, " %*g %*d %*g\n", c1, v->SSB, c2, dfblock, c3, msb);
}
/* Mean Square, errors */
mse = v->SSE / dferr;
/* string left-aligned with initial offset of 2 */
n = g_utf8_strlen(_("Residual"), -1);
bufspace(2, prn);
pputs(prn, _("Residual"));
bufspace(16 - n, prn);
pprintf(prn, " %*g %*d %*g\n", c1, v->SSE, c2, dferr, c3, mse);
/* Mean Square, total */
mst = v->SST / dftotal;
/* string left-aligned with initial offset of 2 */
n = g_utf8_strlen(_("Total"), -1);
bufspace(2, prn);
pputs(prn, _("Total"));
bufspace(16 - n, prn);
pprintf(prn, " %*g %*d %*g\n", c1, v->SST, c2, dftotal, c3, mst);
pputc(prn, '\n');
if (na(v->F)) {
pprintf(prn, " F(%d, %d) = %g / %g (%s)\n\n", dftreat, dferr,
msr, mse, _("undefined"));
} else {
pprintf(prn, " F(%d, %d) = %g / %g = %g ",
dftreat, dferr, msr, mse, v->F);
if (v->pval < .0001) {
pprintf(prn, "[%s %.3g]\n\n", _("p-value"), v->pval);
} else if (!na(v->pval)) {
pprintf(prn, "[%s %.4f]\n\n", _("p-value"), v->pval);
}
}
return 0;
}
static void leverage_print (const MODEL *pmod,
gretl_matrix *S,
double Xvalcrit,
DATASET *dset,
PRN *prn)
{
double lp = 2.0 * pmod->ncoeff / pmod->nobs;
int obslen = max_obs_marker_length(dset);
int t, j, gotlp = 0;
if (obslen < 8) {
obslen = 8;
}
bufspace(obslen, prn);
pprintf(prn, "%*s", UTF_WIDTH(_("residual"), 16), _("residual"));
pprintf(prn, "%*s", UTF_WIDTH(_("leverage"), 16), _("leverage"));
pprintf(prn, "%*s", UTF_WIDTH(_("influence"), 16), _("influence"));
pprintf(prn, "%*s", UTF_WIDTH(_("DFFITS"), 14), _("DFFITS"));
pputc(prn, '\n');
bufspace(obslen, prn);
pputs(prn, " u 0<=h<=1 u*h/(1-h)\n\n");
for (t=pmod->t1, j=0; t<=pmod->t2; t++, j++) {
double h, st, d, f;
char fstr[32];
if (na(pmod->uhat[t])) {
print_obs_marker(t, dset, obslen, prn);
pputc(prn, '\n');
continue;
}
h = gretl_matrix_get(S, j, 0);
if (h > lp) {
gotlp = 1;
}
f = gretl_matrix_get(S, j, 1);
if (!na(f)) {
sprintf(fstr, "%15.5g", f);
} else {
sprintf(fstr, "%15s", _("undefined"));
}
print_obs_marker(t, dset, obslen, prn);
st = gretl_matrix_get(S, j, 2);
d = st * sqrt(h / (1.0 - h));
pprintf(prn, "%14.5g %14.3f%s %s %14.3f\n", pmod->uhat[t], h,
(h > lp)? "*" : " ", fstr, d);
}
if (gotlp) {
pprintf(prn, "\n%s\n", _("('*' indicates a leverage point)"));
} else {
pprintf(prn, "\n%s\n", _("No leverage points were found"));
}
pprintf(prn, "\n%s = %g\n\n", _("Cross-validation criterion"), Xvalcrit);
}
static int cli_exec_line (ExecState *s, DATASET *dset, PRN *cmdprn)
{
char *line = s->line;
CMD *cmd = s->cmd;
PRN *prn = s->prn;
MODEL *model = s->model;
int old_runit = runit;
char runfile[MAXLEN];
int renumber = 0;
int err = 0;
#if 0
fprintf(stderr, "cli_exec_line: '%s'\n", line);
#endif
if (gretl_compiling_function()) {
err = gretl_function_append_line(line);
if (err) {
errmsg(err, prn);
} else {
pprintf(cmdprn, "%s\n", line);
}
return err;
}
if (string_is_blank(line)) {
if (gretl_echo_space()) {
pputc(prn, '\n');
}
return 0;
}
if (!gretl_compiling_loop() && !s->in_comment &&
!cmd->context && !gretl_if_state_false()) {
/* catch requests relating to saved objects, which are not
really "commands" as such */
int action = cli_saved_object_action(line, dset, prn);
if (action == OBJ_ACTION_INVALID) {
return 1; /* action was faulty */
} else if (action != OBJ_ACTION_NONE) {
return 0; /* action was OK (and handled), or ignored */
}
}
/* tell libgretl if we're in batch mode */
gretl_set_batch_mode(batch);
if (gretl_compiling_loop()) {
/* if we're stacking commands for a loop, parse "lightly" */
err = get_command_index(line, cmd);
} else {
err = parse_command_line(line, cmd, dset, NULL);
}
if (err) {
int catch = 0;
gretl_exec_state_uncomment(s);
if (err != E_ALLOC && (cmd->flags & CMD_CATCH)) {
set_gretl_errno(err);
catch = 1;
}
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;
}
int real_levin_lin (int vnum, const int *plist, DATASET *dset,
gretlopt opt, PRN *prn)
{
int u0 = dset->t1 / dset->pd;
int uN = dset->t2 / dset->pd;
int N = uN - u0 + 1; /* units in sample range */
gretl_matrix_block *B;
gretl_matrix *y, *yavg, *b;
gretl_matrix *dy, *X, *ui;
gretl_matrix *e, *ei, *v, *vi;
gretl_matrix *eps;
double pbar, SN = 0;
int t, t1, t2, T, NT;
int s, pt1, pt2, dyT;
int i, j, k, K, m;
int p, pmax, pmin;
int bigrow, p_varies = 0;
int err;
err = LLC_check_plist(plist, N, &pmax, &pmin, &pbar);
if (err) {
return err;
}
/* the 'case' (1 = no const, 2 = const, 3 = const + trend */
m = 2; /* the default */
if (opt & OPT_N) {
/* --nc */
m = 1;
} else if (opt & OPT_T) {
/* --ct */
m = 3;
}
/* does p vary by individual? */
if (pmax > pmin) {
p_varies = 1;
}
p = pmax;
/* the max number of regressors */
k = m + pmax;
t1 = t2 = 0;
/* check that we have a useable common sample */
for (i=0; i<N && !err; i++) {
int pt1 = (i + u0) * dset->pd;
int t1i, t2i;
dset->t1 = pt1;
dset->t2 = dset->t1 + dset->pd - 1;
err = series_adjust_sample(dset->Z[vnum], &dset->t1, &dset->t2);
t1i = dset->t1 - pt1;
t2i = dset->t2 - pt1;
if (i == 0) {
t1 = t1i;
t2 = t2i;
} else if (t1i != t1 || t2i != t2) {
err = E_MISSDATA;
break;
}
}
if (!err) {
err = LLC_sample_check(N, t1, t2, m, plist, &NT);
}
if (!err) {
int Tbar = NT / N;
/* the biggest T we'll need for regressions */
T = t2 - t1 + 1 - (1 + pmin);
/* Bartlett lag truncation (Andrews, 1991) */
K = (int) floor(3.21 * pow(Tbar, 1.0/3));
if (K > Tbar - 3) {
K = Tbar - 3;
}
/* full length of dy vector */
dyT = t2 - t1;
B = gretl_matrix_block_new(&y, T, 1,
&yavg, T+1+p, 1,
&dy, dyT, 1,
&X, T, k,
&b, k, 1,
&ui, T, 1,
&ei, T, 1,
&vi, T, 1,
&e, NT, 1,
&v, NT, 1,
&eps, NT, 1,
NULL);
if (B == NULL) {
err = E_ALLOC;
}
}
if (err) {
return err;
}
if (m > 1) {
/* constant in first column, if wanted */
for (t=0; t<T; t++) {
gretl_matrix_set(X, t, 0, 1.0);
}
}
if (m == 3) {
/* trend in second column, if wanted */
for (t=0; t<T; t++) {
gretl_matrix_set(X, t, 1, t+1);
}
}
gretl_matrix_zero(yavg);
/* compute period sums of y for time-demeaning */
for (i=0; i<N; i++) {
pt1 = t1 + (i + u0) * dset->pd;
pt2 = t2 + (i + u0) * dset->pd;
s = 0;
for (t=pt1; t<=pt2; t++) {
yavg->val[s++] += dset->Z[vnum][t];
}
}
gretl_matrix_divide_by_scalar(yavg, N);
bigrow = 0;
for (i=0; i<N && !err; i++) {
double yti, yti_1;
int p_i, T_i, k_i;
int pt0, ss;
if (p_varies) {
p_i = plist[i+1];
T_i = t2 - t1 + 1 - (1 + p_i);
k_i = m + p_i;
gretl_matrix_reuse(y, T_i, 1);
gretl_matrix_reuse(X, T_i, k_i);
gretl_matrix_reuse(b, k_i, 1);
gretl_matrix_reuse(ei, T_i, 1);
gretl_matrix_reuse(vi, T_i, 1);
} else {
p_i = p;
T_i = T;
k_i = k;
}
/* indices into Z array */
pt1 = t1 + (i + u0) * dset->pd;
pt2 = t2 + (i + u0) * dset->pd;
pt0 = pt1 + 1 + p_i;
/* build (full length) \delta y_t in dy */
s = 0;
for (t=pt1+1; t<=pt2; t++) {
ss = t - pt1;
yti = dset->Z[vnum][t] - gretl_vector_get(yavg, ss);
yti_1 = dset->Z[vnum][t-1] - gretl_vector_get(yavg, ss-1);
gretl_vector_set(dy, s++, yti - yti_1);
}
/* build y_{t-1} in y */
s = 0;
for (t=pt0; t<=pt2; t++) {
yti_1 = dset->Z[vnum][t-1] - gretl_vector_get(yavg, t - pt1 - 1);
gretl_vector_set(y, s++, yti_1);
}
/* augmented case: write lags of dy into X */
for (j=1; j<=p_i; j++) {
int col = m + j - 2;
double dylag;
s = 0;
for (t=pt0; t<=pt2; t++) {
dylag = gretl_vector_get(dy, t - pt1 - 1 - j);
gretl_matrix_set(X, s++, col, dylag);
}
}
/* set lagged y as last regressor */
for (t=0; t<T_i; t++) {
gretl_matrix_set(X, t, k_i - 1, y->val[t]);
}
#if LLC_DEBUG > 1
gretl_matrix_print(dy, "dy");
gretl_matrix_print(y, "y1");
gretl_matrix_print(X, "X");
#endif
if (p_i > 0) {
/* "virtual trimming" of dy for regressions */
dy->val += p_i;
dy->rows -= p_i;
}
/* run (A)DF regression */
err = gretl_matrix_ols(dy, X, b, NULL, ui, NULL);
if (err) {
break;
}
if (k_i > 1) {
/* reduced regressor matrix for auxiliary regressions:
omit the last column containing the lagged level of y
*/
gretl_matrix_reuse(X, T_i, k_i - 1);
gretl_matrix_reuse(b, k_i - 1, 1);
err = gretl_matrix_ols(dy, X, b, NULL, ei, NULL);
if (!err) {
err = gretl_matrix_ols(y, X, b, NULL, vi, NULL);
}
gretl_matrix_reuse(X, T, k);
gretl_matrix_reuse(b, k, 1);
} else {
/* no auxiliary regressions required */
gretl_matrix_copy_values(ei, dy);
gretl_matrix_copy_values(vi, y);
}
if (p_i > 0) {
/* restore dy to full length */
dy->val -= p_i;
dy->rows += p_i;
}
if (!err) {
double sui, s2yi, s2ui = 0.0;
for (t=0; t<T_i; t++) {
s2ui += ui->val[t] * ui->val[t];
}
s2ui /= (T_i - 1);
sui = sqrt(s2ui);
/* write normalized per-unit ei and vi into big matrices */
gretl_matrix_divide_by_scalar(ei, sui);
gretl_matrix_divide_by_scalar(vi, sui);
gretl_matrix_inscribe_matrix(e, ei, bigrow, 0, GRETL_MOD_NONE);
gretl_matrix_inscribe_matrix(v, vi, bigrow, 0, GRETL_MOD_NONE);
bigrow += T_i;
s2yi = LLC_lrvar(dy, K, m, &err);
if (!err) {
/* cumulate ratio of LR std dev to innovation std dev */
SN += sqrt(s2yi) / sui;
}
#if LLC_DEBUG
pprintf(prn, "s2ui = %.8f, s2yi = %.8f\n", s2ui, s2yi);
#endif
}
if (p_varies) {
gretl_matrix_reuse(y, T, 1);
gretl_matrix_reuse(X, T, k);
gretl_matrix_reuse(b, k, 1);
gretl_matrix_reuse(ei, T, 1);
gretl_matrix_reuse(vi, T, 1);
}
}
if (!err) {
/* the final step: full-length regression of e on v */
double ee = 0, vv = 0;
double delta, s2e, STD, td;
double mstar, sstar;
gretl_matrix_reuse(b, 1, 1);
err = gretl_matrix_ols(e, v, b, NULL, eps, NULL);
if (!err) {
for (t=0; t<NT; t++) {
ee += eps->val[t] * eps->val[t];
vv += v->val[t] * v->val[t];
}
SN /= N;
delta = b->val[0];
s2e = ee / NT;
STD = sqrt(s2e) / sqrt(vv);
td = delta / STD;
/* fetch the Levin-Lin-Chu corrections factors */
err = get_LLC_corrections(T, m, &mstar, &sstar);
}
if (!err) {
double z = (td - NT * (SN / s2e) * STD * mstar) / sstar;
double pval = normal_cdf(z);
#if LLC_DEBUG
pprintf(prn, "mustar = %g, sigstar = %g\n", mstar, sstar);
pprintf(prn, "SN = %g, se = %g, STD = %g\n", SN, sqrt(s2e), STD);
#endif
if (!(opt & OPT_Q)) {
const char *heads[] = {
N_("coefficient"),
N_("t-ratio"),
N_("z-score")
};
const char *s = dset->varname[vnum];
char NTstr[32];
int sp[3] = {0, 3, 5};
int w[3] = {4, 6, 0};
pputc(prn, '\n');
pprintf(prn, _("Levin-Lin-Chu pooled ADF test for %s\n"), s);
pprintf(prn, "%s ", _(DF_test_spec(m)));
if (p_varies) {
pprintf(prn, _("including %.2f lags of (1-L)%s (average)"), pbar, s);
} else if (p == 1) {
pprintf(prn, _("including one lag of (1-L)%s"), s);
} else {
pprintf(prn, _("including %d lags of (1-L)%s"), p, s);
}
pputc(prn, '\n');
pprintf(prn, _("Bartlett truncation at %d lags\n"), K);
sprintf(NTstr, "N,T = (%d,%d)", N, dyT + 1);
pprintf(prn, _("%s, using %d observations"), NTstr, NT);
pputs(prn, "\n\n");
for (i=0; i<3; i++) {
pputs(prn, _(heads[i]));
bufspace(w[i], prn);
w[i] = sp[i] + g_utf8_strlen(_(heads[i]), -1);
}
pputc(prn, '\n');
pprintf(prn, "%*.5g %*.3f %*.6g [%.4f]\n\n",
w[0], delta, w[1], td, w[2], z, pval);
}
record_test_result(z, pval, "Levin-Lin-Chu");
}
}
gretl_matrix_block_destroy(B);
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;
}
void process_pipes_cmd(struct pipes_cmd *pcmd, int task)
{
struct pipes_res *res= NULL;
struct pipe *p = NULL;
// check for open
if(pcmd->command == PIPES_OPENSHARED)
{
// create a new shared pipe
struct pipe *p = (struct pipe*)malloc(sizeof(struct pipe));
p->id = get_new_pipeid();
p->type = PIPES_SHAREDPIPE;
p->taskid = ((struct pipes_openshared*)pcmd)->task1;
p->taskid2 = ((struct pipes_openshared*)pcmd)->task2;
p->pf = NULL;
p->creating_task = task;
p->pending = 0;
p->task1_closed = 0;
p->task2_closed = 0;
p->buffer = (struct pipe_buffer*)malloc(sizeof(struct pipe_buffer));
p->buffer->rcursor = p->buffer->wcursor = p->buffer->size = 0;
init(&p->buffer->blocks);
avl_insert(&pipes, p, p->id);
res = build_response_msg(PIPESERR_OK);
((struct pipes_open_res*)res)->pipeid = p->id;
}
else if(pcmd->command == PIPES_OPENFILE)
{
// create a new file pipe
struct pipe *p = (struct pipe*)malloc(sizeof(struct pipe));
char *filepath = get_string(((struct pipes_openfile*)pcmd)->path_smo);
p->id = get_new_pipeid();
p->type = PIPES_FILEPIPE;
p->taskid = ((struct pipes_openshared*)pcmd)->task1;
p->taskid2 = -1;
p->pf = fopen(filepath, (char*)((struct pipes_openfile*)pcmd)->open_mode);
p->creating_task = task;
p->buffer = NULL;
p->pending = 0;
if(p->pf != NULL)
{
avl_insert(&pipes, p, p->id);
res = build_response_msg(PIPESERR_OK);
((struct pipes_open_res*)res)->pipeid = p->id;
}
else
{
res = build_response_msg(PIPESERR_FSERROR);
free(p);
}
free(filepath);
}
else
{
p = (struct pipe*)avl_getvalue(pipes, ((struct pipes_close*)pcmd)->pipeid);
if(p != NULL)
{
/* Check permissions */
switch(pcmd->command)
{
case PIPES_CLOSE:
// a shared pipe must be closed on both ends or by the creating task
if(p->type == PIPES_SHAREDPIPE)
{
if(task != p->taskid && task != p->taskid2 && task != p->creating_task)
{
res = build_response_msg(PIPESERR_ERR);
}
else if((task == p->taskid && p->task1_closed) || (task == p->taskid2 && p->task2_closed))
{
res = build_response_msg(PIPESERR_PIPECLOSED);
}
}
else if(p->type == PIPES_FILEPIPE && task != p->taskid)
{
res = build_response_msg(PIPESERR_ERR);
}
break;
case PIPES_SEEK:
case PIPES_TELL:
break;
case PIPES_WRITE:
case PIPES_PUTS:
case PIPES_PUTC:
if(p->type == PIPES_SHAREDPIPE && task != p->taskid)
{
res = build_response_msg(PIPESERR_ERR);
}
break;
case PIPES_READ:
case PIPES_GETS:
case PIPES_GETC:
if(p->type == PIPES_SHAREDPIPE && task != p->taskid2)
{
res = build_response_msg(PIPESERR_ERR);
}
break;
default:
res = build_response_msg(PIPESERR_ERR);
}
if(res != NULL)
{
res->thr_id = pcmd->thr_id;
res->command = pcmd->command;
send_msg(task, pcmd->ret_port, res);
return;
}
/* Process pipe command */
switch(pcmd->command)
{
case PIPES_CLOSE:
res = pclose((struct pipes_close *)pcmd, p, task);
if(res->ret == PIPESERR_OK) p = NULL;
break;
case PIPES_READ:
res = pread((struct pipes_read *)pcmd, p);
break;
case PIPES_WRITE:
res = pwrite((struct pipes_write *)pcmd, p);
break;
case PIPES_SEEK:
res = pseek((struct pipes_seek *)pcmd, p, task);
break;
case PIPES_TELL:
res = ptell((struct pipes_tell *)pcmd, p, task);
break;
case PIPES_PUTS:
res = pputs((struct pipes_puts *)pcmd, p);
break;
case PIPES_PUTC:
res = pputc((struct pipes_putc *)pcmd, p);
break;
case PIPES_GETS:
res = pgets((struct pipes_gets *)pcmd, p);
break;
case PIPES_GETC:
res = pgetc((struct pipes_getc *)pcmd, p);
break;
default:
res = build_response_msg(PIPESERR_ERR);
}
}
else
{
res = build_response_msg(PIPESERR_PIPECLOSED);
}
}
if(p == NULL || (p != NULL && !(p->pending && (pcmd->command == PIPES_READ
|| (pcmd->command == PIPES_SEEK && task == p->taskid2)
|| pcmd->command == PIPES_GETS
|| pcmd->command == PIPES_GETC))))
{
if(res == NULL)
{
res = build_response_msg(PIPESERR_ERR);
}
res->thr_id = pcmd->thr_id;
res->command = pcmd->command;
send_msg(task, pcmd->ret_port, res);
if(res != NULL) free(res);
}
else
{
// check pending read
if(p != NULL && p->pending && (pcmd->command == PIPES_WRITE
|| (pcmd->command == PIPES_SEEK && task == p->taskid2)
|| pcmd->command == PIPES_READ
|| pcmd->command == PIPES_PUTS
|| pcmd->command == PIPES_PUTC))
{
// process the pending message
process_pending(p);
}
send_msg(task, pcmd->ret_port, res);
if(res != NULL) free(res);
}
}
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;
}
