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 #include "libgretl.h"
21 #include "var.h"
22 #include "vartest.h"
23 #include "johansen.h"
24 #include "varprint.h"
25 #include "libset.h"
26 #include "texprint.h"
27
28 #include <glib.h>
29
30 /**
31 * gretl_VAR_print_sigma:
32 * @var: pointer to gretl VAR structure.
33 * @prn: printing object.
34 *
35 * Prints to @prn the contemporaneous (cross-equation) variance
36 * matrix for @var.
37 *
38 * Returns: 0 on success, 1 on failure.
39 */
40
gretl_VAR_print_sigma(const GRETL_VAR * var,PRN * prn)41 int gretl_VAR_print_sigma (const GRETL_VAR *var, PRN *prn)
42 {
43 int err = 0;
44
45 if (var->S == NULL) {
46 err = 1;
47 } else {
48 print_contemp_covariance_matrix(var->S, var->ldet, prn);
49 }
50
51 return err;
52 }
53
54 /* printing of impulse responses and variance decompositions */
55
56 #define IRF_ROW_MAX 4
57 #define IRF_WIDTH 13
58
59 #define VDC_ROW_MAX 5
60 #define VDC_WIDTH 11
61
62 enum {
63 IRF,
64 VDC
65 };
66
VAR_RTF_row_spec(int ncols,PRN * prn)67 static void VAR_RTF_row_spec (int ncols, PRN *prn)
68 {
69 int lcol = 800, colwid = 1600;
70 int i, cellx = lcol;
71
72 pputs(prn, "{\\trowd \\trqc \\trgaph60\\trleft-30\\trrh262");
73 for (i=0; i<ncols; i++) {
74 pprintf(prn, "\\cellx%d", cellx);
75 cellx += colwid;
76 }
77 pputc(prn, '\n');
78 }
79
VAR_info_header_block(int code,int v,int block,const DATASET * dset,PRN * prn)80 static void VAR_info_header_block (int code, int v, int block,
81 const DATASET *dset,
82 PRN *prn)
83 {
84 int tex = tex_format(prn);
85 int rtf = rtf_format(prn);
86 char vname[48];
87
88 if (tex) {
89 pputs(prn, "\\vspace{1em}\n\n");
90 if (code == IRF) {
91 pprintf(prn, _("Responses to a one-standard error shock in %s"),
92 tex_escape(vname, dset->varname[v]));
93 } else {
94 pprintf(prn, _("Decomposition of variance for %s"),
95 tex_escape(vname, dset->varname[v]));
96 }
97 if (block == 0) {
98 pputs(prn, "\n\n");
99 } else {
100 pprintf(prn, " (%s)\n\n", _("continued"));
101 }
102 pprintf(prn, "\\vspace{1em}\n\n\\begin{longtable}{%s}\n",
103 (code == IRF)? "rrrrr" : "rrrrrr");
104 } else if (rtf) {
105 pputs(prn, "\\par\n\n");
106 if (code == IRF) {
107 pprintf(prn, _("Responses to a one-standard error shock in %s"),
108 dset->varname[v]);
109 } else {
110 pprintf(prn, _("Decomposition of variance for %s"),
111 dset->varname[v]);
112 }
113 if (block == 0) {
114 pputs(prn, "\\par\n\n");
115 } else {
116 pprintf(prn, " (%s)\\par\n\n", _("continued"));
117 }
118 /* FIXME */
119 VAR_RTF_row_spec((code == IRF)? IRF_ROW_MAX : VDC_ROW_MAX, prn);
120 } else {
121 if (code == IRF) {
122 pprintf(prn, _("Responses to a one-standard error shock in %s"),
123 dset->varname[v]);
124 } else {
125 pprintf(prn, _("Decomposition of variance for %s"),
126 dset->varname[v]);
127 }
128 if (block == 0) {
129 pputs(prn, "\n\n");
130 } else {
131 pprintf(prn, " (%s)\n\n", _("continued"));
132 }
133 }
134
135 /* first column: period number header */
136 if (tex) {
137 pprintf(prn, "%s & ", _("period"));
138 } else if (rtf) {
139 pprintf(prn, "\\intbl \\qc %s\\cell ", _("period"));
140 } else {
141 pputs(prn, _("period"));
142 }
143 }
144
VAR_info_print_vname(int i,int v,int endrow,int width,const DATASET * dset,PRN * prn)145 static void VAR_info_print_vname (int i, int v, int endrow, int width,
146 const DATASET *dset, PRN *prn)
147 {
148 int tex = tex_format(prn);
149 int rtf = rtf_format(prn);
150 char vname[32];
151
152 if (tex) {
153 pprintf(prn, " %s ", tex_escape(vname, dset->varname[v]));
154 if (endrow) {
155 pputs(prn, "\\\\");
156 } else {
157 pputs(prn, "& ");
158 }
159 } else if (rtf) {
160 pprintf(prn, "\\qc %s\\cell", dset->varname[v]);
161 if (endrow) {
162 pputs(prn, " \\intbl \\row");
163 }
164 } else {
165 pprintf(prn, "%*s", width, dset->varname[v]);
166 }
167 }
168
VAR_info_print_period(int t,PRN * prn)169 static void VAR_info_print_period (int t, PRN *prn)
170 {
171 if (tex_format(prn)) {
172 pprintf(prn, "%d & ", t);
173 } else if (rtf_format(prn)) {
174 pprintf(prn, "\\intbl \\qc %d\\cell ", t);
175 } else {
176 pprintf(prn, " %3d ", t);
177 }
178 }
179
VAR_info_end_row(PRN * prn)180 static void VAR_info_end_row (PRN *prn)
181 {
182 if (tex_format(prn)) {
183 pputs(prn, "\\\\\n");
184 } else if (rtf_format(prn)) {
185 pputs(prn, "\\intbl \\row\n");
186 } else {
187 pputc(prn, '\n');
188 }
189 }
190
VAR_info_end_table(PRN * prn)191 static void VAR_info_end_table (PRN *prn)
192 {
193 if (tex_format(prn)) {
194 pputs(prn, "\\end{longtable}\n\n");
195 } else if (rtf_format(prn)) {
196 pputs(prn, "}\n");
197 } else {
198 pputc(prn, '\n');
199 }
200 }
201
varprint_namelen(const GRETL_VAR * var,const DATASET * dset,int rmax,int block)202 static int varprint_namelen (const GRETL_VAR *var,
203 const DATASET *dset,
204 int rmax, int block)
205 {
206 int len, maxlen = 0;
207 int i, k, v;
208
209 for (i=0; i<rmax; i++) {
210 k = rmax * block + i - 1;
211 if (k < 0) {
212 continue;
213 }
214 if (k >= var->neqns) {
215 break;
216 }
217 v = var->ylist[k+1];
218 len = strlen(dset->varname[v]);
219 if (len > maxlen) {
220 maxlen = len;
221 }
222 }
223
224 return maxlen;
225 }
226
227 /**
228 * gretl_VAR_print_impulse_response:
229 * @var: pointer to VAR struct.
230 * @shock: index number of the "shock" variable.
231 * @periods: number of periods over which to print response.
232 * @dset: dataset information.
233 * @prn: gretl printing object.
234 *
235 * Prints to @prn the estimated responses of the endogenous
236 * variables in @var to a one-standard deviation shock in
237 * the specified variable: @shock is a zero-based index into
238 * the equations of the VAR so for example if @shock = 1,
239 * the responses are to a shock in the second endogenous
240 * variable in the VAR specification.
241 *
242 * Returns: 0 on success, non-zero code on error.
243 */
244
245 static int
gretl_VAR_print_impulse_response(GRETL_VAR * var,int shock,int periods,const DATASET * dset,PRN * prn)246 gretl_VAR_print_impulse_response (GRETL_VAR *var, int shock,
247 int periods, const DATASET *dset,
248 PRN *prn)
249 {
250 gretl_matrix *rtmp = NULL, *ctmp = NULL;
251 gretl_matrix *C = var->C;
252 int rows = var->neqns * effective_order(var);
253 int block, blockmax;
254 int tex = tex_format(prn);
255 int rtf = rtf_format(prn);
256 int i, t, vsrc, err = 0;
257
258 if (prn == NULL) {
259 return 0;
260 }
261
262 if (shock >= var->neqns) {
263 fprintf(stderr, "Shock variable out of bounds\n");
264 return 1;
265 }
266
267 if (var->ord != NULL) {
268 C = reorder_responses(var, &err);
269 if (err) {
270 return err;
271 }
272 }
273
274 rtmp = gretl_matrix_alloc(rows, var->neqns);
275 ctmp = gretl_matrix_alloc(rows, var->neqns);
276
277 if (rtmp == NULL || ctmp == NULL) {
278 err = E_ALLOC;
279 goto bailout;
280 }
281
282 vsrc = var->ylist[shock + 1];
283
284 blockmax = var->neqns / IRF_ROW_MAX;
285 if (var->neqns % IRF_ROW_MAX) {
286 blockmax++;
287 }
288
289 for (block=0; block<blockmax && !err; block++) {
290 int k, vtarg, endrow;
291 int namelen, width;
292 double r;
293
294 VAR_info_header_block(IRF, vsrc, block, dset, prn);
295
296 namelen = varprint_namelen(var, dset, IRF_ROW_MAX, block);
297 width = (namelen < IRF_WIDTH - 1)? IRF_WIDTH : namelen + 1;
298
299 for (i=0; i<IRF_ROW_MAX; i++) {
300 k = IRF_ROW_MAX * block + i;
301 if (k >= var->neqns) {
302 break;
303 }
304 vtarg = var->ylist[k+1];
305 endrow = !(i < IRF_ROW_MAX - 1 && k < var->neqns - 1);
306 VAR_info_print_vname(i, vtarg, endrow, width, dset, prn);
307 }
308
309 if (tex || rtf) {
310 pputc(prn, '\n');
311 } else {
312 pputs(prn, "\n\n");
313 }
314
315 for (t=0; t<periods && !err; t++) {
316 VAR_info_print_period(t + 1, prn);
317 if (t == 0) {
318 /* calculate initial estimated responses */
319 copy_north_west(rtmp, C, 0);
320 } else {
321 /* calculate further estimated responses */
322 err = gretl_matrix_multiply(var->A, rtmp, ctmp);
323 gretl_matrix_copy_values(rtmp, ctmp);
324 }
325
326 if (err) break;
327
328 for (i=0; i<IRF_ROW_MAX; i++) {
329 k = IRF_ROW_MAX * block + i;
330 if (k >= var->neqns) {
331 break;
332 }
333 r = gretl_matrix_get(rtmp, k, shock);
334 if (tex) {
335 tex_print_double(r, prn);
336 if (i < IRF_ROW_MAX - 1 && k < var->neqns - 1) {
337 pputs(prn, " & ");
338 }
339 } else if (rtf) {
340 pprintf(prn, "\\qc %.5g\\cell ", r);
341 } else {
342 if (i == 0) pputc(prn, ' ');
343 pprintf(prn, "%#*.5g ", width - 1, r);
344 }
345 }
346
347 VAR_info_end_row(prn);
348 }
349
350 VAR_info_end_table(prn);
351 }
352
353 bailout:
354
355 if (rtmp != NULL) gretl_matrix_free(rtmp);
356 if (ctmp != NULL) gretl_matrix_free(ctmp);
357
358 if (C != var->C) {
359 gretl_matrix_free(C);
360 }
361
362 return err;
363 }
364
gretl_VAR_print_all_impulse_responses(GRETL_VAR * var,const DATASET * dset,int horizon,PRN * prn)365 int gretl_VAR_print_all_impulse_responses (GRETL_VAR *var, const DATASET *dset,
366 int horizon, PRN *prn)
367 {
368 int i, err = 0;
369
370 if (horizon <= 0) {
371 horizon = default_VAR_horizon(dset);
372 }
373
374 if (rtf_format(prn)) {
375 pputs(prn, "{\\rtf1\\par\n\\qc ");
376 }
377
378 for (i=0; i<var->neqns && !err; i++) {
379 err = gretl_VAR_print_impulse_response(var, i, horizon, dset,
380 prn);
381 }
382
383 if (rtf_format(prn)) {
384 pputs(prn, "}\n");
385 }
386
387 return err;
388 }
389
390 /**
391 * gretl_VAR_print_fcast_decomp:
392 * @var: pointer to VAR struct.
393 * @targ:
394 * @periods: number of periods over which to print decomposition.
395 * @dset: dataset information.
396 * @prn: gretl printing struct.
397 *
398 *
399 * Returns: 0 on success, non-zero code on error.
400 */
401
402 int
gretl_VAR_print_fcast_decomp(GRETL_VAR * var,int targ,int periods,const DATASET * dset,PRN * prn)403 gretl_VAR_print_fcast_decomp (GRETL_VAR *var, int targ,
404 int periods, const DATASET *dset,
405 PRN *prn)
406 {
407 int vtarg;
408 gretl_matrix *vd = NULL;
409 int block, blockmax;
410 int tex = tex_format(prn);
411 int rtf = rtf_format(prn);
412 int i, t, err = 0;
413
414 if (prn == NULL) {
415 return 0;
416 }
417
418 if (targ >= var->neqns) {
419 fprintf(stderr, "Target variable out of bounds\n");
420 return 1;
421 }
422
423 vd = gretl_VAR_get_fcast_decomp(var, targ, periods, &err);
424 if (err) {
425 pprintf(prn, "Forecast decomposition failed\n");
426 return err;
427 }
428
429 vtarg = var->ylist[targ + 1];
430
431 blockmax = (var->neqns + 1) / VDC_ROW_MAX;
432 if ((var->neqns + 1) % VDC_ROW_MAX) {
433 blockmax++;
434 }
435
436 for (block=0; block<blockmax; block++) {
437 int k, vsrc, endrow;
438 int namelen, width;
439 double r;
440
441 VAR_info_header_block(VDC, vtarg, block, dset, prn);
442
443 namelen = varprint_namelen(var, dset, VDC_ROW_MAX, block);
444 width = (namelen < VDC_WIDTH - 1)? VDC_WIDTH : namelen + 1;
445
446 for (i=0; i<VDC_ROW_MAX; i++) {
447 k = VDC_ROW_MAX * block + i - 1;
448 if (k < 0) {
449 if (tex) {
450 pprintf(prn, " %s & ", _("std. error"));
451 } else if (rtf) {
452 pprintf(prn, " \\qc %s\\cell ", _("std. error"));
453 } else {
454 pprintf(prn, " %14s", _("std. error"));
455 }
456 continue;
457 }
458 if (k >= var->neqns) {
459 break;
460 }
461 vsrc = var->ylist[k+1];
462 endrow = !(i < VDC_ROW_MAX - 1 && k < var->neqns - 1);
463 VAR_info_print_vname(i, vsrc, endrow, width, dset, prn);
464 }
465
466 if (tex || rtf) {
467 pputc(prn, '\n');
468 } else {
469 pputs(prn, "\n\n");
470 }
471
472 for (t=0; t<periods && !err; t++) {
473 VAR_info_print_period(t + 1, prn);
474 for (i=0; i<VDC_ROW_MAX; i++) {
475 k = VDC_ROW_MAX * block + i - 1;
476 if (k < 0) {
477 /* standard error column */
478 r = gretl_matrix_get(vd, t, var->neqns);
479 if (tex) {
480 pprintf(prn, "%g & ", r);
481 } else if (rtf) {
482 pprintf(prn, "\\qc %g\\cell", r);
483 } else {
484 pprintf(prn, " %14g ", r);
485 }
486 continue;
487 }
488 if (k >= var->neqns) {
489 break;
490 }
491 r = gretl_matrix_get(vd, t, k);
492 if (tex) {
493 pprintf(prn, "$%.4f$", r);
494 if (i < VDC_ROW_MAX - 1 && k < var->neqns - 1) {
495 pputs(prn, " & ");
496 }
497 } else if (rtf) {
498 pprintf(prn, "\\qc %.4f\\cell", r);
499 } else {
500 pprintf(prn, "%*.4f ", width - 1, r);
501 }
502 }
503
504 VAR_info_end_row(prn);
505 }
506
507 VAR_info_end_table(prn);
508 }
509
510 if (vd != NULL) {
511 gretl_matrix_free(vd);
512 }
513
514 return err;
515 }
516
gretl_VAR_print_all_fcast_decomps(GRETL_VAR * var,const DATASET * dset,int horizon,PRN * prn)517 int gretl_VAR_print_all_fcast_decomps (GRETL_VAR *var, const DATASET *dset,
518 int horizon, PRN *prn)
519 {
520 int i, err = 0;
521
522 if (horizon <= 0) {
523 horizon = default_VAR_horizon(dset);
524 }
525
526 if (rtf_format(prn)) {
527 pputs(prn, "{\\rtf1\\par\n\\qc ");
528 }
529
530 for (i=0; i<var->neqns && !err; i++) {
531 err = gretl_VAR_print_fcast_decomp(var, i, horizon, dset,
532 prn);
533 }
534
535 if (rtf_format(prn)) {
536 pputs(prn, "}\n");
537 }
538
539 return err;
540 }
541
print_Johansen_test_case(JohansenCode jcode,PRN * prn)542 void print_Johansen_test_case (JohansenCode jcode, PRN *prn)
543 {
544 const char *jcase[] = {
545 N_("Case 1: No constant"),
546 N_("Case 2: Restricted constant"),
547 N_("Case 3: Unrestricted constant"),
548 N_("Case 4: Restricted trend, unrestricted constant"),
549 N_("Case 5: Unrestricted trend and constant")
550 };
551
552 if (jcode <= J_UNREST_TREND) {
553 if (plain_format(prn) || tex_format(prn)) {
554 pputs(prn, _(jcase[jcode]));
555 } else {
556 pputs(prn, _(jcase[jcode]));
557 }
558 }
559 }
560
vecm_beta_varname(char * vname,const GRETL_VAR * v,const DATASET * dset,int i)561 char *vecm_beta_varname (char *vname,
562 const GRETL_VAR *v,
563 const DATASET *dset,
564 int i)
565 {
566 const char *src = "";
567
568 if (i < v->neqns) {
569 src = dset->varname[v->ylist[i+1]];
570 } else if (auto_restr(v) && i == v->neqns) {
571 src = (jcode(v) == J_REST_CONST)? "const" : "trend";
572 } else if (v->rlist != NULL) {
573 int k = i - v->ylist[0] - auto_restr(v) + 1;
574
575 src = dset->varname[v->rlist[k]];
576 }
577
578 maybe_trim_varname(vname, src);
579
580 return vname;
581 }
582
max_beta_namelen(GRETL_VAR * v,const DATASET * dset)583 static int max_beta_namelen (GRETL_VAR *v,
584 const DATASET *dset)
585 {
586 int r = gretl_matrix_rows(v->jinfo->Beta);
587 char s[32];
588 int i, ni, n = 0;
589
590 for (i=0; i<r; i++) {
591 vecm_beta_varname(s, v, dset, i);
592 ni = strlen(s);
593 if (ni > n) {
594 n = ni;
595 }
596 }
597
598 return n;
599 }
600
601 static void
print_VECM_coint_eqns(GRETL_VAR * jvar,const DATASET * dset,PRN * prn)602 print_VECM_coint_eqns (GRETL_VAR *jvar,
603 const DATASET *dset,
604 PRN *prn)
605 {
606 JohansenInfo *jv = jvar->jinfo;
607 int rtf = rtf_format(prn);
608 char namefmt[16];
609 char s[16], vname[32];
610 int rows = gretl_matrix_rows(jv->Beta);
611 int nwid;
612 int i, j;
613 double x;
614
615 pprintf(prn, "beta (%s", _("cointegrating vectors"));
616 if (jv->Bse != NULL) {
617 pprintf(prn, ", %s)", _("standard errors in parentheses"));
618 } else {
619 pputc(prn, ')');
620 }
621
622 gretl_prn_newline(prn);
623 gretl_prn_newline(prn);
624
625 nwid = max_beta_namelen(jvar, dset) + 1;
626 sprintf(namefmt, "%%-%ds", nwid);
627
628 for (i=0; i<rows; i++) {
629 vecm_beta_varname(vname, jvar, dset, i);
630 if (rtf) {
631 pputs(prn, vname);
632 } else {
633 pprintf(prn, namefmt, vname);
634 }
635
636 /* coefficients */
637 for (j=0; j<jv->rank; j++) {
638 x = gretl_matrix_get(jv->Beta, i, j);
639 if (rtf) {
640 pprintf(prn, "\t%#.5g ", x);
641 } else {
642 pprintf(prn, "%#12.5g ", x);
643 }
644 }
645 gretl_prn_newline(prn);
646
647 if (jv->Bse != NULL) {
648 /* standard errors */
649 if (rtf) {
650 pputs(prn, "\t");
651 } else {
652 bufspace(nwid + 1, prn);
653 }
654 for (j=0; j<jv->rank; j++) {
655 x = gretl_matrix_get(jv->Bse, i, j);
656 sprintf(s, "(%#.5g)", x);
657 if (rtf) {
658 pprintf(prn, "\t%s", s);
659 } else {
660 pprintf(prn, "%12s ", s);
661 }
662 }
663 gretl_prn_newline(prn);
664 }
665 }
666
667 gretl_prn_newline(prn);
668
669 rows = gretl_matrix_rows(jv->Alpha);
670
671 pprintf(prn, "alpha (%s", _("adjustment vectors"));
672 if (jv->Ase != NULL) {
673 pprintf(prn, ", %s)", _("standard errors in parentheses"));
674 } else {
675 pputc(prn, ')');
676 }
677
678 gretl_prn_newline(prn);
679 gretl_prn_newline(prn);
680
681 for (i=0; i<rows; i++) {
682 const char *src = dset->varname[jvar->ylist[i+1]];
683
684 if (rtf) {
685 pputs(prn, src);
686 } else {
687 maybe_trim_varname(vname, src);
688 pprintf(prn, namefmt, vname);
689 }
690
691 for (j=0; j<jv->rank; j++) {
692 x = gretl_matrix_get(jv->Alpha, i, j);
693 if (rtf) {
694 pprintf(prn, "\t%#.5g ", x);
695 } else {
696 pprintf(prn, "%#12.5g ", x);
697 }
698 }
699 gretl_prn_newline(prn);
700
701 if (jv->Ase != NULL) {
702 if (rtf) {
703 pputs(prn, "\t");
704 } else {
705 bufspace(nwid + 1, prn);
706 }
707 for (j=0; j<jv->rank; j++) {
708 x = gretl_matrix_get(jv->Ase, i, j);
709 sprintf(s, "(%#.5g)", x);
710 if (rtf) {
711 pprintf(prn, "\t%s", s);
712 } else {
713 pprintf(prn, "%12s ", s);
714 }
715 }
716 gretl_prn_newline(prn);
717 }
718 }
719
720 gretl_prn_newline(prn);
721 }
722
print_VECM_omega(GRETL_VAR * jvar,const DATASET * dset,PRN * prn)723 static void print_VECM_omega (GRETL_VAR *jvar, const DATASET *dset, PRN *prn)
724 {
725 int rtf = rtf_format(prn);
726 int *list = jvar->ylist;
727 const char *src;
728 char vname[32] = {0};
729 int vwidth = 13;
730 int w0, wi = 12;
731 int i, j;
732
733 pprintf(prn, "%s:\n", _("Cross-equation covariance matrix"));
734 gretl_prn_newline(prn);
735
736 w0 = max_namelen_in_list(list, dset) + 1;
737 if (w0 > vwidth) {
738 vwidth = w0;
739 }
740
741 /* top row: names of Y variables */
742
743 for (i=0; i<jvar->neqns; i++) {
744 src = dset->varname[list[i+1]];
745 if (plain_format(prn)) {
746 maybe_trim_varname(vname, src);
747 }
748 if (i == 0) {
749 if (rtf) {
750 pprintf(prn, "\t\t%s", src);
751 } else {
752 wi = strlen(vname);
753 if (wi < vwidth) wi = vwidth;
754 pprintf(prn, "%*s", w0 + wi, vname);
755 }
756 } else {
757 if (rtf) {
758 pprintf(prn, "\t%s", src);
759 } else {
760 wi = strlen(vname) + 1;
761 if (wi < vwidth) wi = vwidth;
762 pprintf(prn, "%*s", wi, vname);
763 }
764 }
765 }
766
767 gretl_prn_newline(prn);
768
769 /* subsequent rows: Y name plus values */
770
771 for (i=0; i<jvar->neqns; i++) {
772 src = dset->varname[list[i+1]];
773 if (plain_format(prn)) {
774 maybe_trim_varname(vname, src);
775 }
776 if (rtf) {
777 pputs(prn, src);
778 if (strlen(src) < 8) {
779 pputc(prn, '\t');
780 }
781 } else {
782 pprintf(prn, "%-*s ", w0, vname);
783 }
784 for (j=0; j<jvar->neqns; j++) {
785 if (rtf) {
786 pprintf(prn, "\t%#.5g", gretl_matrix_get(jvar->S, i, j));
787 } else {
788 src = dset->varname[list[j+1]];
789 wi = strlen(src);
790 if (wi >= NAMETRUNC) {
791 wi = NAMETRUNC - 1;
792 }
793 if (wi < vwidth - 1) wi = vwidth - 1;
794 pprintf(prn, "%#*.5g ", wi, gretl_matrix_get(jvar->S, i, j));
795 }
796 }
797 gretl_prn_newline(prn);
798 }
799
800 gretl_prn_newline(prn);
801
802 pprintf(prn, "%s = %g", _("determinant"), exp(jvar->ldet));
803
804 gretl_prn_newline(prn);
805 }
806
807 /* FIXME TeX and RTF */
808
vecm_print_restrictions(GRETL_VAR * vecm,PRN * prn)809 static void vecm_print_restrictions (GRETL_VAR *vecm, PRN *prn)
810 {
811 if (vecm->jinfo->R != NULL) {
812 pputs(prn, "\n\n");
813 pputs(prn, _("Restrictions on beta:"));
814 pputc(prn, '\n');
815 print_restriction_from_matrices(vecm->jinfo->R, vecm->jinfo->q,
816 'b', gretl_VECM_n_beta(vecm),
817 prn);
818 pputc(prn, '\n');
819 }
820
821 if (vecm->jinfo->Ra != NULL) {
822 if (vecm->jinfo->R == NULL) {
823 pputs(prn, "\n\n");
824 }
825 pputs(prn, _("Restrictions on alpha:"));
826 pputc(prn, '\n');
827 print_restriction_from_matrices(vecm->jinfo->Ra, vecm->jinfo->qa,
828 'a', gretl_VECM_n_alpha(vecm),
829 prn);
830 pputc(prn, '\n');
831 }
832 }
833
print_LR_stat(double x,int df,PRN * prn)834 static void print_LR_stat (double x, int df, PRN *prn)
835 {
836 double pv = chisq_cdf_comp(df, x);
837
838 if (na(pv)) {
839 return;
840 }
841
842 if (tex_format(prn)) {
843 pprintf(prn, "$2 (l_u - l_r) = %g$", x);
844 gretl_prn_newline(prn);
845 pprintf(prn, "$P(\\chi^2_{%d} > %g) = %g$", df, x, pv);
846 } else if (rtf_format(prn)) {
847 pprintf(prn, "2 * (lu - lr) = %g", x);
848 gretl_prn_newline(prn);
849 pprintf(prn, "P(%s(%d) > %g) = %g", _("Chi-square"), df, x, pv);
850 } else {
851 pprintf(prn, "2 * (lu - lr) = %g", x);
852 gretl_prn_newline(prn);
853 pprintf(prn, "P(%s(%d) > %g) = %g", _("Chi-square"), df, x, pv);
854 }
855 }
856
857 enum {
858 LR_TOTAL,
859 LR_RELATIVE
860 };
861
862 static void
vecm_print_LR_test(GRETL_VAR * vecm,PRN * prn,int code)863 vecm_print_LR_test (GRETL_VAR *vecm, PRN *prn, int code)
864 {
865 double ll0, x;
866 int df;
867
868 if (code == LR_RELATIVE) {
869 ll0 = vecm->jinfo->prior_ll;
870 df = vecm->jinfo->lrdf - vecm->jinfo->prior_df;
871 gretl_prn_newline(prn);
872 pputs(prn, _("Relative to prior restriction"));
873 pputc(prn, ':');
874 gretl_prn_newline(prn);
875 } else {
876 ll0 = vecm->jinfo->ll0;
877 df = vecm->jinfo->lrdf;
878 }
879
880 x = 2.0 * (ll0 - vecm->ll);
881
882 if (tex_format(prn)) {
883 pprintf(prn, _("Unrestricted loglikelihood $(l_u) = %.8g$"), ll0);
884 gretl_prn_newline(prn);
885 pprintf(prn, _("Restricted loglikelihood $(l_r) = %.8g$"), vecm->ll);
886 } else {
887 pprintf(prn, _("Unrestricted loglikelihood (lu) = %.8g"), ll0);
888 gretl_prn_newline(prn);
889 pprintf(prn, _("Restricted loglikelihood (lr) = %.8g"), vecm->ll);
890 }
891
892 gretl_prn_newline(prn);
893 print_LR_stat(x, df, prn);
894 gretl_prn_newline(prn);
895 }
896
897 static void
print_vecm_header_info(GRETL_VAR * vecm,int * lldone,PRN * prn)898 print_vecm_header_info (GRETL_VAR *vecm, int *lldone, PRN *prn)
899 {
900 JohansenInfo *J = vecm->jinfo;
901 gretl_prn_newline(prn);
902
903 if (vecm->jinfo == NULL) {
904 return;
905 }
906
907 pprintf(prn, "%s = %d", _("Cointegration rank"), jrank(vecm));
908 gretl_prn_newline(prn);
909 print_Johansen_test_case(jcode(vecm), prn);
910
911 if (J->R != NULL || J->Ra != NULL) {
912 vecm_print_restrictions(vecm, prn);
913 if (!na(J->ll0) && J->lrdf > 0) {
914 vecm_print_LR_test(vecm, prn, LR_TOTAL);
915 *lldone = 1;
916 }
917 if (!na(J->prior_ll) && J->prior_df > 0) {
918 vecm_print_LR_test(vecm, prn, LR_RELATIVE);
919 *lldone = 1;
920 }
921 if (!*lldone) {
922 pputc(prn, '\n');
923 }
924 } else {
925 pputc(prn, '\n');
926 }
927 }
928
VAR_print_LB_stat(const GRETL_VAR * var,PRN * prn)929 static void VAR_print_LB_stat (const GRETL_VAR *var, PRN *prn)
930 {
931 int k = var->order + (var->ci == VECM);
932 int df = var->neqns * var->neqns * (var->LBs - k);
933 double pv = chisq_cdf_comp(df, var->LB);
934
935 if (df <= 0) {
936 return;
937 }
938
939 if (tex_format(prn)) {
940 pprintf(prn, "\\noindent\n%s: LB(%d) = %g, %s = %d [%.4f]\\par\n",
941 _("Portmanteau test"), var->LBs, var->LB,
942 _("df"), df, pv);
943 } else if (rtf_format(prn)) {
944 pprintf(prn, "%s: LB(%d) = %g, %s = %d [%.4f]\\par\n",
945 _("Portmanteau test"), var->LBs, var->LB,
946 _("df"), df, pv);
947 } else {
948 pprintf(prn, "%s: LB(%d) = %g, %s = %d [%.4f]\n",
949 _("Portmanteau test"), var->LBs, var->LB,
950 _("df"), df, pv);
951 }
952 }
953
Ivals_ok(const GRETL_VAR * var)954 static int Ivals_ok (const GRETL_VAR *var)
955 {
956 return var->Ivals != NULL && !na(var->Ivals[0])
957 && !na(var->Ivals[1]) && !na(var->Ivals[2]);
958 }
959
max_Ftest_label_len(GRETL_VAR * var,const DATASET * dset,int maxlag)960 static int max_Ftest_label_len (GRETL_VAR *var,
961 const DATASET *dset,
962 int maxlag)
963 {
964 gchar *tmp = NULL;
965 int len, len1, len2;
966 int maxnamelen = 0;
967 int i, v;
968
969 for (i=0; i<var->neqns; i++) {
970 v = var->models[i]->list[1];
971 len = strlen(dset->varname[v]);
972 if (len > maxnamelen) {
973 maxnamelen = len;
974 }
975 }
976
977 if (maxnamelen >= NAMETRUNC) {
978 maxnamelen = NAMETRUNC - 1;
979 }
980
981 tmp = g_strdup_printf(_("All lags of %s"), "x");
982 len1 = g_utf8_strlen(tmp, -1) + maxnamelen - 1;
983 g_free(tmp);
984
985 tmp = g_strdup_printf(_("All vars, lag %d"), maxlag);
986 len2 = g_utf8_strlen(tmp, -1);
987 g_free(tmp);
988
989 len = (len1 > len2)? len1 : len2;
990
991 return (len > 25)? (len + 1) : 25;
992 }
993
994 /**
995 * gretl_VAR_print:
996 * @var: pointer to VAR struct.
997 * @dset: dataset information.
998 * @opt: if includes %OPT_I, include impulse responses; if
999 * includes %OPT_F, include forecast variance decompositions;
1000 * if includes %OPT_Q, don't print individual regressions.
1001 * @prn: pointer to printing struct.
1002 *
1003 * Prints the models in @var, along with relevant F-tests and
1004 * possibly impulse responses and variance decompositions.
1005 *
1006 * Returns: 0 on success, 1 on failure.
1007 */
1008
gretl_VAR_print(GRETL_VAR * var,const DATASET * dset,gretlopt opt,PRN * prn)1009 int gretl_VAR_print (GRETL_VAR *var, const DATASET *dset, gretlopt opt,
1010 PRN *prn)
1011 {
1012 char startdate[OBSLEN], enddate[OBSLEN];
1013 gchar *label = NULL;
1014 int vecm = (var->ci == VECM);
1015 int dfd = var->models[0]->dfd;
1016 int tex = tex_format(prn);
1017 int rtf = rtf_format(prn);
1018 int quiet = (opt & OPT_Q);
1019 int nlags, maxlag, nextlag;
1020 int llen, fwidth = 0;
1021 int lldone = 0;
1022 double pv;
1023 int i, j, k, v;
1024
1025 if (prn == NULL || (opt & OPT_S)) {
1026 return 0;
1027 }
1028
1029 nlags = var_n_lags(var);
1030 maxlag = var_max_lag(var);
1031
1032 if (var->lags != NULL) {
1033 nextlag = var->lags[nlags - 1];
1034 } else {
1035 nextlag = maxlag - 1;
1036 }
1037
1038 ntolabel(startdate, var->t1, dset);
1039 ntolabel(enddate, var->t2, dset);
1040
1041 if (rtf) {
1042 pputs(prn, "{\\rtf1\\par\n\\qc ");
1043 }
1044
1045 if (vecm) {
1046 label = g_strdup_printf(_("VECM system, lag order %d"), var->order + 1);
1047 } else {
1048 label = g_strdup_printf(_("VAR system, lag order %d"), var->order);
1049 }
1050
1051 if (tex) {
1052 pputs(prn, "\\begin{center}");
1053 pprintf(prn, "\n%s\\\\\n", label);
1054 pprintf(prn, _("%s estimates, observations %s--%s ($T=%d$)"),
1055 (vecm)? _("Maximum likelihood") : _("OLS"), startdate, enddate, var->T);
1056 if (vecm) {
1057 print_vecm_header_info(var, &lldone, prn);
1058 }
1059 pputs(prn, "\n\\end{center}\n");
1060 } else if (rtf) {
1061 gretl_print_toggle_doc_flag(prn);
1062 pprintf(prn, "\n%s\\par\n", label);
1063 pprintf(prn, _("%s estimates, observations %s-%s (T = %d)"),
1064 (vecm)? _("Maximum likelihood") : _("OLS"), startdate, enddate, var->T);
1065 if (vecm) {
1066 print_vecm_header_info(var, &lldone, prn);
1067 }
1068 pputs(prn, "\\par\n\n");
1069 } else {
1070 pprintf(prn, "\n%s\n", label);
1071 pprintf(prn, _("%s estimates, observations %s-%s (T = %d)"),
1072 (vecm)? _("Maximum likelihood") : _("OLS"), startdate, enddate, var->T);
1073 if (vecm) {
1074 print_vecm_header_info(var, &lldone, prn);
1075 }
1076 pputc(prn, '\n');
1077 }
1078
1079 g_free(label);
1080 label = NULL;
1081
1082 if (vecm) {
1083 if (tex_format(prn)) {
1084 tex_print_VECM_coint_eqns(var, dset, prn);
1085 } else {
1086 print_VECM_coint_eqns(var, dset, prn);
1087 }
1088 }
1089
1090 if (tex) {
1091 tex_print_VAR_ll_stats(var, prn);
1092 } else if (rtf) {
1093 if (!lldone) {
1094 pprintf(prn, "%s = %.8g\\par\n", _("Log-likelihood"), var->ll);
1095 }
1096 pprintf(prn, "%s = %.8g\\par\n", _("Determinant of covariance matrix"),
1097 exp(var->ldet));
1098 pprintf(prn, "%s = %.4f\\par\n", _("AIC"), var->AIC);
1099 pprintf(prn, "%s = %.4f\\par\n", _("BIC"), var->BIC);
1100 pprintf(prn, "%s = %.4f\\par\n", _("HQC"), var->HQC);
1101 } else {
1102 if (!lldone) {
1103 pprintf(prn, "%s = %.8g\n", _("Log-likelihood"), var->ll);
1104 }
1105 pprintf(prn, "%s = %.8g\n", _("Determinant of covariance matrix"), exp(var->ldet));
1106 pprintf(prn, "%s = %.4f\n", _("AIC"), var->AIC);
1107 pprintf(prn, "%s = %.4f\n", _("BIC"), var->BIC);
1108 pprintf(prn, "%s = %.4f\n", _("HQC"), var->HQC);
1109 }
1110
1111 if (var->LBs > 0 && !na(var->LB)) {
1112 VAR_print_LB_stat(var, prn);
1113 }
1114
1115 if (vecm && !quiet) {
1116 pputc(prn, '\n');
1117 }
1118
1119 k = 0;
1120
1121 for (i=0; i<var->neqns; i++) {
1122 double Fval;
1123 char Fstr[24];
1124
1125 if (!quiet) {
1126 printmodel(var->models[i], dset, OPT_NONE, prn);
1127 } else {
1128 if (var->ci != VECM) {
1129 v = var->models[i]->list[1];
1130 if (tex) {
1131 pputs(prn, "\n\\begin{center}\n");
1132 pprintf(prn, "%s\\\\[1em]\n", _("Equation for "));
1133 pprintf(prn, "%s\\\n", dset->varname[v]);
1134 pputs(prn, "\n\\end{center}\n");
1135 } else if (rtf) {
1136 pprintf(prn, "\\par\n%s", _("Equation for "));
1137 pprintf(prn, "%s:\\par\n\n", dset->varname[v]);
1138 } else {
1139 pprintf(prn, "\n%s", _("Equation for "));
1140 pprintf(prn, "%s:\n", dset->varname[v]);
1141 }
1142 }
1143 }
1144
1145 if (vecm) {
1146 continue;
1147 }
1148
1149 if (var->order == 0) {
1150 goto skip_lag_tests;
1151 }
1152
1153 if (tex) {
1154 pputs(prn, "\n\\begin{center}\n");
1155 pprintf(prn, "%s\\\\[1em]\n", _("F-tests of zero restrictions"));
1156 pputs(prn, "\\begin{tabular}{lll}\n");
1157 } else if (rtf) {
1158 pprintf(prn, "%s:\\par\n\n", _("F-tests of zero restrictions"));
1159 } else {
1160 pprintf(prn, "%s:\n\n", _("F-tests of zero restrictions"));
1161 }
1162
1163 if (!tex) {
1164 fwidth = max_Ftest_label_len(var, dset, maxlag);
1165 }
1166
1167 for (j=0; j<var->neqns; j++) {
1168 Fval = var->Fvals[k];
1169 if (!na(Fval)) {
1170 gchar *lagstr = NULL;
1171 const char *vname;
1172
1173 pv = snedecor_cdf_comp(nlags, dfd, Fval);
1174 v = (var->models[j])->list[1];
1175 vname = dset->varname[v];
1176 if (tex) {
1177 char tname[32];
1178
1179 pprintf(prn, _("All lags of %s"), tex_escape(tname, vname));
1180 pputs(prn, " & ");
1181 pprintf(prn, "$F(%d, %d) = %g$ & ", nlags, dfd, Fval);
1182 pprintf(prn, "[%.4f]\\\\\n", pv);
1183 } else if (rtf) {
1184 lagstr = g_strdup_printf(_("All lags of %s"), vname);
1185 llen = strlen(lagstr);
1186 pputs(prn, lagstr);
1187 bufspace(fwidth - llen, prn);
1188 pprintf(prn, "F(%d, %d) = %8.5g ", nlags, dfd, Fval);
1189 pprintf(prn, "[%.4f]\\par\n", pv);
1190 } else {
1191 char tmp[NAMETRUNC];
1192
1193 maybe_trim_varname(tmp, vname);
1194 lagstr = g_strdup_printf(_("All lags of %s"), tmp);
1195 llen = g_utf8_strlen(lagstr, -1);
1196 pputs(prn, lagstr);
1197 bufspace(fwidth - llen, prn);
1198 sprintf(Fstr, "F(%d, %d)", nlags, dfd);
1199 pprintf(prn, "%12s = %#8.5g [%.4f]\n", Fstr, Fval, pv);
1200 }
1201 g_free(lagstr);
1202 }
1203 k++;
1204 }
1205
1206 skip_lag_tests:
1207
1208 if (var->order > 0) {
1209 Fval = var->Fvals[k];
1210 if (!na(Fval)) {
1211 gchar *lagstr = NULL;
1212
1213 pv = snedecor_cdf_comp(var->neqns, dfd, Fval);
1214 if (tex) {
1215 pprintf(prn, _("All vars, lag %d"), maxlag);
1216 pputs(prn, " & ");
1217 pprintf(prn, "$F(%d, %d) = %g$ & ", var->neqns, dfd, Fval);
1218 pprintf(prn, "[%.4f]\\\\\n", pv);
1219 } else if (rtf) {
1220 lagstr = g_strdup_printf(_("All vars, lag %d"), maxlag);
1221 llen = strlen(lagstr);
1222 pputs(prn, lagstr);
1223 bufspace(fwidth - llen, prn);
1224 pprintf(prn, "F(%d, %d) = %8.5g ", var->neqns, dfd, Fval);
1225 pprintf(prn, "[%.4f]\\par\n", pv);
1226 } else {
1227 lagstr = g_strdup_printf(_("All vars, lag %d"), maxlag);
1228 llen = g_utf8_strlen(lagstr, -1);
1229 pputs(prn, lagstr);
1230 bufspace(fwidth - llen, prn);
1231 sprintf(Fstr, "F(%d, %d)", var->neqns, dfd);
1232 pprintf(prn, "%12s = %#8.5g [%.4f]\n", Fstr, Fval, pv);
1233 }
1234 g_free(lagstr);
1235 }
1236 k++;
1237 }
1238
1239 if (tex) {
1240 pputs(prn, "\\end{tabular}\n"
1241 "\\end{center}\n\n"
1242 "\\clearpage\n\n");
1243 } else if (rtf) {
1244 pputs(prn, "\\par\\n\n");
1245 }
1246 }
1247
1248 /* global LR test on max lag */
1249 if (!na(var->LR)) {
1250 gchar *h0str, *h1str;
1251 int df = var->neqns * var->neqns;
1252
1253 pputc(prn, '\n');
1254
1255 h0str = g_strdup_printf(_("the longest lag is %d"), nextlag);
1256 h1str = g_strdup_printf(_("the longest lag is %d"), maxlag);
1257
1258 pv = chisq_cdf_comp(df, var->LR);
1259
1260 if (tex) {
1261 pprintf(prn, "\\noindent %s ---\\par\n", _("For the system as a whole"));
1262 pprintf(prn, "%s: %s\\par\n", _("Null hypothesis"), h0str);
1263 pprintf(prn, "%s: %s\\par\n", _("Alternative hypothesis"), h1str);
1264 pprintf(prn, "%s: $\\chi^2_{%d}$ = %.3f [%.4f]\\par\n",
1265 _("Likelihood ratio test"), df, var->LR, pv);
1266 } else if (rtf) {
1267 pprintf(prn, "\\par %s\n", _("For the system as a whole"));
1268 pprintf(prn, "\\par %s: %s\n", _("Null hypothesis"), h0str);
1269 pprintf(prn, "\\par %s: %s\n", _("Alternative hypothesis"), h1str);
1270 pprintf(prn, "\\par %s: %s(%d) = %g [%.4f]\n", _("Likelihood ratio test"),
1271 _("Chi-square"), df, var->LR, pv);
1272 } else {
1273 int ordlen = (var->order > 10)? 2 : 1;
1274
1275 pprintf(prn, "%s:\n\n", _("For the system as a whole"));
1276 pprintf(prn, " %s: %s\n", _("Null hypothesis"), h0str);
1277 pprintf(prn, " %s: %s\n", _("Alternative hypothesis"), h1str);
1278 pprintf(prn, " %s: %s(%d) = %g [%.4f]\n", _("Likelihood ratio test"),
1279 _("Chi-square"), df, var->LR, pv);
1280 if (Ivals_ok(var)) {
1281 /* Info criteria comparison */
1282 pprintf(prn, "\n %s:\n", _("Comparison of information criteria"));
1283 pputs(prn, " ");
1284 pprintf(prn, _("Lag order %*d"), ordlen, var->order);
1285 pprintf(prn, ": AIC = %#.6g, BIC = %#.6g, HQC = %#.6g\n",
1286 var->AIC, var->BIC, var->HQC);
1287 pputs(prn, " ");
1288 pprintf(prn, _("Lag order %*d"), ordlen, var->order - 1);
1289 pprintf(prn, ": AIC = %#.6g, BIC = %#.6g, HQC = %#.6g\n",
1290 var->Ivals[0], var->Ivals[1], var->Ivals[2]);
1291 }
1292 }
1293 g_free(h0str);
1294 g_free(h1str);
1295 }
1296
1297 if (vecm) {
1298 if (tex_format(prn)) {
1299 tex_print_VECM_omega(var, dset, prn);
1300 } else {
1301 print_VECM_omega(var, dset, prn);
1302 pputc(prn, '\n');
1303 }
1304 } else if (var->order > 0) {
1305 pputc(prn, '\n');
1306 }
1307
1308 if (opt & OPT_I) {
1309 gretl_VAR_print_all_impulse_responses(var, dset, 0, prn);
1310 }
1311
1312 if (opt & OPT_F) {
1313 gretl_VAR_print_all_fcast_decomps(var, dset, 0, prn);
1314 }
1315
1316 if (rtf) {
1317 pputs(prn, "}\n");
1318 }
1319
1320 return 0;
1321 }
1322