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 /* model_table.c for gretl */
21
22 #include "gretl.h"
23 #include "model_table.h"
24 #include "session.h"
25 #include "textutil.h"
26 #include "textbuf.h"
27 #include "texprint.h"
28
29 static MODEL **table_models;
30 static int n_models;
31 static char **pnames;
32 static int n_params;
33 static int depvarnum;
34
35 /* may be governed by, and saved in, rc file */
36 static int colheads;
37 static int use_tstats;
38 static int do_pvals;
39 static int do_asts = 1;
40 static int mt_figs = 4; /* figures for printing */
41 static char mt_fmt = 'g'; /* floating-point format ('g' or 'f') */
42
43 static void print_rtf_row_spec (PRN *prn, int tall);
44
45 #define MAX_PORTRAIT_MODELS 6
46 #define MAX_TABLE_MODELS 12
47
48 enum {
49 COLHEAD_ARABIC,
50 COLHEAD_ROMAN,
51 COLHEAD_ALPHA,
52 COLHEAD_NAMES
53 };
54
mtable_errmsg(char * msg,int gui)55 static void mtable_errmsg (char *msg, int gui)
56 {
57 if (gui) {
58 errbox(msg);
59 } else {
60 gretl_errmsg_set(msg);
61 }
62
63 fprintf(stderr, "%s\n", msg);
64 }
65
real_table_n_models(void)66 static int real_table_n_models (void)
67 {
68 int i, len = 0;
69
70 for (i=0; i<n_models; i++) {
71 if (table_models[i] != NULL) {
72 len++;
73 }
74 }
75
76 return len;
77 }
78
model_table_too_many(int gui)79 static int model_table_too_many (int gui)
80 {
81 if (real_table_n_models() == MAX_TABLE_MODELS) {
82 mtable_errmsg(_("Model table is full"), gui);
83 return 1;
84 }
85
86 return 0;
87 }
88
in_model_table(const MODEL * pmod)89 int in_model_table (const MODEL *pmod)
90 {
91 int i;
92
93 if (pmod == NULL || n_models == 0) {
94 return 0;
95 }
96
97 for (i=0; i<n_models; i++) {
98 if (table_models[i] == NULL) {
99 continue;
100 }
101 if (pmod == table_models[i] || pmod->ID == table_models[i]->ID) {
102 return 1;
103 }
104 }
105
106 return 0;
107 }
108
table_model_list(void)109 GList *table_model_list (void)
110 {
111 GList *list = NULL;
112
113 if (n_models > 0) {
114 int i;
115
116 for (i=0; i<n_models; i++) {
117 if (table_models[i] != NULL) {
118 list = g_list_append(list, table_models[i]);
119 }
120 }
121 }
122
123 return list;
124 }
125
model_table_n_models(void)126 int model_table_n_models (void)
127 {
128 return n_models;
129 }
130
model_table_landscape(void)131 int model_table_landscape (void)
132 {
133 return n_models > MAX_PORTRAIT_MODELS;
134 }
135
model_table_model_by_index(int i)136 MODEL *model_table_model_by_index (int i)
137 {
138 if (i >= 0 && i < n_models) {
139 return table_models[i];
140 } else {
141 return NULL;
142 }
143 }
144
model_table_position(const MODEL * pmod)145 int model_table_position (const MODEL *pmod)
146 {
147 int i;
148
149 for (i=0; i<n_models; i++) {
150 if (pmod == table_models[i]) {
151 return i + 1;
152 }
153 }
154
155 return 0;
156 }
157
clear_model_table(int on_exit,PRN * prn)158 void clear_model_table (int on_exit, PRN *prn)
159 {
160 int i;
161
162 if (!on_exit && n_models > 0) {
163 mark_session_changed();
164 }
165
166 for (i=0; i<n_models; i++) {
167 /* reduce refcount on the model pointer */
168 if (table_models[i] != NULL) {
169 gretl_object_unref(table_models[i], GRETL_OBJ_EQN);
170 }
171 }
172
173 free(table_models);
174 table_models = NULL;
175
176 strings_array_free(pnames, n_params);
177 pnames = NULL;
178 n_params = 0;
179
180 n_models = 0;
181
182 if (prn != NULL) {
183 pputs(prn, _("Model table cleared"));
184 pputc(prn, '\n');
185 }
186 }
187
model_table_depvar(void)188 static int model_table_depvar (void)
189 {
190 int i;
191
192 for (i=0; i<n_models; i++) {
193 if (table_models[i] != NULL &&
194 table_models[i]->list != NULL &&
195 table_models[i]->list[0] > 0) {
196 return table_models[i]->list[1];
197 }
198 }
199
200 return -1;
201 }
202
model_table_precheck(MODEL * pmod,int add_mode)203 static int model_table_precheck (MODEL *pmod, int add_mode)
204 {
205 int gui = (add_mode != MODEL_ADD_BY_CMD);
206
207 if (pmod == NULL) {
208 return 1;
209 }
210
211 /* various sorts of models that will not work */
212 if (pmod->ci == NLS || pmod->ci == MLE || pmod->ci == GMM ||
213 pmod->ci == DPANEL || pmod->ci == INTREG || pmod->ci == BIPROBIT) {
214 mtable_errmsg(_("Sorry, this model can't be put in the model table"),
215 gui);
216 return 1;
217 }
218
219 /* nor will ARMA, GARCH */
220 if (pmod->ci == ARMA || pmod->ci == GARCH) {
221 mtable_errmsg(_("Sorry, this model can't be put in the model table"),
222 gui);
223 return 1;
224 }
225
226 if (n_models > 0) {
227 int dv = model_table_depvar();
228
229 /* check that the dependent variable is in common */
230 if (pmod->list[1] != dv) {
231 mtable_errmsg(_("Can't add model to table -- this model has a "
232 "different dependent variable"), gui);
233 return 1;
234 }
235
236 /* check that model is not already on the list */
237 if (in_model_table(pmod)) {
238 mtable_errmsg(_("Model is already included in the table"), 0);
239 return 1;
240 }
241
242 /* check that the model table is not already full */
243 if (model_table_too_many(gui)) {
244 return 1;
245 }
246 }
247
248 return 0;
249 }
250
251 /* @pos will usually be 0, which means: add to end of model table array.
252 But when reconstituting a session, @pos may be a 1-based index of
253 the position within the array that this model should occupy.
254 */
255
real_add_to_model_table(MODEL * pmod,int add_mode,int pos,PRN * prn)256 static int real_add_to_model_table (MODEL *pmod, int add_mode,
257 int pos, PRN *prn)
258 {
259 int i, n = (pos == 0)? n_models + 1 : pos;
260
261 /* is the list started or not? */
262 if (n_models == 0) {
263 table_models = mymalloc(n * sizeof *table_models);
264 if (table_models == NULL) {
265 return 1;
266 }
267 for (i=0; i<n; i++) {
268 table_models[i] = NULL;
269 }
270 n_models = n;
271 } else if (pos == 0 || pos > n_models) {
272 MODEL **mods;
273
274 mods = myrealloc(table_models, n * sizeof *mods);
275 if (mods == NULL) {
276 clear_model_table(0, NULL);
277 return 1;
278 }
279
280 for (i=n_models; i<n; i++) {
281 mods[i] = NULL;
282 }
283
284 table_models = mods;
285 n_models = n;
286 }
287
288 table_models[n-1] = pmod;
289
290 /* augment refcount so model won't get deleted */
291 gretl_object_ref(pmod, GRETL_OBJ_EQN);
292
293 if (add_mode == MODEL_ADD_FROM_MENU) {
294 infobox(_("Model added to table"));
295 } else if (add_mode == MODEL_ADD_BY_CMD) {
296 pputs(prn, _("Model added to table"));
297 pputc(prn, '\n');
298 }
299
300 mark_session_changed();
301
302 return 0;
303 }
304
add_to_model_table(MODEL * pmod,int add_mode,int pos,PRN * prn)305 int add_to_model_table (MODEL *pmod, int add_mode, int pos, PRN *prn)
306 {
307 if (model_table_precheck(pmod, add_mode)) {
308 fprintf(stderr, "add_to_model_table: precheck failed\n");
309 return 1;
310 }
311
312 return real_add_to_model_table(pmod, add_mode, pos, prn);
313 }
314
remove_from_model_table(MODEL * pmod)315 void remove_from_model_table (MODEL *pmod)
316 {
317 if (n_models > 0) {
318 int pos = model_table_position(pmod);
319
320 if (pos == 0) {
321 /* not present */
322 return;
323 } else if (n_models == 1) {
324 /* it's the only model in the table */
325 clear_model_table(0, NULL);
326 } else {
327 /* remove and reshuffle */
328 int i;
329
330 gretl_object_unref(pmod, GRETL_OBJ_EQN);
331
332 for (i=pos-1; i<n_models-1; i++) {
333 table_models[i] = table_models[i+1];
334 }
335
336 table_models[n_models-1] = NULL;
337 n_models--;
338 }
339 }
340 }
341
on_param_list(const char * pname)342 static int on_param_list (const char *pname)
343 {
344 int i;
345
346 for (i=0; i<n_params; i++) {
347 if (!strcmp(pname, pnames[i])) {
348 return 1;
349 }
350 }
351
352 return 0;
353 }
354
add_to_param_list(const MODEL * pmod)355 static int add_to_param_list (const MODEL *pmod)
356 {
357 char pname[VNAMELEN];
358 int i, err = 0;
359
360 for (i=0; i<pmod->ncoeff && !err; i++) {
361 gretl_model_get_param_name(pmod, dataset, i, pname);
362 if (!on_param_list(pname)) {
363 err = strings_array_add(&pnames, &n_params, pname);
364 }
365 }
366
367 return err;
368 }
369
make_full_param_list(void)370 static int make_full_param_list (void)
371 {
372 const MODEL *pmod;
373 int first = 1;
374 int i, err = 0;
375
376 strings_array_free(pnames, n_params);
377 pnames = NULL;
378 n_params = 0;
379
380 for (i=0; i<n_models && !err; i++) {
381 if (table_models[i] != NULL) {
382 pmod = table_models[i];
383 if (first) {
384 depvarnum = gretl_model_get_depvar(pmod);
385 first = 0;
386 }
387 err = add_to_param_list(pmod);
388 }
389 }
390
391 return err;
392 }
393
model_table_is_empty(void)394 static int model_table_is_empty (void)
395 {
396 int i, n = 0;
397
398 if (n_models == 0 || table_models == NULL) {
399 return 1;
400 }
401
402 for (i=0; i<n_models; i++) {
403 if (table_models[i] != NULL) {
404 n++;
405 }
406 }
407
408 return (n == 0);
409 }
410
common_estimator(void)411 static int common_estimator (void)
412 {
413 int i, ci0 = -1;
414
415 for (i=0; i<n_models; i++) {
416 if (table_models[i] != NULL) {
417 if (ci0 == -1) {
418 ci0 = table_models[i]->ci;
419 } else if (table_models[i]->ci != ci0) {
420 return 0;
421 }
422 }
423 }
424
425 return ci0;
426 }
427
common_df(void)428 static int common_df (void)
429 {
430 int i, dfn0 = -1, dfd0 = -1;
431
432 for (i=0; i<n_models; i++) {
433 if (table_models[i] != NULL) {
434 if (dfn0 == -1) {
435 dfn0 = table_models[i]->dfn;
436 dfd0 = table_models[i]->dfd;
437 } else {
438 if (table_models[i]->dfn != dfn0 ||
439 table_models[i]->dfd != dfd0) {
440 return 0;
441 }
442 }
443 }
444 }
445
446 return 1;
447 }
448
short_estimator_string(const MODEL * pmod,PRN * prn)449 static const char *short_estimator_string (const MODEL *pmod, PRN *prn)
450 {
451 if (pmod->ci == HSK) {
452 return N_("HSK");
453 } else if (pmod->ci == ARCH) {
454 return N_("ARCH");
455 } else if (pmod->ci == WLS) {
456 if (gretl_model_get_int(pmod, "iters")) {
457 return N_("MLE");
458 } else {
459 return N_("WLS");
460 }
461 } else if (pmod->ci == PANEL) {
462 if (pmod->opt & OPT_F) {
463 return N_("Within");
464 } else if (pmod->opt & OPT_U) {
465 return N_("GLS");
466 } else {
467 return N_("Between");
468 }
469 } else if (pmod->ci == AR1) {
470 if (pmod->opt & OPT_H) {
471 return N_("HILU");
472 } else if (pmod->opt & OPT_P) {
473 return N_("PWE");
474 } else {
475 return N_("CORC");
476 }
477 } else {
478 return estimator_string(pmod, prn);
479 }
480 }
481
get_asts(double pval,int tex)482 static const char *get_asts (double pval, int tex)
483 {
484 if (pval < 0.01) {
485 return tex ? "$^{***}$" : "***";
486 } else if (pval < 0.05) {
487 return tex ? "$^{**}$" : "**";
488 } else if (pval < 0.10) {
489 return tex ? "$^{*}$" : "*";
490 } else {
491 return tex ? "" : " ";
492 }
493 }
494
get_pre_asts(double pval)495 static const char *get_pre_asts (double pval)
496 {
497 if (pval < 0.01) {
498 return "$\\,\\,\\,$";
499 } else if (pval < 0.05) {
500 return "$\\,\\,$";
501 } else if (pval < 0.10) {
502 return "$\\,$";
503 } else {
504 return "";
505 }
506 }
507
terminate_coeff_row(int namewidth,PRN * prn)508 static void terminate_coeff_row (int namewidth, PRN *prn)
509 {
510 if (tex_format(prn)) {
511 pputs(prn, "\\\\\n");
512 } else if (rtf_format(prn)) {
513 pputs(prn, "\\intbl \\row\n");
514 print_rtf_row_spec(prn, 1);
515 pputs(prn, "\\intbl ");
516 } else {
517 pputc(prn, '\n');
518 bufspace(namewidth + 2, prn);
519 }
520 }
521
modtab_get_pval(const MODEL * pmod,int k)522 static double modtab_get_pval (const MODEL *pmod, int k)
523 {
524 double x = pmod->coeff[k];
525 double s = pmod->sderr[k];
526 double pval = NADBL;
527
528 if (!na(x) && !na(s)) {
529 pval = coeff_pval(pmod->ci, x / s, pmod->dfd);
530 }
531
532 return pval;
533 }
534
mt_print_value(char * s,double x)535 static void mt_print_value (char *s, double x)
536 {
537 if (mt_fmt == 'f') {
538 sprintf(s, "%.*f", mt_figs, x);
539 } else {
540 sprintf(s, "%#.*g", mt_figs, x);
541 gretl_fix_exponent(s);
542 }
543 }
544
print_model_table_coeffs(int namewidth,int colwidth,PRN * prn)545 static void print_model_table_coeffs (int namewidth, int colwidth, PRN *prn)
546 {
547 const MODEL *pmod;
548 char numstr[32], tmp[64];
549 int tex = tex_format(prn);
550 int rtf = rtf_format(prn);
551 int i, j, k;
552
553 /* loop across all variables that appear in any model */
554
555 for (i=0; i<n_params; i++) {
556 char *pname = pnames[i];
557 int first_coeff = 1;
558 int first_se = 1;
559 int first_pval = 1;
560
561 if (tex) {
562 tex_escape(tmp, pname);
563 pprintf(prn, "%s ", tmp);
564 } else if (rtf) {
565 print_rtf_row_spec(prn, 0);
566 pprintf(prn, "\\intbl \\qc %s\\cell ", pname);
567 } else if (strlen(pnames[i]) > namewidth) {
568 sprintf(tmp, "%.*s...", namewidth - 3, pname);
569 pprintf(prn, "%-*s ", namewidth, tmp);
570 } else {
571 pprintf(prn, "%-*s ", namewidth, pname);
572 }
573
574 /* print the coefficient estimates across a row */
575
576 for (j=0; j<n_models; j++) {
577 pmod = table_models[j];
578 if (pmod == NULL) {
579 continue;
580 }
581 if ((k = gretl_model_get_param_number(pmod, dataset, pname)) >= 0) {
582 double x = screen_zero(pmod->coeff[k]);
583
584 mt_print_value(numstr, x);
585
586 if (do_asts) {
587 double pval = modtab_get_pval(pmod, k);
588
589 if (tex) {
590 if (x < 0) {
591 pprintf(prn, "& %s$-$%s%s ", get_pre_asts(pval),
592 numstr + 1, get_asts(pval, 1));
593 } else {
594 pprintf(prn, "& %s%s%s ", get_pre_asts(pval),
595 numstr, get_asts(pval, 1));
596 }
597 } else if (rtf) {
598 pprintf(prn, "\\qc %s%s\\cell ", numstr, get_asts(pval, 0));
599 } else {
600 /* note: strlen(asts) = 3 */
601 pprintf(prn, "%*s%s", (first_coeff)? colwidth : colwidth - 3,
602 numstr, get_asts(pval, 0));
603 }
604 } else {
605 /* not showing asterisks */
606 if (tex) {
607 if (x < 0) {
608 pprintf(prn, "& $-$%s ", numstr + 1);
609 } else {
610 pprintf(prn, "& %s ", numstr);
611 }
612 } else if (rtf) {
613 pprintf(prn, "\\qc %s\\cell ", numstr);
614 } else {
615 pprintf(prn, "%*s", colwidth, numstr);
616 }
617 }
618 first_coeff = 0;
619 } else {
620 /* variable not present in this column */
621 if (tex) {
622 pputs(prn, "& ");
623 } else if (rtf) {
624 pputs(prn, "\\qc \\cell ");
625 } else {
626 bufspace(colwidth, prn);
627 }
628 }
629 }
630
631 terminate_coeff_row(namewidth, prn);
632
633 /* print the t-stats or standard errors across a row */
634
635 for (j=0; j<n_models; j++) {
636 pmod = table_models[j];
637 if (pmod == NULL) {
638 continue;
639 }
640 if ((k = gretl_model_get_param_number(pmod, dataset, pname)) >= 0) {
641 double val;
642
643 if (use_tstats) {
644 val = pmod->coeff[k] / pmod->sderr[k];
645 } else {
646 val = pmod->sderr[k];
647 }
648
649 mt_print_value(numstr, val);
650
651 if (tex) {
652 if (val < 0) {
653 pprintf(prn, "& \\subsize{($-$%s)} ", numstr + 1);
654 } else {
655 pprintf(prn, "& \\subsize{(%s)} ", numstr);
656 }
657 } else if (rtf) {
658 if (first_se) {
659 pputs(prn, "\\qc \\cell ");
660 }
661 pprintf(prn, "\\qc (%s)\\cell ", numstr);
662 } else {
663 sprintf(tmp, "(%s)", numstr);
664 pprintf(prn, "%*s", colwidth, tmp);
665 }
666 first_se = 0;
667 } else {
668 /* variable not present in this column */
669 if (tex) {
670 pputs(prn, "& ");
671 } else if (rtf) {
672 pputs(prn, "\\qc \\cell ");
673 } else {
674 bufspace(colwidth, prn);
675 }
676 }
677 }
678
679 if (do_pvals) {
680 terminate_coeff_row(namewidth, prn);
681 for (j=0; j<n_models; j++) {
682 pmod = table_models[j];
683 if (pmod == NULL) {
684 continue;
685 }
686 if ((k = gretl_model_get_param_number(pmod, dataset, pname)) >= 0) {
687 double pval = modtab_get_pval(pmod, k);
688
689 if (na(pval)) {
690 strcpy(numstr, "NA");
691 } else {
692 sprintf(numstr, "%.*f", mt_figs, pval);
693 }
694
695 if (tex) {
696 pprintf(prn, "& \\subsize{[%s]} ", numstr);
697 } else if (rtf) {
698 if (first_pval) {
699 pputs(prn, "\\qc \\cell ");
700 }
701 pprintf(prn, "\\qc [%s]\\cell ", numstr);
702 } else {
703 sprintf(tmp, "[%s]", numstr);
704 pprintf(prn, "%*s", colwidth, tmp);
705 }
706 first_pval = 0;
707 } else {
708 /* variable not present in this column */
709 if (tex) {
710 pputs(prn, "& ");
711 } else if (rtf) {
712 pputs(prn, "\\qc \\cell ");
713 } else {
714 bufspace(colwidth, prn);
715 }
716 }
717 }
718 }
719
720 if (tex) {
721 pputs(prn, "\\\\ [4pt] \n");
722 } else if (rtf) {
723 pputs(prn, "\\intbl \\row\n");
724 } else {
725 pputs(prn, "\n\n");
726 }
727 }
728 }
729
730 enum {
731 MT_LNL,
732 MT_RSQ,
733 MT_FSTAT
734 };
735
any_stat(int s)736 static int any_stat (int s)
737 {
738 int i;
739
740 for (i=0; i<n_models; i++) {
741 if (table_models[i] != NULL) {
742 if (s == MT_LNL && !na(table_models[i]->lnL)) {
743 return 1;
744 } else if (s == MT_RSQ && !na(table_models[i]->rsq)) {
745 return 1;
746 } else if (s == MT_FSTAT && !na(table_models[i]->fstt)) {
747 return 1;
748 }
749 }
750 }
751
752 return 0;
753 }
754
catch_bad_point(char * s)755 static int catch_bad_point (char *s)
756 {
757 int len = strlen(s);
758 int c = s[len-1];
759
760 if (c == '.' || c == ',') {
761 s[len-1] = '\0';
762 return 1;
763 } else {
764 return 0;
765 }
766 }
767
print_equation_stats(int width0,int colwidth,PRN * prn,int * binary)768 static void print_equation_stats (int width0, int colwidth, PRN *prn,
769 int *binary)
770 {
771 const MODEL *pmod;
772 int same_df, any_R2, any_ll;
773 int tex = tex_format(prn);
774 int rtf = rtf_format(prn);
775 double rsq;
776 int j;
777
778 if (rtf) {
779 print_rtf_row_spec(prn, 0);
780 }
781
782 if (tex) {
783 pprintf(prn, "$%s$ ", _("n"));
784 } else if (rtf) {
785 pprintf(prn, "\\intbl \\qc %s\\cell ", _("n"));
786 } else {
787 pprintf(prn, "%*s", width0, _("n"));
788 }
789
790 for (j=0; j<n_models; j++) {
791 pmod = table_models[j];
792 if (pmod != NULL) {
793 if (tex) {
794 pprintf(prn, "& %d ", pmod->nobs);
795 } else if (rtf) {
796 pprintf(prn, "\\qc %d\\cell ", pmod->nobs);
797 } else {
798 pprintf(prn, "%*d", colwidth, pmod->nobs);
799 }
800 }
801 }
802
803 if (tex) {
804 pputs(prn, "\\\\\n");
805 } else if (rtf) {
806 pputs(prn, "\\intbl \\row\n\\intbl ");
807 } else {
808 pputc(prn, '\n');
809 }
810
811 same_df = common_df();
812
813 any_R2 = any_stat(MT_RSQ);
814 any_ll = any_stat(MT_LNL);
815
816 if (any_R2) {
817 /* print R^2 values */
818 if (tex) {
819 pputs(prn, (same_df)? "$R^2$" : "$\\bar R^2$ ");
820 } else if (rtf) {
821 pprintf(prn, "\\qc %s\\cell ",
822 (same_df)? "R{\\super 2}" : _("Adj. R{\\super 2}"));
823 } else {
824 pprintf(prn, "%*s", width0, (same_df)? _("R-squared") :
825 _("Adj. R**2"));
826 }
827
828 for (j=0; j<n_models; j++) {
829 pmod = table_models[j];
830 if (pmod == NULL) continue;
831 if (pmod->ci == LOGIT || pmod->ci == PROBIT) {
832 rsq = pmod->rsq;
833 } else {
834 rsq = (same_df)? pmod->rsq : pmod->adjrsq;
835 }
836 if (na(rsq)) {
837 if (tex) {
838 pputs(prn, "& ");
839 } else if (rtf) {
840 pputs(prn, "\\qc \\cell ");
841 } else {
842 pputs(prn, " ");
843 }
844 } else if (pmod->ci == LOGIT || pmod->ci == PROBIT) {
845 *binary = 1;
846 /* McFadden */
847 if (tex) {
848 pprintf(prn, "& %.*f ", mt_figs, pmod->rsq);
849 } else if (rtf) {
850 pprintf(prn, "\\qc %.*f\\cell ", mt_figs, pmod->rsq);
851 } else {
852 pprintf(prn, "%*.*f", colwidth, mt_figs, pmod->rsq);
853 }
854 } else {
855 if (tex) {
856 pprintf(prn, "& %.*f ", mt_figs, rsq);
857 } else if (rtf) {
858 pprintf(prn, "\\qc %.*f\\cell ", mt_figs, rsq);
859 } else {
860 pprintf(prn, "%*.*f", colwidth, mt_figs, rsq);
861 }
862 }
863 }
864
865 if (tex) {
866 pputs(prn, "\\\\\n");
867 } else if (rtf) {
868 pputs(prn, "\\intbl \\row\n");
869 } else {
870 pputc(prn, '\n');
871 if (!any_ll) {
872 pputc(prn, '\n');
873 }
874 }
875 }
876
877 if (any_ll) {
878 /* print log-likelihoods */
879 if (tex) {
880 pputs(prn, "$\\ell$");
881 } else if (rtf) {
882 pputs(prn, "\\qc lnL\\cell ");
883 } else {
884 pprintf(prn, "%*s", width0, "lnL");
885 }
886
887 for (j=0; j<n_models; j++) {
888 pmod = table_models[j];
889 if (pmod == NULL) continue;
890 if (na(pmod->lnL)) {
891 if (tex) {
892 pputs(prn, "& ");
893 } else if (rtf) {
894 pputs(prn, "\\qc \\cell ");
895 } else {
896 pputs(prn, " ");
897 }
898 } else {
899 gchar *numstr = NULL;
900
901 if (tex) {
902 if (pmod->lnL > 0) {
903 numstr = g_strdup_printf("%#.*g", mt_figs, pmod->lnL);
904 catch_bad_point(numstr);
905 pprintf(prn, "& %s ", numstr);
906 } else {
907 numstr = g_strdup_printf("%#.*g", mt_figs, -pmod->lnL);
908 catch_bad_point(numstr);
909 pprintf(prn, "& $-$%s ", numstr);
910 }
911 } else if (rtf) {
912 numstr = g_strdup_printf("%#.*g", mt_figs, pmod->lnL);
913 catch_bad_point(numstr);
914 pprintf(prn, "\\qc %s\\cell ", numstr);
915 } else {
916 /* plain text */
917 numstr = g_strdup_printf("%#*.*g", colwidth, mt_figs, pmod->lnL);
918 if (catch_bad_point(numstr)) {
919 g_free(numstr);
920 numstr = g_strdup_printf("%#*.*g", colwidth + 1, mt_figs, pmod->lnL);
921 catch_bad_point(numstr);
922 }
923 pputs(prn, numstr);
924 }
925 g_free(numstr);
926 }
927 }
928
929 if (tex) {
930 pputs(prn, "\\\\\n");
931 } else if (rtf) {
932 pputs(prn, "\\intbl \\row\n");
933 } else {
934 pputs(prn, "\n\n");
935 }
936 }
937 }
938
mtab_max_namelen(void)939 static int mtab_max_namelen (void)
940 {
941 int i, len, maxlen = 8;
942
943 for (i=0; i<n_params; i++) {
944 len = strlen(pnames[i]);
945 if (len > maxlen) {
946 maxlen = len;
947 }
948 }
949
950 if (maxlen > 15) {
951 maxlen = 15;
952 }
953
954 return maxlen;
955 }
956
mtab_get_colwidth(void)957 static int mtab_get_colwidth (void)
958 {
959 int maxlen = 0;
960 int cw = 13;
961
962 if (colheads == COLHEAD_NAMES) {
963 const MODEL *pmod;
964 int i, len;
965
966 for (i=0; i<n_models; i++) {
967 pmod = table_models[i];
968 if (pmod != NULL) {
969 if (pmod->name != NULL) {
970 len = strlen(pmod->name);
971 } else {
972 gchar *tmp = g_strdup_printf(_("Model %d"), pmod->ID);
973
974 len = strlen(tmp);
975 g_free(tmp);
976 }
977 if (len > maxlen) {
978 maxlen = (len > 31)? 31 : len;
979 }
980 }
981 }
982 }
983
984 if (maxlen < 11 && mt_figs > 0 && mt_figs < 4) {
985 cw -= 4 - mt_figs;
986 }
987
988 cw = (cw < maxlen + 2)? maxlen + 2 : cw;
989
990 return cw;
991 }
992
print_estimator_strings(int colwidth,PRN * prn)993 static void print_estimator_strings (int colwidth, PRN *prn)
994 {
995 const char *s;
996 char est[32];
997 int i;
998
999 for (i=0; i<n_models; i++) {
1000 if (table_models[i] != NULL) {
1001 s = short_estimator_string(table_models[i], prn);
1002 if (tex_format(prn)) {
1003 strcpy(est, _(s));
1004 pprintf(prn, " & %s ", est);
1005 } else if (rtf_format(prn)) {
1006 strcpy(est, _(s));
1007 pprintf(prn, "\\qc %s\\cell ", est);
1008 } else {
1009 strcpy(est, _(s));
1010 print_centered(est, colwidth, prn);
1011 }
1012 }
1013 }
1014 }
1015
print_model_head(const MODEL * pmod,int j,int colwidth,PRN * prn)1016 static void print_model_head (const MODEL *pmod, int j, int colwidth,
1017 PRN *prn)
1018 {
1019 gchar *targ = NULL;
1020
1021 if (colheads == COLHEAD_ARABIC) {
1022 targ = g_strdup_printf("(%d)", j + 1);
1023 } else if (colheads == COLHEAD_ROMAN) {
1024 const char *R[] = {
1025 "I", "II", "III", "IV", "V", "VI",
1026 "VII", "VIII", "IX", "X", "XI", "XII"
1027 };
1028
1029 targ = g_strdup_printf("%s", R[j]);
1030 } else if (colheads == COLHEAD_ALPHA) {
1031 targ = g_strdup_printf("%c", 'A' + j);
1032 } else if (tex_format(prn)) {
1033 if (pmod->name != NULL) {
1034 targ = tex_escape_new(pmod->name);
1035 } else {
1036 targ = g_strdup_printf(_("Model %d"), pmod->ID);
1037 }
1038 } else if (rtf_format(prn)) {
1039 if (pmod->name != NULL) {
1040 targ = g_strdup(pmod->name);
1041 gretl_utf8_truncate(targ, 31);
1042 } else {
1043 targ = g_strdup_printf(_("Model %d"), pmod->ID);
1044 }
1045 } else {
1046 if (pmod->name != NULL) {
1047 targ = g_strdup(pmod->name);
1048 gretl_utf8_truncate(targ, 31);
1049 } else {
1050 targ = g_strdup_printf(_("Model %d"), pmod->ID);
1051 }
1052 }
1053
1054 if (tex_format(prn)) {
1055 pprintf(prn, " & %s ", targ);
1056 } else if (rtf_format(prn)) {
1057 pprintf(prn, "\\qc %s\\cell ", targ);
1058 } else {
1059 print_centered(targ, colwidth, prn);
1060 }
1061
1062 g_free(targ);
1063 }
1064
print_column_heads(int colwidth,PRN * prn)1065 static void print_column_heads (int colwidth, PRN *prn)
1066 {
1067 int i, j = 0;
1068
1069 for (i=0; i<n_models; i++) {
1070 if (table_models[i] != NULL) {
1071 print_model_head(table_models[i], j++, colwidth, prn);
1072 }
1073 }
1074 }
1075
1076 static const char *sigstrs[] = {
1077 N_("significant at the 10 percent level"),
1078 N_("significant at the 5 percent level"),
1079 N_("significant at the 1 percent level")
1080 };
1081
plain_print_model_table(PRN * prn)1082 static void plain_print_model_table (PRN *prn)
1083 {
1084 int namelen = mtab_max_namelen();
1085 int colwidth = mtab_get_colwidth();
1086 int ci = common_estimator();
1087 int binary = 0;
1088
1089 if (ci > 0) {
1090 /* all models use same estimation procedure */
1091 pprintf(prn, _("%s estimates"),
1092 _(estimator_string(table_models[0], prn)));
1093 pputc(prn, '\n');
1094 }
1095
1096 pprintf(prn, _("Dependent variable: %s\n"), dataset->varname[depvarnum]);
1097
1098 pputc(prn, '\n');
1099 bufspace(namelen + 4, prn);
1100 print_column_heads(colwidth, prn);
1101 pputc(prn, '\n');
1102
1103 if (ci == 0) {
1104 bufspace(namelen + 4, prn);
1105 print_estimator_strings(colwidth, prn);
1106 pputc(prn, '\n');
1107 }
1108
1109 pputc(prn, '\n');
1110
1111 print_model_table_coeffs(namelen, colwidth, prn);
1112 print_equation_stats(namelen + 1, colwidth, prn, &binary);
1113
1114 if (use_tstats) {
1115 pprintf(prn, "%s\n", _("t-statistics in parentheses"));
1116 } else {
1117 pprintf(prn, "%s\n", _("Standard errors in parentheses"));
1118 }
1119
1120 if (do_pvals) {
1121 pprintf(prn, "%s\n", _("p-values in brackets"));
1122 }
1123
1124 if (do_asts) {
1125 pprintf(prn, "* %s\n", _(sigstrs[0]));
1126 pprintf(prn, "** %s\n", _(sigstrs[1]));
1127 pprintf(prn, "*** %s\n", _(sigstrs[2]));
1128 }
1129
1130 if (binary) {
1131 pprintf(prn, "%s\n", _("For logit and probit, R-squared is "
1132 "McFadden's pseudo-R-squared"));
1133 }
1134 }
1135
display_model_table(int gui)1136 int display_model_table (int gui)
1137 {
1138 int winwidth = 78;
1139 PRN *prn;
1140
1141 if (model_table_is_empty()) {
1142 mtable_errmsg(_("The model table is empty"), gui);
1143 return 1;
1144 }
1145
1146 if (make_full_param_list()) {
1147 return 1;
1148 }
1149
1150 if (bufopen(&prn)) {
1151 clear_model_table(0, NULL);
1152 return 1;
1153 }
1154
1155 get_model_table_prefs(&colheads,
1156 &use_tstats,
1157 &do_pvals,
1158 &do_asts,
1159 &mt_figs,
1160 &mt_fmt);
1161
1162 plain_print_model_table(prn);
1163
1164 if (real_table_n_models() > 5) {
1165 winwidth = 90;
1166 }
1167
1168 view_buffer(prn, winwidth, 450, _("gretl: model table"), VIEW_MODELTABLE,
1169 NULL);
1170
1171 return 0;
1172 }
1173
tex_print_model_table(PRN * prn)1174 static int tex_print_model_table (PRN *prn)
1175 {
1176 int binary = 0;
1177 char tmp[32];
1178 int i, ci;
1179
1180 if (model_table_is_empty()) {
1181 mtable_errmsg(_("The model table is empty"), 1);
1182 return 1;
1183 }
1184
1185 if (make_full_param_list()) {
1186 return 1;
1187 }
1188
1189 if (tex_doc_format(prn)) {
1190 gretl_tex_preamble(prn, GRETL_FORMAT_MODELTAB);
1191 }
1192
1193 pputs(prn, "\n\\newcommand{\\subsize}[1]{\\footnotesize{#1}}\n\n");
1194 pputs(prn, "\\begin{center}\n");
1195
1196 ci = common_estimator();
1197
1198 if (ci > 0) {
1199 /* all models use same estimation procedure */
1200 pprintf(prn, _("%s estimates"),
1201 _(estimator_string(table_models[0], prn)));
1202 pputs(prn, "\\\\\n");
1203 }
1204
1205 tex_escape(tmp, dataset->varname[depvarnum]);
1206 pprintf(prn, "%s: %s \\\\\n", _("Dependent variable"), tmp);
1207
1208 pputs(prn, "\\vspace{1em}\n\n");
1209 pputs(prn, "\\begin{longtable}{l");
1210 for (i=0; i<n_models; i++) {
1211 if (table_models[i] != NULL) {
1212 pputc(prn, 'c');
1213 }
1214 }
1215 pputs(prn, "}\n");
1216
1217 print_column_heads(0, prn);
1218 pputs(prn, "\\\\ ");
1219
1220 if (ci == 0) {
1221 pputc(prn, '\n');
1222 print_estimator_strings(0, prn);
1223 pputs(prn, "\\\\ ");
1224 }
1225
1226 pputs(prn, " [6pt] \n");
1227
1228 print_model_table_coeffs(0, 0, prn);
1229 print_equation_stats(0, 0, prn, &binary);
1230
1231 pputs(prn, "\\end{longtable}\n\n");
1232 pputs(prn, "\\vspace{1em}\n");
1233
1234 if (use_tstats) {
1235 pprintf(prn, "%s\\\\\n", _("$t$-statistics in parentheses"));
1236 } else {
1237 pprintf(prn, "%s\\\\\n", _("Standard errors in parentheses"));
1238 }
1239
1240 if (do_pvals) {
1241 pprintf(prn, "%s\\\\\n", _("$p$-values in brackets"));
1242 }
1243
1244 if (do_asts) {
1245 pprintf(prn, "{}* %s\\\\\n", _(sigstrs[0]));
1246 pprintf(prn, "{}** %s\\\\\n", _(sigstrs[1]));
1247 pprintf(prn, "{}*** %s\\\\\n", _(sigstrs[2]));
1248 }
1249
1250 if (binary) {
1251 pprintf(prn, "%s\\\\\n", _("For logit and probit, $R^2$ is "
1252 "McFadden's pseudo-$R^2$"));
1253 }
1254
1255 pputs(prn, "\\end{center}\n");
1256
1257 if (tex_doc_format(prn)) {
1258 pputs(prn, "\n\\end{document}\n");
1259 }
1260
1261 return 0;
1262 }
1263
print_rtf_row_spec(PRN * prn,int tall)1264 static void print_rtf_row_spec (PRN *prn, int tall)
1265 {
1266 int i, cols = 1 + real_table_n_models();
1267 int col1 = 1000;
1268 int ht = (tall)? 362 : 262;
1269
1270 pprintf(prn, "\\trowd \\trqc \\trgaph30\\trleft-30\\trrh%d", ht);
1271 for (i=0; i<cols; i++) {
1272 pprintf(prn, "\\cellx%d", col1 + i * 1400);
1273 }
1274 pputc(prn, '\n');
1275 }
1276
rtf_print_model_table(PRN * prn)1277 static int rtf_print_model_table (PRN *prn)
1278 {
1279 int ci, binary = 0;
1280
1281 if (model_table_is_empty()) {
1282 mtable_errmsg(_("The model table is empty"), 1);
1283 return 1;
1284 }
1285
1286 if (make_full_param_list()) {
1287 return 1;
1288 }
1289
1290 ci = common_estimator();
1291
1292 pputs(prn, "{\\rtf1\n");
1293
1294 if (ci > 0) {
1295 /* all models use same estimation procedure */
1296 pputs(prn, "\\par \\qc ");
1297 pprintf(prn, _("%s estimates"),
1298 _(estimator_string(table_models[0], prn)));
1299 pputc(prn, '\n');
1300 }
1301
1302 pprintf(prn, "\\par \\qc %s: %s\n\\par\n\\par\n{",
1303 _("Dependent variable"), dataset->varname[depvarnum]);
1304
1305 print_rtf_row_spec(prn, 1);
1306 pputs(prn, "\\intbl \\qc \\cell ");
1307 print_column_heads(0, prn);
1308 pputs(prn, "\\intbl \\row\n");
1309
1310 if (ci == 0) {
1311 pputs(prn, "\\intbl \\qc \\cell ");
1312 print_estimator_strings(0, prn);
1313 pputs(prn, "\\intbl \\row\n");
1314 }
1315
1316 print_model_table_coeffs(0, 0, prn);
1317 print_equation_stats(0, 0, prn, &binary);
1318
1319 pputs(prn, "}\n\n");
1320
1321 if (use_tstats) {
1322 pprintf(prn, "\\par \\qc %s\n", _("t-statistics in parentheses"));
1323 } else {
1324 pprintf(prn, "\\par \\qc %s\n", _("Standard errors in parentheses"));
1325 }
1326
1327 if (do_pvals) {
1328 pprintf(prn, "\\par \\qc %s\n", _("p-values in brackets"));
1329 }
1330
1331 if (do_asts) {
1332 pprintf(prn, "\\par \\qc * %s\n", _(sigstrs[0]));
1333 pprintf(prn, "\\par \\qc ** %s\n", _(sigstrs[1]));
1334 pprintf(prn, "\\par \\qc *** %s\n", _(sigstrs[2]));
1335 }
1336
1337 if (binary) {
1338 pprintf(prn, "\\par \\qc %s\n", _("For logit and probit, "
1339 "R{\\super 2} is "
1340 "McFadden's pseudo-R{\\super 2}"));
1341 }
1342
1343 pputs(prn, "\\par\n}\n");
1344
1345 return 0;
1346 }
1347
special_print_model_table(PRN * prn)1348 int special_print_model_table (PRN *prn)
1349 {
1350 get_model_table_prefs(&colheads,
1351 &use_tstats,
1352 &do_pvals,
1353 &do_asts,
1354 &mt_figs,
1355 &mt_fmt);
1356
1357 if (tex_format(prn)) {
1358 return tex_print_model_table(prn);
1359 } else if (rtf_format(prn)) {
1360 return rtf_print_model_table(prn);
1361 } else {
1362 return 1;
1363 }
1364 }
1365
cli_modeltab_add(PRN * prn)1366 static int cli_modeltab_add (PRN *prn)
1367 {
1368 GretlObjType type;
1369 void *ptr = get_last_model(&type);
1370 int err = 0;
1371
1372 if (type != GRETL_OBJ_EQN) {
1373 gretl_errmsg_set(_("No model is available"));
1374 err = 1;
1375 } else {
1376 MODEL *pmod = (MODEL *) ptr;
1377 MODEL *cpy = NULL;
1378 int freeit = 0;
1379
1380 err = model_table_precheck(pmod, MODEL_ADD_BY_CMD);
1381 if (err) {
1382 return err;
1383 }
1384
1385 cpy = get_model_by_ID(pmod->ID);
1386 if (cpy == NULL) {
1387 cpy = gretl_model_copy(pmod);
1388 if (cpy == NULL) {
1389 err = E_ALLOC;
1390 } else {
1391 freeit = 1;
1392 }
1393 }
1394
1395 if (!err) {
1396 err = real_add_to_model_table(cpy, MODEL_ADD_BY_CMD, 0, prn);
1397 }
1398
1399 if (err && freeit) {
1400 gretl_model_free(cpy);
1401 }
1402 }
1403
1404 return err;
1405 }
1406
print_model_table_direct(const char * fname,gretlopt opt,PRN * msgprn)1407 static int print_model_table_direct (const char *fname,
1408 gretlopt opt,
1409 PRN *msgprn)
1410 {
1411 char outfile[MAXLEN];
1412 PRN *prn;
1413 int err = 0;
1414
1415 if (model_table_is_empty()) {
1416 gretl_errmsg_set(_("The model table is empty"));
1417 return E_DATA;
1418 }
1419
1420 if (make_full_param_list()) {
1421 return E_DATA;
1422 }
1423
1424 strcpy(outfile, fname);
1425 gretl_maybe_switch_dir(fname);
1426
1427 prn = gretl_print_new_with_filename(outfile, &err);
1428 if (err) {
1429 return err;
1430 }
1431
1432 if (has_suffix(fname, ".tex")) {
1433 gretl_print_set_format(prn, GRETL_FORMAT_TEX);
1434 if (opt & OPT_C) {
1435 gretl_print_toggle_doc_flag(prn);
1436 }
1437 } else if (has_suffix(fname, ".rtf")) {
1438 gretl_print_set_format(prn, GRETL_FORMAT_RTF);
1439 }
1440
1441 if (tex_format(prn)) {
1442 err = tex_print_model_table(prn);
1443 } else if (rtf_format(prn)) {
1444 err = rtf_print_model_table(prn);
1445 } else {
1446 plain_print_model_table(prn);
1447 }
1448
1449 gretl_print_destroy(prn);
1450
1451 if (!err) {
1452 pprintf(msgprn, _("wrote %s\n"), outfile);
1453 }
1454
1455 return err;
1456 }
1457
modeltab_exec(const char * param,gretlopt opt,PRN * prn)1458 int modeltab_exec (const char *param, gretlopt opt, PRN *prn)
1459 {
1460 int err = 0;
1461
1462 if ((param != NULL && (opt & OPT_O)) ||
1463 (param == NULL && !(opt & OPT_O))) {
1464 /* the --output option rules out the various
1465 command params; otherwise a param value is
1466 needed
1467 */
1468 return E_PARSE;
1469 } else if (opt & OPT_O) {
1470 /* --output="filename" */
1471 const char *outfile;
1472
1473 outfile = get_optval_string(MODELTAB, OPT_O);
1474 if (outfile == NULL) {
1475 err = E_PARSE;
1476 } else {
1477 err = print_model_table_direct(outfile, opt, prn);
1478 }
1479 } else if (!strcmp(param, "add")) {
1480 err = cli_modeltab_add(prn);
1481 } else if (!strcmp(param, "show")) {
1482 err = display_model_table(0);
1483 } else if (!strcmp(param, "free")) {
1484 if (!model_table_is_empty()) {
1485 clear_model_table(0, prn);
1486 }
1487 } else {
1488 err = E_PARSE;
1489 }
1490
1491 return err;
1492 }
1493
format_model_table(windata_t * vwin)1494 void format_model_table (windata_t *vwin)
1495 {
1496 int colhead_opt;
1497 int se_opt, pv_opt;
1498 int ast_opt, figs;
1499 char fmt;
1500 int resp;
1501
1502 get_model_table_prefs(&colheads,
1503 &use_tstats,
1504 &do_pvals,
1505 &do_asts,
1506 &figs,
1507 &fmt);
1508
1509 colhead_opt = colheads;
1510 se_opt = use_tstats;
1511 pv_opt = do_pvals;
1512 ast_opt = do_asts;
1513 figs = mt_figs;
1514 fmt = mt_fmt;
1515
1516 resp = model_table_dialog(&colhead_opt, &se_opt, &pv_opt, &ast_opt,
1517 &figs, &fmt, vwin->main);
1518
1519 if (resp == GRETL_CANCEL) {
1520 return;
1521 }
1522
1523 if (colhead_opt == colheads && se_opt == use_tstats &&
1524 pv_opt == do_pvals && ast_opt == do_asts && figs == mt_figs) {
1525 /* no-op */
1526 return;
1527 } else {
1528 GtkTextBuffer *buf;
1529 const char *newtext;
1530 PRN *prn;
1531
1532 colheads = colhead_opt;
1533 use_tstats = se_opt;
1534 do_pvals = pv_opt;
1535 do_asts = ast_opt;
1536 mt_figs = figs;
1537 mt_fmt = fmt;
1538
1539 set_model_table_prefs(colheads,
1540 use_tstats,
1541 do_pvals,
1542 do_asts,
1543 mt_figs,
1544 mt_fmt);
1545
1546 if (bufopen(&prn)) {
1547 return;
1548 }
1549
1550 plain_print_model_table(prn);
1551 newtext = gretl_print_get_buffer(prn);
1552 buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(vwin->text));
1553 gtk_text_buffer_set_text(buf, "", -1);
1554 textview_set_text(vwin->text, newtext);
1555 gretl_print_destroy(prn);
1556 }
1557 }
1558