1 /*
2 * gretl -- Gnu Regression, Econometrics and Time-series Library
3 * Copyright (C) 2001 Allin Cottrell and Riccardo "Jack" Lucchetti
4 *
5 * This program is free software: you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation, either version 3 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 *
18 */
19
20 /* printout.c - simple text print routines for some gretl structs */
21
22 #include "libgretl.h"
23 #include "version.h"
24 #include "libset.h"
25 #include "forecast.h"
26 #include "gretl_func.h"
27 #include "uservar.h"
28 #include "gretl_string_table.h"
29 #include "gretl_midas.h"
30 #include "matrix_extra.h"
31
32 #include <time.h>
33
34 #define PDEBUG 0
35
36 static int gretl_digits = 6;
37
38 static int get_print_range (int len, int *start, int *stop);
39
bufspace(int n,PRN * prn)40 void bufspace (int n, PRN *prn)
41 {
42 while (n-- > 0) {
43 pputc(prn, ' ');
44 }
45 }
46
47 /**
48 * printxx:
49 * @xx: number to print.
50 * @str: buffer into which to print.
51 * @ci: command index (PRINT or SUMMARY).
52 *
53 * Print a string representation of the double-precision value @xx
54 * to the buffer @str, in a format that depends on @ci.
55 */
56
printxx(const double xx,char * str,int ci)57 static void printxx (const double xx, char *str, int ci)
58 {
59 int d = (ci == PRINT)? 8 : 6;
60
61 sprintf(str, "%#*.*g", d, gretl_digits, xx);
62 }
63
covhdr(PRN * prn)64 static void covhdr (PRN *prn)
65 {
66 pprintf(prn, "%s:\n\n",
67 _("Covariance matrix of regression coefficients"));
68 }
69
70 /**
71 * session_time:
72 * @prn: where to print.
73 *
74 * Print the current time to the specified printing object,
75 * or to %stdout if @prn is %NULL.
76 */
77
session_time(PRN * prn)78 void session_time (PRN *prn)
79 {
80 char timestr[48];
81 PRN *myprn = NULL;
82
83 if (prn == NULL) {
84 myprn = gretl_print_new(GRETL_PRINT_STDOUT, NULL);
85 prn = myprn;
86 }
87
88 print_time(timestr);
89 pprintf(prn, "%s: %s\n", _("Current session"), timestr);
90
91 if (myprn != NULL) {
92 gretl_print_destroy(myprn);
93 }
94 }
95
96 /**
97 * logo:
98 * @quiet: if non-zero, just print version ID, else print
99 * copyright info also.
100 *
101 * Print to stdout gretl version information.
102 */
103
logo(int quiet)104 void logo (int quiet)
105 {
106 printf(_("gretl version %s\n"), GRETL_VERSION);
107
108 if (!quiet) {
109 puts(_("Copyright Ramu Ramanathan, Allin Cottrell and Riccardo \"Jack\" Lucchetti"));
110 puts(_("This is free software with ABSOLUTELY NO WARRANTY"));
111 }
112 }
113
114 /**
115 * gui_logo:
116 * @prn: where to print.
117 *
118 * Print gretl GUI version information to the specified printing
119 * object, or to %stdout if @prn is %NULL.
120 */
121
gui_logo(PRN * prn)122 void gui_logo (PRN *prn)
123 {
124 PRN *myprn = NULL;
125
126 if (prn == NULL) {
127 myprn = gretl_print_new(GRETL_PRINT_STDOUT, NULL);
128 prn = myprn;
129 }
130
131 pprintf(prn, _("gretl: gui client for gretl version %s,\n"), GRETL_VERSION);
132 pputs(prn, _("Copyright Allin Cottrell and Riccardo \"Jack\" Lucchetti"));
133 pputc(prn, '\n');
134 pputs(prn, _("This is free software with ABSOLUTELY NO WARRANTY"));
135 pputc(prn, '\n');
136
137 if (myprn != NULL) {
138 gretl_print_destroy(myprn);
139 }
140 }
141
142 /**
143 * lib_logo:
144 *
145 * Print gretl library version information to stdout.
146 */
147
lib_logo(void)148 void lib_logo (void)
149 {
150 printf("\nLibgretl-1.0, revision %d\n", LIBGRETL_REVISION);
151 }
152
153 /**
154 * gui_script_logo:
155 * @prn: gretl printing struct.
156 *
157 * Print to @prn a header for script output in gui program.
158 */
159
gui_script_logo(PRN * prn)160 void gui_script_logo (PRN *prn)
161 {
162 char timestr[48];
163
164 pprintf(prn, _("gretl version %s\n"), GRETL_VERSION);
165 print_time(timestr);
166 pprintf(prn, "%s: %s\n", _("Current session"), timestr);
167 pputc(prn, '\n');
168 }
169
170 /* ----------------------------------------------------- */
171
172 static void
print_coeff_interval(const CoeffIntervals * cf,int i,PRN * prn)173 print_coeff_interval (const CoeffIntervals *cf, int i, PRN *prn)
174 {
175 int n = strlen(cf->names[i]);
176
177 if (n > 16) {
178 pprintf(prn, "%.15s~ ", cf->names[i]);
179 bufspace(3, prn);
180 } else {
181 pprintf(prn, "%14s ", cf->names[i]);
182 bufspace(5, prn);
183 }
184
185 if (isnan(cf->coeff[i])) {
186 pprintf(prn, "%*s", UTF_WIDTH(_("undefined"), 16), _("undefined"));
187 } else {
188 gretl_print_value(cf->coeff[i], prn);
189 }
190
191 if (isnan(cf->maxerr[i])) {
192 pprintf(prn, "%*s", UTF_WIDTH(_("undefined"), 10), _("undefined"));
193 } else {
194 pprintf(prn, " %#12.6g %#12.6g",
195 cf->coeff[i] - cf->maxerr[i],
196 cf->coeff[i] + cf->maxerr[i]);
197 }
198
199 pputc(prn, '\n');
200 }
201
202 /**
203 * print_centered:
204 * @s: string to print.
205 * @width: width of field.
206 * @prn: gretl printing struct.
207 *
208 * If the string @s is shorter than width, print it centered
209 * in a field of the given width (otherwise just print it
210 * straight).
211 */
212
print_centered(const char * s,int width,PRN * prn)213 void print_centered (const char *s, int width, PRN *prn)
214 {
215 int rem = width - strlen(s);
216
217 if (rem <= 1) {
218 pprintf(prn, "%s", s);
219 } else {
220 int i, off = rem / 2;
221
222 for (i=0; i<off; i++) {
223 pputs(prn, " ");
224 }
225 pprintf(prn, "%-*s", width - off, s);
226 }
227 }
228
229 /**
230 * max_obs_marker_length:
231 * @dset: dataset information.
232 *
233 * Returns: the length of the longest observation marker
234 * within the current sample range.
235 */
236
max_obs_marker_length(const DATASET * dset)237 int max_obs_marker_length (const DATASET *dset)
238 {
239 char s[OBSLEN];
240 int t, n, nmax = 0;
241
242 if (dset->S != NULL) {
243 /* we have specific observation strings */
244 for (t=dset->t1; t<=dset->t2; t++) {
245 get_obs_string(s, t, dset);
246 n = g_utf8_strlen(s, -1);
247 if (n > nmax) {
248 nmax = n;
249 }
250 if (nmax == OBSLEN - 1) {
251 break;
252 }
253 }
254 } else if (dated_daily_data(dset)) {
255 get_obs_string(s, dset->t2, dset);
256 nmax = strlen(s);
257 } else if (dataset_is_time_series(dset)) {
258 switch (dset->pd) {
259 case 1: /* annual: YYYY */
260 case 10: /* decennial: YYYY */
261 nmax = 4;
262 break;
263 case 4: /* quarterly: YYYY:Q */
264 nmax = 6;
265 break;
266 case 12: /* monthly: YYYY:MM */
267 nmax = 7;
268 break;
269 default:
270 break;
271 }
272 if (nmax == 0) {
273 get_obs_string(s, dset->t2, dset);
274 nmax = strlen(s);
275 }
276 } else {
277 int T = dset->t2 - dset->t1 + 1;
278 int incr = (T < 120)? 1 : (T / 100.0);
279
280 for (t=dset->t1; t<=dset->t2; t+=incr) {
281 get_obs_string(s, t, dset);
282 n = strlen(s);
283 if (n > nmax) {
284 nmax = n;
285 }
286 }
287 }
288
289 return nmax;
290 }
291
292 /**
293 * text_print_model_confints:
294 * @cf: pointer to confidence intervals.
295 * @prn: gretl printing struct.
296 *
297 * Print to @prn the 95 percent confidence intervals for parameter
298 * estimates contained in @cf.
299 */
300
text_print_model_confints(const CoeffIntervals * cf,PRN * prn)301 void text_print_model_confints (const CoeffIntervals *cf, PRN *prn)
302 {
303 double tail = cf->alpha / 2;
304 int i;
305
306 if (cf->asy) {
307 pprintf(prn, "z(%g) = %.4f\n\n", tail, cf->t);
308 } else {
309 pprintf(prn, "t(%d, %g) = %.3f\n\n", cf->df, tail, cf->t);
310 }
311
312 /* xgettext:no-c-format */
313 pprintf(prn, _(" VARIABLE COEFFICIENT %g%% CONFIDENCE "
314 "INTERVAL\n\n"), 100 * (1 - cf->alpha));
315
316 for (i=0; i<cf->ncoeff; i++) {
317 print_coeff_interval(cf, i, prn);
318 }
319
320 pputc(prn, '\n');
321 }
322
print_freq_test(const FreqDist * freq,PRN * prn)323 void print_freq_test (const FreqDist *freq, PRN *prn)
324 {
325 double pval = NADBL;
326
327 if (freq->dist == D_NORMAL) {
328 pval = chisq_cdf_comp(2, freq->test);
329 pprintf(prn, "\n%s:\n",
330 _("Test for null hypothesis of normal distribution"));
331 pprintf(prn, "%s(2) = %.3f %s %.5f\n",
332 _("Chi-square"), freq->test,
333 _("with p-value"), pval);
334 } else if (freq->dist == D_GAMMA) {
335 pval = normal_pvalue_2(freq->test);
336 pprintf(prn, "\n%s:\n",
337 _("Test for null hypothesis of gamma distribution"));
338 pprintf(prn, "z = %.3f %s %.5f\n", freq->test,
339 _("with p-value"), pval);
340 }
341
342 pputc(prn, '\n');
343
344 if (!na(pval)) {
345 record_test_result(freq->test, pval);
346 }
347 }
348
349 /**
350 * print_freq:
351 * @freq: gretl frequency distribution struct.
352 * @varno: ID number of the series in question.
353 * @dset: pointer to dataset.
354 * @prn: gretl printing struct.
355 *
356 * Print frequency distribution to @prn.
357 */
358
print_freq(const FreqDist * freq,int varno,const DATASET * dset,PRN * prn)359 void print_freq (const FreqDist *freq, int varno, const DATASET *dset,
360 PRN *prn)
361 {
362 int i, k, nlw, K;
363 int total, valid;
364 char word[64];
365 double f, cumf = 0;
366
367 if (freq == NULL) {
368 return;
369 }
370
371 K = freq->numbins - 1;
372 valid = freq->n;
373 total = freq->t2 - freq->t1 + 1;
374
375 pprintf(prn, _("\nFrequency distribution for %s, obs %d-%d\n"),
376 freq->varname, freq->t1 + 1, freq->t2 + 1);
377
378 if (freq->numbins == 0) {
379 if (!na(freq->test)) {
380 print_freq_test(freq, prn);
381 }
382 return;
383 }
384
385 if (freq->strvals) {
386 int len, maxlen = 0;
387
388 for (i=0; i<freq->numbins; i++) {
389 /* FIXME UTF-8? */
390 len = g_utf8_strlen(freq->S[i], -1);
391 if (len > maxlen) {
392 maxlen = len;
393 }
394 }
395 len = maxlen > 31 ? 31 : maxlen < 10 ? 10 : maxlen;
396
397 pputc(prn, '\n');
398 bufspace(len, prn);
399 pputs(prn, _("frequency percent\n\n"));
400 for (k=0; k<=K; k++) {
401 *word = '\0';
402 gretl_utf8_strncat(word, freq->S[k], len-2);
403 pputs(prn, word);
404 nlw = len - g_utf8_strlen(word, -1);
405 bufspace(nlw, prn);
406 pprintf(prn, "%6d ", freq->f[k]);
407 f = 100.0 * freq->f[k] / valid;
408 pprintf(prn, " %6.2f%% ", f);
409 if (f < 100) {
410 i = 0.36 * f;
411 while (i--) {
412 pputc(prn, '*');
413 }
414 }
415 pputc(prn, '\n');
416 }
417 } else if (freq->discrete) {
418 pputs(prn, _("\n frequency rel. cum.\n\n"));
419 for (k=0; k<=K; k++) {
420 sprintf(word, "%4g", freq->midpt[k]);
421 pputs(prn, word);
422 nlw = 10 - strlen(word);
423 bufspace(nlw, prn);
424 pprintf(prn, "%6d ", freq->f[k]);
425 f = 100.0 * freq->f[k] / valid;
426 cumf += f;
427 pprintf(prn, " %6.2f%% %7.2f%% ", f, cumf);
428 if (f < 100) {
429 i = 0.36 * f;
430 while (i--) {
431 pputc(prn, '*');
432 }
433 }
434 pputc(prn, '\n');
435 }
436 } else {
437 int digits = 5;
438 int someneg = 0, somemneg = 0;
439 int len, xlen, mxlen;
440 double x;
441
442 pprintf(prn, _("number of bins = %d, mean = %g, sd = %g\n"),
443 freq->numbins, freq->xbar, freq->sdx);
444 pputs(prn,
445 _("\n interval midpt frequency rel. cum.\n\n"));
446
447 tryagain:
448
449 xlen = mxlen = 0;
450
451 for (k=0; k<=K; k++) {
452 x = freq->endpt[k];
453 if (x < 0) {
454 someneg = 1;
455 }
456 sprintf(word, "%#.*g", digits, x);
457 len = strlen(word);
458 if (len > xlen) {
459 xlen = len;
460 }
461 x = freq->midpt[k];
462 if (x < 0) {
463 somemneg = 1;
464 }
465 sprintf(word, "%#.*g", digits, x);
466 len = strlen(word);
467 if (len > mxlen) {
468 mxlen = len;
469 }
470 }
471
472 if (xlen > 10 && digits == 5) {
473 digits--;
474 goto tryagain;
475 }
476
477 xlen++;
478 xlen = (xlen > 10)? xlen : 10;
479
480 mxlen++;
481 mxlen = (mxlen > 10)? mxlen : 10;
482
483 for (k=0; k<=K; k++) {
484 *word = '\0';
485 if (k == 0) {
486 pprintf(prn, "%*s", xlen + 3, " < ");
487 } else if (k == K) {
488 pprintf(prn, "%*s", xlen + 3, ">= ");
489 } else {
490 sprintf(word, "%#.*g", digits, freq->endpt[k]);
491 pprintf(prn, "%*s", xlen, word);
492 pputs(prn, " - ");
493 }
494
495 x = (k == K && K > 0)? freq->endpt[k] : freq->endpt[k+1];
496 if (x > 0 && someneg) {
497 sprintf(word, " %#.*g", digits, x);
498 } else {
499 sprintf(word, "%#.*g", digits, x);
500 }
501 pprintf(prn, "%-*s", xlen, word);
502
503 x = freq->midpt[k];
504 if (x > 0 && somemneg) {
505 sprintf(word, " %#.*g", digits, x);
506 } else {
507 sprintf(word, "%#.*g", digits, x);
508 }
509 pprintf(prn, "%-*s", mxlen, word);
510
511 pprintf(prn, "%6d ", freq->f[k]);
512
513 f = 100.0 * freq->f[k] / valid;
514 cumf += f;
515 pprintf(prn, " %6.2f%% %7.2f%% ", f, cumf);
516 i = 0.36 * f;
517 if (K > 1) {
518 while (i--) {
519 pputc(prn, '*');
520 }
521 }
522 pputc(prn, '\n');
523 }
524 }
525
526 if (valid < total) {
527 int missing = total - valid;
528
529 pprintf(prn, "\n%s = %d (%5.2f%%)\n", _("Missing observations"),
530 missing, 100 * (double) missing / total);
531 }
532
533 if (!na(freq->test)) {
534 print_freq_test(freq, prn);
535 } else {
536 pputc(prn, '\n');
537 }
538 }
539
tex_xtab_heading(const Xtab * tab,PRN * prn)540 static void tex_xtab_heading (const Xtab *tab, PRN *prn)
541 {
542 char s1[9 + VNAMELEN * 2] = {0};
543 char s2[9 + VNAMELEN * 2] = {0};
544 const char *src;
545 char *targ;
546 int i, j, k;
547
548 strcpy(s1, "\\texttt{");
549 strcpy(s2, "\\texttt{");
550
551 /* fix any underscores in series names */
552 for (k=0; k<2; k++) {
553 targ = k == 0 ? s1 : s2;
554 src = k == 0 ? tab->rvarname : tab->cvarname;
555 for (i=0, j=8; src[i]; i++, j++) {
556 if (src[i] == '_') {
557 strcat(targ, "\\_");
558 j++;
559 } else {
560 targ[j] = src[i];
561 }
562 }
563 strcat(targ, "}");
564 }
565
566 pprintf(prn, _("Cross-tabulation of %s (rows) against %s (columns)"),
567 s1, s2);
568 pputs(prn, "\n\n\\vspace{1em}\n\n");
569 }
570
row_strlen(const Xtab * tab)571 static int row_strlen (const Xtab *tab)
572 {
573 int i, n, nmax = 0;
574
575 for (i=0; i<tab->rows; i++) {
576 n = g_utf8_strlen(tab->Sr[i], -1);
577 if (n > nmax) {
578 nmax = n;
579 }
580 }
581
582 return nmax;
583 }
584
col_strlen(const Xtab * tab)585 static int col_strlen (const Xtab *tab)
586 {
587 int j, n, nmax = 0;
588
589 for (j=0; j<tab->cols; j++) {
590 n = g_utf8_strlen(tab->Sc[j], -1);
591 if (n > nmax) {
592 nmax = n;
593 }
594 }
595
596 return nmax;
597 }
598
599 /* allow for wider columns when cell counts are large numbers */
600
get_xtab_col_widths(const Xtab * tab,int stdwidth,int * cwidth,int * twidth)601 static void get_xtab_col_widths (const Xtab *tab, int stdwidth,
602 int *cwidth, int *twidth)
603 {
604 int i, di, dmax = 0;
605
606 /* column width */
607 for (i=0; i<tab->cols; i++) {
608 di = (int) (floor(log10(tab->ctotal[i])));
609 dmax = di > dmax ? di : dmax;
610 }
611 *cwidth = (dmax >= stdwidth - 2)? dmax + 3 : stdwidth;
612
613 /* totals width */
614 dmax = 0;
615 for (i=0; i<tab->rows; i++) {
616 di = (int) (floor(log10(tab->rtotal[i])));
617 dmax = di > dmax ? di : dmax;
618 }
619 *twidth = (dmax >= stdwidth - 2)? dmax + 3 : stdwidth;
620 }
621
real_print_xtab(const Xtab * tab,const DATASET * dset,gretlopt opt,PRN * prn)622 static void real_print_xtab (const Xtab *tab, const DATASET *dset,
623 gretlopt opt, PRN *prn)
624 {
625 double x, y, cj, ri;
626 int n5 = 0;
627 double ymin = 1.0e-7;
628 double pearson = 0.0;
629 double pval = NADBL;
630 char lbl[64];
631 int rlen = 0;
632 int clen = 0;
633 int cw, tw;
634 int stdw = 6;
635 int totals = 1;
636 int tex = 0;
637 int bold = 0;
638 int i, j;
639
640 if (opt & OPT_T) {
641 /* LaTeX output */
642 tex = 1;
643 if ((opt & OPT_E) && !(tab->rstrs || tab->cstrs)) {
644 /* bold-face equal values */
645 bold = 1;
646 }
647 /* don't bother with chi-square */
648 pearson = NADBL;
649 }
650
651 if (opt & OPT_N) {
652 totals = 0;
653 }
654
655 if (*tab->rvarname != '\0' && *tab->cvarname != '\0') {
656 pputc(prn, '\n');
657 if (tex) {
658 tex_xtab_heading(tab, prn);
659 } else {
660 pprintf(prn, _("Cross-tabulation of %s (rows) against %s (columns)"),
661 tab->rvarname, tab->cvarname);
662 pputs(prn, "\n\n");
663 }
664 } else {
665 pputc(prn, '\n');
666 }
667
668 if (tex) {
669 int nc = tab->cols + 1 + totals;
670
671 pputs(prn, "\\begin{tabular}{");
672 pputs(prn, "r|");
673 for (j=1; j<nc; j++) {
674 pputc(prn, 'r');
675 }
676 pputs(prn, "}\n");
677 }
678
679 if (tex) {
680 pputs(prn, " & ");
681 }
682
683 if (tab->rstrs) {
684 rlen = 2 + row_strlen(tab);
685 if (rlen > 16) {
686 rlen = 16;
687 } else if (rlen < 7) {
688 rlen = 7;
689 }
690 } else {
691 rlen = 7;
692 }
693
694 /* allow for BIG integers */
695 get_xtab_col_widths(tab, stdw, &cw, &tw);
696
697 if (tab->cstrs) {
698 clen = 2 + col_strlen(tab);
699 if (clen > 12) {
700 clen = 12;
701 } else if (clen < cw) {
702 clen = 6;
703 }
704 } else {
705 clen = cw;
706 }
707
708 bufspace(rlen, prn);
709
710 /* header row: column labels */
711
712 for (j=0; j<tab->cols; j++) {
713 if (tab->cstrs) {
714 *lbl = '\0';
715 strncat(lbl, tab->Sc[j], 63);
716 gretl_utf8_truncate(lbl, clen-2);
717 if (tex) {
718 pputs(prn, lbl);
719 } else {
720 bufspace(clen - g_utf8_strlen(lbl, -1), prn);
721 pputs(prn, lbl);
722 }
723 } else {
724 cj = tab->cval[j];
725 if (tex) {
726 pprintf(prn, "%4g", cj);
727 } else {
728 pprintf(prn, "[%*g]", cw-2, cj);
729 }
730 }
731 if (tex) {
732 if (j < tab->cols - 1 || totals) {
733 pputs(prn, " & ");
734 } else {
735 pputs(prn, "\\\\ \\hline\n");
736 }
737 }
738 }
739
740 if (totals) {
741 if (tex) {
742 pprintf(prn,"$\\Sigma$\\\\ \\hline\n");
743 } else {
744 bufspace(2 + (tw - stdw), prn);
745 pprintf(prn,"%s\n \n", _("TOT."));
746 }
747 } else if (!tex) {
748 pputc(prn, '\n');
749 }
750
751 /* body of table */
752
753 for (i=0; i<tab->rows; i++) {
754 if (tab->rtotal[i] == 0) {
755 continue;
756 }
757 if (tab->rstrs) {
758 *lbl = '\0';
759 strncat(lbl, tab->Sr[i], 63);
760 gretl_utf8_truncate(lbl, rlen-2);
761 pputs(prn, lbl);
762 if (!tex) {
763 bufspace(rlen - g_utf8_strlen(lbl, -1), prn);
764 }
765 } else {
766 ri = tab->rval[i];
767 if (tex) {
768 pprintf(prn, "%4g", ri);
769 } else {
770 pprintf(prn, "[%4g] ", ri);
771 }
772 }
773 if (tex) {
774 pputs(prn, " & ");
775 }
776 /* row counts */
777 for (j=0; j<tab->cols; j++) {
778 if (tab->ctotal[j] > 0) {
779 if (tab->f[i][j] || (opt & OPT_Z)) {
780 if (opt & (OPT_C | OPT_R)) {
781 if (opt & OPT_C) {
782 x = 100.0 * tab->f[i][j] / tab->ctotal[j];
783 } else {
784 x = 100.0 * tab->f[i][j] / tab->rtotal[i];
785 }
786 if (tex) {
787 /* FIXME strvals! */
788 if (bold && tab->cval[j] == tab->rval[i]) {
789 pprintf(prn, "\\textbf{%.1f%%%%}", x);
790 } else {
791 pprintf(prn, "%*.1f%%%%", clen, x);
792 }
793 } else {
794 pprintf(prn, "%*.1f%%", clen-1, x);
795 }
796 } else {
797 if (bold && tab->cval[j] == tab->rval[i]) {
798 pprintf(prn, "\\textbf{%d} ", tab->f[i][j]);
799 } else {
800 pprintf(prn, "%*d", clen, tab->f[i][j]);
801 }
802 }
803 } else if (!tex) {
804 bufspace(clen, prn);
805 }
806 if (tex && (totals || j < tab->cols-1)) {
807 pputs(prn, "& ");
808 }
809 }
810 if (!na(pearson)) {
811 /* cumulate chi-square */
812 y = ((double) tab->rtotal[i] * tab->ctotal[j]) / tab->n;
813 if (y < ymin) {
814 pearson = NADBL;
815 } else {
816 x = (double) tab->f[i][j] - y;
817 pearson += x * x / y;
818 if (y >= 5) {
819 n5++;
820 }
821 }
822 }
823 }
824 if (totals) {
825 /* row totals */
826 if (opt & OPT_C) {
827 x = 100.0 * tab->rtotal[i] / tab->n;
828 if (tex) {
829 pprintf(prn, "%5.1f%%%%", x);
830 } else {
831 pprintf(prn, "%5.1f%%", x);
832 }
833 } else {
834 pprintf(prn, "%*d", tw, tab->rtotal[i]);
835 }
836 }
837 /* terminate row */
838 if (tex) {
839 if (totals && i == tab->rows-1) {
840 pputs(prn, "\\\\ [2pt]\n");
841 } else {
842 pputs(prn, "\\\\\n");
843 }
844 } else {
845 pputc(prn, '\n');
846 }
847 }
848
849 /* footer row */
850
851 if (totals) {
852 /* column totals */
853 if (tex) {
854 pputs(prn, "$\\Sigma$ & ");
855 } else {
856 pputc(prn, '\n');
857 pprintf(prn, "%-*s", rlen, _("TOTAL"));
858 }
859 for (j=0; j<tab->cols; j++) {
860 if (opt & OPT_R) {
861 x = 100.0 * tab->ctotal[j] / tab->n;
862 if (tex) {
863 pprintf(prn, "%*.1f%%%%", clen, x);
864 } else {
865 pprintf(prn, "%*.1f%%", clen-1, x);
866 }
867 } else {
868 pprintf(prn, "%*d", clen, tab->ctotal[j]);
869 }
870 if (tex) {
871 pputs(prn, "& ");
872 }
873 }
874 pprintf(prn, "%*d\n", tw, tab->n);
875 }
876
877 if (tex) {
878 pputs(prn, "\\end{tabular}\n");
879 return;
880 }
881
882 /* additional information, if applicable */
883
884 if (tab->missing) {
885 pputc(prn, '\n');
886 pprintf(prn, _("%d missing values"), tab->missing);
887 pputc(prn, '\n');
888 }
889
890 if (na(pearson)) {
891 pputc(prn, '\n');
892 pprintf(prn, _("Pearson chi-square test not computed: some "
893 "expected frequencies were less\n"
894 "than %g\n"), ymin);
895 } else {
896 double n5p = (double) n5 / (tab->rows * tab->cols);
897 int df = (tab->rows - 1) * (tab->cols - 1);
898
899 pval = chisq_cdf_comp(df, pearson);
900 if (na(pval)) {
901 pearson = NADBL;
902 } else {
903 pputc(prn, '\n');
904 pprintf(prn, _("Pearson chi-square test = %g (%d df, p-value = %g)"),
905 pearson, df, pval);
906 pputc(prn, '\n');
907 if (!tex && n5p < 0.80) {
908 /* xgettext:no-c-format */
909 pputs(prn, _("Warning: Less than of 80% of cells had expected "
910 "values of 5 or greater.\n"));
911 }
912 }
913 }
914
915 if (opt & OPT_S) {
916 /* saving Pearson test result */
917 record_test_result(pearson, pval);
918 }
919
920 if (!tex && tab->rows == 2 && tab->cols == 2) {
921 fishers_exact_test(tab, prn);
922 }
923 }
924
925 /**
926 * print_xtab:
927 * @tab: gretl cross-tabulation struct.
928 * @dset: pointer to dataset, or NULL.
929 * @opt: may contain %OPT_R to print row percentages, %OPT_C
930 * to print column percentages, %OPT_Z to display zero entries,
931 * %OPT_T to print as TeX (LaTeX), %OPT_N to omit marginal
932 * totals, %OPT_B to bold-face counts where the row and
933 * column values are equal (TeX only), %OPT_S to record
934 * Pearson test result.
935 * @prn: gretl printing struct.
936 *
937 * Print crosstab to @prn.
938 */
939
print_xtab(const Xtab * tab,const DATASET * dset,gretlopt opt,PRN * prn)940 void print_xtab (const Xtab *tab, const DATASET *dset,
941 gretlopt opt, PRN *prn)
942 {
943 int done = 0;
944
945 if (opt & OPT_T) {
946 /* --tex : are we printing to file? */
947 const char *fname = get_optval_string(XTAB, OPT_T);
948
949 if (fname != NULL && *fname != '\0') {
950 int err = 0;
951 PRN *xprn;
952
953 gretl_maybe_switch_dir(fname);
954 xprn = gretl_print_new_with_filename(fname, &err);
955 if (err) {
956 pprintf(prn, _("Couldn't write to %s"), fname);
957 pputc(prn, '\n');
958 } else {
959 real_print_xtab(tab, dset, opt, xprn);
960 gretl_print_destroy(xprn);
961 }
962 done = 1;
963 }
964 }
965
966 if (!done) {
967 real_print_xtab(tab, dset, opt, prn);
968 }
969 }
970
971 /**
972 * print_smpl:
973 * @dset: data information struct
974 * @fulln: full length of data series, if dataset is
975 * subsampled, or 0 if not applicable/known.
976 * @opt: may include OPT_F to force showing the sample
977 * range even when "messages" are turned off.
978 * @prn: gretl printing struct.
979 *
980 * Prints the current sample information to @prn.
981 */
982
print_smpl(const DATASET * dset,int fulln,gretlopt opt,PRN * prn)983 void print_smpl (const DATASET *dset, int fulln,
984 gretlopt opt, PRN *prn)
985 {
986 if (dset == NULL || dset->v == 0 || prn == NULL) {
987 return;
988 }
989
990 if (!(opt & OPT_F) && !gretl_messages_on()) {
991 /* hush */
992 return;
993 }
994
995 if (fulln && !dataset_is_panel(dset)) {
996 pprintf(prn, _("Full data set: %d observations\n"), fulln);
997 if (sample_size(dset) < dset->n ||
998 (dataset_is_time_series(dset) && dset->sd0 > 1)) {
999 print_sample_obs(dset, prn);
1000 } else {
1001 pprintf(prn, _("Current sample: %d observations\n"),
1002 dset->n);
1003 }
1004 return;
1005 }
1006
1007 if (fulln) {
1008 pprintf(prn, _("Full data set: %d observations\n"), fulln);
1009 } else {
1010 pprintf(prn, "%s: %s - %s (n = %d)\n", _("Full data range"),
1011 dset->stobs, dset->endobs, dset->n);
1012 }
1013
1014 if (dset->t1 > 0 || dset->t2 < dset->n - 1 ||
1015 (fulln && dataset_is_panel(dset))) {
1016 print_sample_obs(dset, prn);
1017 }
1018
1019 pputc(prn, '\n');
1020 }
1021
print_var_smpl(int v,const DATASET * dset,PRN * prn)1022 static void print_var_smpl (int v, const DATASET *dset, PRN *prn)
1023 {
1024 int t, n = 0;
1025
1026 if (dset->t1 > 0 || dset->t2 < dset->n - 1) {
1027 char d1[OBSLEN], d2[OBSLEN];
1028 ntolabel(d1, dset->t1, dset);
1029 ntolabel(d2, dset->t2, dset);
1030
1031 pprintf(prn, "%s: %s - %s", _("Current sample"), d1, d2);
1032 } else {
1033 pprintf(prn, "%s: %s - %s", _("Full data range"),
1034 dset->stobs, dset->endobs);
1035 }
1036
1037 for (t=dset->t1; t<=dset->t2; t++) {
1038 if (!na(dset->Z[v][t])) {
1039 n++;
1040 }
1041 }
1042
1043 pprintf(prn, " (n = %d)\n", n);
1044 }
1045
1046 /**
1047 * gretl_fix_exponent:
1048 * @s: string representation of floating-point number.
1049 *
1050 * Some C libraries (e.g. MS) print an "extra" zero in the exponent
1051 * when using scientific notation, e.g. "1.45E-002". This function
1052 * checks for this and cuts it out if need be.
1053 *
1054 * Returns: the corrected numeric string.
1055 */
1056
gretl_fix_exponent(char * s)1057 char *gretl_fix_exponent (char *s)
1058 {
1059 char *p;
1060 int n;
1061
1062 if ((p = strstr(s, "+00")) || (p = strstr(s, "-00"))) {
1063 if (*(p+3)) {
1064 memmove(p+1, p+2, strlen(p+1));
1065 }
1066 }
1067
1068 n = strlen(s);
1069 if (s[n-1] == '.' || s[n-1] == ',') {
1070 /* delete trailing junk */
1071 s[n-1] = '\0';
1072 }
1073
1074 return s;
1075 }
1076
1077 /* determine the max number of characters that will be output when
1078 printing Z[v] over the current sample range using format %.*f
1079 or %#.*g, with precision 'digits'
1080 */
1081
max_number_length(int v,const DATASET * dset,char fmt,int digits)1082 static int max_number_length (int v, const DATASET *dset,
1083 char fmt, int digits)
1084 {
1085 double a, x, amax = 0.0, amin = 1.0e300;
1086 int t, n, maxsgn = 0, minsgn = 0;
1087
1088 for (t=dset->t1; t<=dset->t2; t++) {
1089 x = dset->Z[v][t];
1090 if (!na(x)) {
1091 a = fabs(x);
1092 if (a > amax) {
1093 amax = a;
1094 maxsgn = (x < 0);
1095 }
1096 if (fmt == 'g' && a < amin) {
1097 amin = a;
1098 minsgn = (x < 0);
1099 }
1100 }
1101 }
1102
1103 if (fmt == 'f') {
1104 if (amax <= 1.0) {
1105 n = 1;
1106 } else {
1107 n = ceil(log10(amax)) + (fmod(amax, 10) == 0);
1108 }
1109 n += digits + 1 + maxsgn;
1110 } else {
1111 double l10 = log10(amax);
1112 int amaxn = digits + 1, aminn = digits + 1;
1113
1114 if (l10 >= digits) {
1115 amaxn += 5 + maxsgn;
1116 }
1117 l10 = log10(amin);
1118 if (l10 < -4) {
1119 aminn += 5 + minsgn;
1120 } else if (l10 < 0) {
1121 aminn += (int) ceil(-l10) + minsgn;
1122 }
1123 n = (amaxn > aminn)? amaxn : aminn;
1124 #if 0
1125 fprintf(stderr, "var %d, amax=%g, amin=%g, n=%d\n",
1126 v, amax, amin, n);
1127 #endif
1128 }
1129
1130 return n;
1131 }
1132
series_column_width(int v,const DATASET * dset,char fmt,int digits)1133 static int series_column_width (int v, const DATASET *dset,
1134 char fmt, int digits)
1135 {
1136 int namelen = strlen(dset->varname[v]);
1137 int numlen = max_number_length(v, dset, fmt, digits);
1138
1139 return (namelen > numlen)? namelen : numlen;
1140 }
1141
1142
1143 /* For some reason sprintf using "%#G" seems to stick an extra
1144 zero on the end of some numbers -- i.e. when using a precision
1145 of 6 you can get a result of "1.000000", with 6 trailing
1146 zeros. The following function checks for this and lops it
1147 off if need be.
1148 */
1149
cut_extra_zero(char * s,int digits)1150 static char *cut_extra_zero (char *s, int digits)
1151 {
1152 if (strchr(s, 'E') == NULL && strchr(s, 'e') == NULL) {
1153 int n = strspn(s, "-.,0");
1154 int m = (strchr(s + n, '.') || strchr(s + n, ','));
1155
1156 s[n + m + digits] = '\0';
1157 }
1158
1159 return s;
1160 }
1161
cut_trailing_point(char * s)1162 static char *cut_trailing_point (char *s)
1163 {
1164 int n = strlen(s);
1165
1166 if (s[n-1] == '.' || s[n-1] == ',') {
1167 s[n-1] = '\0';
1168 }
1169
1170 return s;
1171 }
1172
1173 /* below: targ should be 36 bytes long */
1174
gretl_sprint_fullwidth_double(double x,int digits,char * targ,PRN * prn)1175 void gretl_sprint_fullwidth_double (double x, int digits, char *targ,
1176 PRN *prn)
1177 {
1178 char decpoint;
1179 int n;
1180
1181 *targ = '\0';
1182
1183 if (na(x)) {
1184 strcpy(targ, "NA");
1185 return;
1186 }
1187
1188 decpoint = get_local_decpoint();
1189
1190 if (digits == -4) {
1191 if (x < .0001 && x > 0.0) {
1192 sprintf(targ, "%#.3g", x);
1193 digits = 3;
1194 } else {
1195 sprintf(targ, "%.4f", x);
1196 return;
1197 }
1198 } else {
1199 /* let's not print non-zero values for numbers smaller than
1200 machine zero */
1201 x = screen_zero(x);
1202 sprintf(targ, "%#.*g", digits, x);
1203 }
1204
1205 gretl_fix_exponent(targ);
1206
1207 n = strlen(targ) - 1;
1208 if (targ[n] == decpoint) {
1209 targ[n] = '\0';
1210 }
1211
1212 cut_extra_zero(targ, digits);
1213
1214 if (*targ == '-' && gretl_print_has_minus(prn)) {
1215 char tmp[36];
1216
1217 strcpy(tmp, targ + 1);
1218 *targ = '\0';
1219 strcat(targ, "−"); /* U+2212: minus */
1220 strcat(targ, tmp);
1221 }
1222 }
1223
1224 /* The following function formats a double in such a way that the
1225 decimal point will be printed in the same position for all
1226 numbers printed this way. The total width of the number
1227 string (including possible padding on left or right) is
1228 2 * P + 5 characters, where P denotes the precision ("digits").
1229 */
1230
gretl_print_fullwidth_double(double x,int digits,PRN * prn)1231 void gretl_print_fullwidth_double (double x, int digits, PRN *prn)
1232 {
1233 char numstr[36], final[36];
1234 int totlen = 2 * digits + 5; /* try changing this? */
1235 int i, tmp, forept = 0;
1236 char decpoint;
1237 char *p;
1238
1239 decpoint = get_local_decpoint();
1240
1241 /* let's not print non-zero values for numbers smaller than
1242 machine zero */
1243 x = screen_zero(x);
1244
1245 sprintf(numstr, "%#.*G", digits, x);
1246
1247 gretl_fix_exponent(numstr);
1248
1249 p = strchr(numstr, decpoint);
1250 if (p != NULL) {
1251 forept = p - numstr;
1252 } else {
1253 /* handle case of no decimal point, added Sept 2, 2005 */
1254 forept = strlen(numstr);
1255 }
1256
1257 tmp = digits + 1 - forept;
1258 *final = 0;
1259 for (i=0; i<tmp; i++) {
1260 strcat(final, " ");
1261 }
1262
1263 tmp = strlen(numstr) - 1;
1264 if (numstr[tmp] == decpoint) {
1265 numstr[tmp] = 0;
1266 }
1267
1268 cut_extra_zero(numstr, digits);
1269
1270 strcat(final, numstr);
1271
1272 tmp = totlen - strlen(final);
1273 for (i=0; i<tmp; i++) {
1274 strcat(final, " ");
1275 }
1276
1277 pputs(prn, final);
1278 }
1279
get_gretl_digits(void)1280 int get_gretl_digits (void)
1281 {
1282 return gretl_digits;
1283 }
1284
set_gretl_digits(int d)1285 int set_gretl_digits (int d)
1286 {
1287 if (d >= 3 && d <= 6) {
1288 gretl_digits = d;
1289 return 0;
1290 } else {
1291 /* In the contexts where we're using @gretl_digits
1292 we don't want it to be less than 3 or greater
1293 than 6.
1294 */
1295 return E_INVARG;
1296 }
1297 }
1298
gretl_print_value(double x,PRN * prn)1299 void gretl_print_value (double x, PRN *prn)
1300 {
1301 gretl_print_fullwidth_double(x, gretl_digits, prn);
1302 }
1303
1304 /**
1305 * print_contemporaneous_covariance_matrix:
1306 * @m: covariance matrix.
1307 * @ldet: log-determinant of @m.
1308 * @prn: gretl printing struct.
1309 *
1310 * Print to @prn the covariance matrix @m, with correlations
1311 * above the diagonal, and followed by the log determinant.
1312 */
1313
1314 void
print_contemp_covariance_matrix(const gretl_matrix * m,double ldet,PRN * prn)1315 print_contemp_covariance_matrix (const gretl_matrix *m,
1316 double ldet, PRN *prn)
1317 {
1318 int tex = tex_format(prn);
1319 int rows = gretl_matrix_rows(m);
1320 int cols = gretl_matrix_cols(m);
1321 int jmax = 1;
1322 char numstr[16];
1323 double x;
1324 int i, j;
1325
1326 if (tex) {
1327 pputs(prn, "\\begin{center}\n");
1328 pprintf(prn, "%s \\\\\n", _("Cross-equation VCV for residuals"));
1329 pprintf(prn, "(%s)\n\n", _("correlations above the diagonal"));
1330 pputs(prn, "\\[\n\\begin{array}{");
1331 for (j=0; j<cols; j++) {
1332 pputc(prn, 'c');
1333 }
1334 pputs(prn, "}\n");
1335 } else {
1336 pprintf(prn, "%s\n", _("Cross-equation VCV for residuals"));
1337 pprintf(prn, "(%s)\n\n", _("correlations above the diagonal"));
1338 }
1339
1340 for (i=0; i<rows; i++) {
1341 for (j=0; j<jmax; j++) {
1342 pprintf(prn, "%#13.5g", gretl_matrix_get(m, i, j));
1343 if (tex && j < cols - 1) {
1344 pputs(prn, " & ");
1345 }
1346 }
1347 for (j=jmax; j<cols; j++) {
1348 x = gretl_matrix_get(m, i, i) * gretl_matrix_get(m, j, j);
1349 x = sqrt(x);
1350 x = gretl_matrix_get(m, i, j) / x;
1351 sprintf(numstr,"(%.3f)", x);
1352 pprintf(prn, "%13s", numstr);
1353 if (tex && j < cols - 1) {
1354 pputs(prn, " & ");
1355 }
1356 }
1357 if (tex) {
1358 pputs(prn, "\\\\\n");
1359 } else {
1360 pputc(prn, '\n');
1361 }
1362 if (jmax < cols) {
1363 jmax++;
1364 }
1365 }
1366
1367 if (tex) {
1368 pputs(prn, "\\end{array}\n\\]\n");
1369 }
1370
1371 if (!na(ldet)) {
1372 if (tex) {
1373 if (ldet < 0) {
1374 pprintf(prn, "\n%s = ", _("log determinant"));
1375 pprintf(prn, "$-$%g\n", -ldet);
1376 } else {
1377 pprintf(prn, "\n%s = %g\n", _("log determinant"), ldet);
1378 }
1379 } else {
1380 pprintf(prn, "\n%s = %g\n", _("log determinant"), ldet);
1381 }
1382 }
1383
1384 if (tex) {
1385 pputs(prn, "\n\\end{center}\n");
1386 }
1387 }
1388
1389 /**
1390 * outcovmx:
1391 * @pmod: pointer to model.
1392 * @dset: data information struct.
1393 * @prn: gretl printing struct.
1394 *
1395 * Print to @prn the variance-covariance matrix for the parameter
1396 * estimates in @pmod.
1397 *
1398 * Returns: 0 on successful completion, error code on error.
1399 */
1400
outcovmx(MODEL * pmod,const DATASET * dset,PRN * prn)1401 int outcovmx (MODEL *pmod, const DATASET *dset, PRN *prn)
1402 {
1403 VMatrix *vmat;
1404 int err = 0;
1405
1406 vmat = gretl_model_get_vcv(pmod, dset);
1407
1408 if (vmat == NULL) {
1409 err = E_ALLOC;
1410 } else {
1411 text_print_vmatrix(vmat, prn);
1412 free_vmatrix(vmat);
1413 }
1414
1415 return err;
1416 }
1417
outxx(double x,int ci,int wid,PRN * prn)1418 static void outxx (double x, int ci, int wid, PRN *prn)
1419 {
1420 if (isnan(x) || na(x)) {
1421 if (ci == CORR) {
1422 pprintf(prn, "%*s", UTF_WIDTH(_("NA"), wid),
1423 _("NA"));
1424 } else {
1425 bufspace(wid, prn);
1426 }
1427 } else if (ci == CORR) {
1428 pprintf(prn, " %*.4f", wid - 1, x);
1429 } else {
1430 char numstr[18];
1431
1432 if (x == -0) x = 0.0;
1433
1434 if (x != 0 && x > -0.001 && x < 0.001) {
1435 sprintf(numstr, "%.5e", x);
1436 } else {
1437 sprintf(numstr, "%g", x);
1438 }
1439 gretl_fix_exponent(numstr);
1440 pprintf(prn, "%*s", wid, numstr);
1441 }
1442 }
1443
vmat_maxlen(VMatrix * vmat)1444 static int vmat_maxlen (VMatrix *vmat)
1445 {
1446 int i, len, maxlen = 0;
1447
1448 for (i=0; i<vmat->dim; i++) {
1449 len = strlen(vmat->names[i]);
1450 if (len > maxlen) {
1451 maxlen = len;
1452 }
1453 }
1454
1455 return maxlen;
1456 }
1457
1458 /* Given a one dimensional array which represents a symmetric
1459 matrix, prints out an upper triangular matrix of any size.
1460
1461 Due to screen and printer column limitations the program breaks up
1462 a large upper triangular matrix into 5 variables at a time. For
1463 example, if there were 10 variables the program would first print
1464 an upper triangular matrix of the first 5 rows and columns, then
1465 it would print a rectangular matrix of the first 5 rows but now
1466 columns 6 - 10, and finally an upper triangular matrix of rows 6 -
1467 10 and columns 6 - 10
1468 */
1469
text_print_vmatrix(VMatrix * vmat,PRN * prn)1470 void text_print_vmatrix (VMatrix *vmat, PRN *prn)
1471 {
1472 register int i, j;
1473 int n, nf, li2, p, k, idx, ij2;
1474 int maxlen = 0;
1475 int fwidth = 14;
1476 int fields = 5;
1477 const char *s;
1478
1479 if (vmat->ci != CORR) {
1480 covhdr(prn);
1481 }
1482
1483 maxlen = vmat_maxlen(vmat);
1484 if (maxlen > 10) {
1485 fields = 4;
1486 fwidth = 16;
1487 }
1488
1489 for (i=0; i<=vmat->dim/fields; i++) {
1490 nf = i * fields;
1491 li2 = vmat->dim - nf;
1492 p = (li2 > fields) ? fields : li2;
1493 if (p == 0) break;
1494
1495 /* print the varname headings */
1496 for (j=1; j<=p; ++j) {
1497 s = vmat->names[j + nf - 1];
1498 n = strlen(s);
1499 if (n > fwidth - 1) {
1500 pprintf(prn, " %.*s~", fwidth - 2, s);
1501 } else {
1502 bufspace(fwidth - n, prn);
1503 pputs(prn, s);
1504 }
1505 }
1506 pputc(prn, '\n');
1507
1508 /* print rectangular part, if any, of matrix */
1509 for (j=0; j<nf; j++) {
1510 for (k=0; k<p; k++) {
1511 idx = ijton(j, nf+k, vmat->dim);
1512 outxx(vmat->vec[idx], vmat->ci, fwidth, prn);
1513 }
1514 if (fwidth < 15) pputc(prn, ' ');
1515 n = strlen(vmat->names[j]);
1516 if (n > fwidth - 1) {
1517 pprintf(prn, " %.*s~\n", fwidth - 2, vmat->names[j]);
1518 } else {
1519 pprintf(prn, " %s\n", vmat->names[j]);
1520 }
1521 }
1522
1523 /* print upper triangular part of matrix */
1524 for (j=0; j<p; ++j) {
1525 ij2 = nf + j;
1526 bufspace(fwidth * j, prn);
1527 for (k=j; k<p; k++) {
1528 idx = ijton(ij2, nf+k, vmat->dim);
1529 outxx(vmat->vec[idx], vmat->ci, fwidth, prn);
1530 }
1531 if (fwidth < 15) pputc(prn, ' ');
1532 n = strlen(vmat->names[ij2]);
1533 if (n > fwidth - 1) {
1534 pprintf(prn, " %.*s~\n", fwidth - 2, vmat->names[ij2]);
1535 } else {
1536 pprintf(prn, " %s\n", vmat->names[ij2]);
1537 }
1538 }
1539 pputc(prn, '\n');
1540 }
1541 }
1542
fit_resid_head(const FITRESID * fr,const DATASET * dset,int obslen,PRN * prn)1543 static int fit_resid_head (const FITRESID *fr,
1544 const DATASET *dset,
1545 int obslen,
1546 PRN *prn)
1547 {
1548 char label[32];
1549 char obs1[OBSLEN], obs2[OBSLEN];
1550 int kstep = fr->method == FC_KSTEP;
1551 int ywidth;
1552
1553 if (kstep) {
1554 ntolabel(obs1, fr->model_t1, dset);
1555 pprintf(prn, _("Recursive %d-step ahead forecasts"), fr->k);
1556 pputs(prn, "\n\n");
1557 pprintf(prn, _("The forecast for time t is based on (a) coefficients obtained by\n"
1558 "estimating the model over the sample %s to t-%d, and (b) the\n"
1559 "regressors evaluated at time t."), obs1, fr->k);
1560 pputs(prn, "\n\n");
1561 pputs(prn, _("This is truly a forecast only if all the stochastic regressors\n"
1562 "are in fact lagged values."));
1563 pputs(prn, "\n\n");
1564 } else {
1565 ntolabel(obs1, fr->t1, dset);
1566 ntolabel(obs2, fr->t2, dset);
1567 pprintf(prn, _("Model estimation range: %s - %s"), obs1, obs2);
1568 pputc(prn, '\n');
1569
1570 if (fr->std) {
1571 pprintf(prn, "%s\n", _("The residuals are standardized"));
1572 } else if (!na(fr->sigma)) {
1573 pprintf(prn, "%s = %.*g\n", _("Standard error of the regression"),
1574 gretl_digits, fr->sigma);
1575 }
1576 }
1577
1578 pputc(prn, '\n');
1579 bufspace(obslen, prn);
1580
1581 /* column 1 */
1582 maybe_trim_varname(label, fr->depvar);
1583 ywidth = strlen(label) + 1;
1584 if (ywidth < 13) {
1585 ywidth = 13;
1586 }
1587 pprintf(prn, "%*s", ywidth, label);
1588
1589 /* column 2 */
1590 strcpy(label, (kstep)? _("forecast") : _("fitted"));
1591 pprintf(prn, "%*s", UTF_WIDTH(label, 13), label);
1592
1593 /* column 3 */
1594 strcpy(label, (kstep)? _("error") : _("residual"));
1595 pprintf(prn, "%*s", UTF_WIDTH(label, 13), label);
1596
1597 pputs(prn, "\n\n");
1598
1599 return ywidth;
1600 }
1601
get_series_name(const DATASET * dset,int i,gchar ** altname,int debug)1602 static const char *get_series_name (const DATASET *dset, int i,
1603 gchar **altname, int debug)
1604 {
1605 gchar *showname = NULL;
1606 const char *sname = dset->varname[i];
1607 const char *lname;
1608 const char *ret;
1609
1610 if (debug) {
1611 ret = sname;
1612 } else if (series_is_listarg(dset, i, &lname)) {
1613 if (lname != NULL) {
1614 showname = g_strdup_printf("%s.%s", lname, sname);
1615 *altname = showname;
1616 ret = showname;
1617 } else {
1618 ret = "[masked]";
1619 }
1620 } else {
1621 ret = sname;
1622 }
1623
1624 return ret;
1625 }
1626
1627 /* prints a heading with the names of the variables in @list */
1628
varheading(const int * list,int leader,const int * wid,const DATASET * dset,char delim,PRN * prn)1629 static void varheading (const int *list, int leader,
1630 const int *wid, const DATASET *dset,
1631 char delim, PRN *prn)
1632 {
1633 const char *name;
1634 gchar *tmp;
1635 int i, vi;
1636
1637 if (delim) {
1638 if (leader >= 0) {
1639 pprintf(prn, "obs%c", delim);
1640 }
1641 for (i=1; i<=list[0]; i++) {
1642 vi = list[i];
1643 pputs(prn, dset->varname[vi]);
1644 if (i < list[0]) {
1645 pputc(prn, delim);
1646 }
1647 }
1648 pputc(prn, '\n');
1649 } else if (rtf_format(prn)) {
1650 pputs(prn, "{obs\\cell ");
1651 for (i=1; i<=list[0]; i++) {
1652 vi = list[i];
1653 pprintf(prn, "%s\\cell ", dset->varname[vi]);
1654 }
1655 pputs(prn, "}\n");
1656 } else {
1657 pputc(prn, '\n');
1658 bufspace(leader, prn);
1659 for (i=1; i<=list[0]; i++) {
1660 vi = list[i];
1661 tmp = NULL;
1662 name = get_series_name(dset, vi, &tmp, 0);
1663 pprintf(prn, "%*s", wid[i], name);
1664 g_free(tmp);
1665 }
1666 pputs(prn, "\n\n");
1667 }
1668 }
1669
1670 /**
1671 * gretl_printxn:
1672 * @x: number to print.
1673 * @n: controls width of output.
1674 * @prn: gretl printing struct.
1675 *
1676 * Print a string representation of the double-precision value @x
1677 * in a format that depends on @n.
1678 */
1679
gretl_printxn(double x,int n,PRN * prn)1680 void gretl_printxn (double x, int n, PRN *prn)
1681 {
1682 char s[32];
1683 int ls;
1684
1685 if (na(x)) {
1686 *s = '\0';
1687 } else {
1688 printxx(x, s, PRINT);
1689 }
1690
1691 ls = strlen(s);
1692
1693 pputc(prn, ' ');
1694 bufspace(n - 3 - ls, prn);
1695 pputs(prn, s);
1696 }
1697
fcast_print_x(double x,int n,int pmax,PRN * prn)1698 static void fcast_print_x (double x, int n, int pmax, PRN *prn)
1699 {
1700 if (pmax != PMAX_NOT_AVAILABLE && !na(x)) {
1701 pprintf(prn, "%*.*f", n - 2, pmax, x);
1702 } else {
1703 gretl_printxn(x, n, prn);
1704 }
1705 }
1706
print_stringvals_for_var(const DATASET * dset,int v,PRN * prn)1707 static void print_stringvals_for_var (const DATASET *dset, int v, PRN *prn)
1708 {
1709 const char *s;
1710 int ls = 0;
1711 int t, n;
1712
1713 for (t=dset->t1; t<=dset->t2; t++) {
1714 s = series_get_string_for_obs(dset, v, t);
1715 if (s == NULL) {
1716 s = "(null)";
1717 }
1718 n = strlen(s);
1719 if (ls + n > 78) {
1720 pputc(prn, '\n');
1721 ls = 0;
1722 }
1723 pprintf(prn, "%s ", s);
1724 ls += n;
1725 }
1726
1727 pputc(prn, '\n');
1728 }
1729
1730 /* prints series @v from current sample t1 to t2 */
1731
print_series_by_var(const DATASET * dset,int v,PRN * prn)1732 static void print_series_by_var (const DATASET *dset, int v, PRN *prn)
1733 {
1734 const double *z = dset->Z[v];
1735 char format[12];
1736 int t, ls = 0;
1737 int anyneg = 0;
1738 double x;
1739
1740 for (t=dset->t1; t<=dset->t2; t++) {
1741 if (z[t] < 0) {
1742 anyneg = 1;
1743 break;
1744 }
1745 }
1746
1747 if (anyneg) {
1748 sprintf(format, "%% #.%dg ", gretl_digits);
1749 } else {
1750 sprintf(format, "%%#.%dg ", gretl_digits);
1751 }
1752
1753 for (t=dset->t1; t<=dset->t2; t++) {
1754 char str[32];
1755 int n;
1756
1757 x = z[t];
1758
1759 if (na(x)) {
1760 sprintf(str, "%*s ", gretl_digits + 1 + anyneg, "NA");
1761 } else if (isnan(x)) {
1762 sprintf(str, "%*s ", gretl_digits + 1 + anyneg, "NaN");
1763 } else if (isinf(x)) {
1764 sprintf(str, "%*s ", gretl_digits + 1 + anyneg,
1765 (x < 0)? "-inf" : "inf");
1766 } else {
1767 sprintf(str, format, x);
1768 }
1769
1770 n = strlen(str);
1771 if (ls + n > 78) {
1772 pputc(prn, '\n');
1773 ls = 0;
1774 }
1775
1776 pputs(prn, str);
1777 ls += n;
1778 }
1779
1780 pputc(prn, '\n');
1781 }
1782
1783 #define SMAX 7 /* stipulated max. significant digits */
1784 #define TEST_PLACES 12 /* # of decimal places to use in test string */
1785
1786 /**
1787 * get_signif:
1788 * @x: array to examine
1789 * @n: length of the array
1790 *
1791 * Examines array @x from the point of view of printing the
1792 * data. Tries to determine the most economical yet faithful
1793 * string representation of the data.
1794 *
1795 * Returns: if successful, either a positive integer representing
1796 * the number of significant digits to use when printing the
1797 * series (e.g. when using the %%g conversion in printf), or a
1798 * negative integer representing the number of decimal places
1799 * to use (e.g. with the %%f conversion). If unsuccessful,
1800 * returns #PMAX_NOT_AVAILABLE.
1801 */
1802
get_signif(const double * x,int n)1803 static int get_signif (const double *x, int n)
1804 {
1805 static char numstr[48];
1806 int i, j, s, smax = 0;
1807 int lead, leadmax = 0, leadmin = 99;
1808 int gotdec, trail, trailmax = 0;
1809 double xx;
1810 int allfrac = 1;
1811 char decpoint;
1812
1813 decpoint = get_local_decpoint();
1814
1815 for (i=0; i<n; i++) {
1816
1817 if (na(x[i])) {
1818 continue;
1819 }
1820
1821 xx = fabs(x[i]);
1822
1823 if (xx > 0 && (xx < 1.0e-6 || xx > 1.0e+8)) {
1824 return PMAX_NOT_AVAILABLE;
1825 }
1826
1827 if (xx >= 1.0) {
1828 allfrac = 0;
1829 }
1830
1831 sprintf(numstr, "%.*f", TEST_PLACES, xx);
1832 s = strlen(numstr) - 1;
1833 trail = TEST_PLACES;
1834 gotdec = 0;
1835
1836 for (j=s; j>0; j--) {
1837 if (numstr[j] == '0') {
1838 s--;
1839 if (!gotdec) {
1840 trail--;
1841 }
1842 } else if (numstr[j] == decpoint) {
1843 gotdec = 1;
1844 if (xx < 10000) {
1845 break;
1846 } else {
1847 continue;
1848 }
1849 } else {
1850 break;
1851 }
1852 }
1853
1854 if (trail > trailmax) {
1855 trailmax = trail;
1856 }
1857
1858 if (xx < 1.0) {
1859 s--; /* don't count leading zero */
1860 }
1861
1862 if (s > smax) {
1863 smax = s;
1864 }
1865
1866 #if PDEBUG
1867 fprintf(stderr, "get_signif: set smax = %d\n", smax);
1868 #endif
1869
1870 lead = 0;
1871 for (j=0; j<=s; j++) {
1872 if (xx >= 1.0 && numstr[j] != decpoint) {
1873 lead++;
1874 } else {
1875 break;
1876 }
1877 }
1878
1879 if (lead > leadmax) {
1880 leadmax = lead;
1881 }
1882 if (lead < leadmin) {
1883 leadmin = lead;
1884 }
1885 }
1886
1887 if (smax > SMAX) {
1888 smax = SMAX;
1889 }
1890
1891 if (trailmax > 0 && (leadmax + trailmax <= SMAX)) {
1892 smax = -trailmax;
1893 } else if ((leadmin < leadmax) && (leadmax < smax)) {
1894 #if PDEBUG
1895 fprintf(stderr, "get_signif: setting smax = -(%d - %d)\n",
1896 smax, leadmax);
1897 #endif
1898 smax = -1 * (smax - leadmax); /* # of decimal places */
1899 } else if (leadmax == smax) {
1900 smax = 0;
1901 } else if (leadmax == 0 && !allfrac) {
1902 #if PDEBUG
1903 fprintf(stderr, "get_signif: setting smax = -(%d - 1)\n", smax);
1904 #endif
1905 smax = -1 * (smax - 1);
1906 }
1907
1908 return smax;
1909 }
1910
g_too_long(double x,int signif)1911 static int g_too_long (double x, int signif)
1912 {
1913 char n1[32], n2[32];
1914
1915 sprintf(n1, "%.*G", signif, x);
1916 sprintf(n2, "%.0f", x);
1917
1918 return (strlen(n1) > strlen(n2));
1919 }
1920
bufprintnum(char * buf,double x,int signif,int gprec,int width)1921 static char *bufprintnum (char *buf, double x, int signif,
1922 int gprec, int width)
1923 {
1924 static char numstr[32];
1925 int i, l;
1926
1927 *buf = '\0';
1928
1929 if (isnan(x)) {
1930 strcpy(numstr, "NaN");
1931 goto finish;
1932 } else if (isinf(x)) {
1933 strcpy(numstr, (x < 0)? "-inf" : "inf");
1934 goto finish;
1935 }
1936
1937 /* guard against monster numbers that will smash the stack */
1938 if (fabs(x) > 1.0e20 || signif == PMAX_NOT_AVAILABLE) {
1939 sprintf(numstr, "%.*g", gprec, x);
1940 goto finish;
1941 }
1942
1943 if (signif < 0) {
1944 sprintf(numstr, "%.*f", -signif, x);
1945 } else if (signif == 0) {
1946 sprintf(numstr, "%.0f", x);
1947 } else {
1948 double a = fabs(x);
1949
1950 if (a < 1) l = 0;
1951 else if (a < 10) l = 1;
1952 else if (a < 100) l = 2;
1953 else if (a < 1000) l = 3;
1954 else if (a < 10000) l = 4;
1955 else if (a < 100000) l = 5;
1956 else if (a < 1000000) l = 6;
1957 else l = 7;
1958
1959 #if PDEBUG
1960 fprintf(stderr, "%g: got %d for leftvals, %d for signif\n",
1961 x, l, signif);
1962 #endif
1963
1964 if (l == 6 && signif < 6) {
1965 sprintf(numstr, "%.0f", x);
1966 } else if (l >= signif) {
1967 #if PDEBUG
1968 fprintf(stderr, " printing with '%%.%dG'\n", signif);
1969 #endif
1970 if (g_too_long(x, signif)) {
1971 sprintf(numstr, "%.0f", x);
1972 } else {
1973 sprintf(numstr, "%.*G", signif, x);
1974 }
1975 } else if (a >= .10) {
1976 #if PDEBUG
1977 fprintf(stderr, " printing with '%%.%df'\n", signif-l);
1978 #endif
1979 sprintf(numstr, "%.*f", signif - l, x);
1980 } else {
1981 if (signif > 4) {
1982 signif = 4;
1983 }
1984 #if PDEBUG
1985 fprintf(stderr, " printing with '%%#.%dG'\n", signif);
1986 #endif
1987 sprintf(numstr, "%#.*G", signif, x); /* # wanted? */
1988 }
1989 }
1990
1991 finish:
1992
1993 if (width > 0) {
1994 /* pad on left as needed */
1995 l = width - strlen(numstr);
1996 for (i=0; i<l; i++) {
1997 strcat(buf, " ");
1998 }
1999 }
2000 strcat(buf, numstr);
2001
2002 return buf;
2003 }
2004
real_print_obs_marker(int t,const DATASET * dset,int len,int pad,PRN * prn)2005 static void real_print_obs_marker (int t, const DATASET *dset,
2006 int len, int pad, PRN *prn)
2007 {
2008 char tmp[OBSLEN] = {0};
2009 int thislen = len;
2010
2011 if (dataset_has_markers(dset)) {
2012 strcpy(tmp, dset->S[t]);
2013 thislen = get_utf_width(tmp, len);
2014 } else {
2015 ntolabel(tmp, t, dset);
2016 }
2017
2018 if (pad) {
2019 pprintf(prn, "%*s ", thislen, tmp);
2020 } else {
2021 pprintf(prn, "%*s", thislen, tmp);
2022 }
2023 }
2024
2025 /**
2026 * print_obs_marker:
2027 * @t: observation number.
2028 * @dset: data information struct.
2029 * @len: width to which to print.
2030 * @prn: gretl printing struct.
2031 *
2032 * Print a string (label, date or obs number) representing the given @t.
2033 */
2034
print_obs_marker(int t,const DATASET * dset,int len,PRN * prn)2035 void print_obs_marker (int t, const DATASET *dset, int len, PRN *prn)
2036 {
2037 real_print_obs_marker(t, dset, len, 1, prn);
2038 }
2039
maybe_trim_varname(char * targ,const char * src)2040 char *maybe_trim_varname (char *targ, const char *src)
2041 {
2042 int srclen = strlen(src);
2043
2044 if (srclen < NAMETRUNC) {
2045 strcpy(targ, src);
2046 } else {
2047 const char *p = strrchr(src, '_');
2048
2049 *targ = '\0';
2050
2051 if (p != NULL && isdigit(*(p+1)) && strlen(p) < 4) {
2052 /* preserve lag identifier? */
2053 int snip = srclen - NAMETRUNC + 2;
2054 int fore = p - src;
2055
2056 strncat(targ, src, fore - snip);
2057 strcat(targ, "~");
2058 strcat(targ, p);
2059 } else {
2060 strncat(targ, src, NAMETRUNC - 2);
2061 strcat(targ, "~");
2062 }
2063 }
2064
2065 return targ;
2066 }
2067
max_namelen_in_list(const int * list,const DATASET * dset)2068 int max_namelen_in_list (const int *list, const DATASET *dset)
2069 {
2070 int i, vi, ni, n = 0;
2071
2072 for (i=1; i<=list[0]; i++) {
2073 vi = list[i];
2074 if (vi >= 0 && vi < dset->v) {
2075 ni = strlen(dset->varname[list[i]]);
2076 if (ni > n) {
2077 n = ni;
2078 }
2079 }
2080 }
2081
2082 if (n >= NAMETRUNC) {
2083 n = NAMETRUNC - 1;
2084 }
2085
2086 return n;
2087 }
2088
show_series(int i,int fd,const DATASET * dset,int debug)2089 static int show_series (int i, int fd, const DATASET *dset,
2090 int debug)
2091 {
2092 if (debug) {
2093 /* show all */
2094 return 1;
2095 } else {
2096 return (i == 0 || fd == 0 || series_get_stack_level(dset, i) == fd);
2097 }
2098 }
2099
2100 /**
2101 * list_series:
2102 * @dset: data information struct.
2103 * @opt: may contain OPT_D for debugging.
2104 * @prn: gretl printing struct
2105 *
2106 * Prints a list of the names of the series currently defined.
2107 */
2108
list_series(const DATASET * dset,gretlopt opt,PRN * prn)2109 void list_series (const DATASET *dset, gretlopt opt, PRN *prn)
2110 {
2111 int fd = gretl_function_depth();
2112 int debug = (opt & OPT_D);
2113 const char *name;
2114 gchar *tmp;
2115 int len, maxlen = 0;
2116 int nv = 4, n = 0;
2117 int i, j;
2118
2119 if (dset->v == 0) {
2120 pprintf(prn, _("No series are defined\n"));
2121 return;
2122 }
2123
2124 for (i=0; i<dset->v; i++) {
2125 if (show_series(i, fd, dset, debug)) {
2126 tmp = NULL;
2127 name = get_series_name(dset, i, &tmp, debug);
2128 len = strlen(name);
2129 if (len > maxlen) {
2130 maxlen = len;
2131 }
2132 g_free(tmp);
2133 n++;
2134 }
2135 }
2136
2137 if (maxlen < 9) {
2138 nv = 5;
2139 } else if (maxlen > 20) {
2140 nv = 1;
2141 } else if (maxlen > 13) {
2142 nv = 3;
2143 }
2144
2145 pprintf(prn, _("Listing %d variables:\n"), n);
2146
2147 j = 1;
2148 for (i=0; i<dset->v; i++) {
2149 if (show_series(i, fd, dset, debug)) {
2150 tmp = NULL;
2151 name = get_series_name(dset, i, &tmp, debug);
2152 if (debug) {
2153 pprintf(prn, "%3d) %-*s level %d\n", i, maxlen + 2,
2154 name, series_get_stack_level(dset, i));
2155 } else {
2156 pprintf(prn, "%3d) %-*s", i, maxlen + 2, name);
2157 if (j % nv == 0) {
2158 pputc(prn, '\n');
2159 }
2160 }
2161 g_free(tmp);
2162 j++;
2163 }
2164 }
2165
2166 if (n % nv) {
2167 pputc(prn, '\n');
2168 }
2169
2170 pputc(prn, '\n');
2171 }
2172
2173 /**
2174 * maybe_list_series:
2175 * @dset: data information struct.
2176 * @prn: gretl printing struct
2177 *
2178 * Prints a list of the names of the series currently defined,
2179 * unless gretl messaging is turned off.
2180 */
2181
maybe_list_series(const DATASET * dset,PRN * prn)2182 void maybe_list_series (const DATASET *dset, PRN *prn)
2183 {
2184 if (gretl_messages_on() && !gretl_looping() && dset->v < 51) {
2185 list_series(dset, OPT_NONE, prn);
2186 }
2187 }
2188
line_count(const char * s)2189 static int line_count (const char *s)
2190 {
2191 int n = 1;
2192
2193 while (*s) {
2194 if (*s == '\n') n++;
2195 s++;
2196 }
2197
2198 return n;
2199 }
2200
string_print_range(const char * s,int lmin,int lmax,PRN * prn)2201 static void string_print_range (const char *s, int lmin, int lmax,
2202 PRN *prn)
2203 {
2204 int len, l = 0;
2205
2206 while (*s && l < lmax) {
2207 len = strcspn(s, "\r\n");
2208 if (l >= lmin) {
2209 pprintf(prn, "%.*s\n", len, s);
2210 }
2211 s += len;
2212 if (*s == '\r') s++;
2213 if (*s == '\n') s++;
2214 l++;
2215 }
2216 }
2217
print_listed_objects(const char * s,const DATASET * dset,gretlopt opt,PRN * prn)2218 static int print_listed_objects (const char *s,
2219 const DATASET *dset,
2220 gretlopt opt,
2221 PRN *prn)
2222 {
2223 const char *syms = "=+-/*<>?|~^!%&.,:;\\'[({$";
2224 char *name = NULL;
2225 int err = 0;
2226
2227 if (!strcmp(s, "$sysinfo")) {
2228 gretl_bundle *b = get_sysinfo_bundle(&err);
2229
2230 if (b != NULL) {
2231 gretl_bundle_print(b, prn);
2232 }
2233 return err;
2234 }
2235
2236 if (strcspn(s, syms) < strlen(s)) {
2237 /* try treating as expression to be evaluated */
2238 return generate(s, (DATASET *) dset, GRETL_TYPE_NONE, OPT_P, prn);
2239 }
2240
2241 while ((name = gretl_word_strdup(s, &s, OPT_S | OPT_U, &err)) != NULL) {
2242 user_var *uv = get_user_var_by_name(name);
2243
2244 if (uv == NULL) {
2245 err = E_UNKVAR;
2246 break;
2247 } else if (opt & OPT_R) {
2248 GretlType t = user_var_get_type(uv);
2249 int start, stop;
2250
2251 if (t == GRETL_TYPE_ARRAY) {
2252 gretl_array *a = user_var_get_value(uv);
2253 int len = gretl_array_get_length(a);
2254
2255 err = get_print_range(len, &start, &stop);
2256 if (!err) {
2257 err = gretl_array_print_range(a, start, stop+1, prn);
2258 }
2259 } else if (t == GRETL_TYPE_MATRIX) {
2260 gretl_matrix *m = user_var_get_value(uv);
2261 int len = gretl_matrix_rows(m);
2262
2263 err = get_print_range(len, &start, &stop);
2264 if (!err) {
2265 gretl_matrix_print_range(m, name, start, stop+1, prn);
2266 }
2267 } else if (t == GRETL_TYPE_STRING) {
2268 const char *s = user_var_get_value(uv);
2269 int len = line_count(s);
2270
2271 err = get_print_range(len, &start, &stop);
2272 if (!err) {
2273 string_print_range(s, start, stop+1, prn);
2274 }
2275 } else {
2276 err = print_user_var_by_name(name, dset, opt, prn);
2277 }
2278 } else {
2279 err = print_user_var_by_name(name, dset, opt, prn);
2280 }
2281 free(name);
2282 if (err) {
2283 break;
2284 }
2285 }
2286
2287 return err;
2288 }
2289
adjust_print_list(int * list,int * screenvar,gretlopt opt)2290 static int adjust_print_list (int *list, int *screenvar,
2291 gretlopt opt)
2292 {
2293 int pos;
2294
2295 if (!(opt & OPT_O)) {
2296 return E_PARSE;
2297 }
2298
2299 pos = gretl_list_separator_position(list);
2300
2301 if (list[0] < 3 || pos != list[0] - 1) {
2302 return E_PARSE;
2303 } else {
2304 *screenvar = list[list[0]];
2305 list[0] = pos - 1;
2306 }
2307
2308 return 0;
2309 }
2310
obslen_from_t(int t)2311 static int obslen_from_t (int t)
2312 {
2313 char s[OBSLEN];
2314
2315 sprintf(s, "%d", t + 1);
2316 return strlen(s);
2317 }
2318
2319 /* in case we're printing a lot of data to a PRN that uses a
2320 buffer, pre-allocate a relatively big chunk of memory
2321 */
2322
check_prn_size(const int * list,const DATASET * dset,PRN * prn)2323 static int check_prn_size (const int *list, const DATASET *dset,
2324 PRN *prn)
2325 {
2326 int nx = list[0] * (dset->t2 - dset->t1 + 1);
2327 int err = 0;
2328
2329 if (nx > 1000) {
2330 err = gretl_print_alloc(prn, nx * 12);
2331 }
2332
2333 return err;
2334 }
2335
get_pmax_array(const int * list,const DATASET * dset)2336 static int *get_pmax_array (const int *list, const DATASET *dset)
2337 {
2338 int *pmax = malloc(list[0] * sizeof *pmax);
2339 int i, vi, T = sample_size(dset);
2340
2341 if (pmax == NULL) {
2342 return NULL;
2343 }
2344
2345 /* this runs fairly quickly, even for large dataset */
2346
2347 for (i=1; i<=list[0]; i++) {
2348 vi = list[i];
2349 pmax[i-1] = get_signif(dset->Z[vi] + dset->t1, T);
2350 }
2351
2352 return pmax;
2353 }
2354
bufprint_string(char * buf,const char * s,int width,PRN * prn)2355 static void bufprint_string (char *buf, const char *s,
2356 int width, PRN *prn)
2357 {
2358 int n = width - g_utf8_strlen(s, -1);
2359
2360 *buf = '\0';
2361
2362 if (n > 0) {
2363 bufspace(n, prn);
2364 pputs(prn, s);
2365 } else {
2366 gretl_utf8_strncat(buf, s, width - 3);
2367 n = width - g_utf8_strlen(buf, -1);
2368 bufspace(n-1, prn);
2369 pputs(prn, buf);
2370 pputc(prn, '~');
2371 }
2372 }
2373
get_print_range(int len,int * start,int * stop)2374 static int get_print_range (int len, int *start, int *stop)
2375 {
2376 const char *s = get_optval_string(PRINT, OPT_R);
2377 int err = 0;
2378
2379 if (s == NULL || *s == '\0' || strchr(s, ':') == NULL) {
2380 err = E_DATA;
2381 } else {
2382 int k1 = 0, k2 = 0, nf = 0;
2383 char **S = gretl_string_split(s, &nf, ":");
2384
2385 if (S == NULL || nf != 2) {
2386 err = E_PARSE;
2387 } else {
2388 if (S[0][0] == '\0') {
2389 k1 = 1;
2390 } else {
2391 k1 = gretl_int_from_string(S[0], &err);
2392 }
2393 if (!err) {
2394 if (S[1][0] == '\0') {
2395 k2 = len;
2396 } else {
2397 k2 = gretl_int_from_string(S[1], &err);
2398 }
2399 }
2400 }
2401
2402 if (!err && (k1 == 0 || k2 == 0)) {
2403 fprintf(stderr, "get_print_range: got a zero value\n");
2404 err = E_INVARG;
2405 }
2406 if (!err && (k1 < 0 || k2 < 0)) {
2407 if (k1 < 0) {
2408 k1 = len + k1 + 1;
2409 }
2410 if (k2 < 0) {
2411 k2 = len + k2 + 1;
2412 }
2413 if (k2 < k1) {
2414 fprintf(stderr, "get_print_range: got empty range\n");
2415 }
2416 }
2417 if (!err && (k1 > len || k2 > len)) {
2418 fprintf(stderr, "get_print_range: out of bounds\n");
2419 err = E_INVARG;
2420 }
2421 if (!err) {
2422 *start = k1 - 1;
2423 *stop = k2 - 1;
2424 }
2425
2426 strings_array_free(S, nf);
2427 }
2428
2429 return err;
2430 }
2431
column_widths_from_list(const int * list,const DATASET * dset)2432 static int *column_widths_from_list (const int *list,
2433 const DATASET *dset)
2434 {
2435 int *ret = gretl_list_new(list[0]);
2436 int i, w, maxw = 0;
2437
2438 for (i=1; i<=list[0]; i++) {
2439 w = 1 + series_get_string_width(dset, list[i]);
2440 if (w > maxw) {
2441 if (list[0] > 1 && w > 32) {
2442 w = 32;
2443 }
2444 maxw = w;
2445 }
2446 /* check this minimum? */
2447 ret[i] = w < 13 ? 13 : w;
2448 }
2449
2450 if (maxw <= 13) {
2451 /* standardize on moderate width */
2452 for (i=1; i<=list[0]; i++) {
2453 ret[i] = 13;
2454 }
2455 }
2456
2457 return ret;
2458 }
2459
print_plain_numbers(int * list,const DATASET * dset,PRN * prn)2460 static void print_plain_numbers (int *list, const DATASET *dset,
2461 PRN *prn)
2462 {
2463 int i, vi, t;
2464
2465 for (t=dset->t1; t<=dset->t2; t++) {
2466 for (i=1; i<=list[0]; i++) {
2467 vi = list[i];
2468 if (na(dset->Z[vi][t])) {
2469 pputs(prn, "NA");
2470 } else {
2471 pprintf(prn, "%.8g", dset->Z[vi][t]);
2472 }
2473 if (i < list[0]) {
2474 pputc(prn, ' ');
2475 } else {
2476 pputc(prn, '\n');
2477 }
2478 }
2479 }
2480 }
2481
2482 /* print the series referenced in @list by observation */
2483
print_by_obs(int * list,const DATASET * dset,gretlopt opt,int screenvar,PRN * prn)2484 static int print_by_obs (int *list, const DATASET *dset,
2485 gretlopt opt, int screenvar,
2486 PRN *prn)
2487 {
2488 int BMAX = libset_get_int(DATACOLS);
2489 int i, j, j0, k, t, nrem;
2490 int *colwidths = NULL;
2491 int obslen = 0;
2492 int *pmax = NULL;
2493 char buf[128];
2494 int blist[BMAX+1];
2495 int wlist[BMAX+1];
2496 int gprec = 6;
2497 int vi, wi;
2498 double x;
2499 int err = 0;
2500
2501 if (!(opt & OPT_S)) {
2502 pmax = get_pmax_array(list, dset);
2503 if (pmax == NULL) {
2504 return E_ALLOC;
2505 }
2506 }
2507
2508 if (opt & OPT_D) {
2509 obslen = obslen_from_t(dset->t2);
2510 } else {
2511 obslen = max_obs_marker_length(dset);
2512 }
2513
2514 colwidths = column_widths_from_list(list, dset);
2515
2516 nrem = list[0];
2517 k = 1;
2518
2519 while (nrem > 0) {
2520 /* fill the "block" list */
2521 j0 = k;
2522 wlist[0] = blist[0] = 0;
2523 for (i=1; i<=BMAX && nrem>0; i++) {
2524 blist[i] = list[k];
2525 blist[0] += 1;
2526 wlist[i] = colwidths[k];
2527 wlist[0] += 1;
2528 k++;
2529 nrem--;
2530 }
2531
2532 varheading(blist, obslen, wlist, dset, 0, prn);
2533
2534 for (t=dset->t1; t<=dset->t2; t++) {
2535 if (screenvar && dset->Z[screenvar][t] == 0.0) {
2536 /* screened out by boolean */
2537 continue;
2538 }
2539 if (opt & OPT_D) {
2540 pprintf(prn, "%*d", obslen, t + 1);
2541 } else {
2542 real_print_obs_marker(t, dset, obslen, 0, prn);
2543 }
2544 for (i=1, j=j0; i<=blist[0]; i++, j++) {
2545 vi = blist[i];
2546 wi = wlist[i];
2547 if (!(opt & OPT_U) && is_string_valued(dset, vi)) {
2548 const char *s = series_get_string_for_obs(dset, vi, t);
2549
2550 if (s == NULL || *s == '\0') {
2551 bufspace(wi, prn);
2552 } else {
2553 bufprint_string(buf, s, wi, prn);
2554 }
2555 } else {
2556 x = dset->Z[vi][t];
2557 if (na(x)) {
2558 bufspace(wi, prn);
2559 } else {
2560 bufprintnum(buf, x, pmax[j-1], gprec, wi);
2561 pputs(prn, buf);
2562 }
2563 }
2564 }
2565 pputc(prn, '\n');
2566 }
2567 }
2568
2569 pputc(prn, '\n');
2570
2571 free(pmax);
2572 free(colwidths);
2573
2574 return err;
2575 }
2576
print_by_var(const int * list,const DATASET * dset,gretlopt opt,PRN * prn)2577 static int print_by_var (const int *list, const DATASET *dset,
2578 gretlopt opt, PRN *prn)
2579 {
2580 const char *name;
2581 gchar *tmp;
2582 int i, vi;
2583
2584 pputc(prn, '\n');
2585
2586 for (i=1; i<=list[0]; i++) {
2587 vi = list[i];
2588 if (vi > dset->v) {
2589 continue;
2590 }
2591 if (list[0] > 1) {
2592 tmp = NULL;
2593 name = get_series_name(dset, vi, &tmp, 0);
2594 pprintf(prn, "%s:\n", name);
2595 g_free(tmp);
2596 }
2597 print_var_smpl(vi, dset, prn);
2598 pputc(prn, '\n');
2599 if (!(opt & OPT_U) && is_string_valued(dset, vi)) {
2600 print_stringvals_for_var(dset, vi, prn);
2601 } else {
2602 print_series_by_var(dset, vi, prn);
2603 }
2604 pputc(prn, '\n');
2605 }
2606
2607 return 0;
2608 }
2609
midas_print_list(const int * list,const DATASET * dset,PRN * prn)2610 static int midas_print_list (const int *list,
2611 const DATASET *dset,
2612 PRN *prn)
2613 {
2614 DATASET *tmpset = NULL;
2615 int err = 0;
2616
2617 tmpset = midas_aux_dataset(list, dset, &err);
2618
2619 if (!err) {
2620 int mlist[2] = {1, 0};
2621
2622 err = print_by_obs(mlist, tmpset, OPT_NONE, 0, prn);
2623 destroy_dataset(tmpset);
2624 }
2625
2626 return err;
2627 }
2628
2629 /**
2630 * printdata:
2631 * @list: list of variables to print.
2632 * @ostr: optional string holding names of non-series objects to print.
2633 * @dset: dataset struct.
2634 * @opt: if OPT_O, print the data by observation (series in columns);
2635 * if OPT_D, use simple obs numbers, not dates; if OPT_M, print midas
2636 * list in original time-series order; if OPT_R print specified range
2637 * of object; if OPT_X (relevant only for series), print the data
2638 * by observation without any header or observation info.
2639 * @prn: gretl printing struct.
2640 *
2641 * Print the data for the variables in @list over the currently
2642 * defined sample range, or the objects named in @ostr.
2643 *
2644 * Returns: 0 on successful completion, non-zero code on error.
2645 */
2646
printdata(const int * list,const char * ostr,DATASET * dset,gretlopt opt,PRN * prn)2647 int printdata (const int *list, const char *ostr,
2648 DATASET *dset, gretlopt opt,
2649 PRN *prn)
2650 {
2651 int screenvar = 0;
2652 int *plist = NULL;
2653 int err = 0;
2654
2655 if (list != NULL && list[0] == 0) {
2656 /* explicitly empty list given */
2657 if (ostr == NULL) {
2658 return 0; /* no-op */
2659 } else {
2660 goto endprint;
2661 }
2662 } else if (list == NULL) {
2663 /* no list given */
2664 if (ostr == NULL && dset != NULL) {
2665 int nvars = 0;
2666
2667 plist = full_var_list(dset, &nvars);
2668 if (nvars == 0) {
2669 /* no-op */
2670 return 0;
2671 }
2672 } else {
2673 goto endprint;
2674 }
2675 } else {
2676 plist = gretl_list_copy(list);
2677 }
2678
2679 /* at this point plist should have something in it */
2680 if (plist == NULL) {
2681 return E_ALLOC;
2682 }
2683
2684 if (opt & OPT_M) {
2685 err = midas_print_list(plist, dset, prn);
2686 free(plist);
2687 return err;
2688 }
2689
2690 if (gretl_list_has_separator(plist)) {
2691 err = adjust_print_list(plist, &screenvar, opt);
2692 if (err) {
2693 free(plist);
2694 return err;
2695 }
2696 }
2697
2698 if (plist[0] == 0) {
2699 /* no series */
2700 pputc(prn, '\n');
2701 goto endprint;
2702 }
2703
2704 if (gretl_print_has_buffer(prn)) {
2705 err = check_prn_size(plist, dset, prn);
2706 if (err) {
2707 goto endprint;
2708 }
2709 }
2710
2711 if (opt & OPT_R) {
2712 /* --range */
2713 int save_t1 = dset->t1;
2714 int save_t2 = dset->t2;
2715 int start = 0, stop = 0;
2716
2717 err = get_print_range(sample_size(dset), &start, &stop);
2718 if (err) {
2719 return err;
2720 } else if (stop < start) {
2721 goto endprint;
2722 }
2723 dset->t1 = save_t1 + start;
2724 dset->t2 = save_t1 + stop;
2725 if (opt & OPT_X) {
2726 print_plain_numbers(plist, dset, prn);
2727 } else if (opt & OPT_O) {
2728 err = print_by_obs(plist, dset, opt, screenvar, prn);
2729 } else {
2730 err = print_by_var(plist, dset, opt, prn);
2731 }
2732 dset->t1 = save_t1;
2733 dset->t2 = save_t2;
2734 } else {
2735 if (opt & OPT_X) {
2736 print_plain_numbers(plist, dset, prn);
2737 } else if (opt & OPT_O) {
2738 err = print_by_obs(plist, dset, opt, screenvar, prn);
2739 } else {
2740 err = print_by_var(plist, dset, opt, prn);
2741 }
2742 }
2743
2744 endprint:
2745
2746 if (!err && ostr != NULL) {
2747 err = print_listed_objects(ostr, dset, opt, prn);
2748 }
2749
2750 free(plist);
2751
2752 return err;
2753 }
2754
print_series_with_format(const int * list,const DATASET * dset,char fmt,int digits,PRN * prn)2755 int print_series_with_format (const int *list,
2756 const DATASET *dset,
2757 char fmt, int digits,
2758 PRN *prn)
2759 {
2760 int BMAX = libset_get_int(DATACOLS);
2761 int i, j, j0, v, t, k, nrem = 0;
2762 int *colwidths, blist[BMAX+1];
2763 char obslabel[OBSLEN];
2764 char format[16];
2765 char *buf = NULL;
2766 int buflen, obslen;
2767 double x;
2768 int err = 0;
2769
2770 if (list == NULL || list[0] == 0) {
2771 return 0;
2772 }
2773
2774 for (i=1; i<=list[0]; i++) {
2775 if (list[i] >= dset->v) {
2776 return E_DATA;
2777 }
2778 }
2779
2780 colwidths = gretl_list_new(list[0]);
2781 if (colwidths == NULL) {
2782 return E_ALLOC;
2783 }
2784
2785 nrem = list[0];
2786
2787 buflen = 0;
2788 for (i=1; i<=list[0]; i++) {
2789 colwidths[i] = series_column_width(list[i], dset, fmt, digits);
2790 colwidths[i] += 3;
2791 if (colwidths[i] > buflen) {
2792 buflen = colwidths[i];
2793 }
2794 }
2795
2796 buf = malloc(buflen);
2797 if (buf == NULL) {
2798 free(colwidths);
2799 return E_ALLOC;
2800 }
2801
2802 if (gretl_print_has_buffer(prn)) {
2803 err = check_prn_size(list, dset, prn);
2804 if (err) {
2805 goto bailout;
2806 }
2807 }
2808
2809 if (fmt == 'f') {
2810 sprintf(format, "%%.%df", digits);
2811 } else {
2812 sprintf(format, "%%#.%dg", digits);
2813 }
2814
2815 obslen = max_obs_marker_length(dset);
2816
2817 k = 1;
2818
2819 while (nrem > 0) {
2820 /* fill the "block" list */
2821 j0 = k;
2822 blist[0] = 0;
2823 for (i=1; i<=BMAX && nrem>0; i++) {
2824 blist[i] = list[k++];
2825 blist[0] += 1;
2826 nrem--;
2827 }
2828
2829 /* print block heading */
2830 bufspace(obslen, prn);
2831 for (i=1, j=j0; i<=blist[0]; i++, j++) {
2832 v = blist[i];
2833 pprintf(prn, "%*s", colwidths[j], dset->varname[v]);
2834 }
2835 pputs(prn, "\n\n");
2836
2837 /* print block observations */
2838 for (t=dset->t1; t<=dset->t2; t++) {
2839 get_obs_string(obslabel, t, dset);
2840 pprintf(prn, "%*s", obslen, obslabel);
2841 for (i=1, j=j0; i<=blist[0]; i++, j++) {
2842 v = blist[i];
2843 x = dset->Z[v][t];
2844 if (na(x)) {
2845 bufspace(colwidths[j], prn);
2846 } else {
2847 sprintf(buf, format, x);
2848 if (fmt == 'g') {
2849 /* post-process ugliness */
2850 cut_trailing_point(cut_extra_zero(buf, digits));
2851 }
2852 pprintf(prn, "%*s", colwidths[j], buf);
2853 }
2854 }
2855 pputc(prn, '\n');
2856 }
2857 pputc(prn, '\n');
2858 }
2859
2860 bailout:
2861
2862 free(colwidths);
2863 free(buf);
2864
2865 return err;
2866 }
2867
2868 enum {
2869 RTF_HEADER,
2870 RTF_TRAILER
2871 };
2872
rtf_print_row_spec(int ncols,int type,PRN * prn)2873 static void rtf_print_row_spec (int ncols, int type, PRN *prn)
2874 {
2875 int j;
2876
2877 if (type == RTF_TRAILER) {
2878 pputc(prn, '{');
2879 }
2880
2881 pputs(prn, "\\trowd\\trautofit1\n\\intbl\n");
2882 for (j=1; j<=ncols; j++) {
2883 pprintf(prn, "\\cellx%d\n", j);
2884 }
2885
2886 if (type == RTF_TRAILER) {
2887 pputs(prn, "\\row }\n");
2888 }
2889 }
2890
2891 /**
2892 * print_data_in_columns:
2893 * @list: list of variables to print.
2894 * @obsvec: list of observation numbers (or %NULL)
2895 * @dset: dataset struct.
2896 * @opt: may include OPT_X to exclude the observations
2897 * column that is usually printed first.
2898 * @prn: gretl printing struct.
2899 *
2900 * Print the data for the variables in @list. If @obsvec is not %NULL,
2901 * it should specify a sort order; the first element of @obsvec must
2902 * contain the number of observations that follow. By default, printing is
2903 * plain text, formatted in columns using space characters, but if the @prn
2904 * format is set to %GRETL_FORMAT_CSV then printing respects the user's
2905 * choice of column delimiter, and if the format is set to %GRETL_FORMAT_RTF
2906 * the data are printed as an RTF table.
2907 *
2908 * Returns: 0 on successful completion, non-zero code on error.
2909 */
2910
print_data_in_columns(const int * list,const int * obsvec,const DATASET * dset,gretlopt opt,PRN * prn)2911 int print_data_in_columns (const int *list, const int *obsvec,
2912 const DATASET *dset, gretlopt opt,
2913 PRN *prn)
2914 {
2915 int csv = csv_format(prn);
2916 int rtf = rtf_format(prn);
2917 const char *csv_na = "";
2918 int print_obs = 1;
2919 char delim = 0;
2920 int *pmax = NULL;
2921 int *colwidths = NULL;
2922 double xx;
2923 char obs_string[OBSLEN];
2924 char buf[128];
2925 int ncols = 0, obslen = 0;
2926 int gprec = 6;
2927 int i, s, t, T;
2928
2929 if (obsvec != NULL) {
2930 T = obsvec[0];
2931 } else {
2932 T = sample_size(dset);
2933 }
2934
2935 /* we must have a non-empty list of variables */
2936 if (list == NULL || list[0] < 1) {
2937 return E_DATA;
2938 }
2939
2940 /* ...with no bad variable numbers */
2941 for (i=1; i<=list[0]; i++) {
2942 if (list[i] < 0 || list[i] >= dset->v) {
2943 return E_DATA;
2944 }
2945 }
2946
2947 /* and T must be in bounds */
2948 if (T > dset->n - dset->t1) {
2949 return E_DATA;
2950 }
2951
2952 pmax = get_pmax_array(list, dset);
2953 if (pmax == NULL) {
2954 return E_ALLOC;
2955 }
2956
2957 if (csv) {
2958 /* columns delimited by some character */
2959 gprec = 15;
2960 delim = get_data_export_delimiter();
2961 if (get_local_decpoint() == ',' && delim == ',') {
2962 delim = ';';
2963 }
2964 csv_na = get_csv_na_write_string();
2965 if (opt & OPT_X) {
2966 print_obs = 0;
2967 obslen = -1;
2968 }
2969 } else if (rtf) {
2970 ncols = list[0] + 1;
2971 } else {
2972 colwidths = column_widths_from_list(list, dset);
2973 obslen = max_obs_marker_length(dset);
2974 }
2975
2976 if (rtf) {
2977 pputs(prn, "{\\rtf1\n");
2978 rtf_print_row_spec(ncols, RTF_HEADER, prn);
2979 }
2980
2981 varheading(list, obslen, colwidths, dset, delim, prn);
2982
2983 if (rtf) {
2984 rtf_print_row_spec(ncols, RTF_TRAILER, prn);
2985 }
2986
2987 /* print data by observations */
2988 for (s=0; s<T; s++) {
2989 t = (obsvec != NULL)? obsvec[s+1] : (dset->t1 + s);
2990 if (t >= dset->n) {
2991 continue;
2992 }
2993
2994 if (rtf) {
2995 rtf_print_row_spec(ncols, RTF_HEADER, prn);
2996 pputc(prn, '{');
2997 }
2998
2999 if (print_obs) {
3000 get_obs_string(obs_string, t, dset);
3001 if (csv) {
3002 pprintf(prn, "%s%c", obs_string, delim);
3003 } else if (rtf) {
3004 pprintf(prn, "%s\\cell ", obs_string);
3005 } else {
3006 pprintf(prn, "%*s", obslen, obs_string);
3007 }
3008 }
3009
3010 for (i=1; i<=list[0]; i++) {
3011 const char *strval = NULL;
3012 int wi = 0;
3013
3014 if (colwidths != NULL) {
3015 wi = colwidths[i];
3016 }
3017
3018 if (is_string_valued(dset, list[i])) {
3019 strval = series_get_string_for_obs(dset, list[i], t);
3020 }
3021
3022 if (strval != NULL) {
3023 /* display string value */
3024 if (*strval == '\0') {
3025 if (csv) {
3026 pputs(prn, "\"\"");
3027 } else if (rtf) {
3028 pputs(prn, "\\qr \\cell ");
3029 } else {
3030 bufspace(wi, prn);
3031 }
3032 } else if (csv) {
3033 pprintf(prn, "\"%s\"", strval);
3034 } else if (rtf) {
3035 pprintf(prn, "\\qr %s\\cell ", strval);
3036 } else {
3037 bufprint_string(buf, strval, wi, prn);
3038 }
3039 } else {
3040 /* numerical value */
3041 xx = dset->Z[list[i]][t];
3042 if (na(xx)) {
3043 if (csv) {
3044 pputs(prn, csv_na);
3045 } else if (rtf) {
3046 pputs(prn, "\\qr NA\\cell ");
3047 } else {
3048 bufspace(wi, prn);
3049 }
3050 } else {
3051 if (rtf) {
3052 bufprintnum(buf, xx, pmax[i-1], gprec, 0);
3053 pprintf(prn, "\\qr %s\\cell ", buf);
3054 } else {
3055 bufprintnum(buf, xx, pmax[i-1], gprec, wi);
3056 pputs(prn, buf);
3057 }
3058 }
3059 }
3060 if (csv && i < list[0]) {
3061 pputc(prn, delim);
3062 }
3063 }
3064 if (rtf) {
3065 pputs(prn, "}\n");
3066 rtf_print_row_spec(ncols, RTF_TRAILER, prn);
3067 } else {
3068 pputc(prn, '\n');
3069 }
3070 }
3071
3072 if (rtf) {
3073 pputs(prn, "}\n");
3074 } else {
3075 pputc(prn, '\n');
3076 }
3077
3078 free(pmax);
3079 free(colwidths);
3080
3081 return 0;
3082 }
3083
print_fcast_stats_matrix(const gretl_matrix * m,int T,gretlopt opt,PRN * prn)3084 int print_fcast_stats_matrix (const gretl_matrix *m,
3085 int T, gretlopt opt,
3086 PRN *prn)
3087 {
3088 const char *strs[] = {
3089 N_("Mean Error"),
3090 N_("Root Mean Squared Error"),
3091 N_("Mean Absolute Error"),
3092 N_("Mean Percentage Error"),
3093 N_("Mean Absolute Percentage Error"),
3094 N_("Theil's U1"),
3095 N_("Bias proportion, UM"),
3096 N_("Regression proportion, UR"),
3097 N_("Disturbance proportion, UD")
3098 };
3099 const char *U2_str = N_("Theil's U2");
3100 double x;
3101 int i, n, nmax = 0;
3102 int len, err = 0;
3103
3104 len = gretl_vector_get_length(m);
3105
3106 for (i=0; i<len; i++) {
3107 x = gretl_vector_get(m, i);
3108 if (!isnan(x)) {
3109 n = g_utf8_strlen(_(strs[i]), -1);
3110 if (n > nmax) {
3111 nmax = n;
3112 }
3113 }
3114 }
3115
3116 nmax += 2;
3117
3118 pputs(prn, " ");
3119 pputs(prn, _("Forecast evaluation statistics"));
3120 pputc(prn, ' ');
3121 pprintf(prn, _("using %d observations"), T);
3122 pputs(prn, "\n\n");
3123
3124 for (i=0; i<len; i++) {
3125 const char *si;
3126
3127 x = gretl_vector_get(m, i);
3128 if (!isnan(x)) {
3129 si = (i == 5 && (opt & OPT_T))? U2_str : strs[i];
3130 pprintf(prn, " %-*s % .5g\n", UTF_WIDTH(_(si), nmax), _(si), x);
3131 }
3132 }
3133 pputc(prn, '\n');
3134
3135 return err;
3136 }
3137
fr_print_fc_stats(const FITRESID * fr,gretlopt opt,PRN * prn)3138 static int fr_print_fc_stats (const FITRESID *fr, gretlopt opt,
3139 PRN *prn)
3140 {
3141 gretl_matrix *m;
3142 int t1, t2, n_used;
3143 int err = 0;
3144
3145 fcast_get_continuous_range(fr, &t1, &t2);
3146
3147 if (t2 - t1 + 1 <= 0) {
3148 return E_MISSDATA;
3149 }
3150
3151 m = forecast_stats(fr->actual, fr->fitted, t1, t2, &n_used,
3152 opt, &err);
3153
3154 if (!err) {
3155 err = print_fcast_stats_matrix(m, n_used, opt, prn);
3156 }
3157
3158 gretl_matrix_free(m);
3159
3160 return err;
3161 }
3162
3163 #define SIGMA_MIN 1.0e-18
3164
text_print_fit_resid(const FITRESID * fr,const DATASET * dset,PRN * prn)3165 int text_print_fit_resid (const FITRESID *fr,
3166 const DATASET *dset,
3167 PRN *prn)
3168 {
3169 gretlopt fc_opt = OPT_NONE;
3170 int kstep = fr->method == FC_KSTEP;
3171 int t, anyast = 0;
3172 double yt, yf, et;
3173 int ywidth;
3174 int obslen;
3175 int err = 0;
3176
3177 obslen = max_obs_marker_length(dset);
3178 ywidth = fit_resid_head(fr, dset, obslen, prn);
3179
3180 for (t=fr->t1; t<=fr->t2; t++) {
3181 real_print_obs_marker(t, dset, obslen, 0, prn);
3182
3183 yt = fr->actual[t];
3184 yf = fr->fitted[t];
3185 et = fr->resid[t];
3186
3187 if (na(yt)) {
3188 pputc(prn, '\n');
3189 } else if (na(yf)) {
3190 if (fr->pmax != PMAX_NOT_AVAILABLE) {
3191 pprintf(prn, "%*.*f\n", ywidth, fr->pmax, yt);
3192 } else {
3193 pprintf(prn, "%#*g\n", ywidth, yt);
3194 }
3195 } else if (na(et)) {
3196 if (fr->pmax != PMAX_NOT_AVAILABLE) {
3197 pprintf(prn, "%*.*f", ywidth, fr->pmax, yt);
3198 pprintf(prn, "%13.*f", fr->pmax, yf);
3199 } else {
3200 pprintf(prn, "%#*g\n", ywidth, yt);
3201 pprintf(prn, "%#13g\n", yf);
3202 }
3203 } else {
3204 int ast = 0;
3205
3206 if (!kstep && fr->sigma > SIGMA_MIN) {
3207 ast = (fabs(et) > 2.5 * fr->sigma);
3208 if (ast) {
3209 anyast = 1;
3210 }
3211 }
3212 if (fr->pmax != PMAX_NOT_AVAILABLE) {
3213 pprintf(prn, "%*.*f%13.*f%13.*f%s\n", ywidth,
3214 fr->pmax, yt, fr->pmax, yf, fr->pmax, et,
3215 (ast)? " *" : "");
3216 } else {
3217 pprintf(prn, "%#*g%#13g%#13g%s\n",
3218 ywidth, yt, yf, et,
3219 (ast)? " *" : "");
3220 }
3221 }
3222 }
3223
3224 pputc(prn, '\n');
3225
3226 if (anyast) {
3227 pputs(prn, _("Note: * denotes a residual in excess of "
3228 "2.5 standard errors\n"));
3229 }
3230
3231 if (dataset_is_time_series(dset)) {
3232 fc_opt |= OPT_T;
3233 }
3234 fr_print_fc_stats(fr, fc_opt, prn);
3235
3236 if (kstep && fr->nobs > 0 && gretl_in_gui_mode()) {
3237 err = plot_fcast_errs(fr, NULL, dset, OPT_NONE);
3238 }
3239
3240 return err;
3241 }
3242
3243 /**
3244 * text_print_forecast:
3245 * @fr: pointer to structure containing forecasts.
3246 * @dset: dataset information.
3247 * @opt: if includes %OPT_P, make a plot of the forecasts;
3248 * if includes %OPT_N, skip printing of the forecast
3249 * evaluation statistics.
3250 * @prn: printing struct.
3251 *
3252 * Prints the forecasts in @fr to @prn, and also plots the
3253 * forecasts if %OPT_P is given. If a plot is requested and
3254 * @fr includes forecast standard errors, then the options
3255 * %OPT_F or %OPT_L may be given to use "fill" style or lines,
3256 * respectively, for the confidence bands (the default style
3257 * being vertical bars per observation).
3258 *
3259 * Returns: 0 on success, non-zero error code on error.
3260 */
3261
text_print_forecast(const FITRESID * fr,DATASET * dset,gretlopt opt,PRN * prn)3262 int text_print_forecast (const FITRESID *fr, DATASET *dset,
3263 gretlopt opt, PRN *prn)
3264 {
3265 int do_errs = (fr->sderr != NULL);
3266 int obslen, pmax = fr->pmax;
3267 int errpmax = fr->pmax;
3268 int quiet = (opt & OPT_Q);
3269 int ywidth;
3270 double *maxerr = NULL;
3271 double conf = 100 * (1 - fr->alpha);
3272 double tval = 0;
3273 char label[32];
3274 int t, err = 0;
3275
3276 if (opt & OPT_T) {
3277 /* --stats-only */
3278 return fr_print_fc_stats(fr, OPT_D, prn);
3279 }
3280
3281 if (do_errs) {
3282 maxerr = malloc(fr->nobs * sizeof *maxerr);
3283 if (maxerr == NULL) {
3284 return E_ALLOC;
3285 }
3286 }
3287
3288 if (!quiet) {
3289 pputc(prn, '\n');
3290 }
3291
3292 if (do_errs) {
3293 double a2 = fr->alpha / 2;
3294
3295 tval = (fr->asymp)? normal_critval(a2) : student_critval(fr->df, a2);
3296
3297 if (!quiet) {
3298 if (fr->asymp) {
3299 pprintf(prn, _(" For %g%% confidence intervals, z(%g) = %.2f\n"),
3300 conf, a2, tval);
3301 } else {
3302 pprintf(prn, _(" For %g%% confidence intervals, t(%d, %g) = %.3f\n"),
3303 conf, fr->df, a2, tval);
3304 }
3305 }
3306 }
3307
3308 obslen = max_obs_marker_length(dset);
3309
3310 if (!quiet) {
3311 pputc(prn, '\n');
3312 }
3313
3314 bufspace(obslen + 1, prn);
3315
3316 maybe_trim_varname(label, fr->depvar);
3317 ywidth = strlen(label) + 1;
3318 if (ywidth < 12) {
3319 ywidth = 12;
3320 }
3321 pprintf(prn, "%*s", ywidth, label);
3322
3323 pprintf(prn, "%*s", UTF_WIDTH(_("prediction"), 14), _("prediction"));
3324
3325 if (do_errs) {
3326 pprintf(prn, "%*s", UTF_WIDTH(_(" std. error"), 14), _(" std. error"));
3327 pprintf(prn, _(" %g%% interval\n"), conf);
3328 } else {
3329 pputc(prn, '\n');
3330 }
3331
3332 pputc(prn, '\n');
3333
3334 if (do_errs) {
3335 for (t=0; t<fr->t1; t++) {
3336 maxerr[t] = NADBL;
3337 }
3338 if (pmax < 4) {
3339 errpmax = pmax + 1;
3340 }
3341 }
3342
3343 for (t=fr->t0; t<=fr->t2; t++) {
3344 print_obs_marker(t, dset, obslen, prn);
3345 fcast_print_x(fr->actual[t], ywidth + 2, pmax, prn);
3346
3347 if (na(fr->fitted[t])) {
3348 pputc(prn, '\n');
3349 continue;
3350 }
3351
3352 fcast_print_x(fr->fitted[t], 15, pmax, prn);
3353
3354 if (do_errs) {
3355 if (na(fr->sderr[t])) {
3356 maxerr[t] = NADBL;
3357 } else {
3358 fcast_print_x(fr->sderr[t], 15, errpmax, prn);
3359 maxerr[t] = tval * fr->sderr[t];
3360 fcast_print_x(fr->fitted[t] - maxerr[t], 15, pmax, prn);
3361 pputs(prn, " - ");
3362 fcast_print_x(fr->fitted[t] + maxerr[t], 10, pmax, prn);
3363 }
3364 }
3365 pputc(prn, '\n');
3366 }
3367
3368 pputc(prn, '\n');
3369
3370 if (!(opt & OPT_N)) {
3371 gretlopt fc_opt = OPT_D;
3372
3373 if (dataset_is_time_series(dset)) {
3374 fc_opt |= OPT_T;
3375 }
3376 fr_print_fc_stats(fr, fc_opt, prn);
3377 }
3378
3379 /* do we really want a plot for non-time series? */
3380
3381 if ((opt & OPT_P) && fr->nobs > 0) {
3382 err = plot_fcast_errs(fr, maxerr, dset, opt);
3383 }
3384
3385 if (maxerr != NULL) {
3386 free(maxerr);
3387 }
3388
3389 return err;
3390 }
3391
3392 /**
3393 * print_fit_resid:
3394 * @pmod: pointer to gretl model.
3395 * @dset: dataset struct.
3396 * @prn: gretl printing struct.
3397 *
3398 * Print to @prn the fitted values and residuals from @pmod.
3399 *
3400 * Returns: 0 on successful completion, 1 on error.
3401 */
3402
print_fit_resid(const MODEL * pmod,const DATASET * dset,PRN * prn)3403 int print_fit_resid (const MODEL *pmod, const DATASET *dset,
3404 PRN *prn)
3405 {
3406 FITRESID *fr;
3407 int err = 0;
3408
3409 fr = get_fit_resid(pmod, dset, &err);
3410
3411 if (!err) {
3412 text_print_fit_resid(fr, dset, prn);
3413 free_fit_resid(fr);
3414 }
3415
3416 return err;
3417 }
3418
print_iter_val(double x,int i,int k,PRN * prn)3419 static void print_iter_val (double x, int i, int k, PRN *prn)
3420 {
3421 if (na(x)) {
3422 pprintf(prn, "%-12s", "NA");
3423 } else {
3424 pprintf(prn, "%#12.5g", x);
3425 }
3426 if (i && i % 6 == 5 && i < k-1) {
3427 pprintf(prn, "\n%12s", " ");
3428 }
3429 }
3430
3431 /**
3432 * print_iter_info:
3433 * @iter: iteration number.
3434 * @crit: criterion (e.g. log-likelihood).
3435 * @type: type of criterion (%C_LOGLIK or %C_OTHER)
3436 * @k: number of parameters.
3437 * @b: parameter array.
3438 * @g: gradient array.
3439 * @sl: step length.
3440 * @prn: gretl printing struct.
3441 *
3442 * Print to @prn information pertaining to step @iter of an
3443 * iterative estimation process.
3444 */
3445
3446 void
print_iter_info(int iter,double crit,int type,int k,const double * b,const double * g,double sl,PRN * prn)3447 print_iter_info (int iter, double crit, int type, int k,
3448 const double *b, const double *g,
3449 double sl, PRN *prn)
3450 {
3451 const char *cstrs[] = {
3452 N_("loglikelihood"),
3453 N_("GMM criterion"),
3454 N_("SSR"),
3455 N_("Criterion"),
3456 };
3457 const char *cstr = cstrs[type];
3458 double x;
3459 int details;
3460 int sldone = 0;
3461 int i;
3462
3463 details = libset_get_int(MAX_VERBOSE) == 2;
3464
3465 if (type == C_GMM) {
3466 crit = -crit;
3467 } else if (type == C_SSR && crit < 0) {
3468 crit = -crit;
3469 }
3470
3471 if (iter < 0) {
3472 pprintf(prn, "--- %s:\n", _("FINAL VALUES"));
3473 } else if (details) {
3474 pprintf(prn, "%s %4d: ", _("Iteration"), iter);
3475 } else {
3476 if (iter == 1) {
3477 gretl_print_ensure_vspace(prn);
3478 pprintf(prn, "--- %s\n", _("Iteration"));
3479 }
3480 pprintf(prn, "%4d: ", iter);
3481 }
3482
3483 if (na(crit) || na(-crit)) {
3484 pprintf(prn, "%s = NA", _(cstr));
3485 } else if (details) {
3486 pprintf(prn, "%s = %#.12g", _(cstr), crit);
3487 } else {
3488 pprintf(prn, "%s %#.12g", _(cstr), crit);
3489 }
3490
3491 if (sl > 0.0 && !na(sl)) {
3492 if (details || g == NULL) {
3493 pprintf(prn, _(" (steplength = %g)"), sl);
3494 } else {
3495 pprintf(prn, _(" (step %g"), sl);
3496 sldone = 1;
3497 }
3498 }
3499
3500 if (details) {
3501 pputc(prn, '\n');
3502 if (b != NULL) {
3503 pputs(prn, _("Parameters: "));
3504 for (i=0; i<k; i++) {
3505 print_iter_val(b[i], i, k, prn);
3506 }
3507 pputc(prn, '\n');
3508 }
3509 }
3510
3511 if (g != NULL) {
3512 if (details) {
3513 pputs(prn, _("Gradients: "));
3514 }
3515 x = 0.0;
3516 for (i=0; i<k; i++) {
3517 x += fabs(b[i] * g[i]);
3518 if (details) {
3519 print_iter_val(g[i], i, k, prn);
3520 }
3521 }
3522 if (details) {
3523 pprintf(prn, " (%s %.2e)", _("norm"), sqrt(x/k));
3524 } else if (sldone) {
3525 pprintf(prn, ", %s %.2e)", _("norm"), sqrt(x/k));
3526 } else {
3527 pprintf(prn, " (%s %.2e)", _("norm"), sqrt(x/k));
3528 }
3529 if (details || iter == -1) {
3530 pputc(prn, '\n');
3531 }
3532 }
3533
3534 if (iter >= 0) {
3535 pputc(prn, '\n');
3536 }
3537 }
3538
in_usa(void)3539 int in_usa (void)
3540 {
3541 static int ustime = -1;
3542
3543 if (ustime < 0) {
3544 char test[12];
3545 struct tm t = {0};
3546
3547 t.tm_year = 100;
3548 t.tm_mon = 0;
3549 t.tm_mday = 31;
3550
3551 strftime(test, sizeof test, "%x", &t);
3552
3553 if (!strncmp(test, "01/31", 5)) {
3554 ustime = 1;
3555 } else {
3556 ustime = 0;
3557 }
3558 }
3559
3560 return ustime;
3561 }
3562
3563 typedef struct readbuf_ readbuf;
3564
3565 struct readbuf_ {
3566 const char *start;
3567 const char *point;
3568 };
3569
3570 static readbuf *rbuf;
3571 static int n_bufs;
3572
matching_buffer(const char * s)3573 static readbuf *matching_buffer (const char *s)
3574 {
3575 int i;
3576
3577 for (i=0; i<n_bufs; i++) {
3578 if (rbuf[i].start == s) {
3579 return &rbuf[i];
3580 }
3581 }
3582
3583 return NULL;
3584 }
3585
3586 /**
3587 * bufgets_init:
3588 * @buf: source buffer.
3589 *
3590 * Initializes a text buffer for use with bufgets().
3591 *
3592 * Returns: 0 on success, non-zero on error.
3593 */
3594
bufgets_init(const char * buf)3595 int bufgets_init (const char *buf)
3596 {
3597 readbuf *tmp = matching_buffer(buf);
3598 int i, err = 0;
3599
3600 if (buf == NULL) {
3601 fprintf(stderr, "bufgets_init: got NULL argument\n");
3602 return 1;
3603 } else if (tmp != NULL) {
3604 fprintf(stderr, "GRETL ERROR: buffer at %p is already "
3605 "initialized\n", (void *) buf);
3606 return 1;
3607 }
3608
3609 for (i=0; i<n_bufs; i++) {
3610 if (rbuf[i].start == NULL) {
3611 /* OK, re-use an existing slot */
3612 rbuf[i].start = rbuf[i].point = buf;
3613 return 0;
3614 }
3615 }
3616
3617 tmp = realloc(rbuf, (n_bufs + 1) * sizeof *tmp);
3618
3619 if (tmp == NULL) {
3620 err = E_ALLOC;
3621 } else {
3622 rbuf = tmp;
3623 rbuf[n_bufs].start = rbuf[n_bufs].point = buf;
3624 n_bufs++;
3625 }
3626
3627 return err;
3628 }
3629
query_bufgets_init(const char * buf)3630 int query_bufgets_init (const char *buf)
3631 {
3632 if (matching_buffer(buf) != NULL) {
3633 return 0; /* OK */
3634 } else {
3635 return bufgets_init(buf);
3636 }
3637 }
3638
rbuf_get_point(const char * s)3639 static const char *rbuf_get_point (const char *s)
3640 {
3641 readbuf *rbuf = matching_buffer(s);
3642
3643 return (rbuf == NULL)? NULL : rbuf->point;
3644 }
3645
rbuf_set_point(const char * s,const char * p)3646 static void rbuf_set_point (const char *s, const char *p)
3647 {
3648 readbuf *rbuf = matching_buffer(s);
3649
3650 if (rbuf != NULL) {
3651 rbuf->point = p;
3652 }
3653 }
3654
3655 /**
3656 * bufgets_finalize:
3657 * @buf: source buffer.
3658 *
3659 * Signals that we are done reading from @buf.
3660 */
3661
bufgets_finalize(const char * buf)3662 void bufgets_finalize (const char *buf)
3663 {
3664 readbuf *rbuf = matching_buffer(buf);
3665
3666 if (rbuf != NULL) {
3667 rbuf->start = rbuf->point = NULL;
3668 }
3669 }
3670
3671 /**
3672 * bufgets:
3673 * @s: target string (must be pre-allocated).
3674 * @size: maximum number of characters to read.
3675 * @buf: source buffer.
3676 *
3677 * This function works much like fgets, reading successive lines
3678 * from a buffer rather than a file.
3679 * Important note: use of bufgets() on a particular buffer must be
3680 * preceded by a call to bufgets_init() on the same buffer, and must be
3681 * followed by a call to bufgets_finalize(), again on the same
3682 * buffer.
3683 *
3684 * Returns: @s (or %NULL if nothing more can be read from @buf).
3685 */
3686
bufgets(char * s,size_t size,const char * buf)3687 char *bufgets (char *s, size_t size, const char *buf)
3688 {
3689 enum {
3690 GOT_LF = 1,
3691 GOT_CR,
3692 GOT_CRLF
3693 };
3694 int i, status = 0;
3695 const char *p;
3696
3697 p = rbuf_get_point(buf);
3698 if (p == NULL) {
3699 return NULL;
3700 }
3701
3702 if (*p == '\0') {
3703 /* reached the end of the buffer */
3704 return NULL;
3705 }
3706
3707 *s = 0;
3708 /* advance to line-end, end of buffer, or maximum size,
3709 whichever comes first */
3710 for (i=0; ; i++) {
3711 s[i] = p[i];
3712 if (p[i] == '\0') {
3713 break;
3714 }
3715 if (p[i] == '\r') {
3716 s[i] = '\0';
3717 if (p[i+1] == '\n') {
3718 status = GOT_CRLF;
3719 } else {
3720 status = GOT_CR;
3721 }
3722 break;
3723 }
3724 if (p[i] == '\n') {
3725 s[i] = '\0';
3726 status = GOT_LF;
3727 break;
3728 }
3729 if (i == size - 1) {
3730 fprintf(stderr, "*** bufgets: line too long: max %d characters\n",
3731 (int) size);
3732 s[i] = '\0';
3733 fprintf(stderr, " '%.16s...'\n", s);
3734 break;
3735 }
3736 }
3737
3738 /* advance the buffer pointer */
3739 p += i;
3740 if (status == GOT_CR || status == GOT_LF) {
3741 p++;
3742 } else if (status == GOT_CRLF) {
3743 p += 2;
3744 }
3745
3746 /* replace newline */
3747 if (status && i < size - 1) {
3748 strcat(s, "\n");
3749 }
3750
3751 rbuf_set_point(buf, p);
3752
3753 return s;
3754 }
3755
bufgets_peek_line_length(const char * buf)3756 size_t bufgets_peek_line_length (const char *buf)
3757 {
3758 const char *p = rbuf_get_point(buf);
3759 size_t len = 0;
3760
3761 if (p == NULL || *p == '\0') {
3762 return 0;
3763 }
3764
3765 while (*p) {
3766 if (*p == '\r' || *p == '\n') {
3767 break;
3768 } else {
3769 len++;
3770 p++;
3771 }
3772 }
3773
3774 return len + 1;
3775 }
3776
3777 /**
3778 * bufseek:
3779 * @buf: char buffer.
3780 * @offset: offset from start of @buf.
3781 *
3782 * Buffer equivalent of fseek() with SEEK_SET. Note that @buf
3783 * must first be initialized via bufgets_init().
3784 *
3785 * Returns: 0 on success, 1 on error.
3786 */
3787
bufseek(const char * buf,long int offset)3788 int bufseek (const char *buf, long int offset)
3789 {
3790 readbuf *rbuf = matching_buffer(buf);
3791
3792 if (rbuf != NULL) {
3793 rbuf->point = rbuf->start + offset;
3794 return 0;
3795 }
3796
3797 return 1;
3798 }
3799
3800 /**
3801 * buf_rewind:
3802 * @buf: char buffer.
3803 *
3804 * Buffer equivalent of rewind(). Note that @buf
3805 * must first be initialized using bufgets_init().
3806 */
3807
buf_rewind(const char * buf)3808 void buf_rewind (const char *buf)
3809 {
3810 bufseek(buf, 0);
3811 }
3812
3813 /**
3814 * buf_back_lines:
3815 * @buf: char buffer.
3816 * @n: number of lines.
3817 *
3818 * Applies only when @buf has been initialized with bufgets_init().
3819 * Moves the reading point of @buf for bufgets() back by @n lines,
3820 * if possible, or to the start of the buffer if @n is greater than
3821 * the number of previous lines.
3822 *
3823 * Returns: 0 on success, 1 on error.
3824 */
3825
buf_back_lines(const char * buf,int n)3826 int buf_back_lines (const char *buf, int n)
3827 {
3828 readbuf *rbuf = matching_buffer(buf);
3829
3830 if (rbuf != NULL) {
3831 const char *p = rbuf->point;
3832 int i, len = p - rbuf->start;
3833 int count = 0;
3834
3835 for (i=0; i<len; i++) {
3836 p--;
3837 if (*p == '\n') {
3838 count++;
3839 }
3840 if (count == n + 1) {
3841 p++;
3842 break;
3843 }
3844 }
3845 rbuf->point = p;
3846 return 0;
3847 }
3848
3849 return 1;
3850 }
3851
3852 /**
3853 * buftell:
3854 * @buf: char buffer.
3855 *
3856 * Buffer equivalent of ftell. Note that @buf
3857 * must first be initialized via bufgets_init().
3858 *
3859 * Returns: offset from start of buffer.
3860 */
3861
buftell(const char * buf)3862 long buftell (const char *buf)
3863 {
3864 readbuf *rbuf = matching_buffer(buf);
3865
3866 return (rbuf == NULL)? 0 : rbuf->point - rbuf->start;
3867 }
3868
3869 /* for internal use */
3870
bufgets_cleanup(void)3871 void bufgets_cleanup (void)
3872 {
3873 if (n_bufs > 0) {
3874 free(rbuf);
3875 rbuf = NULL;
3876 n_bufs = 0;
3877 }
3878 }
3879