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; }