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 /* graphing.c for gretl */
21
22 #include "libgretl.h"
23 #include "var.h"
24 #include "system.h"
25 #include "libset.h"
26 #include "matrix_extra.h"
27 #include "forecast.h"
28 #include "plotspec.h"
29 #include "usermat.h"
30 #include "gretl_panel.h"
31 #include "missing_private.h"
32 #include "gretl_string_table.h"
33 #include "uservar.h"
34 #include "gretl_midas.h"
35 #include "boxplots.h"
36
37 #ifdef WIN32
38 # include "gretl_win32.h"
39 #endif
40
41 #include <unistd.h>
42 #include <errno.h>
43
44 #define GP_DEBUG 0
45
46 #ifdef WIN32
47 # include <windows.h>
48 #else
49 # include <signal.h>
50 # if HAVE_SYS_WAIT_H
51 # include <sys/wait.h>
52 # endif
53 # ifndef WEXITSTATUS
54 # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
55 # endif
56 # ifndef WIFEXITED
57 # define WIFEXITED(stat_val) (((stat_val) & 255) == 0)
58 # endif
59 #endif /* ! _WIN32 */
60
61 /* length of buffer for "set term ..." */
62 #define TERMLEN 256
63
64 static char gnuplot_path[MAXLEN];
65 static int gp_small_font_size;
66 static double default_png_scale = 1.0;
67 static int xwide = 0;
68
69 static char ad_hoc_font[64];
70
71 typedef struct gnuplot_info_ gnuplot_info;
72
73 struct gnuplot_info_ {
74 GptFlags flags;
75 FitType fit;
76 int *list;
77 int t1;
78 int t2;
79 double xrange;
80 char timefmt[16];
81 char xtics[64];
82 char xfmt[16];
83 char yfmt[16];
84 const char *yformula;
85 const double *x;
86 gretl_matrix *dvals;
87 int *withlist;
88 int band;
89 double ybase;
90 };
91
92 enum {
93 W_POINTS,
94 W_LINES,
95 W_IMPULSES,
96 W_LP,
97 W_BOXES,
98 W_STEPS
99 };
100
101 #define MAX_LETTERBOX_LINES 8
102
103 #define ts_plot(g) ((g)->flags & GPT_TS)
104
105 #if GP_DEBUG
106 static void print_gnuplot_flags (int flags, int revised);
107 #endif
108
109 struct plot_type_info {
110 PlotType ptype;
111 const char *pstr;
112 };
113
114 struct plot_type_info ptinfo[] = {
115 { PLOT_REGULAR, NULL },
116 { PLOT_CORRELOGRAM, "correlogram" },
117 { PLOT_CUSUM, "CUSUM test" },
118 { PLOT_FORECAST, "forecasts with 95 pc conf. interval" },
119 { PLOT_FREQ_SIMPLE, "frequency plot (simple)" },
120 { PLOT_FREQ_NORMAL, "frequency plot (against normal)" },
121 { PLOT_FREQ_GAMMA, "frequency plot (against gamma)" },
122 { PLOT_FREQ_DISCRETE, "frequency plot (discrete)" },
123 { PLOT_GARCH, "GARCH residual plot" },
124 { PLOT_HURST, "rescaled range plot" },
125 { PLOT_IRFBOOT, "impulse response plot with quantiles" },
126 { PLOT_KERNEL, "kernel density plot" },
127 { PLOT_LEVERAGE, "leverage/influence plot" },
128 { PLOT_MULTI_SCATTER, "multiple scatterplots" },
129 { PLOT_PERIODOGRAM, "periodogram" },
130 { PLOT_RANGE_MEAN, "range-mean plot" },
131 { PLOT_H_TEST, "sampling distribution" },
132 { PLOT_PROB_DIST, "probability distribution" },
133 { PLOT_TRI_GRAPH, "TRAMO / X12A tri-graph" },
134 { PLOT_ROOTS, "roots plot" },
135 { PLOT_ELLIPSE, "confidence ellipse plot" },
136 { PLOT_MULTI_IRF, "multiple impulse responses" },
137 { PLOT_PANEL, "multiple panel plots" },
138 { PLOT_BI_GRAPH, "double time-series plot" },
139 { PLOT_MANY_TS, "multiple timeseries" },
140 { PLOT_RQ_TAU, "tau sequence plot" },
141 { PLOT_FACTORIZED, "factorized scatter" },
142 { PLOT_BOXPLOTS, "boxplots" },
143 { PLOT_CURVE, "curve" },
144 { PLOT_QQ, "QQ plot" },
145 { PLOT_USER, "user-defined plot" },
146 { PLOT_XCORRELOGRAM, "cross-correlogram" },
147 { PLOT_BAR, "bars" },
148 { PLOT_STACKED_BAR, "stacked-bars" },
149 { PLOT_3D, "3-D plot" },
150 { PLOT_BAND, "band plot" },
151 { PLOT_HEATMAP, "heatmap" },
152 { PLOT_GEOMAP, "geoplot" },
153 { PLOT_TYPE_MAX, NULL }
154 };
155
156 enum {
157 BP_REGULAR,
158 BP_BLOCKMAT
159 };
160
161 static int graph_list_adjust_sample (int *list,
162 gnuplot_info *ginfo,
163 const DATASET *dset,
164 int listmin);
165 static void clear_gpinfo (gnuplot_info *gi);
166 static void make_time_tics (gnuplot_info *gi,
167 const DATASET *dset,
168 int many, char *xlabel,
169 PRN *prn);
170 static void get_multiplot_layout (int n, int tseries,
171 int *rows, int *cols);
172 static int plot_with_band (int mode,
173 gnuplot_info *gi,
174 const char *literal,
175 DATASET *dset,
176 gretlopt opt);
177
178 static char *gretl_emf_term_line (char *term_line,
179 PlotType ptype,
180 GptFlags flags);
181
182 #ifndef WIN32
183
184 #define SPAWN_DEBUG 0
185
186 /**
187 * gnuplot_test_command:
188 * @cmd: gnuplot command string.
189 *
190 * See if the installed version of gnuplot will accept a given
191 * command.
192 *
193 * Returns: 0 if gnuplot successfully handles the given command,
194 * 1 on error.
195 */
196
gnuplot_test_command(const char * cmd)197 int gnuplot_test_command (const char *cmd)
198 {
199 int ok, ret = 1;
200 int child_pid = 0, sinp = 0, serr = 0;
201 GError *error = NULL;
202 gchar *argv[] = {
203 NULL,
204 NULL
205 };
206
207 if (*gnuplot_path == '\0') {
208 strcpy(gnuplot_path, gretl_gnuplot_path());
209 }
210
211 argv[0] = gnuplot_path;
212
213 ok = g_spawn_async_with_pipes (NULL,
214 argv,
215 NULL,
216 G_SPAWN_SEARCH_PATH |
217 G_SPAWN_STDOUT_TO_DEV_NULL |
218 G_SPAWN_DO_NOT_REAP_CHILD,
219 NULL,
220 NULL,
221 &child_pid,
222 &sinp,
223 NULL,
224 &serr,
225 &error);
226
227 # if SPAWN_DEBUG
228 fprintf(stderr, "Testing gnuplot command '%s'\n", cmd);
229 fprintf(stderr, "ok=%d, child_pid=%d, sinp=%d\n",
230 ok, child_pid, sinp);
231 # endif
232
233 if (ok) {
234 char errbuf[128];
235 int test, status;
236 int errbytes = 0;
237
238 errbytes += write(sinp, cmd, strlen(cmd));
239 errbytes += write(sinp, "\n", 1);
240 close(sinp);
241 test = waitpid(child_pid, &status, 0);
242 # if SPAWN_DEBUG
243 fprintf(stderr, "waitpid returned %d, WIFEXITED %d, "
244 "WEXITSTATUS %d\n", test, WIFEXITED(status),
245 WEXITSTATUS(status));
246 # endif
247 if (test == child_pid && WIFEXITED(status)) {
248 ret = WEXITSTATUS(status);
249 }
250 errbytes = read(serr, errbuf, sizeof errbuf - 1);
251 if (errbytes > 0) {
252 errbuf[errbytes] = '\0';
253 if (strstr(errbuf, "not find/open font")) {
254 # if SPAWN_DEBUG
255 fprintf(stderr, "%s\n", errbuf);
256 # endif
257 if (strstr(cmd, "font") != NULL) {
258 ret = 1;
259 }
260 }
261 }
262 close(serr);
263 } else {
264 fprintf(stderr, "error: '%s'\n", error->message);
265 g_error_free(error);
266 }
267
268 # if SPAWN_DEBUG
269 fprintf(stderr, "gnuplot test: ret = %d\n", ret);
270 # endif
271
272 return ret;
273 }
274
275 #if defined(OS_OSX) && defined(PKGBUILD)
276 # define GP_RETRY 1
277 #else
278 # define GP_RETRY 0
279 #endif
280
gnuplot_version(int * msg_done)281 static double gnuplot_version (int *msg_done)
282 {
283 static double vnum = 0.0;
284
285 if (vnum == 0.0) {
286 #if GP_RETRY
287 int retries = 0;
288 #endif
289 GError *gerr = NULL;
290 gboolean ok;
291 gchar *sout = NULL;
292 gchar *serr = NULL;
293 gchar *argv[] = {
294 NULL,
295 NULL,
296 NULL
297 };
298
299 if (*gnuplot_path == '\0') {
300 strcpy(gnuplot_path, gretl_gnuplot_path());
301 }
302
303 argv[0] = gnuplot_path;
304 argv[1] = "--version";
305
306 #if GP_RETRY
307 retry:
308 #endif
309 ok = g_spawn_sync (NULL,
310 argv,
311 NULL,
312 G_SPAWN_SEARCH_PATH,
313 NULL,
314 NULL,
315 &sout,
316 &serr,
317 NULL,
318 &gerr);
319
320 if (ok && sout != NULL) {
321 if (!strncmp(sout, "gnuplot ", 8)) {
322 /* e.g. "gnuplot 5.0 patchlevel 0" */
323 char *s = strstr(sout, "patchlevel");
324 int plev;
325
326 vnum = dot_atof(sout + 8);
327 if (s != NULL && sscanf(s + 10, "%d", &plev) == 1) {
328 vnum += plev / 100.0;
329 }
330 }
331 }
332
333 #if GP_RETRY
334 if (vnum == 0 && retries == 0) {
335 /* try substituting default value */
336 if (gerr != NULL) {
337 g_error_free(gerr);
338 gerr = NULL;
339 }
340 fprintf(stderr, "gnuplot: failed on '%s'\n", gnuplot_path);
341 g_free(sout); sout = NULL;
342 g_free(serr); serr = NULL;
343 sprintf(gnuplot_path, "%sgnuplot", gretl_bindir());
344 fprintf(stderr, "gnuplot: retry with '%s'\n", gnuplot_path);
345 retries = 1;
346 goto retry;
347 } else if (vnum > 0 && retries == 1) {
348 gretl_set_path_by_name("gnuplot", gnuplot_path);
349 }
350 #endif
351
352 if (vnum == 0) {
353 if (gerr != NULL) {
354 /* We might see something like:
355 Failed to execute child process <bad-path>
356 */
357 gretl_errmsg_set(gerr->message);
358 g_error_free(gerr);
359 *msg_done = 1;
360 } else if (serr != NULL && *serr != '\0') {
361 gretl_errmsg_set(serr);
362 *msg_done = 1;
363 }
364 }
365
366 g_free(sout);
367 g_free(serr);
368 }
369
370 return vnum;
371 }
372
373 #else /* MS Windows */
374
gnuplot_version(void)375 static double gnuplot_version (void)
376 {
377 /* As of early 2020, the packages for Windows
378 include gnuplot 5.2 */
379 return 5.2;
380 }
381
382 #endif /* MS Windows or not */
383
gp_list_pos(const char * s,const int * list,const DATASET * dset)384 static int gp_list_pos (const char *s, const int *list,
385 const DATASET *dset)
386 {
387 int k;
388
389 if (integer_string(s)) {
390 k = atoi(s);
391 } else {
392 k = current_series_index(dset, s);
393 }
394
395 return in_gretl_list(list, k);
396 }
397
398 static int plot_ci = GNUPLOT;
399
set_effective_plot_ci(int ci)400 void set_effective_plot_ci (int ci)
401 {
402 plot_ci = ci;
403 }
404
405 /* When we get from the user something like
406
407 --with-lines=foo,bar
408
409 this indicates that the "with lines" format should be
410 applied to selected y-axis variables, not all.
411 */
412
gp_set_non_point_info(gnuplot_info * gi,const int * list,const DATASET * dset,gretlopt opt)413 static int gp_set_non_point_info (gnuplot_info *gi,
414 const int *list,
415 const DATASET *dset,
416 gretlopt opt)
417 {
418 const char *s = get_optval_string(plot_ci, opt);
419 int withval = W_POINTS;
420 int i, imax = gi->withlist[0];
421
422 if (opt == OPT_O) {
423 withval = W_LINES;
424 } else if (opt == OPT_M) {
425 withval = W_IMPULSES;
426 } else if (opt == OPT_P) {
427 withval = W_LP;
428 } else if (opt == OPT_B) {
429 withval = W_BOXES;
430 } else if (opt & OPT_Q) {
431 withval = W_STEPS;
432 }
433
434 if (s == NULL) {
435 /* spec applies to all members of list */
436 for (i=1; i<=imax; i++) {
437 if (gi->withlist[i] == W_POINTS) {
438 gi->withlist[i] = withval;
439 }
440 }
441 } else if (strchr(s, ',') != NULL) {
442 /* spec has multiple components */
443 gchar **strs = g_strsplit(s, ",", 0);
444 int j;
445
446 for (j=0; strs[j]!=NULL; j++) {
447 i = gp_list_pos(strs[j], list, dset);
448 if (i > 0 && i <= imax) {
449 gi->withlist[i] = withval;
450 }
451 }
452 g_strfreev(strs);
453 } else {
454 /* just one component */
455 i = gp_list_pos(s, list, dset);
456 if (i > 0 && i <= imax) {
457 gi->withlist[i] = withval;
458 }
459 }
460
461 return 0;
462 }
463
plain_lines_spec(gretlopt opt)464 static int plain_lines_spec (gretlopt opt)
465 {
466 if ((opt & OPT_O) && !(opt & (OPT_M | OPT_B | OPT_P | OPT_Q))) {
467 return get_optval_string(plot_ci, OPT_O) == NULL;
468 } else {
469 return 0;
470 }
471 }
472
plain_impulses_spec(gretlopt opt)473 static int plain_impulses_spec (gretlopt opt)
474 {
475 if ((opt & OPT_M) && !(opt & (OPT_O | OPT_B | OPT_P | OPT_Q))) {
476 return get_optval_string(plot_ci, OPT_M) == NULL;
477 } else {
478 return 0;
479 }
480 }
481
plain_steps_spec(gretlopt opt)482 static int plain_steps_spec (gretlopt opt)
483 {
484 if ((opt & OPT_Q) && !(opt & (OPT_O | OPT_M | OPT_B | OPT_P))) {
485 return get_optval_string(plot_ci, OPT_Q) == NULL;
486 } else {
487 return 0;
488 }
489 }
490
get_fit_type(gnuplot_info * gi)491 static int get_fit_type (gnuplot_info *gi)
492 {
493 const char *ftype = get_optval_string(plot_ci, OPT_F);
494 int err = 0;
495
496 if (ftype == NULL || *ftype == '\0') {
497 err = E_DATA;
498 } else if (!strcmp(ftype, "none")) {
499 gi->flags |= GPT_FIT_OMIT;
500 } else if (!strcmp(ftype, "linear")) {
501 gi->fit = PLOT_FIT_OLS;
502 } else if (!strcmp(ftype, "quadratic")) {
503 gi->fit = PLOT_FIT_QUADRATIC;
504 } else if (!strcmp(ftype, "cubic")) {
505 gi->fit = PLOT_FIT_CUBIC;
506 } else if (!strcmp(ftype, "inverse")) {
507 gi->fit = PLOT_FIT_INVERSE;
508 } else if (!strcmp(ftype, "loess")) {
509 gi->fit = PLOT_FIT_LOESS;
510 } else if (!strcmp(ftype, "semilog")) {
511 gi->fit = PLOT_FIT_LOGLIN;
512 } else if (!strcmp(ftype, "linlog")) {
513 gi->fit = PLOT_FIT_LINLOG;
514 } else {
515 err = invalid_field_error(ftype);
516 }
517
518 return err;
519 }
520
maybe_record_font_choice(gretlopt opt)521 static void maybe_record_font_choice (gretlopt opt)
522 {
523 const char *s = get_optval_string(plot_ci, opt);
524
525 if (s != NULL) {
526 ad_hoc_font[0] = '\0';
527 strcat(ad_hoc_font, s);
528 gretl_charsub(ad_hoc_font, ',', ' ');
529 }
530 }
531
get_gp_flags(gnuplot_info * gi,gretlopt opt,const int * list,const DATASET * dset)532 static int get_gp_flags (gnuplot_info *gi, gretlopt opt,
533 const int *list, const DATASET *dset)
534 {
535 int n_yvars = list[0] - 1;
536 int err = 0;
537
538 gi->flags = 0;
539
540 if (opt & OPT_N) {
541 /* --band */
542 if (opt & OPT_T) {
543 /* --time-series */
544 gi->flags |= (GPT_TS | GPT_IDX);
545 /* there's no xvar in @list */
546 n_yvars++;
547 }
548 gi->flags |= GPT_FIT_OMIT;
549 gi->band = 1;
550 goto linespec;
551 }
552
553 if (opt & OPT_W) {
554 /* --font=<fontspec> */
555 maybe_record_font_choice(OPT_W);
556 }
557
558 if (opt & OPT_L) {
559 /* log y axis */
560 const char *sbase = get_optval_string(GNUPLOT, OPT_L);
561
562 gi->flags |= GPT_LOGY;
563 gi->ybase = 10;
564 if (sbase != NULL) {
565 gi->ybase = atof(sbase);
566 if (gi->ybase <= 0) {
567 gi->ybase = 10;
568 }
569 }
570 }
571
572 if (opt & OPT_S) {
573 /* the old --suppress-fitted option may still be used
574 internally, for some plot types */
575 gi->flags |= GPT_FIT_OMIT;
576 }
577
578 if (opt & OPT_R) {
579 /* internal option for residual plot */
580 gi->flags |= GPT_RESIDS;
581 } else if (opt & OPT_A) {
582 /* internal option for fitted-actual plot */
583 gi->flags |= GPT_FA;
584 }
585
586 if (opt & OPT_Z) {
587 /* --dummy */
588 gi->flags |= GPT_DUMMY;
589 } else if (opt & OPT_C) {
590 /* --control */
591 gi->flags |= GPT_XYZ;
592 } else {
593 if (opt & OPT_T) {
594 /* --time-series */
595 gi->flags |= GPT_IDX;
596 /* there's no xvar in @list */
597 n_yvars++;
598 }
599 }
600
601 linespec:
602
603 if (plain_lines_spec(opt)) {
604 /* just using lines */
605 gi->flags |= GPT_LINES;
606 } else if (plain_impulses_spec(opt)) {
607 /* just using impulses */
608 gi->flags |= GPT_IMPULSES;
609 } else if (plain_steps_spec(opt)) {
610 /* just using steps */
611 gi->flags |= GPT_STEPS;
612 } else if (opt & (OPT_M | OPT_O | OPT_P | OPT_B)) {
613 /* for handling per-variable "plot with" options */
614 gi->withlist = gretl_list_new(n_yvars);
615 }
616
617 if (gi->withlist != NULL) {
618 if (opt & OPT_M) {
619 /* --with-impulses */
620 gp_set_non_point_info(gi, list, dset, OPT_M);
621 }
622 if (opt & OPT_O) {
623 /* --with-lines */
624 gp_set_non_point_info(gi, list, dset, OPT_O);
625 }
626 if (opt & OPT_P) {
627 /* --with-lp */
628 gp_set_non_point_info(gi, list, dset, OPT_P);
629 }
630 if (opt & OPT_B) {
631 /* --with-boxes */
632 gp_set_non_point_info(gi, list, dset, OPT_B);
633 }
634 }
635
636 if (opt & OPT_G) {
637 /* internal option, saving as icon */
638 gi->flags |= GPT_ICON;
639 }
640
641 gi->fit = PLOT_FIT_NONE;
642
643 if (!(gi->flags & GPT_FIT_OMIT) && n_yvars == 1) {
644 if (opt & OPT_F) {
645 /* the --fit=fitspec option */
646 err = get_fit_type(gi);
647 }
648 }
649
650 if (xwide) {
651 /* access file-scope global */
652 gi->flags |= GPT_XW;
653 xwide = 0;
654 }
655
656 #if GP_DEBUG
657 if (gi->flags) {
658 print_gnuplot_flags(gi->flags, 0);
659 }
660 #endif
661
662 return err;
663 }
664
665 #define GP_USE_NAN 1
666
667 /* With gnuplot 5, if we represent NAs by "?" (flagging that we're
668 doing so with 'set datafile missing "?"') then in "with-lines"
669 plots the lines are continuous across the missing values (joining
670 the successive non-missing values), so giving no visual clue that
671 there's anything missing. If we want lines to have gaps in case of
672 missing values we need to write "NaN" rather than "?" into the
673 gnuplot data block. See the gnuplot 5 doc for "missing":
674
675 "Gnuplot makes a distinction between missing data and invalid data
676 (e.g. "NaN", 1/0.). For example invalid data causes a gap in a
677 line drawn through sequential data points; missing data does not."
678
679 This represents a change from gnuplot 4 behavior, which I didn't
680 notice for quite a while. But I think we want the gaps, hence
681 the following function.
682
683 Allin, 2018-08-12
684 */
685
686 #if GP_USE_NAN
687 static const char *gpna = "NaN";
688 #else
689 static const char *gpna = "?";
690 #endif
691
write_gp_dataval(double x,FILE * fp,int final)692 void write_gp_dataval (double x, FILE *fp, int final)
693 {
694 if (final) {
695 if (na(x)) {
696 fprintf(fp, "%s\n", gpna);
697 } else {
698 fprintf(fp, "%.10g\n", x);
699 }
700 } else {
701 if (na(x)) {
702 fprintf(fp, "%s ", gpna);
703 } else {
704 fprintf(fp, "%.10g ", x);
705 }
706 }
707 }
708
printvars(FILE * fp,int t,const int * list,const DATASET * dset,gnuplot_info * gi,const char * label,double offset)709 static void printvars (FILE *fp, int t,
710 const int *list,
711 const DATASET *dset,
712 gnuplot_info *gi,
713 const char *label,
714 double offset)
715 {
716 const double *x = (gi != NULL)? gi->x : NULL;
717 double xt;
718 int i;
719
720 if (x != NULL) {
721 xt = x[t] + offset;
722 if (gi->flags & GPT_TIMEFMT) {
723 fprintf(fp, "%.0f ", xt);
724 } else {
725 fprintf(fp, "%.10g ", xt);
726 }
727 }
728
729 for (i=1; i<=list[0]; i++) {
730 xt = dset->Z[list[i]][t];
731 if (!na(xt) && x == NULL && i == 1) {
732 /* the x variable */
733 xt += offset;
734 }
735 write_gp_dataval(xt, fp, 0);
736 }
737
738 if (label != NULL) {
739 fprintf(fp, "# %s", label);
740 }
741
742 fputc('\n', fp);
743 }
744
factor_check(gnuplot_info * gi,const DATASET * dset)745 static int factor_check (gnuplot_info *gi, const DATASET *dset)
746 {
747 int err = 0;
748 int v3 = 0;
749
750 if (gi->list[0] != 3) {
751 err = E_DATA;
752 } else {
753 v3 = gi->list[3];
754 if (!accept_as_discrete(dset, v3, 0)) {
755 err = E_DATA;
756 }
757 }
758
759 if (err) {
760 gretl_errmsg_set(_("You must supply three variables, the last of "
761 "which is discrete"));
762 } else {
763 const double *d = dset->Z[v3] + gi->t1;
764 int T = gi->t2 - gi->t1 + 1;
765
766 gi->dvals = gretl_matrix_values(d, T, OPT_S, &err);
767 }
768
769 return err;
770 }
771
772 #ifndef WIN32
773
gnuplot_has_wxt(void)774 int gnuplot_has_wxt (void)
775 {
776 static int err = -1;
777
778 if (err == -1) {
779 err = gnuplot_test_command("set term wxt");
780 }
781
782 return !err;
783 }
784
gnuplot_has_x11(void)785 static int gnuplot_has_x11 (void)
786 {
787 static int err = -1;
788
789 if (err == -1) {
790 err = gnuplot_test_command("set term x11");
791 }
792
793 return !err;
794 }
795
gnuplot_has_qt(void)796 static int gnuplot_has_qt (void)
797 {
798 static int err = -1;
799
800 if (err == -1) {
801 err = gnuplot_test_command("set term qt");
802 }
803
804 return !err;
805 }
806
gnuplot_has_tikz(void)807 static int gnuplot_has_tikz (void)
808 {
809 static int err = -1;
810
811 if (err == -1) {
812 err = gnuplot_test_command("set term tikz");
813 }
814
815 return !err;
816 }
817
818 #else
819
gnuplot_has_wxt(void)820 int gnuplot_has_wxt (void)
821 {
822 /* There's no WxWidgets support in the current
823 Windows build of gnuplot 5
824 */
825 return 0;
826 }
827
gnuplot_has_tikz(void)828 static int gnuplot_has_tikz (void)
829 {
830 /* There's no Lua/TikZ support in the current
831 Windows build of gnuplot 5
832 */
833 return 0;
834 }
835
836 #endif /* !WIN32 or WIN32 */
837
838 static gretlRGB user_color[N_GP_LINETYPES] = {
839 0xff0000,
840 0x0000ff,
841 0x00cc00,
842 0xbf25b2,
843 0x8faab3,
844 0xffa500,
845 0xe51e10,
846 0x000000
847 };
848
849 /* apparatus for handling plot "extra" colors */
850
851 static gretlRGB extra_color[2] = {
852 0x5f6b84,
853 0xdddddd
854 };
855
856 static gretlRGB user_extra_color[2] = {
857 0x5f6b84,
858 0xdddddd
859 };
860
get_boxcolor(void)861 gretlRGB get_boxcolor (void)
862 {
863 return user_extra_color[0];
864 }
865
set_boxcolor(gretlRGB color)866 void set_boxcolor (gretlRGB color) {
867 user_extra_color[0] = color;
868 }
869
get_shadecolor(void)870 gretlRGB get_shadecolor (void)
871 {
872 return user_extra_color[1];
873 }
874
set_shadecolor(gretlRGB color)875 void set_shadecolor (gretlRGB color) {
876 user_extra_color[1] = color;
877 }
878
print_rgb_hash(char * s,gretlRGB color)879 void print_rgb_hash (char *s, gretlRGB color)
880 {
881 sprintf(s, "#%06X", color);
882 }
883
gretl_rgb_get(const char * s)884 gretlRGB gretl_rgb_get (const char *s)
885 {
886 gretlRGB x = 0;
887
888 if (sscanf(s, "#%x", &x) != 1) {
889 x = 0;
890 }
891
892 return x;
893 }
894
print_palette_string(char * s)895 void print_palette_string (char *s)
896 {
897 sprintf(s, "x%06X x%06X", user_extra_color[0],
898 user_extra_color[0]);
899 }
900
get_graph_color(int i)901 gretlRGB get_graph_color (int i)
902 {
903 return (i >= 0 && i < N_GP_LINETYPES)? user_color[i] : 0;
904 }
905
set_graph_color_from_string(int i,const char * s)906 void set_graph_color_from_string (int i, const char *s)
907 {
908 int err = 0;
909
910 if (i >= 0 && i < 2) {
911 gretlRGB x;
912
913 if (sscanf(s + 1, "%06x", &x) == 1) {
914 user_extra_color[i] = x;
915 } else {
916 err = 1;
917 }
918 } else {
919 err = 1;
920 }
921
922 if (err) {
923 fprintf(stderr, "Error in set_graph_palette_from_string(%d, '%s')\n",
924 i, s);
925 }
926 }
927
graph_palette_reset(int i)928 void graph_palette_reset (int i)
929 {
930 if (i >= 0 && i < 2) {
931 user_extra_color[i] = extra_color[i];
932 }
933 }
934
935 /* Given a string @s such as "Sans 8" or "Bodoni MT 12", write
936 the name part into @name and the point-size part into @psz.
937 Return 2 if we got both a name and a size, 1 if we just
938 got a name, 0 if we got nothing.
939 */
940
split_graph_fontspec(const char * s,char * name,int * psz)941 int split_graph_fontspec (const char *s, char *name, int *psz)
942 {
943 int i, k = 0, n = strlen(s);
944 int nf = 0;
945
946 for (i=n-1; i>0; i--) {
947 if (isdigit(s[i])) k++;
948 else break;
949 }
950
951 if (k > 0) {
952 /* got a size */
953 char ptstr[8];
954
955 *ptstr = *name = '\0';
956 strncat(ptstr, s + n - k, k);
957 *psz = atoi(ptstr);
958 strncat(name, s, n - k - 1);
959 nf = 2;
960 } else if (*s != '\0') {
961 nf = 1;
962 strcpy(name, s);
963 }
964
965 return nf;
966 }
967
gretl_png_font_string(void)968 char *gretl_png_font_string (void)
969 {
970 const char *s = gretl_png_font();
971 char fstr[256];
972 char name[128];
973 int nf, ptsize = 0;
974
975 fstr[0] = '\0';
976 nf = split_graph_fontspec(s, name, &ptsize);
977 if (nf == 2) {
978 sprintf(fstr, " font \"%s,%d\"", name, ptsize);
979 } else if (nf == 1) {
980 sprintf(fstr, " font \"%s\"", name);
981 }
982
983 return gretl_strdup(fstr);
984 }
985
maybe_set_small_font(int nplots)986 static void maybe_set_small_font (int nplots)
987 {
988 gp_small_font_size = (nplots > 4)? 6 : 0;
989 }
990
write_png_font_string(char * fstr,char * ad_hoc_fontspec,PlotType ptype,const char * grfont,double scale)991 static void write_png_font_string (char *fstr,
992 char *ad_hoc_fontspec,
993 PlotType ptype,
994 const char *grfont,
995 double scale)
996 {
997 int adhoc = 0;
998
999 if (grfont == NULL) {
1000 if (ad_hoc_font[0] != '\0') {
1001 adhoc = 1;
1002 grfont = ad_hoc_font;
1003 } else {
1004 grfont = gretl_png_font();
1005 }
1006 }
1007
1008 if (*grfont == '\0') {
1009 grfont = getenv("GRETL_PNG_GRAPH_FONT");
1010 }
1011
1012 if (*grfont == '\0') {
1013 *fstr = '\0';
1014 return;
1015 } else {
1016 char fname[128];
1017 int nf, fsize = 0;
1018
1019 nf = split_graph_fontspec(grfont, fname, &fsize);
1020 if (nf == 2) {
1021 if (maybe_big_multiplot(ptype) && gp_small_font_size > 0) {
1022 fsize = gp_small_font_size;
1023 }
1024 if (scale > 1.0) {
1025 fsize = round(scale * fsize);
1026 }
1027 sprintf(fstr, " font \"%s,%d\"", fname, fsize);
1028 } else if (nf == 1) {
1029 sprintf(fstr, " font \"%s\"", fname);
1030 }
1031 if (adhoc) {
1032 strcpy(ad_hoc_fontspec, grfont);
1033 }
1034 /* ensure this setting doesn't outstay its welcome */
1035 ad_hoc_font[0] = '\0';
1036 }
1037 }
1038
1039 /* for gnuplot pdfcairo, epscairo output */
1040
write_other_font_string(char * fstr,int stdsize)1041 static void write_other_font_string (char *fstr, int stdsize)
1042 {
1043 if (ad_hoc_font[0] != '\0') {
1044 char fname[128];
1045 int nf, fsize = 0;
1046
1047 nf = split_graph_fontspec(ad_hoc_font, fname, &fsize);
1048 if (nf == 2) {
1049 sprintf(fstr, "%s,%d", fname, fsize);
1050 } else if (nf == 1) {
1051 sprintf(fstr, "%s,%d", fname, stdsize);
1052 }
1053 ad_hoc_font[0] = '\0';
1054 } else {
1055 sprintf(fstr, "sans,%d", stdsize);
1056 }
1057 }
1058
1059 /* gnuplot styles apparatus */
1060
1061 static char gp_style[32]; /* basename of style file */
1062 static gchar *alt_sty; /* content of style file */
1063
1064 static const char *classic_sty =
1065 "# gpstyle classic\n"
1066 "set linetype 1 pt 1 lc rgb \"#FF0000\"\n" /* red */
1067 "set linetype 2 pt 2 lc rgb \"#0000FF\"\n" /* blue */
1068 "set linetype 3 pt 3 lc rgb \"#00CC00\"\n" /* non-standard green */
1069 "set linetype 4 pt 4 lc rgb \"#BF25B2\"\n" /* purple */
1070 "set linetype 5 pt 5 lc rgb \"#8FAAB3\"\n" /* gray-blue */
1071 "set linetype 6 pt 6 lc rgb \"#FFA500\"\n" /* yellow-orange */
1072 "set linetype 7 pt 7 lc rgb \"#E51E10\"\n" /* unnamed red */
1073 "set linetype 8 pt 8 lc rgb \"#000000\"\n"; /* black */
1074
1075 /* Read 8 line colors out of @s and transcribe to the
1076 @user_colors array. Fail if we can't get all 8.
1077 */
1078
transcribe_style(const char * s)1079 static int transcribe_style (const char *s)
1080 {
1081 const char *p = s;
1082 gretlRGB rgb;
1083 int i, got;
1084
1085 for (i=0; i<N_GP_LINETYPES; i++) {
1086 p = strstr(p, " lc rgb ");
1087 got = 0;
1088 if (p != NULL) {
1089 p += 8;
1090 p += strspn(p, " ");
1091 if (sscanf(p+1, "#%x", &rgb) == 1) {
1092 user_color[i] = rgb;
1093 got = 1;
1094 p += 8;
1095 }
1096 }
1097 if (!got) {
1098 break;
1099 }
1100 }
1101
1102 return i < N_GP_LINETYPES ? E_DATA : 0;
1103 }
1104
1105 /* Given a style-name (provisionally copied to @gp_style),
1106 try to find its file and check it for conformance.
1107 */
1108
try_set_alt_sty(void)1109 static int try_set_alt_sty (void)
1110 {
1111 GError *gerr = NULL;
1112 gsize len = 0;
1113 gchar *try = NULL;
1114 gchar *fname;
1115 int err = 0;
1116
1117 fname = g_build_filename(gretl_home(), "data",
1118 "gnuplot", gp_style, NULL);
1119
1120 if (g_file_get_contents(fname, &try, &len, &gerr)) {
1121 err = transcribe_style(try);
1122 if (err) {
1123 /* failed to conform to spec */
1124 fprintf(stderr, "%s failed spec check\n", gp_style);
1125 set_plotstyle("classic");
1126 } else {
1127 /* OK, put the style in place */
1128 g_free(alt_sty);
1129 alt_sty = try;
1130 }
1131 } else {
1132 /* couldn't find the file */
1133 if (gerr != NULL) {
1134 fprintf(stderr, "%s\n", gerr->message);
1135 g_error_free(gerr);
1136 }
1137 err = E_FOPEN;
1138 }
1139
1140 g_free(fname);
1141
1142 return err;
1143 }
1144
1145 /* callback from libset.c, in response to "set plot_style <name>" */
1146
set_plotstyle(const char * style)1147 int set_plotstyle (const char *style)
1148 {
1149 int to_classic = 0;
1150
1151 if (!strcmp(style, "classic") || !strcmp(style, "default")) {
1152 /* "default" is just for backward compat */
1153 to_classic = 1;
1154 }
1155
1156 if (!strcmp(style, gp_style)) {
1157 return 0; /* no-op */
1158 } else if (to_classic && *gp_style == '\0') {
1159 return 0; /* no-op */
1160 } else if (to_classic) {
1161 /* replace alt with classic */
1162 g_free(alt_sty);
1163 alt_sty = NULL;
1164 gp_style[0] = '\0';
1165 transcribe_style(classic_sty);
1166 return 0;
1167 } else {
1168 /* try replacing current with what's requested */
1169 sprintf(gp_style, "%s.gpsty", style);
1170 return try_set_alt_sty();
1171 }
1172 }
1173
get_plotstyle(void)1174 const char *get_plotstyle (void)
1175 {
1176 static char pstyle[32];
1177 char *p;
1178
1179 strcpy(pstyle, gp_style);
1180 p = strrchr(pstyle, '.');
1181 if (p != NULL) {
1182 *p = '\0';
1183 }
1184
1185 return pstyle;
1186 }
1187
1188 /* Write the content of either the default, or an alternative,
1189 gnuplot style into @fp. The @offset argument allows for
1190 skipping one or more leading linetype definitions.
1191 */
1192
inject_gp_style(int offset,FILE * fp)1193 static void inject_gp_style (int offset, FILE *fp)
1194 {
1195 const char *sty = alt_sty != NULL ? alt_sty : classic_sty;
1196 const char *sub = NULL;
1197
1198 if (offset > 0) {
1199 char targ[32];
1200
1201 sprintf(targ, "set linetype %d", offset + 1);
1202 sub = strstr(sty, targ);
1203 }
1204
1205 fputs(sub != NULL ? sub : sty, fp);
1206 }
1207
write_plot_line_styles(int ptype,FILE * fp)1208 void write_plot_line_styles (int ptype, FILE *fp)
1209 {
1210 char cstr[12];
1211 int i;
1212
1213 if (ptype == PLOT_3D) {
1214 for (i=0; i<2; i++) {
1215 print_rgb_hash(cstr, user_color[i]);
1216 fprintf(fp, "set linetype %d lc rgb \"%s\"\n", i+1, cstr);
1217 }
1218 } else if (ptype == PLOT_BOXPLOTS) {
1219 for (i=0; i<2; i++) {
1220 print_rgb_hash(cstr, user_color[i+1]);
1221 fprintf(fp, "set linetype %d lc rgb \"%s\"\n", i+1, cstr);
1222 }
1223 } else if (frequency_plot_code(ptype)) {
1224 print_rgb_hash(cstr, get_boxcolor());
1225 fprintf(fp, "set linetype 1 lc rgb \"%s\"\n", cstr);
1226 fputs("set linetype 2 lc rgb \"#000000\"\n", fp);
1227 } else if (ptype == PLOT_RQ_TAU) {
1228 fputs("set linetype 1 lc rgb \"#000000\"\n", fp);
1229 fputs("set linetype 2 lc rgb \"#000000\"\n", fp);
1230 fputs("set linetype 3 lc rgb \"#0000FF\"\n", fp);
1231 fputs("set linetype 4 lc rgb \"#0000FF\"\n", fp);
1232 fputs("set linetype 5 lc rgb \"#0000FF\"\n", fp);
1233 fputs("set linetype 6 lc rgb \"#FFA500\"\n", fp);
1234 fputs("set linetype 7 lc rgb \"#E51E10\"\n", fp);
1235 fputs("set linetype 8 lc rgb \"#000000\"\n", fp);
1236 } else if (ptype == PLOT_HEATMAP || ptype == PLOT_GEOMAP) {
1237 ; /* these are handled specially */
1238 } else {
1239 /* the primary default case */
1240 inject_gp_style(0, fp);
1241 }
1242 }
1243
1244 /* end gnuplot styles apparatus */
1245
1246 #ifdef WIN32
1247
1248 /* Here we're looking at a path, @src, that we're going
1249 to write into a gnuplot script, as (part of) the
1250 plot output filename or the plot bounding-box
1251 filename. Since we write "set encoding utf8" into the
1252 preamble to our plot scripts we need to ensure that
1253 the path is in fact in UTF-8 (even on MS Windows).
1254 We also want to ensure use of forward slashes in this
1255 context.
1256 */
1257
adjust_filename(char * targ,const char * src,int ensure_utf8)1258 static int adjust_filename (char *targ, const char *src,
1259 int ensure_utf8)
1260 {
1261 int err = 0;
1262
1263 *targ = '\0';
1264
1265 if (ensure_utf8 && !g_utf8_validate(src, -1, NULL)) {
1266 GError *gerr = NULL;
1267 gchar *tmp;
1268 gsize sz;
1269
1270 tmp = g_locale_to_utf8(src, -1, NULL, &sz, &gerr);
1271 if (tmp != NULL) {
1272 strcpy(targ, tmp);
1273 g_free(tmp);
1274 } else {
1275 err = 1;
1276 if (gerr != NULL) {
1277 gretl_errmsg_set(gerr->message);
1278 g_error_free(gerr);
1279 }
1280 }
1281 } else {
1282 /* @src is assumed to be OK already */
1283 strcpy(targ, src);
1284 }
1285
1286 if (!err) {
1287 while (*targ) {
1288 if (*targ == '\\') *targ = '/';
1289 targ++;
1290 }
1291 }
1292
1293 return err;
1294 }
1295
1296 #endif
1297
1298 /* Get gnuplot to print the dimensions of a PNG plot, in terms
1299 of both pixels and data bounds (gnuplot >= 4.4.0).
1300 */
1301
write_plot_bounding_box_request(FILE * fp)1302 int write_plot_bounding_box_request (FILE *fp)
1303 {
1304 #ifdef WIN32
1305 char buf[FILENAME_MAX];
1306 int err;
1307
1308 err = adjust_filename(buf, gretl_dotdir(), 1);
1309 if (!err) {
1310 fprintf(fp, "set print \"%sgretltmp.png.bounds\"\n", buf);
1311 } else {
1312 return err;
1313 }
1314 #else
1315 fprintf(fp, "set print \"%sgretltmp.png.bounds\"\n", gretl_dotdir());
1316 #endif
1317
1318 fputs("print \"pixel_bounds: \", GPVAL_TERM_XMIN, GPVAL_TERM_XMAX, "
1319 "GPVAL_TERM_YMIN, GPVAL_TERM_YMAX\n", fp);
1320 fputs("print \"data_bounds: \", GPVAL_X_MIN, GPVAL_X_MAX, "
1321 "GPVAL_Y_MIN, GPVAL_Y_MAX\n", fp);
1322 fputs("print \"term_size: \", GPVAL_TERM_XSIZE, "
1323 "GPVAL_TERM_YSIZE, GPVAL_TERM_SCALE\n", fp);
1324
1325 return 0;
1326 }
1327
do_plot_bounding_box(void)1328 static int do_plot_bounding_box (void)
1329 {
1330 FILE *fp = gretl_fopen(gretl_plotfile(), "ab");
1331 int err = 0;
1332
1333 if (fp != NULL) {
1334 err = write_plot_bounding_box_request(fp);
1335 fclose(fp);
1336 } else {
1337 err = E_FOPEN;
1338 }
1339
1340 return err;
1341 }
1342
1343 /* apparatus for plots at custom sizes (e.g. maps) */
1344
1345 static float special_width;
1346 static float special_height;
1347
set_special_plot_size(float width,float height)1348 void set_special_plot_size (float width, float height)
1349 {
1350 special_width = width;
1351 special_height = height;
1352 }
1353
clear_special_size(void)1354 static void clear_special_size (void)
1355 {
1356 special_width = special_height = 0;
1357 }
1358
special_size_is_set(void)1359 static int special_size_is_set (void)
1360 {
1361 return special_width > 0 && special_height > 0;
1362 }
1363
1364 /* end special size apparatus */
1365
maybe_set_eps_pdf_dims(char * s,PlotType ptype,GptFlags flags)1366 static void maybe_set_eps_pdf_dims (char *s, PlotType ptype, GptFlags flags)
1367 {
1368 double w = 0, h = 0;
1369
1370 if (special_size_is_set()) {
1371 w = (5.0 * special_width) / GP_WIDTH;
1372 h = (3.5 * special_height) / GP_HEIGHT;
1373 clear_special_size();
1374 } else if (flags & GPT_LETTERBOX) {
1375 /* for time series */
1376 w = (5.0 * GP_LB_WIDTH) / GP_WIDTH;
1377 h = (3.5 * GP_LB_HEIGHT) / GP_HEIGHT;
1378 } else if (flags & GPT_XL) {
1379 /* large */
1380 w = (5.0 * GP_XL_WIDTH) / GP_WIDTH;
1381 h = (3.5 * GP_XL_HEIGHT) / GP_HEIGHT;
1382 } else if (flags & GPT_XXL) {
1383 /* extra large */
1384 w = h = (5.0 * GP_XXL_WIDTH) / GP_WIDTH;
1385 } else if (flags & GPT_XW) {
1386 /* extra wide */
1387 w = (5.0 * GP_XW_WIDTH) / GP_WIDTH;
1388 h = 3.5;
1389 } else if (ptype == PLOT_ROOTS || ptype == PLOT_QQ) {
1390 /* square plots */
1391 w = h = 3.5;
1392 }
1393
1394 if (w > 0 && h > 0) {
1395 char size_str[32];
1396
1397 gretl_push_c_numeric_locale();
1398 sprintf(size_str, " size %.2f,%.2f", w, h);
1399 gretl_pop_c_numeric_locale();
1400 strcat(s, size_str);
1401 }
1402 }
1403
append_gp_encoding(char * s)1404 static void append_gp_encoding (char *s)
1405 {
1406 strcat(s, "\nset encoding utf8");
1407 }
1408
1409 /* In @pdf_term_line and @eps_term_line: should "dashed" be
1410 appended when "mono" is specified? Try experimenting?
1411 */
1412
gretl_pdf_term_line(char * term_line,PlotType ptype,GptFlags flags)1413 static char *gretl_pdf_term_line (char *term_line,
1414 PlotType ptype,
1415 GptFlags flags)
1416 {
1417 char font_string[128];
1418 int ptsize;
1419
1420 ptsize = (ptype == PLOT_MULTI_SCATTER)? 6 : 12;
1421
1422 *font_string = '\0';
1423 write_other_font_string(font_string, ptsize);
1424
1425 sprintf(term_line, "set term pdfcairo noenhanced font \"%s\"",
1426 font_string);
1427
1428 maybe_set_eps_pdf_dims(term_line, ptype, flags);
1429 append_gp_encoding(term_line);
1430
1431 return term_line;
1432 }
1433
gretl_eps_term_line(char * term_line,PlotType ptype,GptFlags flags)1434 static char *gretl_eps_term_line (char *term_line,
1435 PlotType ptype,
1436 GptFlags flags)
1437 {
1438 char font_string[128];
1439 int ptsize;
1440
1441 ptsize = (ptype == PLOT_MULTI_SCATTER)? 6 : 12;
1442
1443 *font_string = '\0';
1444 write_other_font_string(font_string, ptsize);
1445
1446 sprintf(term_line, "set term epscairo noenhanced font \"%s\"",
1447 font_string);
1448
1449 maybe_set_eps_pdf_dims(term_line, ptype, flags);
1450 append_gp_encoding(term_line);
1451
1452 return term_line;
1453 }
1454
gretl_tex_term_line(char * term_line,PlotType ptype,GptFlags flags)1455 static char *gretl_tex_term_line (char *term_line,
1456 PlotType ptype,
1457 GptFlags flags)
1458 {
1459 if (gnuplot_has_tikz()) {
1460 strcpy(term_line, "set term tikz");
1461 } else {
1462 strcpy(term_line, "set term cairolatex");
1463 }
1464
1465 append_gp_encoding(term_line);
1466
1467 return term_line;
1468 }
1469
plot_get_scaled_dimensions(int * width,int * height,double scale)1470 void plot_get_scaled_dimensions (int *width, int *height, double scale)
1471 {
1472 *width *= scale;
1473 *height *= scale;
1474
1475 /* PNG: round up to an even number of pixels if need be */
1476 if (*width % 2) *width += 1;
1477 if (*height % 2) *height += 1;
1478 }
1479
write_png_size_string(char * s,PlotType ptype,GptFlags flags,double scale)1480 static void write_png_size_string (char *s, PlotType ptype,
1481 GptFlags flags, double scale)
1482 {
1483 int w = GP_WIDTH, h = GP_HEIGHT;
1484
1485 if (special_size_is_set()) {
1486 w = (int) special_width;
1487 h = (int) special_height;
1488 clear_special_size();
1489 } else if (flags & GPT_LETTERBOX) {
1490 /* time series plots */
1491 w = GP_LB_WIDTH;
1492 h = GP_LB_HEIGHT;
1493 } else if (flags & GPT_XL) {
1494 /* large */
1495 w = GP_XL_WIDTH;
1496 h = GP_XL_HEIGHT;
1497 } else if (flags & GPT_XXL) {
1498 /* extra large */
1499 w = GP_XXL_WIDTH;
1500 h = GP_XXL_HEIGHT;
1501 } else if (flags & GPT_XW) {
1502 /* extra wide */
1503 w = GP_XW_WIDTH;
1504 h = GP_HEIGHT;
1505 } else if (ptype == PLOT_ROOTS || ptype == PLOT_QQ) {
1506 /* square plots */
1507 w = h = GP_SQ_SIZE;
1508 }
1509
1510 if (scale != 1.0) {
1511 plot_get_scaled_dimensions(&w, &h, scale);
1512 }
1513
1514 *s = '\0';
1515 sprintf(s, " size %d,%d", w, h);
1516 }
1517
1518 /* platform-specific on-screen term string */
1519
var_term_line(char * term_line,int ptype)1520 static char *var_term_line (char *term_line, int ptype)
1521 {
1522 char font_string[140];
1523 char size_string[16];
1524 const char *varterm;
1525
1526 #ifdef WIN32
1527 varterm = "windows";
1528 #else
1529 if (gnuplot_has_wxt()) {
1530 varterm = "wxt";
1531 } else if (gnuplot_has_qt()) {
1532 varterm = "qt";
1533 } else {
1534 varterm = "x11";
1535 }
1536 #endif
1537
1538 *font_string = *size_string = '\0';
1539 write_png_font_string(font_string, "", ptype, NULL, 1.0);
1540 write_png_size_string(size_string, ptype, 0, 1.0);
1541
1542 sprintf(term_line, "set term %s%s%s noenhanced",
1543 varterm, font_string, size_string);
1544
1545 append_gp_encoding(term_line);
1546
1547 return term_line;
1548 }
1549
real_png_term_line(char * term_line,PlotType ptype,GptFlags flags,const char * specfont,double scale)1550 static char *real_png_term_line (char *term_line,
1551 PlotType ptype,
1552 GptFlags flags,
1553 const char *specfont,
1554 double scale)
1555 {
1556 char ad_hoc_fontspec[128];
1557 char font_string[140];
1558 char size_string[16];
1559
1560 *font_string = *size_string = *ad_hoc_fontspec = '\0';
1561
1562 write_png_font_string(font_string, ad_hoc_fontspec,
1563 ptype, specfont, scale);
1564 write_png_size_string(size_string, ptype, flags, scale);
1565
1566 sprintf(term_line, "set term pngcairo%s%s noenhanced",
1567 font_string, size_string);
1568
1569 append_gp_encoding(term_line);
1570
1571 if (*ad_hoc_fontspec != '\0') {
1572 strcat(term_line, "\n# fontspec: ");
1573 strcat(term_line, ad_hoc_fontspec);
1574 }
1575
1576 #if GP_DEBUG
1577 fprintf(stderr, "png term line:\n'%s'\n", term_line);
1578 #endif
1579
1580 return term_line;
1581 }
1582
gretl_png_term_line(char * term_line,PlotType ptype,GptFlags flags)1583 static char *gretl_png_term_line (char *term_line,
1584 PlotType ptype,
1585 GptFlags flags)
1586 {
1587 if (ptype == PLOT_GEOMAP) {
1588 return real_png_term_line(term_line, ptype, flags, NULL, 1.0);
1589 } else {
1590 double s = default_png_scale;
1591
1592 return real_png_term_line(term_line, ptype, flags, NULL, s);
1593 }
1594 }
1595
1596 /**
1597 * gretl_gnuplot_term_line:
1598 * @ttype: code for the gnuplot "terminal" type.
1599 * @ptype: indication of the sort of plot to be made, which
1600 * may make a difference to the color palette chosen.
1601 * @flags: plot option flags.
1602 * @font: if non-NULL, try to respect a specified font.
1603 *
1604 * Constructs a suitable line for sending to gnuplot to invoke
1605 * the specified "terminal".
1606 *
1607 * Returns: a static char * pointer.
1608 */
1609
gretl_gnuplot_term_line(TermType ttype,PlotType ptype,GptFlags flags,const char * font)1610 const char *gretl_gnuplot_term_line (TermType ttype,
1611 PlotType ptype,
1612 GptFlags flags,
1613 const char *font)
1614 {
1615 static char term_line[TERMLEN];
1616
1617 *term_line = '\0';
1618
1619 if (font != NULL && ad_hoc_font[0] == '\0') {
1620 strcpy(ad_hoc_font, font);
1621 }
1622
1623 if (ttype == GP_TERM_PNG) {
1624 double s = default_png_scale;
1625
1626 real_png_term_line(term_line, ptype, flags, NULL, s);
1627 } else if (ttype == GP_TERM_PDF) {
1628 gretl_pdf_term_line(term_line, ptype, flags);
1629 } else if (ttype == GP_TERM_EPS) {
1630 gretl_eps_term_line(term_line, ptype, flags);
1631 } else if (ttype == GP_TERM_EMF) {
1632 gretl_emf_term_line(term_line, ptype, flags);
1633 } else if (ttype == GP_TERM_SVG) {
1634 strcpy(term_line, "set term svg noenhanced");
1635 append_gp_encoding(term_line);
1636 } else if (ttype == GP_TERM_FIG) {
1637 strcpy(term_line, "set term fig");
1638 append_gp_encoding(term_line);
1639 } else if (ttype == GP_TERM_TEX) {
1640 gretl_tex_term_line(term_line, ptype, flags);
1641 } else if (ttype == GP_TERM_VAR) {
1642 var_term_line(term_line, ptype);
1643 }
1644
1645 return term_line;
1646 }
1647
get_png_line_for_plotspec(const GPT_SPEC * spec)1648 const char *get_png_line_for_plotspec (const GPT_SPEC *spec)
1649 {
1650 static char term_line[TERMLEN];
1651
1652 real_png_term_line(term_line, spec->code, spec->flags,
1653 spec->fontstr, spec->scale);
1654 return term_line;
1655 }
1656
gnuplot_png_set_default_scale(double s)1657 void gnuplot_png_set_default_scale (double s)
1658 {
1659 if (s >= 0.5 && s <= 2.0) {
1660 default_png_scale = s;
1661 }
1662 }
1663
write_emf_font_string(char * fstr)1664 static void write_emf_font_string (char *fstr)
1665 {
1666 const char *src = NULL;
1667 int stdsize = 16;
1668 int adhoc = 0;
1669
1670 if (ad_hoc_font[0] != '\0') {
1671 src = ad_hoc_font;
1672 adhoc = 1;
1673 } else {
1674 src = gretl_png_font();
1675 }
1676
1677 if (src != NULL) {
1678 char fname[128];
1679 int nf, fsize = 0;
1680
1681 nf = split_graph_fontspec(src, fname, &fsize);
1682 if (nf == 2) {
1683 if (adhoc) {
1684 /* go with what the user specified */
1685 sprintf(fstr, "font \"%s,%d\"", fname, fsize);
1686 } else {
1687 /* adjust size to avoid tiny text? */
1688 fsize = (fsize <= 8)? 12 : 16;
1689 sprintf(fstr, "font \"%s,%d\"", fname, fsize);
1690 }
1691 } else if (nf == 1) {
1692 sprintf(fstr, "font \"%s,%d\"", fname, stdsize);
1693 }
1694 ad_hoc_font[0] = '\0';
1695 } else {
1696 sprintf(fstr, "font \"sans,%d\"", stdsize);
1697 }
1698 }
1699
gretl_emf_term_line(char * term_line,PlotType ptype,GptFlags flags)1700 static char *gretl_emf_term_line (char *term_line,
1701 PlotType ptype,
1702 GptFlags flags)
1703 {
1704 gchar *size_string = NULL;
1705 char font_string[140];
1706
1707 *font_string = '\0';
1708 write_emf_font_string(font_string);
1709
1710 if (special_size_is_set()) {
1711 size_string = g_strdup_printf("size %d,%d ",
1712 (int) special_width,
1713 (int) special_height);
1714 clear_special_size();
1715 }
1716
1717 if (flags & GPT_MONO) {
1718 strcat(term_line, "set term emf dash noenhanced ");
1719 } else {
1720 strcat(term_line, "set term emf color noenhanced ");
1721 }
1722
1723 if (size_string != NULL) {
1724 strcat(term_line, size_string);
1725 g_free(size_string);
1726 }
1727
1728 if (*font_string != '\0') {
1729 strcat(term_line, font_string);
1730 }
1731
1732 append_gp_encoding(term_line);
1733
1734 return term_line;
1735 }
1736
1737 /**
1738 * plot_type_from_string:
1739 * @str: initial comment line from plot file.
1740 *
1741 * Returns: the special plot code corresponding to the initial
1742 * comment string in the plot file, or %PLOT_REGULAR if no special
1743 * comment is recognized.
1744 */
1745
plot_type_from_string(const char * str)1746 PlotType plot_type_from_string (const char *str)
1747 {
1748 int i, len, ret = PLOT_REGULAR;
1749
1750 for (i=1; ptinfo[i].pstr != NULL; i++) {
1751 len = strlen(ptinfo[i].pstr);
1752 if (!strncmp(str + 2, ptinfo[i].pstr, len)) {
1753 ret = ptinfo[i].ptype;
1754 break;
1755 }
1756 }
1757
1758 return ret;
1759 }
1760
write_plot_type_string(PlotType ptype,GptFlags flags,FILE * fp)1761 int write_plot_type_string (PlotType ptype, GptFlags flags, FILE *fp)
1762 {
1763 int i, ret = 0;
1764
1765 if (ptype == PLOT_GEOMAP) {
1766 /* handled specially */
1767 return 0;
1768 }
1769
1770 for (i=1; i<PLOT_TYPE_MAX; i++) {
1771 if (ptype == ptinfo[i].ptype) {
1772 if (flags & GPT_XL) {
1773 fprintf(fp, "# %s (large)\n", ptinfo[i].pstr);
1774 } else if (flags & GPT_XXL) {
1775 fprintf(fp, "# %s (extra-large)\n", ptinfo[i].pstr);
1776 } else if (flags & GPT_XW) {
1777 fprintf(fp, "# %s (extra-wide)\n", ptinfo[i].pstr);
1778 } else {
1779 fprintf(fp, "# %s\n", ptinfo[i].pstr);
1780 }
1781 ret = 1;
1782 break;
1783 }
1784 }
1785
1786 if (ret == 0 && (flags & GPT_XW)) {
1787 fputs("# extra-wide\n", fp);
1788 }
1789
1790 if (get_local_decpoint() == ',') {
1791 /* is this right? */
1792 fputs("set decimalsign ','\n", fp);
1793 }
1794
1795 return ret;
1796 }
1797
print_term_string(int ttype,PlotType ptype,GptFlags flags,FILE * fp)1798 static void print_term_string (int ttype, PlotType ptype,
1799 GptFlags flags, FILE *fp)
1800 {
1801 char term_line[TERMLEN];
1802
1803 *term_line = '\0';
1804
1805 if (ttype == GP_TERM_EPS) {
1806 gretl_eps_term_line(term_line, ptype, flags);
1807 } else if (ttype == GP_TERM_PDF) {
1808 gretl_pdf_term_line(term_line, ptype, flags);
1809 } else if (ttype == GP_TERM_PNG) {
1810 gretl_png_term_line(term_line, ptype, flags);
1811 } else if (ttype == GP_TERM_EMF) {
1812 gretl_emf_term_line(term_line, ptype, flags);
1813 } else if (ttype == GP_TERM_FIG) {
1814 strcpy(term_line, "set term fig\nset encoding utf8");
1815 } else if (ttype == GP_TERM_SVG) {
1816 strcpy(term_line, "set term svg noenhanced\nset encoding utf8");
1817 } else if (ttype == GP_TERM_TEX) {
1818 gretl_tex_term_line(term_line, ptype, flags);
1819 }
1820
1821 if (*term_line != '\0') {
1822 fprintf(fp, "%s\n", term_line);
1823 if (flags & GPT_MONO) {
1824 fputs("set mono\n", fp);
1825 } else {
1826 write_plot_line_styles(ptype, fp);
1827 }
1828 }
1829 }
1830
1831 static int gretl_plot_count;
1832 static int this_term_type;
1833
1834 /* recorder for filename given via --output=foo */
1835 static char gnuplot_outname[FILENAME_MAX];
1836
set_term_type_from_fname(const char * fname)1837 static int set_term_type_from_fname (const char *fname)
1838 {
1839 if (has_suffix(fname, ".eps")) {
1840 this_term_type = GP_TERM_EPS;
1841 } else if (has_suffix(fname, ".ps")) {
1842 this_term_type = GP_TERM_EPS;
1843 } else if (has_suffix(fname, ".pdf")) {
1844 this_term_type = GP_TERM_PDF;
1845 } else if (has_suffix(fname, ".png")) {
1846 this_term_type = GP_TERM_PNG;
1847 } else if (has_suffix(fname, ".fig")) {
1848 this_term_type = GP_TERM_FIG;
1849 } else if (has_suffix(fname, ".emf")) {
1850 this_term_type = GP_TERM_EMF;
1851 } else if (has_suffix(fname, ".svg")) {
1852 this_term_type = GP_TERM_SVG;
1853 } else if (has_suffix(fname, ".tex")) {
1854 this_term_type = GP_TERM_TEX;
1855 } else if (!strcmp(fname, "gnuplot")) {
1856 this_term_type = GP_TERM_VAR;
1857 }
1858
1859 return this_term_type;
1860 }
1861
specified_gp_output_format(void)1862 int specified_gp_output_format (void)
1863 {
1864 return this_term_type;
1865 }
1866
reset_plot_count(void)1867 void reset_plot_count (void)
1868 {
1869 gretl_plot_count = 0;
1870 }
1871
1872 /* if @path is non-NULL we use it, otherwise we make a path
1873 using @dotdir and "gretltmp.png"
1874 */
1875
write_plot_output_line(const char * path,FILE * fp)1876 int write_plot_output_line (const char *path, FILE *fp)
1877 {
1878 #ifdef WIN32
1879 char buf[FILENAME_MAX];
1880 int err = 0;
1881
1882 if (path == NULL) {
1883 err = adjust_filename(buf, gretl_dotdir(), 1);
1884 if (!err) {
1885 fprintf(fp, "set output \"%sgretltmp.png\"\n", buf);
1886 }
1887 } else {
1888 err = adjust_filename(buf, path, 1);
1889 if (!err) {
1890 fprintf(fp, "set output \"%s\"\n", buf);
1891 }
1892 }
1893
1894 return err;
1895 #else
1896 if (path == NULL) {
1897 fprintf(fp, "set output \"%sgretltmp.png\"\n", gretl_dotdir());
1898 } else {
1899 fprintf(fp, "set output \"%s\"\n", path);
1900 }
1901
1902 return 0;
1903 #endif
1904 }
1905
gp_set_up_batch(char * fname,PlotType ptype,GptFlags flags,const char * optname,int * err)1906 static FILE *gp_set_up_batch (char *fname,
1907 PlotType ptype,
1908 GptFlags flags,
1909 const char *optname,
1910 int *err)
1911 {
1912 int fmt = GP_TERM_NONE;
1913 FILE *fp = NULL;
1914
1915 if (optname != NULL) {
1916 /* user gave --output=<filename> */
1917 fmt = set_term_type_from_fname(optname);
1918 if (fmt) {
1919 /* input needs processing */
1920 strcpy(gnuplot_outname, optname);
1921 gretl_maybe_prepend_dir(gnuplot_outname);
1922 sprintf(fname, "%sgpttmp.XXXXXX", gretl_dotdir());
1923 fp = gretl_mktemp(fname, "w");
1924 } else {
1925 /* just passing gnuplot commands through */
1926 this_term_type = GP_TERM_PLT;
1927 strcpy(fname, optname);
1928 gretl_maybe_prepend_dir(fname);
1929 fp = gretl_fopen(fname, "w");
1930 }
1931 } else {
1932 /* auto-constructed gnuplot commands filename */
1933 this_term_type = GP_TERM_PLT;
1934 sprintf(fname, "gpttmp%02d.plt", ++gretl_plot_count);
1935 gretl_maybe_prepend_dir(fname);
1936 fp = gretl_fopen(fname, "w");
1937 }
1938
1939 if (fp == NULL) {
1940 *err = E_FOPEN;
1941 } else {
1942 gretl_set_path_by_name("plotfile", fname);
1943 if (*gnuplot_outname != '\0') {
1944 /* write terminal/style/output lines */
1945 print_term_string(fmt, ptype, flags, fp);
1946 write_plot_output_line(gnuplot_outname, fp);
1947 } else {
1948 /* just write style lines */
1949 write_plot_line_styles(ptype, fp);
1950 }
1951 if (get_local_decpoint() == ',') {
1952 fputs("set decimalsign ','\n", fp);
1953 }
1954 }
1955
1956 return fp;
1957 }
1958
1959 static char *iact_gpfile;
1960
1961 /* Set-up for an "interactive" plot: we open a file in the user's
1962 dotdir into which gnuplot commands will be written. If we're
1963 running the GUI program this command file will eventually be used
1964 to create a PNG file for display in a gretl window; otherwise
1965 (gretlcli) the commands will eventually be sent to gnuplot for
1966 "direct" display (e.g. using the x11 or windows terminal).
1967
1968 In this function we just open the file for writing; if in GUI
1969 mode insert a suitable PNG terminal line and output spec line;
1970 and write some header-type material including our line style
1971 specifications.
1972 */
1973
gp_set_up_interactive(char * fname,PlotType ptype,GptFlags flags,int * err)1974 static FILE *gp_set_up_interactive (char *fname, PlotType ptype,
1975 GptFlags flags, int *err)
1976 {
1977 int gui = gretl_in_gui_mode();
1978 FILE *fp = NULL;
1979
1980 if (iact_gpfile != NULL) {
1981 fname = iact_gpfile;
1982 fp = gretl_fopen(fname, "wb");
1983 iact_gpfile = NULL;
1984 } else if (gui) {
1985 /* the filename should be unique */
1986 sprintf(fname, "%sgpttmp.XXXXXX", gretl_dotdir());
1987 fp = gretl_mktemp(fname, "wb");
1988 } else {
1989 /* gretlcli: no need for uniqueness */
1990 sprintf(fname, "%sgpttmp.plt", gretl_dotdir());
1991 fp = gretl_fopen(fname, "wb");
1992 }
1993
1994 if (fp == NULL) {
1995 *err = E_FOPEN;
1996 } else {
1997 gretl_set_path_by_name("plotfile", fname);
1998 if (gui) {
1999 /* set up for PNG output */
2000 fprintf(fp, "%s\n", gretl_gnuplot_term_line(GP_TERM_PNG, ptype,
2001 flags, NULL));
2002 if (default_png_scale != 1.0) {
2003 gretl_push_c_numeric_locale();
2004 fprintf(fp, "# scale = %.1f\n", default_png_scale);
2005 fputs("# auto linewidth\n", fp);
2006 gretl_pop_c_numeric_locale();
2007 }
2008 write_plot_output_line(NULL, fp);
2009 } else if (ptype == PLOT_GEOMAP) {
2010 fprintf(fp, "%s\n", gretl_gnuplot_term_line(GP_TERM_VAR, ptype,
2011 flags, NULL));
2012 } else {
2013 fputs("set termoption noenhanced\n", fp);
2014 }
2015 write_plot_type_string(ptype, flags, fp);
2016 write_plot_line_styles(ptype, fp);
2017 }
2018
2019 return fp;
2020 }
2021
2022 #ifndef WIN32
2023
gnuplot_too_old(void)2024 static int gnuplot_too_old (void)
2025 {
2026 static double gpv;
2027 int msg_done = 0;
2028 int ret = 0;
2029
2030 if (gpv == 0.0) {
2031 gpv = gnuplot_version(&msg_done);
2032 }
2033
2034 if (gpv == 0.0) {
2035 if (!msg_done) {
2036 gretl_errmsg_sprintf("'%s': gnuplot is broken or too old: must be >= version 5.0",
2037 gretl_gnuplot_path());
2038 }
2039 ret = 1;
2040 } else if (gpv < 5.0) {
2041 gretl_errmsg_sprintf("Gnuplot %g is too old: must be >= version 5.0", gpv);
2042 ret = 1;
2043 }
2044
2045 return ret;
2046 }
2047
2048 #endif
2049
got_display_option(const char * s)2050 static int got_display_option (const char *s)
2051 {
2052 return s != NULL && !strcmp(s, "display");
2053 }
2054
got_none_option(const char * s)2055 static int got_none_option (const char *s)
2056 {
2057 return s != NULL && !strcmp(s, "none");
2058 }
2059
plot_output_option(PlotType p,int * pci)2060 static const char *plot_output_option (PlotType p, int *pci)
2061 {
2062 int ci = plot_ci;
2063 const char *s;
2064
2065 /* set a more specific command index based on
2066 the plot type, if applicable */
2067
2068 if (p == PLOT_MULTI_SCATTER) {
2069 ci = SCATTERS;
2070 } else if (p == PLOT_BOXPLOTS) {
2071 ci = BXPLOT;
2072 } else if (p == PLOT_FORECAST) {
2073 ci = FCAST;
2074 } else if (p == PLOT_CORRELOGRAM) {
2075 ci = CORRGM;
2076 } else if (p == PLOT_XCORRELOGRAM) {
2077 ci = XCORRGM;
2078 } else if (p == PLOT_PERIODOGRAM) {
2079 ci = PERGM;
2080 } else if (p == PLOT_HURST) {
2081 ci = HURST;
2082 } else if (p == PLOT_QQ) {
2083 ci = QQPLOT;
2084 } else if (p == PLOT_RANGE_MEAN) {
2085 ci = RMPLOT;
2086 } else if (p == PLOT_LEVERAGE) {
2087 ci = LEVERAGE;
2088 } else if (p == PLOT_FREQ_SIMPLE ||
2089 p == PLOT_FREQ_NORMAL ||
2090 p == PLOT_FREQ_GAMMA ||
2091 p == PLOT_FREQ_DISCRETE) {
2092 ci = FREQ;
2093 } else if (p == PLOT_HEATMAP) {
2094 ci = CORR;
2095 } else if (p == PLOT_CUSUM) {
2096 ci = CUSUM;
2097 }
2098
2099 s = get_optval_string(ci, OPT_U);
2100 if (s != NULL && *s == '\0') {
2101 s = NULL;
2102 }
2103
2104 if (pci != NULL) {
2105 *pci = ci;
2106 }
2107
2108 return s;
2109 }
2110
2111 /**
2112 * open_plot_input_file:
2113 * @ptype: indication of the sort of plot to be made.
2114 * @flags: may inflect some characteristics of plot.
2115 * @err: location to receive error code.
2116 *
2117 * Opens a file into which gnuplot commands will be written.
2118 * Depending on the prospective use of the stream, some
2119 * header-type material may be written into it (the primary
2120 * case being when we're going to produce PNG output
2121 * for display in the gretl GUI). The prospective use is
2122 * figured out based on the program state, @ptype and
2123 * @flags.
2124 *
2125 * Returns: writable stream on success, %NULL on failure.
2126 */
2127
open_plot_input_file(PlotType ptype,GptFlags flags,int * err)2128 FILE *open_plot_input_file (PlotType ptype, GptFlags flags, int *err)
2129 {
2130 char fname[FILENAME_MAX] = {0};
2131 const char *optname = NULL;
2132 int ci, interactive = 0;
2133 FILE *fp = NULL;
2134
2135 /* ensure we have 'gnuplot_path' in place (file-scope static var) */
2136 if (*gnuplot_path == '\0') {
2137 strcpy(gnuplot_path, gretl_gnuplot_path());
2138 }
2139
2140 #ifndef WIN32
2141 if (gnuplot_too_old()) {
2142 *err = E_EXTERNAL;
2143 return NULL;
2144 }
2145 #endif
2146
2147 /* initialize */
2148 this_term_type = GP_TERM_NONE;
2149 *gnuplot_outname = '\0';
2150
2151 /* check for --output=whatever option */
2152 optname = plot_output_option(ptype, &ci);
2153
2154 if (got_display_option(optname)) {
2155 /* --output=display specified */
2156 interactive = 1;
2157 } else if (optname != NULL) {
2158 /* --output=filename specified */
2159 interactive = 0;
2160 } else if (flags & GPT_ICON) {
2161 interactive = 1;
2162 } else {
2163 /* default */
2164 interactive = !gretl_in_batch_mode();
2165 }
2166
2167 #if GP_DEBUG
2168 fprintf(stderr, "optname = '%s', interactive = %d\n",
2169 optname == NULL ? "null" : optname, interactive);
2170 #endif
2171
2172 if (interactive) {
2173 fp = gp_set_up_interactive(fname, ptype, flags, err);
2174 } else {
2175 fp = gp_set_up_batch(fname, ptype, flags, optname, err);
2176 }
2177
2178 #if GP_DEBUG
2179 fprintf(stderr, "open_plot_input_file: '%s'\n", gretl_plotfile());
2180 #endif
2181
2182 return fp;
2183 }
2184
2185 /* For plot-types that are generated by commands that also produce
2186 textual output: based on the program state and command option,
2187 figure out if a plot is actually wanted or not. In interactive mode
2188 the answer will be Yes unless --plot=none has been given; in batch
2189 mode the answer will be No unless --plot=display or --plot=fname
2190 has been given.
2191 */
2192
gnuplot_graph_wanted(PlotType ptype,gretlopt opt)2193 int gnuplot_graph_wanted (PlotType ptype, gretlopt opt)
2194 {
2195 const char *optname = NULL;
2196 int ret = 0;
2197
2198 if (opt & OPT_U) {
2199 /* check for --plot=whatever option */
2200 optname = plot_output_option(ptype, NULL);
2201 }
2202
2203 if (got_none_option(optname)) {
2204 /* --plot=none specified */
2205 ret = 0;
2206 } else if (optname != NULL) {
2207 /* --plot=display or --plot=fname specified */
2208 ret = 1;
2209 } else {
2210 /* defaults */
2211 ret = !gretl_in_batch_mode();
2212 }
2213
2214 return ret;
2215 }
2216
2217 /**
2218 * gnuplot_cleanup:
2219 *
2220 * Removes any temporary gnuplot input file written in
2221 * the user's dot directory.
2222 */
2223
gnuplot_cleanup(void)2224 void gnuplot_cleanup (void)
2225 {
2226 const char *p, *fname = gretl_plotfile();
2227
2228 p = strstr(fname, "gpttmp");
2229
2230 if (p != NULL) {
2231 int pnum;
2232
2233 if (sscanf(p, "gpttmp%d.plt", &pnum) == 0) {
2234 gretl_remove(fname);
2235 }
2236 }
2237 }
2238
2239 static int graph_file_written;
2240
graph_written_to_file(void)2241 int graph_written_to_file (void)
2242 {
2243 return graph_file_written;
2244 }
2245
2246 static int graph_file_shown;
2247
graph_displayed(void)2248 int graph_displayed (void)
2249 {
2250 return graph_file_shown;
2251 }
2252
remove_old_png(void)2253 static void remove_old_png (void)
2254 {
2255 gchar *tmp = gretl_make_dotpath("gretltmp.png");
2256
2257 gretl_remove(tmp);
2258 g_free(tmp);
2259 }
2260
2261 /*
2262 * gnuplot_make_graph:
2263 *
2264 * Executes gnuplot to produce a graph: in the gretl GUI
2265 * in interactive mode this will be a PNG file. In the
2266 * CLI program in interactive mode there will be a direct
2267 * call to gnuplot to display the graph. In batch mode
2268 * the type of file written depends on the options selected
2269 * by the user.
2270 *
2271 * Returns: 0 on success, non-zero on error.
2272 */
2273
gnuplot_make_graph(void)2274 static int gnuplot_make_graph (void)
2275 {
2276 char buf[MAXLEN];
2277 const char *fname = gretl_plotfile();
2278 int gui = gretl_in_gui_mode();
2279 int fmt, err = 0;
2280
2281 graph_file_written = 0;
2282 graph_file_shown = 0;
2283 fmt = specified_gp_output_format();
2284
2285 if (fmt == GP_TERM_PLT) {
2286 /* no-op: just the gnuplot commands are wanted */
2287 graph_file_written = 1;
2288 return 0;
2289 } else if (fmt == GP_TERM_NONE && gui) {
2290 do_plot_bounding_box();
2291 /* ensure we don't get stale output */
2292 remove_old_png();
2293 }
2294
2295 #ifdef WIN32
2296 if (gui || fmt) {
2297 sprintf(buf, "\"%s\" \"%s\"", gretl_gnuplot_path(), fname);
2298 } else {
2299 /* gretlcli, interactive */
2300 sprintf(buf, "\"%s\" -persist \"%s\"", gretl_gnuplot_path(), fname);
2301 }
2302 err = gretl_spawn(buf);
2303 #else /* !WIN32 */
2304 if (gui || fmt) {
2305 sprintf(buf, "%s \"%s\"", gretl_gnuplot_path(), fname);
2306 } else {
2307 /* gretlcli, interactive */
2308 sprintf(buf, "%s -persist \"%s\"", gretl_gnuplot_path(), fname);
2309 }
2310 err = gretl_spawn(buf);
2311 #endif
2312
2313 #if GP_DEBUG
2314 fprintf(stderr, "gnuplot_make_graph:\n"
2315 " command='%s', fmt = %d, err = %d\n", buf, fmt, err);
2316 #endif
2317
2318 if (fmt) {
2319 /* got a user-specified output format */
2320 if (err) {
2321 /* leave the bad file for diagnostic purposes */
2322 fprintf(stderr, "err = %d: bad file is '%s'\n", err, fname);
2323 } else {
2324 /* remove the temporary input file */
2325 gretl_remove(fname);
2326 if (fmt == GP_TERM_VAR) {
2327 graph_file_shown = 1;
2328 } else {
2329 gretl_set_path_by_name("plotfile", gnuplot_outname);
2330 graph_file_written = 1;
2331 }
2332 }
2333 }
2334
2335 return err;
2336 }
2337
2338 /**
2339 * finalize_plot_input_file:
2340 * @fp: stream to which gnuplot commands have been written.
2341 *
2342 * Closes @fp and attempts to "make" the graph that it specifies.
2343 *
2344 * Returns: 0 on success, non-zero code on error.
2345 */
2346
finalize_plot_input_file(FILE * fp)2347 int finalize_plot_input_file (FILE *fp)
2348 {
2349 int err;
2350
2351 if (fp != NULL) {
2352 fclose(fp);
2353 err = gnuplot_make_graph();
2354 if (!err) {
2355 /* for the benefit of gretl_cmd_exec() in interact.c,
2356 indicate that we actually produced a plot */
2357 set_plot_produced();
2358 }
2359 } else {
2360 err = 1;
2361 }
2362
2363 return err;
2364 }
2365
2366 /**
2367 * finalize_3d_plot_input_file:
2368 * @fp: stream to which gnuplot commands have been written.
2369 *
2370 * Closes @fp and alerts libgretl to the fact that an interactive
2371 * 3-D plot is wanted.
2372 *
2373 * Returns: 0 on success, non-zero code on error.
2374 */
2375
finalize_3d_plot_input_file(FILE * fp)2376 int finalize_3d_plot_input_file (FILE *fp)
2377 {
2378 int err = 0;
2379
2380 if (fp != NULL) {
2381 fclose(fp);
2382 graph_file_written = 1;
2383 } else {
2384 err = 1;
2385 }
2386
2387 return err;
2388 }
2389
2390 enum {
2391 GTITLE_VLS,
2392 GTITLE_RESID,
2393 GTITLE_AF,
2394 GTITLE_AFV
2395 } graph_titles;
2396
make_gtitle(gnuplot_info * gi,int code,const char * s1,const char * s2,FILE * fp)2397 static void make_gtitle (gnuplot_info *gi, int code,
2398 const char *s1, const char *s2,
2399 FILE *fp)
2400 {
2401 char depvar[VNAMELEN];
2402 gchar *title = NULL;
2403
2404 switch (code) {
2405 case GTITLE_VLS:
2406 if (gi->fit == PLOT_FIT_OLS) {
2407 title = g_strdup_printf(_("%s versus %s (with least squares fit)"),
2408 s1, s2);
2409 } else if (gi->fit == PLOT_FIT_INVERSE) {
2410 title = g_strdup_printf(_("%s versus %s (with inverse fit)"),
2411 s1, s2);
2412 } else if (gi->fit == PLOT_FIT_QUADRATIC) {
2413 title = g_strdup_printf(_("%s versus %s (with quadratic fit)"),
2414 s1, s2);
2415 } else if (gi->fit == PLOT_FIT_CUBIC) {
2416 title = g_strdup_printf(_("%s versus %s (with cubic fit)"),
2417 s1, s2);
2418 }
2419 break;
2420 case GTITLE_RESID:
2421 if (strncmp(s1, "residual for ", 13) == 0 &&
2422 gretl_scan_varname(s1 + 13, depvar) == 1) {
2423 title = g_strdup_printf(_("Regression residuals (= observed - fitted %s)"),
2424 depvar);
2425 }
2426 break;
2427 case GTITLE_AF:
2428 title = g_strdup_printf(_("Actual and fitted %s"), s1);
2429 break;
2430 case GTITLE_AFV:
2431 if (s2 == NULL || (gi->flags & GPT_TS)) {
2432 title = g_strdup_printf(_("Actual and fitted %s"), s1);
2433 } else {
2434 title = g_strdup_printf(_("Actual and fitted %s versus %s"), s1, s2);
2435 }
2436 break;
2437 default:
2438 break;
2439 }
2440
2441 if (title != NULL) {
2442 fprintf(fp, "set title \"%s\"\n", title);
2443 g_free(title);
2444 }
2445 }
2446
print_axis_label(char axis,const char * s,FILE * fp)2447 static void print_axis_label (char axis, const char *s, FILE *fp)
2448 {
2449 if (strchr(s, '\'')) {
2450 fprintf(fp, "set %clabel \"%s\"\n", axis, s);
2451 } else {
2452 fprintf(fp, "set %clabel '%s'\n", axis, s);
2453 }
2454 }
2455
literal_line_out(const char * s,int len,FILE * fp)2456 static int literal_line_out (const char *s, int len,
2457 FILE *fp)
2458 {
2459 char *q, *p = malloc(len + 1);
2460 int n, warn = 0;
2461
2462 if (p != NULL) {
2463 *p = '\0';
2464 strncat(p, s, len);
2465 q = p + strspn(p, " \t");
2466 n = strlen(q);
2467 if (n > 0) {
2468 /* note: allow "set termoption ..." */
2469 if (!strncmp(q, "set term ", 9)) {
2470 warn = 1;
2471 } else {
2472 fputs(q, fp);
2473 if (q[n-1] != '\n') {
2474 fputc('\n', fp);
2475 }
2476 }
2477 }
2478 free(p);
2479 }
2480
2481 return warn;
2482 }
2483
gnuplot_literal_from_string(const char * s,FILE * fp)2484 static int gnuplot_literal_from_string (const char *s,
2485 FILE *fp)
2486 {
2487 const char *p;
2488 int braces = 1;
2489 int wi, warn = 0;
2490
2491 s += strspn(s, " \t{");
2492 p = s;
2493
2494 fputs("# start literal lines\n", fp);
2495
2496 while (*s) {
2497 if (*s == '{') {
2498 braces++;
2499 } else if (*s == '}') {
2500 braces--;
2501 }
2502 if (braces == 0) {
2503 break;
2504 }
2505 if (*s == ';') {
2506 wi = literal_line_out(p, s - p, fp);
2507 if (wi && !warn) {
2508 warn = 1;
2509 }
2510 p = s + 1;
2511 }
2512 s++;
2513 }
2514
2515 fputs("# end literal lines\n", fp);
2516
2517 return warn;
2518 }
2519
2520 /* Alternative (undocumented!) means of supplying "literal"
2521 lines to the "gnuplot" command (as opposed to the time-
2522 honored "{...}" mechanism). Syntax is
2523
2524 gnuplot <args> --tweaks=<name-of-array-of-strings>
2525
2526 FIXME: document this or get rid of it! Although this
2527 mechanism has something going for it, maybe it's too
2528 late to substitute it for the old method.
2529 */
2530
literal_strings_from_opt(int ci,int * ns,int * real_ns)2531 static char **literal_strings_from_opt (int ci, int *ns,
2532 int *real_ns)
2533 {
2534 const char *aname = get_optval_string(ci, OPT_K);
2535 char **S = NULL;
2536
2537 *ns = *real_ns = 0;
2538
2539 if (aname != NULL) {
2540 GretlType type;
2541 gretl_array *A;
2542 int i;
2543
2544 A = user_var_get_value_and_type(aname, &type);
2545
2546 if (A != NULL && type == GRETL_TYPE_ARRAY) {
2547 S = gretl_array_get_strings(A, ns);
2548 if (*ns > 0) {
2549 for (i=0; i<*ns; i++) {
2550 if (S[i] != NULL && S[i][0] != '\0') {
2551 *real_ns += 1;
2552 }
2553 }
2554 }
2555 }
2556 }
2557
2558 return S;
2559 }
2560
gnuplot_literal_from_opt(int ci,FILE * fp)2561 static int gnuplot_literal_from_opt (int ci, FILE *fp)
2562 {
2563 char *s, **S;
2564 int ns, real_ns;
2565 int warn = 0;
2566
2567 S = literal_strings_from_opt(ci, &ns, &real_ns);
2568
2569 if (real_ns > 0) {
2570 int i, n;
2571
2572 fputs("# start literal lines\n", fp);
2573
2574 for (i=0; i<ns; i++) {
2575 if (S[i] != NULL) {
2576 s = S[i];
2577 s += strspn(s, " \t");
2578 n = strlen(s);
2579 if (n > 0) {
2580 if (!strncmp(s, "set term", 8)) {
2581 warn = 1;
2582 } else {
2583 fputs(s, fp);
2584 if (s[n-1] != '\n') {
2585 fputc('\n', fp);
2586 }
2587 }
2588 }
2589 }
2590 }
2591
2592 fputs("# end literal lines\n", fp);
2593 }
2594
2595 return warn;
2596 }
2597
print_gnuplot_literal_lines(const char * s,int ci,gretlopt opt,FILE * fp)2598 int print_gnuplot_literal_lines (const char *s, int ci,
2599 gretlopt opt, FILE *fp)
2600 {
2601 if (s != NULL && *s != '\0') {
2602 gnuplot_literal_from_string(s, fp);
2603 } else if (opt & OPT_K) {
2604 gnuplot_literal_from_opt(ci, fp);
2605 }
2606
2607 return 0;
2608 }
2609
print_extra_literal_lines(char ** S,int ns,FILE * fp)2610 static void print_extra_literal_lines (char **S,
2611 int ns,
2612 FILE *fp)
2613 {
2614 int i, n;
2615
2616 for (i=0; i<ns; i++) {
2617 if (S[i] != NULL) {
2618 n = strlen(S[i]);
2619 if (n > 0) {
2620 fputs(S[i], fp);
2621 if (S[i][n-1] != '\n') {
2622 fputc('\n', fp);
2623 }
2624 }
2625 }
2626 }
2627 }
2628
loess_plot(gnuplot_info * gi,const char * literal,const DATASET * dset)2629 static int loess_plot (gnuplot_info *gi, const char *literal,
2630 const DATASET *dset)
2631 {
2632 gretl_matrix *y = NULL;
2633 gretl_matrix *x = NULL;
2634 gretl_matrix *yh = NULL;
2635 int xno, yno = gi->list[1];
2636 const double *yvar = dset->Z[yno];
2637 const double *xvar;
2638 FILE *fp = NULL;
2639 gchar *title = NULL;
2640 int t, T, d = 1;
2641 double q = 0.5;
2642 int err = 0;
2643
2644 if (gi->x != NULL) {
2645 xno = 0;
2646 xvar = gi->x;
2647 } else {
2648 xno = gi->list[2];
2649 xvar = dset->Z[xno];
2650 }
2651
2652 err = graph_list_adjust_sample(gi->list, gi, dset, 2);
2653 if (!err && gi->list[0] > 2) {
2654 err = E_DATA;
2655 }
2656 if (err) {
2657 return err;
2658 }
2659
2660 fp = open_plot_input_file(PLOT_REGULAR, gi->flags, &err);
2661 if (err) {
2662 return E_FOPEN;
2663 }
2664
2665 err = gretl_plotfit_matrices(yvar, xvar, PLOT_FIT_LOESS,
2666 gi->t1, gi->t2, &y, &x);
2667
2668 if (!err) {
2669 err = sort_pairs_by_x(x, y, NULL, NULL); /* markers! */
2670 }
2671
2672 if (!err) {
2673 yh = loess_fit(x, y, d, q, OPT_R, &err);
2674 }
2675
2676 if (err) {
2677 fclose(fp);
2678 goto bailout;
2679 }
2680
2681 if (xno > 0) {
2682 const char *s1 = series_get_graph_name(dset, yno);
2683 const char *s2 = series_get_graph_name(dset, xno);
2684
2685 title = g_strdup_printf(_("%s versus %s (with loess fit)"), s1, s2);
2686 print_keypos_string(GP_KEY_LEFT_TOP, fp);
2687 fprintf(fp, "set title \"%s\"\n", title);
2688 g_free(title);
2689 print_axis_label('y', s1, fp);
2690 print_axis_label('x', s2, fp);
2691 } else {
2692 print_keypos_string(GP_KEY_LEFT_TOP, fp);
2693 print_axis_label('y', series_get_graph_name(dset, yno), fp);
2694 }
2695
2696 print_auto_fit_string(PLOT_FIT_LOESS, fp);
2697
2698 print_gnuplot_literal_lines(literal, GNUPLOT, OPT_NONE, fp);
2699
2700 fputs("plot \\\n", fp);
2701 fputs(" '-' using 1:2 notitle w points, \\\n", fp);
2702 title = g_strdup_printf(_("loess fit, d = %d, q = %g"), d, q);
2703 fprintf(fp, " '-' using 1:2 title \"%s\" w lines\n", title);
2704 g_free(title);
2705
2706 T = gretl_vector_get_length(yh);
2707
2708 gretl_push_c_numeric_locale();
2709
2710 for (t=0; t<T; t++) {
2711 fprintf(fp, "%.10g %.10g\n", x->val[t], y->val[t]);
2712 }
2713 fputs("e\n", fp);
2714
2715 for (t=0; t<T; t++) {
2716 fprintf(fp, "%.10g %.10g\n", x->val[t], yh->val[t]);
2717 }
2718 fputs("e\n", fp);
2719
2720 gretl_pop_c_numeric_locale();
2721
2722 err = finalize_plot_input_file(fp);
2723
2724 bailout:
2725
2726 gretl_matrix_free(y);
2727 gretl_matrix_free(x);
2728 gretl_matrix_free(yh);
2729 clear_gpinfo(gi);
2730
2731 return err;
2732 }
2733
get_fitted_line(gnuplot_info * gi,const DATASET * dset,gchar ** targ)2734 static int get_fitted_line (gnuplot_info *gi,
2735 const DATASET *dset,
2736 gchar **targ)
2737 {
2738 gretl_matrix *y = NULL;
2739 gretl_matrix *X = NULL;
2740 gretl_matrix *b = NULL;
2741 gretl_matrix *V = NULL;
2742 const double *yvar, *xvar = NULL;
2743 double x0, s2 = 0, *ps2 = NULL;
2744 int allow_err = 0;
2745 int err = 0;
2746
2747 if (gi->x != NULL && (dset->pd == 1 || dset->pd == 4 || dset->pd == 12)) {
2748 /* starting value of time index */
2749 x0 = gi->x[gi->t1];
2750 } else {
2751 xvar = dset->Z[gi->list[2]];
2752 x0 = NADBL;
2753 }
2754
2755 yvar = dset->Z[gi->list[1]];
2756
2757 if (gi->fit == PLOT_FIT_NONE) {
2758 /* Doing first-time automatic OLS: we want to check for
2759 statistical significance of the slope coefficient
2760 to see if it's worth drawing the fitted line, so
2761 we have to allocate the variance matrix; otherwise
2762 we only need the coefficients.
2763 */
2764 V = gretl_matrix_alloc(2, 2);
2765 if (V == NULL) {
2766 return E_ALLOC;
2767 }
2768 ps2 = &s2;
2769 /* if the fit attempt is automatic we'll allow it to
2770 fail without aborting the plot */
2771 allow_err = 1;
2772 }
2773
2774 err = gretl_plotfit_matrices(yvar, xvar, gi->fit,
2775 dset->t1, dset->t2,
2776 &y, &X);
2777
2778 if (!err) {
2779 int k = 2;
2780
2781 if (gi->fit == PLOT_FIT_CUBIC) {
2782 k = 4;
2783 } else if (gi->fit == PLOT_FIT_QUADRATIC) {
2784 k = 3;
2785 }
2786 b = gretl_column_vector_alloc(k);
2787 if (b == NULL) {
2788 err = E_ALLOC;
2789 } else if (gi->fit == PLOT_FIT_LOGLIN) {
2790 ps2 = &s2;
2791 }
2792 }
2793
2794 if (!err) {
2795 err = gretl_matrix_ols(y, X, b, V, NULL, ps2);
2796 }
2797
2798 if (!err && gi->fit == PLOT_FIT_NONE) {
2799 /* the "automatic" case */
2800 double pv, v = gretl_matrix_get(V, 1, 1);
2801 int T = gretl_vector_get_length(y);
2802
2803 pv = student_pvalue_2(T - 2, b->val[1] / sqrt(v));
2804 /* show the line if the two-tailed p-value for the slope coeff
2805 is less than 0.1, otherwise discard it */
2806 if (pv < 0.10) {
2807 gi->fit = PLOT_FIT_OLS;
2808 }
2809 }
2810
2811 if (!err && gi->fit != PLOT_FIT_NONE) {
2812 GPT_LINE line = {0};
2813 double pd = dset->pd;
2814
2815 if (gi->fit == PLOT_FIT_LOGLIN) {
2816 b->val[0] += s2 / 2;
2817 }
2818 set_plotfit_line(&line, gi->fit, b->val, x0, pd);
2819 *targ = g_strdup_printf("%s title \"%s\" w lines\n",
2820 line.formula, line.title);
2821 g_free(line.formula);
2822 g_free(line.title);
2823 gi->flags |= GPT_AUTO_FIT;
2824 }
2825
2826 gretl_matrix_free(y);
2827 gretl_matrix_free(X);
2828 gretl_matrix_free(b);
2829 gretl_matrix_free(V);
2830
2831 if (err && allow_err) {
2832 err = 0;
2833 }
2834
2835 return err;
2836 }
2837
2838 /* support the "fit" options for a single time-series plot */
2839
time_fit_plot(gnuplot_info * gi,const char * literal,const DATASET * dset)2840 static int time_fit_plot (gnuplot_info *gi, const char *literal,
2841 const DATASET *dset)
2842 {
2843 int yno = gi->list[1];
2844 const double *yvar = dset->Z[yno];
2845 gchar *fitline = NULL;
2846 FILE *fp = NULL;
2847 PRN *prn;
2848 int t, err = 0;
2849
2850 if (gi->x == NULL) {
2851 return E_DATA;
2852 }
2853
2854 err = graph_list_adjust_sample(gi->list, gi, dset, 1);
2855 if (err) {
2856 return err;
2857 }
2858
2859 err = get_fitted_line(gi, dset, &fitline);
2860 if (err) {
2861 return err;
2862 }
2863
2864 gi->flags |= GPT_LETTERBOX;
2865
2866 fp = open_plot_input_file(PLOT_REGULAR, gi->flags, &err);
2867 if (err) {
2868 g_free(fitline);
2869 return err;
2870 }
2871
2872 prn = gretl_print_new_with_stream(fp);
2873
2874 if (prn != NULL) {
2875 make_time_tics(gi, dset, 0, NULL, prn);
2876 gretl_print_detach_stream(prn);
2877 gretl_print_destroy(prn);
2878 }
2879
2880 print_keypos_string(GP_KEY_LEFT_TOP, fp);
2881 print_axis_label('y', series_get_graph_name(dset, yno), fp);
2882 print_auto_fit_string(gi->fit, fp);
2883 print_gnuplot_literal_lines(literal, GNUPLOT, OPT_NONE, fp);
2884
2885 fputs("plot \\\n", fp);
2886 fputs(" '-' using 1:2 notitle w lines, \\\n", fp);
2887
2888 gretl_push_c_numeric_locale();
2889
2890 fprintf(fp, " %s", fitline);
2891 g_free(fitline);
2892
2893 for (t=gi->t1; t<=gi->t2; t++) {
2894 if (gi->flags & GPT_TIMEFMT) {
2895 fprintf(fp, "%.0f %.10g\n", gi->x[t], yvar[t]);
2896 } else {
2897 fprintf(fp, "%.10g %.10g\n", gi->x[t], yvar[t]);
2898 }
2899 }
2900 fputs("e\n", fp);
2901
2902 gretl_pop_c_numeric_locale();
2903
2904 err = finalize_plot_input_file(fp);
2905 clear_gpinfo(gi);
2906
2907 return err;
2908 }
2909
check_tic_labels(double vmin,double vmax,gnuplot_info * gi,char axis)2910 static int check_tic_labels (double vmin, double vmax,
2911 gnuplot_info *gi,
2912 char axis)
2913 {
2914 char s1[32], s2[32];
2915 int d, err = 0;
2916
2917 for (d=6; d<12; d++) {
2918 sprintf(s1, "%.*g", d, vmin);
2919 sprintf(s2, "%.*g", d, vmax);
2920 if (strcmp(s1, s2)) {
2921 break;
2922 }
2923 }
2924
2925 if (d > 6) {
2926 if (axis == 'x') {
2927 sprintf(gi->xfmt, "%% .%dg", d+1);
2928 if (vmax > vmin) {
2929 sprintf(gi->xtics, "%.*g %#.6g", d+1, vmin,
2930 (vmax - vmin)/ 4.0);
2931 }
2932 } else {
2933 sprintf(gi->yfmt, "%% .%dg", d+1);
2934 }
2935 }
2936
2937 return err;
2938 }
2939
check_y_tics(gnuplot_info * gi,const double ** Z,FILE * fp)2940 static void check_y_tics (gnuplot_info *gi, const double **Z,
2941 FILE *fp)
2942 {
2943 double ymin, ymax;
2944
2945 *gi->yfmt = '\0';
2946
2947 gretl_minmax(gi->t1, gi->t2, Z[gi->list[1]], &ymin, &ymax);
2948 check_tic_labels(ymin, ymax, gi, 'y');
2949
2950 if (*gi->yfmt != '\0') {
2951 fprintf(fp, "set format y \"%s\"\n", gi->yfmt);
2952 }
2953 }
2954
2955 /* Find the minimum and maximum x-axis values and construct the gnuplot
2956 x-range. We have to be a bit careful here to include only values
2957 that will actually display on the plot, i.e. x-values that are
2958 accompanied by at least one non-missing y-axis value.
2959
2960 In the case of a "factorized" plot the factor variable must also
2961 be non-missing in order to include a given data point.
2962
2963 We also have to avoid creating an "empty x range" that will choke
2964 gnuplot.
2965 */
2966
print_x_range_from_list(gnuplot_info * gi,const DATASET * dset,const int * list,FILE * fp)2967 static void print_x_range_from_list (gnuplot_info *gi,
2968 const DATASET *dset,
2969 const int *list,
2970 FILE *fp)
2971 {
2972 const double *x, *d = NULL;
2973 int k, l0 = list[0];
2974
2975 if (gi->flags & GPT_DUMMY) {
2976 /* the factor variable comes last and the x variable
2977 is in second-last place */
2978 d = dset->Z[list[l0]];
2979 k = l0 - 1;
2980 } else {
2981 /* the x variable comes last in the list */
2982 k = l0;
2983 }
2984
2985 x = dset->Z[list[k]];
2986
2987 if (gretl_isdummy(gi->t1, gi->t2, x)) {
2988 fputs("set xrange [-1:2]\n", fp);
2989 fputs("set xtics (\"0\" 0, \"1\" 1)\n", fp);
2990 gi->xrange = 3;
2991 } else {
2992 double xmin, xmin0 = NADBL;
2993 double xmax, xmax0 = NADBL;
2994 int t, i, vy, obs_ok;
2995
2996 for (t=gi->t1; t<=gi->t2; t++) {
2997 obs_ok = 0;
2998 if (!na(x[t]) && (d == NULL || !na(d[t]))) {
2999 for (i=1; i<k; i++) {
3000 vy = list[i];
3001 if (!na(dset->Z[vy][t])) {
3002 /* got x obs and at least one y obs */
3003 obs_ok = 1;
3004 break;
3005 }
3006 }
3007 }
3008 if (obs_ok) {
3009 if (na(xmin0) || x[t] < xmin0) {
3010 xmin0 = x[t];
3011 }
3012 if (na(xmax0) || x[t] > xmax0) {
3013 xmax0 = x[t];
3014 }
3015 }
3016 }
3017
3018 gi->xrange = xmax0 - xmin0;
3019
3020 if (gi->xrange == 0.0) {
3021 /* construct a non-empty range */
3022 xmin = xmin0 - 0.5;
3023 xmax = xmin0 + 0.5;
3024 } else {
3025 xmin = xmin0 - gi->xrange * .025;
3026 if (xmin0 >= 0.0 && xmin < 0.0) {
3027 xmin = 0.0;
3028 }
3029 xmax = xmax0 + gi->xrange * .025;
3030 }
3031
3032 fprintf(fp, "set xrange [%.10g:%.10g]\n", xmin, xmax);
3033 gi->xrange = xmax - xmin;
3034 check_tic_labels(xmin0, xmax0, gi, 'x');
3035 }
3036 }
3037
print_x_range(gnuplot_info * gi,FILE * fp)3038 static void print_x_range (gnuplot_info *gi, FILE *fp)
3039 {
3040 if (gretl_isdummy(gi->t1, gi->t2, gi->x)) {
3041 fputs("set xrange [-1:2]\n", fp);
3042 fputs("set xtics (\"0\" 0, \"1\" 1)\n", fp);
3043 gi->xrange = 3;
3044 } else {
3045 double xmin0, xmin, xmax0, xmax;
3046
3047 gretl_minmax(gi->t1, gi->t2, gi->x, &xmin0, &xmax0);
3048 gi->xrange = xmax0 - xmin0;
3049 xmin = xmin0 - gi->xrange * .025;
3050 if (xmin0 >= 0.0 && xmin < 0.0) {
3051 xmin = 0.0;
3052 }
3053 xmax = xmax0 + gi->xrange * .025;
3054 fprintf(fp, "set xrange [%.10g:%.10g]\n", xmin, xmax);
3055 gi->xrange = xmax - xmin;
3056 }
3057 }
3058
3059 /* two or more y vars plotted against some x: test to see if we want
3060 to use two y axes */
3061
3062 static void
check_for_yscale(gnuplot_info * gi,const double ** Z,int * oddman)3063 check_for_yscale (gnuplot_info *gi, const double **Z, int *oddman)
3064 {
3065 double ymin[6], ymax[6];
3066 double ratio;
3067 int lmax = gi->list[0];
3068 int i, j, oddcount;
3069
3070 #if GP_DEBUG
3071 fprintf(stderr, "gnuplot: doing check_for_yscale, listlen %d\n",
3072 gi->list[0]);
3073 #endif
3074
3075 if (gi->flags & GPT_IDX) {
3076 /* do this only if we haven't added a 0 at the end of
3077 the list */
3078 if (gi->list[lmax] != 0) {
3079 lmax++;
3080 }
3081 }
3082
3083 /* find minima, maxima of the y-axis vars */
3084 for (i=1; i<lmax; i++) {
3085 gretl_minmax(gi->t1, gi->t2, Z[gi->list[i]],
3086 &ymin[i-1], &ymax[i-1]);
3087 }
3088
3089 gi->flags &= ~GPT_Y2AXIS;
3090
3091 for (i=lmax-1; i>0; i--) {
3092 oddcount = 0;
3093 for (j=1; j<lmax; j++) {
3094 if (j != i) {
3095 ratio = ymax[i-1] / ymax[j-1];
3096 if (ratio > 5.0 || ratio < 0.2) {
3097 gi->flags |= GPT_Y2AXIS;
3098 oddcount++;
3099 }
3100 }
3101 }
3102 if (oddcount == lmax - 2) {
3103 /* series at list position i differs considerably in scale
3104 from all the others in the list */
3105 *oddman = i;
3106 break;
3107 }
3108 }
3109
3110 if (*oddman == 0) {
3111 gi->flags &= ~GPT_Y2AXIS;
3112 }
3113 }
3114
print_gp_dummy_data(gnuplot_info * gi,const DATASET * dset,FILE * fp)3115 static int print_gp_dummy_data (gnuplot_info *gi,
3116 const DATASET *dset,
3117 FILE *fp)
3118 {
3119 const double *d = dset->Z[gi->list[3]];
3120 const double *y = dset->Z[gi->list[1]];
3121 double xt, yt;
3122 int i, t, n;
3123
3124 n = gretl_vector_get_length(gi->dvals);
3125
3126 for (i=0; i<n; i++) {
3127 for (t=gi->t1; t<=gi->t2; t++) {
3128 if (gi->x != NULL) {
3129 xt = gi->x[t];
3130 } else {
3131 xt = dset->Z[gi->list[2]][t];
3132 if (na(xt)) {
3133 continue;
3134 }
3135 }
3136 if (na(d[t])) {
3137 continue;
3138 }
3139 yt = (d[t] == gi->dvals->val[i])? y[t] : NADBL;
3140 if (na(yt)) {
3141 fprintf(fp, "%.10g %s\n", xt, gpna);
3142 } else {
3143 fprintf(fp, "%.10g %.10g", xt, yt);
3144 if (!(gi->flags & GPT_TS)) {
3145 if (dset->markers) {
3146 fprintf(fp, " # %s", dset->S[t]);
3147 } else if (dataset_is_time_series(dset)) {
3148 char obs[OBSLEN];
3149
3150 ntolabel(obs, t, dset);
3151 fprintf(fp, " # %s", obs);
3152 }
3153 }
3154 fputc('\n', fp);
3155 }
3156 }
3157 fputs("e\n", fp);
3158 }
3159
3160 return 0;
3161 }
3162
3163 /* for printing panel time-series graph: insert a discontinuity
3164 between the panel units */
3165
3166 static void
maybe_print_panel_jot(int t,const DATASET * dset,FILE * fp)3167 maybe_print_panel_jot (int t, const DATASET *dset, FILE *fp)
3168 {
3169 char obs[OBSLEN];
3170 int maj, min;
3171
3172 ntolabel(obs, t, dset);
3173 sscanf(obs, "%d:%d", &maj, &min);
3174 if (maj > 1 && min == 1) {
3175 fprintf(fp, "%g %s\n", t + 0.5, gpna);
3176 }
3177 }
3178
3179 /* sanity check for totally empty graph */
3180
3181 static int
all_graph_data_missing(const int * list,int t,const double ** Z)3182 all_graph_data_missing (const int *list, int t, const double **Z)
3183 {
3184 int i;
3185
3186 for (i=1; i<=list[0]; i++) {
3187 if (!na(Z[list[i]][t])) {
3188 return 0;
3189 }
3190 }
3191
3192 return 1;
3193 }
3194
use_impulses(gnuplot_info * gi)3195 static int use_impulses (gnuplot_info *gi)
3196 {
3197 if (gi->withlist != NULL) {
3198 int i;
3199
3200 for (i=1; i<=gi->withlist[0]; i++) {
3201 if (gi->withlist[i] == W_IMPULSES) {
3202 return 1;
3203 }
3204 }
3205 }
3206
3207 return 0;
3208 }
3209
use_lines(gnuplot_info * gi)3210 static int use_lines (gnuplot_info *gi)
3211 {
3212 if (gi->withlist != NULL) {
3213 int i;
3214
3215 for (i=1; i<=gi->withlist[0]; i++) {
3216 if (gi->withlist[i] == W_LINES) {
3217 return 1;
3218 }
3219 }
3220 }
3221
3222 return 0;
3223 }
3224
3225 /* list of series IDs for which we should skip observations
3226 with NAs when printing the plot data */
3227 static int *na_skiplist;
3228
print_gp_data(gnuplot_info * gi,const DATASET * dset,FILE * fp)3229 static void print_gp_data (gnuplot_info *gi, const DATASET *dset,
3230 FILE *fp)
3231 {
3232 int n = gi->t2 - gi->t1 + 1;
3233 double offset = 0.0;
3234 int datlist[3];
3235 int lmax, ynum = 2;
3236 int nomarkers = 0;
3237 int i, t;
3238
3239 /* multi impulse plot? calculate offset for lines */
3240 if (use_impulses(gi) && gi->list[0] > 2) {
3241 offset = 0.10 * gi->xrange / n;
3242 }
3243
3244 if (gi->x != NULL) {
3245 lmax = gi->list[0] - 1;
3246 datlist[0] = 1;
3247 ynum = 1;
3248 } else {
3249 lmax = gi->list[0] - 1;
3250 datlist[0] = 2;
3251 datlist[1] = gi->list[gi->list[0]];
3252 }
3253
3254 if (use_impulses(gi) || use_lines(gi)) {
3255 nomarkers = 1;
3256 }
3257
3258 /* loop across the variables, printing x then y[i] for each i */
3259
3260 for (i=1; i<=lmax; i++) {
3261 double xoff = offset * (i - 1);
3262
3263 datlist[ynum] = gi->list[i];
3264
3265 for (t=gi->t1; t<=gi->t2; t++) {
3266 const char *label = NULL;
3267 char obs[OBSLEN];
3268
3269 if (in_gretl_list(na_skiplist, datlist[ynum]) &&
3270 na(dset->Z[datlist[ynum]][t])) {
3271 continue;
3272 } else if (gi->x == NULL &&
3273 all_graph_data_missing(gi->list, t, (const double **) dset->Z)) {
3274 continue;
3275 }
3276 if (!(gi->flags & GPT_TS) && i == 1) {
3277 if (dset->markers) {
3278 label = dset->S[t];
3279 } else if (!nomarkers && dataset_is_time_series(dset)) {
3280 ntolabel(obs, t, dset);
3281 label = obs;
3282 }
3283 }
3284 if ((gi->flags & GPT_TS) && dset->structure == STACKED_TIME_SERIES) {
3285 maybe_print_panel_jot(t, dset, fp);
3286 }
3287 printvars(fp, t, datlist, dset, gi, label, xoff);
3288 }
3289
3290 fputs("e\n", fp);
3291 }
3292 }
3293
3294 static int
gpinfo_init(gnuplot_info * gi,gretlopt opt,const int * list,const char * literal,const DATASET * dset)3295 gpinfo_init (gnuplot_info *gi, gretlopt opt, const int *list,
3296 const char *literal, const DATASET *dset)
3297 {
3298 int l0 = list[0];
3299 int err = 0;
3300
3301 gi->withlist = NULL;
3302 gi->yformula = NULL;
3303 gi->x = NULL;
3304 gi->list = NULL;
3305 gi->dvals = NULL;
3306 gi->band = 0;
3307
3308 err = get_gp_flags(gi, opt, list, dset);
3309 if (err) {
3310 return err;
3311 }
3312
3313 if (gi->band) {
3314 /* force single y-axis in "band" case */
3315 opt |= OPT_Y;
3316 }
3317
3318 if (gi->fit == PLOT_FIT_NONE) {
3319 gi->flags |= GPT_TS; /* may be renounced later */
3320 }
3321
3322 if (dset->t2 - dset->t1 + 1 <= 0) {
3323 /* null sample range */
3324 return E_DATA;
3325 }
3326
3327 gi->t1 = dset->t1;
3328 gi->t2 = dset->t2;
3329 gi->xrange = 0.0;
3330 gi->timefmt[0] = '\0';
3331 gi->xtics[0] = '\0';
3332 gi->xfmt[0] = '\0';
3333 gi->yfmt[0] = '\0';
3334
3335 if (l0 < 2 && !(gi->flags & GPT_IDX)) {
3336 return E_ARGS;
3337 }
3338
3339 if ((gi->flags & GPT_DUMMY) && (gi->flags & GPT_IDX)) {
3340 return E_BADOPT;
3341 }
3342
3343 gi->list = gretl_list_copy(list);
3344 if (gi->list == NULL) {
3345 return E_ALLOC;
3346 }
3347
3348 if ((l0 > 2 || (l0 > 1 && (gi->flags & GPT_IDX))) &&
3349 l0 < 7 && !(gi->flags & GPT_RESIDS) && !(gi->flags & GPT_FA)
3350 && !(gi->flags & GPT_DUMMY) && !(opt & OPT_Y)) {
3351 /* FIXME GPT_XYZ ? */
3352 /* allow probe for using two y axes */
3353 #if GP_DEBUG
3354 fprintf(stderr, "l0 = %d, setting y2axis probe\n", l0);
3355 #endif
3356 gi->flags |= GPT_Y2AXIS;
3357 }
3358
3359 if ((gi->flags & GPT_FA) && literal != NULL &&
3360 !strncmp(literal, "yformula: ", 10)) {
3361 /* fitted vs actual plot with fitted given by formula */
3362 gi->yformula = literal + 10;
3363 }
3364
3365 if (literal != NULL && strstr(literal, "set style data")) {
3366 gi->flags |= GPT_DATA_STYLE;
3367 }
3368
3369 #if GP_DEBUG
3370 if (gi->flags) {
3371 print_gnuplot_flags(gi->flags, 1);
3372 }
3373 #endif
3374
3375 return 0;
3376 }
3377
clear_gpinfo(gnuplot_info * gi)3378 static void clear_gpinfo (gnuplot_info *gi)
3379 {
3380 free(gi->list);
3381 gretl_matrix_free(gi->dvals);
3382 free(gi->withlist);
3383 }
3384
3385 #if GP_DEBUG
3386
print_gnuplot_flags(int flags,int revised)3387 static void print_gnuplot_flags (int flags, int revised)
3388 {
3389 if (revised) {
3390 fprintf(stderr, "*** gnuplot flags after initial revision:\n");
3391 } else {
3392 fprintf(stderr, "*** gnuplot() called with flags:\n");
3393 }
3394
3395 if (flags & GPT_RESIDS) {
3396 fprintf(stderr, " GPT_RESIDS\n");
3397 }
3398 if (flags & GPT_FA) {
3399 fprintf(stderr, " GPT_FA\n");
3400 }
3401 if (flags & GPT_DUMMY) {
3402 fprintf(stderr, " GPT_DUMMY\n");
3403 }
3404 if (flags & GPT_XYZ) {
3405 fprintf(stderr, " GPT_XYZ\n");
3406 }
3407 if (flags & GPT_FIT_OMIT) {
3408 fprintf(stderr, " GPT_FIT_OMIT\n");
3409 }
3410 if (flags & GPT_DATA_STYLE) {
3411 fprintf(stderr, " GPT_DATA_STYLE\n");
3412 }
3413 if (flags & GPT_IDX) {
3414 fprintf(stderr, " GPT_IDX\n");
3415 }
3416 if (flags & GPT_TS) {
3417 fprintf(stderr, " GPT_TS\n");
3418 }
3419 if (flags & GPT_Y2AXIS) {
3420 fprintf(stderr, " GPT_Y2AXIS\n");
3421 }
3422 if (flags & GPT_AUTO_FIT) {
3423 fprintf(stderr, " GPT_AUTO_FIT\n");
3424 }
3425 if (flags & GPT_FIT_HIDDEN) {
3426 fprintf(stderr, " GPT_FIT_HIDDEN\n");
3427 }
3428 }
3429
3430 #endif
3431
set_lwstr(const DATASET * dset,int v,char * s)3432 static void set_lwstr (const DATASET *dset, int v, char *s)
3433 {
3434 if (default_png_scale > 1.0) {
3435 strcpy(s, " lw 2");
3436 } else {
3437 *s = '\0';
3438 }
3439 }
3440
set_withstr(gnuplot_info * gi,int i,char * str)3441 static void set_withstr (gnuplot_info *gi, int i, char *str)
3442 {
3443 if (gi->flags & GPT_DATA_STYLE) {
3444 *str = '\0';
3445 } else if (gi->withlist != NULL) {
3446 int withval = W_POINTS;
3447
3448 if (i > 0 && i <= gi->withlist[0]) {
3449 withval = gi->withlist[i];
3450 }
3451
3452 if (withval == W_LINES) {
3453 strcpy(str, "w lines");
3454 } else if (withval == W_IMPULSES) {
3455 strcpy(str, "w impulses");
3456 } else if (withval == W_LP) {
3457 strcpy(str, "w linespoints");
3458 } else if (withval == W_BOXES) {
3459 strcpy(str, "w boxes");
3460 } else if (withval == W_STEPS) {
3461 strcpy(str, "w steps");
3462 } else {
3463 strcpy(str, "w points");
3464 }
3465 } else if (gi->flags & GPT_LINES) {
3466 strcpy(str, "w lines");
3467 } else if (gi->flags & GPT_IMPULSES) {
3468 strcpy(str, "w impulses");
3469 } else if (gi->flags & GPT_STEPS) {
3470 strcpy(str, "w steps");
3471 } else {
3472 strcpy(str, "w points");
3473 }
3474 }
3475
graph_list_adjust_sample(int * list,gnuplot_info * ginfo,const DATASET * dset,int listmin)3476 static int graph_list_adjust_sample (int *list,
3477 gnuplot_info *ginfo,
3478 const DATASET *dset,
3479 int listmin)
3480 {
3481 int t1min = ginfo->t1;
3482 int t2max = ginfo->t2;
3483 int i, t, vi, t_ok;
3484 int err = 0;
3485
3486 for (t=t1min; t<=t2max; t++) {
3487 t_ok = 0;
3488 for (i=1; i<=list[0]; i++) {
3489 vi = list[i];
3490 if (vi > 0 && !na(dset->Z[vi][t])) {
3491 t_ok = 1;
3492 break;
3493 }
3494 }
3495 if (t_ok) {
3496 break;
3497 }
3498 t1min++;
3499 }
3500
3501 for (t=t2max; t>t1min; t--) {
3502 t_ok = 0;
3503 for (i=1; i<=list[0]; i++) {
3504 vi = list[i];
3505 if (vi > 0 && !na(dset->Z[vi][t])) {
3506 t_ok = 1;
3507 break;
3508 }
3509 }
3510 if (t_ok) {
3511 break;
3512 }
3513 t2max--;
3514 }
3515
3516 if (t2max > t1min) {
3517 for (i=1; i<=list[0]; i++) {
3518 int all_missing = 1;
3519
3520 vi = list[i];
3521 for (t=t1min; t<=t2max; t++) {
3522 if (!na(dset->Z[vi][t])) {
3523 all_missing = 0;
3524 break;
3525 }
3526 }
3527 if (all_missing) {
3528 gretl_list_delete_at_pos(list, i);
3529 i--;
3530 }
3531 }
3532 }
3533
3534 ginfo->t1 = t1min;
3535 ginfo->t2 = t2max;
3536
3537 if (ginfo->t1 >= ginfo->t2 || list[0] < listmin) {
3538 err = E_MISSDATA;
3539 }
3540
3541 return err;
3542 }
3543
3544 /* Check whether mktime() works for the starting date.
3545 Note that it won't work on Windows for dates prior to
3546 1970 since Microsoft doesn't handle negative time_t
3547 values.
3548 */
3549
timefmt_useable(const DATASET * dset)3550 static int timefmt_useable (const DATASET *dset)
3551 {
3552 char *test, datestr[OBSLEN];
3553 struct tm t = {0};
3554 int ok = 0;
3555
3556 if (sample_size(dset) > 300) {
3557 /* not a good idea? */
3558 return 0;
3559 }
3560
3561 errno = 0;
3562
3563 if (dset->S != NULL) {
3564 strcpy(datestr, dset->S[dset->t1]);
3565 } else {
3566 calendar_date_string(datestr, dset->t1, dset);
3567 }
3568
3569 test = strptime(datestr, "%Y-%m-%d", &t);
3570 if (test != NULL && *test == '\0') {
3571 mktime(&t);
3572 ok = (errno == 0);
3573 }
3574
3575 errno = 0;
3576
3577 return ok;
3578 }
3579
maybe_add_plotx(gnuplot_info * gi,int time_fit,const DATASET * dset)3580 static int maybe_add_plotx (gnuplot_info *gi, int time_fit,
3581 const DATASET *dset)
3582 {
3583 gretlopt xopt = OPT_NONE;
3584 int k = gi->list[0];
3585 int add0 = 0;
3586
3587 /* are we really doing a time-series plot? */
3588 if (k > 1 && !strcmp(dset->varname[gi->list[k]], "time")) {
3589 ; /* yes */
3590 } else if (gi->flags & GPT_IDX) {
3591 add0 = 1; /* yes */
3592 } else {
3593 /* no: get out */
3594 gi->flags &= ~GPT_TS;
3595 return 0;
3596 }
3597
3598 if (!time_fit) {
3599 if (dated_daily_data(dset) || dated_weekly_data(dset)) {
3600 if (timefmt_useable(dset)) {
3601 /* experimental */
3602 gi->flags |= GPT_TIMEFMT;
3603 xopt = OPT_T;
3604 }
3605 }
3606 }
3607
3608 gi->x = gretl_plotx(dset, xopt);
3609 if (gi->x == NULL) {
3610 return E_ALLOC;
3611 }
3612
3613 /* a bit ugly, but add a dummy list entry for
3614 the 'virtual' plot variable */
3615 if (add0) {
3616 gretl_list_append_term(&gi->list, 0);
3617 if (gi->list == NULL) {
3618 return E_ALLOC;
3619 }
3620 }
3621
3622 #if GP_DEBUG
3623 fprintf(stderr, "maybe_add_plotx: gi->x at %p\n",
3624 (void *) gi->x);
3625 printlist(gi->list, "gi->list");
3626 #endif
3627
3628 return 0;
3629 }
3630
gnuplot_missval_string(FILE * fp)3631 void gnuplot_missval_string (FILE *fp)
3632 {
3633 fputs("set datafile missing \"?\"\n", fp);
3634 }
3635
graph_month_name(char * mname,int m)3636 static void graph_month_name (char *mname, int m)
3637 {
3638 struct tm mt;
3639
3640 mt.tm_sec = 0;
3641 mt.tm_min = 0;
3642 mt.tm_hour = 0;
3643 mt.tm_mday = 1;
3644 mt.tm_mon = m - 1;
3645 mt.tm_year = 100;
3646
3647 strftime(mname, 7, "%b", &mt);
3648
3649 if (!g_utf8_validate(mname, -1, NULL)) {
3650 /* we might be in a non-UTF-8 locale */
3651 gchar *tmp;
3652 gsize bytes;
3653
3654 tmp = g_locale_to_utf8(mname, -1, NULL, &bytes, NULL);
3655 if (tmp != NULL) {
3656 strcpy(mname, tmp);
3657 g_free(tmp);
3658 }
3659 }
3660 }
3661
3662 /* for short daily time-series plots: write month names
3663 into the xtics */
3664
make_named_month_tics(const gnuplot_info * gi,double yrs,PRN * prn)3665 static void make_named_month_tics (const gnuplot_info *gi, double yrs,
3666 PRN *prn)
3667 {
3668 double t0 = gi->x[gi->t1];
3669 double t1 = gi->x[gi->t2];
3670 double x, tw = 1.0/12;
3671 int i, m, n = 0;
3672 char mname[16];
3673 int notfirst = 0;
3674 int scale = (int) (yrs * 1.5);
3675
3676 if (scale == 0) {
3677 scale = 1;
3678 }
3679
3680 t0 += (1.0 - (t0 - floor(t0)) * 12.0) / 12.0;
3681 for (x=t0; x<t1; x+=tw) n++;
3682
3683 x = (t0 - floor(t0)) * 12;
3684 m = 1 + ((x - floor(x) > .8)? ceil(x) : floor(x));
3685 if (m > 12) m -= 12;
3686
3687 pputs(prn, "set xtics (");
3688 x = t0;
3689
3690 gretl_push_c_numeric_locale();
3691
3692 for (i=0; i<n; i++) {
3693 if (m == 1) {
3694 if (notfirst) {
3695 pputs(prn, ", ");
3696 }
3697 pprintf(prn, "\"%4.0f\" %.10g", x, x);
3698 notfirst = 1;
3699 } else if ((scale == 1) || (m % scale == 1)) {
3700 graph_month_name(mname, m);
3701 if (notfirst) {
3702 pputs(prn, ", ");
3703 }
3704 pprintf(prn, "\"%s\" %.10g", mname, x);
3705 notfirst = 1;
3706 }
3707 m++;
3708 x += tw;
3709 if (m > 12) m -= 12;
3710 }
3711
3712 gretl_pop_c_numeric_locale();
3713
3714 pputs(prn, ")\n");
3715 }
3716
continues_unit(const DATASET * dset,int t)3717 static int continues_unit (const DATASET *dset, int t)
3718 {
3719 return t / dset->pd == (t-1) / dset->pd;
3720 }
3721
3722 /* Below: we're making a combined time series plot for panel data.
3723 That is, time series for unit 1, followed by time series for unit
3724 2, etc. We'd like to show tic marks to represent the start of each
3725 unit's time series, but we have to watch out for the case where
3726 there are "too many" units -- we don't want a dense fudge of marks
3727 on the x-axis. In that case we put a tic mark only for every k'th
3728 unit.
3729 */
3730
make_panel_unit_tics(const DATASET * dset,gnuplot_info * gi,PRN * prn)3731 static void make_panel_unit_tics (const DATASET *dset,
3732 gnuplot_info *gi,
3733 PRN *prn)
3734 {
3735 int maxtics, ticskip;
3736 double ntics;
3737 int printed;
3738 int u, t, n;
3739
3740 pputs(prn, "set xtics (");
3741
3742 gretl_push_c_numeric_locale();
3743
3744 /* how many panel units are included in the plot? */
3745 maxtics = gi->t2 / dset->pd - gi->t1 / dset->pd + 1;
3746
3747 ntics = maxtics;
3748 while (ntics > 20) {
3749 ntics /= 1.5;
3750 }
3751
3752 ticskip = maxtics / ceil(ntics);
3753
3754 if (ticskip == 1 && ntics < maxtics) {
3755 /* otherwise we'll get an incomplete scale */
3756 ntics = maxtics;
3757 }
3758
3759 n = printed = 0;
3760 u = gi->t1 / dset->pd;
3761
3762 for (t=gi->t1; t<=gi->t2 && printed<ntics; t++) {
3763 if (t == gi->t1 || !continues_unit(dset, t)) {
3764 u++;
3765 if (n % ticskip == 0) {
3766 pprintf(prn, "\"%d\" %.10g", u, gi->x[t]);
3767 if (++printed < ntics) {
3768 pputs(prn, ", ");
3769 }
3770 }
3771 n++;
3772 }
3773 }
3774
3775 gretl_pop_c_numeric_locale();
3776
3777 pputs(prn, ")\n");
3778 }
3779
make_calendar_tics(const DATASET * dset,const gnuplot_info * gi,PRN * prn)3780 static void make_calendar_tics (const DATASET *dset,
3781 const gnuplot_info *gi,
3782 PRN *prn)
3783 {
3784 int T = gi->t2 - gi->t1 + 1;
3785 double yrs;
3786
3787 if (dset->pd == 52) {
3788 yrs = T / 52.0;
3789 } else {
3790 yrs = T / (dset->pd * 52.0);
3791 }
3792
3793 if (yrs <= 3) {
3794 make_named_month_tics(gi, yrs, prn);
3795 } else if (yrs < 6) {
3796 /* don't show ugly "fractions of years" */
3797 pputs(prn, "set xtics 1\n");
3798 if (yrs < 3) {
3799 /* put monthly minor tics */
3800 pputs(prn, "set mxtics 12\n");
3801 } else if (yrs < 5) {
3802 /* quarterly minor tics */
3803 pputs(prn, "set mxtics 4\n");
3804 }
3805 }
3806 }
3807
multiple_groups(const DATASET * dset,int t1,int t2)3808 static int multiple_groups (const DATASET *dset, int t1, int t2)
3809 {
3810 int ret = 0;
3811
3812 if (dataset_is_panel(dset)) {
3813 ret = (t2 / dset->pd > t1 / dset->pd);
3814 }
3815
3816 return ret;
3817 }
3818
single_year_sample(const DATASET * dset,int t1,int t2)3819 static int single_year_sample (const DATASET *dset,
3820 int t1, int t2)
3821 {
3822 char obs[OBSLEN];
3823 int y1, y2;
3824
3825 ntolabel(obs, t1, dset);
3826 y1 = atoi(obs);
3827 ntolabel(obs, t2, dset);
3828 y2 = atoi(obs);
3829
3830 return y2 == y1;
3831 }
3832
3833 /* special tics for time series plots */
3834
make_time_tics(gnuplot_info * gi,const DATASET * dset,int many,char * xlabel,PRN * prn)3835 static void make_time_tics (gnuplot_info *gi,
3836 const DATASET *dset,
3837 int many, char *xlabel,
3838 PRN *prn)
3839 {
3840 if (many) {
3841 pprintf(prn, "# multiple timeseries %d\n", dset->pd);
3842 } else {
3843 pprintf(prn, "# timeseries %d", dset->pd);
3844 gi->flags |= GPT_LETTERBOX;
3845 pputs(prn, " (letterbox)\n");
3846 }
3847
3848 if (gi->flags & GPT_TIMEFMT) {
3849 pputs(prn, "set xdata time\n");
3850 strcpy(gi->timefmt, "%s");
3851 pprintf(prn, "set timefmt \"%s\"\n", gi->timefmt);
3852 if (single_year_sample(dset, gi->t1, gi->t2)) {
3853 strcpy(gi->xfmt, "%m-%d");
3854 } else {
3855 strcpy(gi->xfmt, "%y-%m-%d"); /* two-digit year */
3856 }
3857 pprintf(prn, "set format x \"%s\"\n", gi->xfmt);
3858 pputs(prn, "set xtics rotate by -45\n");
3859 return;
3860 }
3861
3862 if (dset->pd == 4 && (gi->t2 - gi->t1) / 4 < 8) {
3863 pputs(prn, "set xtics nomirror 0,1\n");
3864 pputs(prn, "set mxtics 4\n");
3865 } else if (dset->pd == 12 && (gi->t2 - gi->t1) / 12 < 8) {
3866 pputs(prn, "set xtics nomirror 0,1\n");
3867 pputs(prn, "set mxtics 12\n");
3868 } else if (dated_daily_data(dset) || dated_weekly_data(dset)) {
3869 make_calendar_tics(dset, gi, prn);
3870 } else if (multiple_groups(dset, gi->t1, gi->t2)) {
3871 make_panel_unit_tics(dset, gi, prn);
3872 if (xlabel != NULL) {
3873 strcpy(xlabel, _("time series by group"));
3874 }
3875 }
3876 }
3877
3878 /* Handle the use of a matrix in the context of the "plot" command
3879 block, or create a plot directly from a matrix and a plot list.
3880 */
3881
matrix_plot(gretl_matrix * m,const int * list,const char * literal,gretlopt opt)3882 int matrix_plot (gretl_matrix *m, const int *list, const char *literal,
3883 gretlopt opt)
3884 {
3885 DATASET *dset = NULL;
3886 int *plotlist = NULL;
3887 int pmax, err = 0;
3888
3889 if (gretl_is_null_matrix(m)) {
3890 return E_DATA;
3891 }
3892
3893 if (list != NULL && list[0] == 0) {
3894 dset = gretl_dataset_from_matrix(m, NULL, OPT_B, &err);
3895 } else {
3896 dset = gretl_dataset_from_matrix(m, list, OPT_B, &err);
3897 }
3898
3899 if (err) {
3900 return err;
3901 }
3902
3903 pmax = dset->v - 1;
3904
3905 if (pmax <= 0) {
3906 err = E_DATA;
3907 } else {
3908 plotlist = gretl_consecutive_list_new(1, pmax);
3909 if (plotlist == NULL) {
3910 err = E_ALLOC;
3911 }
3912 }
3913
3914 if (!err) {
3915 if (opt & OPT_N) {
3916 gnuplot_info gi;
3917
3918 err = gpinfo_init(&gi, opt, plotlist, literal, dset);
3919 if (!err) {
3920 err = maybe_add_plotx(&gi, 0, dset);
3921 }
3922 if (!err) {
3923 err = plot_with_band(BP_BLOCKMAT, &gi, literal,
3924 dset, opt);
3925 }
3926 } else {
3927 err = gnuplot(plotlist, literal, dset, opt);
3928 }
3929 }
3930
3931 destroy_dataset(dset);
3932 free(plotlist);
3933
3934 return err;
3935 }
3936
plotlist_is_group_invariant(const int * list,const DATASET * dset)3937 static int plotlist_is_group_invariant (const int *list, const DATASET *dset)
3938 {
3939 int i;
3940
3941 for (i=1; i<=list[0]; i++) {
3942 if (!series_is_group_invariant(dset, list[i])) {
3943 return 0;
3944 }
3945 }
3946
3947 return 1;
3948 }
3949
panel_group_invariant_plot(const int * plotlist,const char * literal,DATASET * dset,gretlopt opt)3950 static int panel_group_invariant_plot (const int *plotlist,
3951 const char *literal,
3952 DATASET *dset,
3953 gretlopt opt)
3954 {
3955 DATASET orig = *dset;
3956 int err;
3957
3958 /* limit sample to first group */
3959 dset->t1 = 0;
3960 dset->t2 = dset->pd - 1;
3961
3962 /* and mark as time-series data */
3963 if (dset->panel_pd > 0) {
3964 dset->pd = dset->panel_pd;
3965 dset->sd0 = dset->panel_sd0;
3966 dset->structure = TIME_SERIES;
3967 } else {
3968 dset->structure = SPECIAL_TIME_SERIES;
3969 dset->pd = 1;
3970 }
3971
3972 err = gnuplot(plotlist, literal, dset, opt);
3973
3974 /* put everything back as it was */
3975 *dset = orig;
3976
3977 return err;
3978 }
3979
3980 /**
3981 * gnuplot:
3982 * @plotlist: list of variables to plot, by ID number.
3983 * @literal: commands to be passed to gnuplot.
3984 * @dset: dataset struct.
3985 * @opt: option flags.
3986 *
3987 * Writes a gnuplot plot file to display the values of the
3988 * variables in @list and calls gnuplot to make the graph.
3989 *
3990 * Returns: 0 on successful completion, non-zero code on error.
3991 */
3992
gnuplot(const int * plotlist,const char * literal,const DATASET * dset,gretlopt opt)3993 int gnuplot (const int *plotlist, const char *literal,
3994 const DATASET *dset, gretlopt opt)
3995 {
3996 PRN *prn = NULL;
3997 FILE *fp = NULL;
3998 int *list = NULL;
3999 char s1[MAXDISP] = {0};
4000 char s2[MAXDISP] = {0};
4001 char xlabel[MAXDISP] = {0};
4002 char withstr[16] = {0};
4003 char lwstr[8] = {0};
4004 char keystr[48] = {0};
4005 gchar *fitline = NULL;
4006 int time_fit = 0;
4007 int oddman = 0;
4008 int many = 0;
4009 int set_xrange = 1;
4010 PlotType ptype;
4011 gnuplot_info gi = {0};
4012 int i, err = 0;
4013
4014 gretl_error_clear();
4015
4016 if ((opt & OPT_T) && (opt & OPT_F)) {
4017 if (plotlist[0] > 1 || !dataset_is_time_series(dset)) {
4018 return E_BADOPT;
4019 } else {
4020 time_fit = 1;
4021 }
4022 }
4023
4024 if (literal != NULL && strstr(literal, "set xdata time")) {
4025 set_xrange = 0;
4026 }
4027
4028 if (dataset_is_panel(dset) &&
4029 plotlist_is_group_invariant(plotlist, dset)) {
4030 #if GP_DEBUG
4031 fprintf(stderr, "doing panel_group_invariant_plot\n");
4032 #endif
4033 return panel_group_invariant_plot(plotlist, literal,
4034 (DATASET *) dset, opt);
4035 }
4036
4037 #if GP_DEBUG
4038 printlist(plotlist, "gnuplot: plotlist");
4039 fprintf(stderr, "incoming plot range: obs %d to %d\n", dset->t1, dset->t2);
4040 #endif
4041
4042 err = gpinfo_init(&gi, opt, plotlist, literal, dset);
4043 if (err) {
4044 goto bailout;
4045 }
4046
4047 #if GP_DEBUG
4048 fprintf(stderr, "after gpinfo_init: gi.fit = %d\n", gi.fit);
4049 #endif
4050
4051 err = maybe_add_plotx(&gi, time_fit, dset);
4052 if (err) {
4053 goto bailout;
4054 }
4055
4056 if (gi.fit == PLOT_FIT_LOESS) {
4057 return loess_plot(&gi, literal, dset);
4058 }
4059
4060 if (time_fit) {
4061 return time_fit_plot(&gi, literal, dset);
4062 }
4063
4064 if (gi.band) {
4065 return plot_with_band(BP_REGULAR, &gi, literal,
4066 (DATASET *) dset, opt);
4067 }
4068
4069 if (gi.list[0] > MAX_LETTERBOX_LINES + 1) {
4070 many = 1;
4071 }
4072
4073 /* convenience pointer */
4074 list = gi.list;
4075
4076 /* set x-axis label for non-time series plots */
4077 if (!(gi.flags & GPT_TS)) {
4078 int v = (gi.flags & GPT_DUMMY)? list[2] : list[list[0]];
4079
4080 strcpy(xlabel, series_get_graph_name(dset, v));
4081 }
4082
4083 prn = gretl_print_new(GRETL_PRINT_BUFFER, &err);
4084 if (err) {
4085 goto bailout;
4086 }
4087
4088 /* adjust sample range, and reject if it's empty */
4089 err = graph_list_adjust_sample(list, &gi, dset, 2);
4090 if (err) {
4091 goto bailout;
4092 }
4093
4094 /* add a regression line if appropriate */
4095 if (!use_impulses(&gi) && !(gi.flags & GPT_FIT_OMIT) && list[0] == 2 &&
4096 !(gi.flags & GPT_TS) && !(gi.flags & GPT_RESIDS)) {
4097 err = get_fitted_line(&gi, dset, &fitline);
4098 if (err) {
4099 goto bailout;
4100 } else {
4101 const char *xname = dset->varname[list[2]];
4102 const char *yname = dset->varname[list[1]];
4103
4104 if (*xname != '\0' && *yname != '\0') {
4105 pprintf(prn, "# X = '%s' (%d)\n", xname, list[2]);
4106 pprintf(prn, "# Y = '%s' (%d)\n", yname, list[1]);
4107 }
4108 }
4109 }
4110
4111 ptype = PLOT_REGULAR;
4112
4113 /* separation by dummy: create special vars */
4114 if (gi.flags & GPT_DUMMY) {
4115 err = factor_check(&gi, dset);
4116 if (err) {
4117 goto bailout;
4118 }
4119 ptype = PLOT_FACTORIZED;
4120 }
4121
4122 /* special tics for time series plots */
4123 if (gi.flags & GPT_TS) {
4124 make_time_tics(&gi, dset, many, xlabel, prn);
4125 }
4126
4127 /* open file and, if that goes OK, dump the prn into it
4128 after writing the header
4129 */
4130 fp = open_plot_input_file(ptype, gi.flags, &err);
4131 if (err) {
4132 gretl_print_destroy(prn);
4133 goto bailout;
4134 }
4135
4136 fputs(gretl_print_get_buffer(prn), fp);
4137 gretl_print_destroy(prn);
4138
4139 print_axis_label('x', xlabel, fp);
4140 fputs("set xzeroaxis\n", fp);
4141 gnuplot_missval_string(fp);
4142
4143 if (gi.flags & GPT_LOGY) {
4144 fprintf(fp, "set logscale y %g\n", gi.ybase);
4145 }
4146
4147 /* key: default to left top */
4148 strcpy(keystr, "set key left top\n");
4149
4150 if (list[0] == 1) {
4151 /* only one variable (time series) */
4152 print_axis_label('y', series_get_graph_name(dset, list[1]), fp);
4153 strcpy(keystr, "set nokey\n");
4154 } else if (list[0] == 2) {
4155 /* plotting two variables */
4156 int no_key = 1;
4157
4158 if (gi.flags & GPT_AUTO_FIT) {
4159 print_auto_fit_string(gi.fit, fp);
4160 if (gi.flags & GPT_FA) {
4161 make_gtitle(&gi, GTITLE_AFV, series_get_graph_name(dset, list[1]),
4162 series_get_graph_name(dset, list[2]), fp);
4163 } else {
4164 make_gtitle(&gi, GTITLE_VLS, series_get_graph_name(dset, list[1]),
4165 xlabel, fp);
4166 }
4167 no_key = 0;
4168 }
4169 if (gi.flags & GPT_RESIDS && !(gi.flags & GPT_DUMMY)) {
4170 const char *vlabel = series_get_label(dset, list[1]);
4171
4172 make_gtitle(&gi, GTITLE_RESID, vlabel == NULL ? "residual" : vlabel,
4173 NULL, fp);
4174 fprintf(fp, "set ylabel '%s'\n", _("residual"));
4175 } else {
4176 print_axis_label('y', series_get_graph_name(dset, list[1]), fp);
4177 }
4178 if (no_key) {
4179 strcpy(keystr, "set nokey\n");
4180 }
4181 } else if ((gi.flags & GPT_RESIDS) && (gi.flags & GPT_DUMMY)) {
4182 const char *vlabel = series_get_label(dset, list[1]);
4183
4184 make_gtitle(&gi, GTITLE_RESID, vlabel == NULL ? "residual" : vlabel,
4185 NULL, fp);
4186 fprintf(fp, "set ylabel '%s'\n", _("residual"));
4187 } else if (gi.flags & GPT_FA) {
4188 if (list[3] == dset->v - 1) {
4189 /* x var is just time or index: is this always right? */
4190 make_gtitle(&gi, GTITLE_AF, series_get_graph_name(dset, list[2]),
4191 NULL, fp);
4192 } else {
4193 make_gtitle(&gi, GTITLE_AFV, series_get_graph_name(dset, list[2]),
4194 series_get_graph_name(dset, list[3]), fp);
4195 }
4196 print_axis_label('y', series_get_graph_name(dset, list[2]), fp);
4197 }
4198
4199 if (many) {
4200 strcpy(keystr, "set key outside\n");
4201 }
4202
4203 fputs(keystr, fp);
4204
4205 gretl_push_c_numeric_locale();
4206
4207 if (set_xrange) {
4208 if (gi.x != NULL) {
4209 print_x_range(&gi, fp);
4210 } else {
4211 print_x_range_from_list(&gi, dset, list, fp);
4212 }
4213 }
4214
4215 if (!(gi.flags & GPT_TIMEFMT) && *gi.xfmt != '\0' && *gi.xtics != '\0') {
4216 /* remedial handling of broken tics */
4217 fprintf(fp, "set format x \"%s\"\n", gi.xfmt);
4218 fprintf(fp, "set xtics %s\n", gi.xtics);
4219 }
4220
4221 if (gi.flags & GPT_Y2AXIS) {
4222 check_for_yscale(&gi, (const double **) dset->Z, &oddman);
4223 if (gi.flags & GPT_Y2AXIS) {
4224 fputs("set ytics nomirror\n", fp);
4225 fputs("set y2tics\n", fp);
4226 }
4227 } else if (gi.yformula == NULL && list[0] == 2) {
4228 check_y_tics(&gi, (const double **) dset->Z, fp);
4229 }
4230
4231 #if GP_DEBUG
4232 fprintf(stderr, "literal = '%s', yformula = '%s'\n", literal,
4233 gi.yformula);
4234 #endif
4235
4236 if (gi.yformula != NULL) {
4237 /* cut out the "dummy" yvar that is in fact represented
4238 by a formula rather than raw data */
4239 list[1] = list[2];
4240 list[2] = list[3];
4241 list[0] = 2;
4242 } else {
4243 print_gnuplot_literal_lines(literal, GNUPLOT, opt, fp);
4244 }
4245
4246 /* now print the 'plot' lines */
4247 fputs("plot \\\n", fp);
4248 if (gi.flags & GPT_Y2AXIS) {
4249 /* using two y axes */
4250 int lmax = list[0];
4251
4252 if ((gi.flags & GPT_IDX) && list[lmax] != 0) {
4253 lmax++;
4254 }
4255 for (i=1; i<lmax; i++) {
4256 set_lwstr(dset, list[i], lwstr);
4257 set_withstr(&gi, i, withstr);
4258 fprintf(fp, " '-' using 1:2 axes %s title \"%s (%s)\" %s%s%s",
4259 (i == oddman)? "x1y2" : "x1y1",
4260 series_get_graph_name(dset, list[i]),
4261 (i == oddman)? _("right") : _("left"),
4262 withstr,
4263 lwstr,
4264 (i == lmax - 1)? "\n" : ", \\\n");
4265 }
4266 } else if (gi.flags & GPT_DUMMY) {
4267 /* plot shows separation by discrete variable */
4268 int nd = gretl_vector_get_length(gi.dvals);
4269 int dv = list[3];
4270 series_table *st;
4271
4272 strcpy(s1, (gi.flags & GPT_RESIDS)? _("residual") :
4273 series_get_graph_name(dset, list[1]));
4274 strcpy(s2, series_get_graph_name(dset, dv));
4275 st = series_get_string_table(dset, dv);
4276
4277 for (i=0; i<nd; i++) {
4278 double di = gretl_vector_get(gi.dvals, i);
4279
4280 if (st != NULL) {
4281 fprintf(fp, " '-' using 1:2 title \"%s (%s=%s)\" w points",
4282 s1, s2, series_table_get_string(st, di));
4283 } else {
4284 fprintf(fp, " '-' using 1:2 title \"%s (%s=%g)\" w points",
4285 s1, s2, di);
4286 }
4287 if (i < nd - 1) {
4288 fputs(", \\\n", fp);
4289 } else {
4290 fputc('\n', fp);
4291 }
4292 }
4293 } else if (gi.yformula != NULL) {
4294 /* we have a formula to plot, not just data */
4295 fprintf(fp, " '-' using 1:2 title \"%s\" w points, \\\n", _("actual"));
4296 fprintf(fp, "%s title '%s' w lines\n", gi.yformula, _("fitted"));
4297 } else if (gi.flags & GPT_FA) {
4298 /* this is a fitted vs actual plot */
4299 /* try reversing here: 2014-09-22 */
4300 int tmp = list[1];
4301
4302 list[1] = list[2];
4303 list[2] = tmp;
4304 set_withstr(&gi, 1, withstr);
4305 fprintf(fp, " '-' using 1:2 title \"%s\" %s, \\\n", _("actual"), withstr);
4306 fprintf(fp, " '-' using 1:2 title \"%s\" %s\n", _("fitted"), withstr);
4307 } else {
4308 /* all other cases */
4309 int lmax = list[0] - 1;
4310
4311 for (i=1; i<=lmax; i++) {
4312 set_lwstr(dset, list[i], lwstr);
4313 if (list[0] == 2 && !(gi.flags & GPT_TIMEFMT)) {
4314 *s1 = '\0';
4315 } else {
4316 strcpy(s1, series_get_graph_name(dset, list[i]));
4317 }
4318 set_withstr(&gi, i, withstr);
4319 fprintf(fp, " '-' using 1:2 title \"%s\" %s%s", s1, withstr, lwstr);
4320 if (i < lmax || (gi.flags & GPT_AUTO_FIT)) {
4321 fputs(", \\\n", fp);
4322 } else {
4323 fputc('\n', fp);
4324 }
4325 }
4326 }
4327
4328 if (fitline != NULL) {
4329 fputs(fitline, fp);
4330 }
4331
4332 /* print the data to be graphed */
4333 if (gi.flags & GPT_DUMMY) {
4334 print_gp_dummy_data(&gi, dset, fp);
4335 } else {
4336 print_gp_data(&gi, dset, fp);
4337 }
4338
4339 gretl_pop_c_numeric_locale();
4340
4341 err = finalize_plot_input_file(fp);
4342
4343 bailout:
4344
4345 g_free(fitline);
4346 clear_gpinfo(&gi);
4347
4348 return err;
4349 }
4350
theil_forecast_plot(const int * plotlist,const DATASET * dset,gretlopt opt)4351 int theil_forecast_plot (const int *plotlist, const DATASET *dset,
4352 gretlopt opt)
4353 {
4354 FILE *fp = NULL;
4355 gnuplot_info gi;
4356 int vx, vy;
4357 int err = 0;
4358
4359 gretl_error_clear();
4360
4361 if (plotlist[0] != 2) {
4362 return E_DATA;
4363 }
4364
4365 err = gpinfo_init(&gi, opt | OPT_S, plotlist, NULL, dset);
4366 if (err) {
4367 goto bailout;
4368 }
4369
4370 /* ensure the time-series flag is unset */
4371 gi.flags &= ~GPT_TS;
4372
4373 err = graph_list_adjust_sample(gi.list, &gi, dset, 1);
4374 if (err) {
4375 goto bailout;
4376 }
4377
4378 fp = open_plot_input_file(PLOT_REGULAR, gi.flags, &err);
4379 if (err) {
4380 goto bailout;
4381 }
4382
4383 vx = gi.list[2];
4384 vy = gi.list[1];
4385
4386 print_axis_label('x', series_get_graph_name(dset, vx), fp);
4387 print_axis_label('y', series_get_graph_name(dset, vy), fp);
4388
4389 fputs("set xzeroaxis\n", fp);
4390 gnuplot_missval_string(fp);
4391 fputs("set key left top\n", fp);
4392
4393 gretl_push_c_numeric_locale();
4394
4395 print_x_range_from_list(&gi, dset, gi.list, fp);
4396
4397 fputs("plot \\\n", fp);
4398 fputs(" '-' using 1:2 notitle w points, \\\n", fp);
4399 fprintf(fp, " x title \"%s\" w lines\n", _("actual = predicted"));
4400
4401 print_gp_data(&gi, dset, fp);
4402
4403 gretl_pop_c_numeric_locale();
4404
4405 err = finalize_plot_input_file(fp);
4406
4407 bailout:
4408
4409 clear_gpinfo(&gi);
4410
4411 return err;
4412 }
4413
scatters_time_tics(const double * obs,const DATASET * dset,FILE * fp)4414 static void scatters_time_tics (const double *obs,
4415 const DATASET *dset,
4416 FILE *fp)
4417 {
4418 double startdate = obs[dset->t1];
4419 double enddate = obs[dset->t2];
4420 double obsrange = enddate - startdate;
4421 int k1 = ceil(startdate);
4422 int k2 = floor(enddate);
4423 int nmaj = k2 - k1 + 1;
4424
4425 fputs("set xtics nomirror\n", fp);
4426
4427 if (obsrange > 8) {
4428 double incr = obsrange / 4;
4429
4430 fprintf(fp, "set xrange [%g:%g]\n", floor(startdate), ceil(enddate));
4431 fprintf(fp, "set xtics %g,%g\n", ceil(startdate), floor(incr));
4432 } else if (nmaj == 0) {
4433 fputs("set format x ''\n", fp);
4434 } else {
4435 /* integer major tics plus minor */
4436 int T = dset->t2 - dset->t1 + 1;
4437
4438 fprintf(fp, "set xrange [%g:%g]\n", startdate, enddate);
4439 fprintf(fp, "set xtics %g,1\n", floor(startdate));
4440 if (T < 55) {
4441 fprintf(fp, "set mxtics %d\n", dset->pd);
4442 }
4443 }
4444 }
4445
scatters_set_timefmt(const DATASET * dset,const double * obs,FILE * fp)4446 static void scatters_set_timefmt (const DATASET *dset,
4447 const double *obs,
4448 FILE *fp)
4449 {
4450 double T = obs[dset->t2] - obs[dset->t1];
4451 int ntics = 6;
4452
4453 fputs("set xdata time\n", fp);
4454 fputs("set timefmt \"%s\"\n", fp);
4455 if (single_year_sample(dset, dset->t1, dset->t2)) {
4456 fputs("set format x \"%m-%d\"\n", fp);
4457 } else {
4458 fputs("set format x \"%Y-%m-%d\"\n", fp);
4459 }
4460 fputs("set xtics rotate by -45\n", fp);
4461 fprintf(fp, "set xtics %g\n", round(T/ntics));
4462 }
4463
4464 /**
4465 * multi_scatters:
4466 * @list: list of variables to plot, by ID number.
4467 * @dset: dataset struct.
4468 * @opt: can include %OPT_O to use lines, %OPT_U to
4469 * direct output to a named file.
4470 *
4471 * Writes a gnuplot plot file to display up to 16 small graphs
4472 * based on the variables in @list, and calls gnuplot to make
4473 * the graph.
4474 *
4475 * Returns: 0 on successful completion, error code on error.
4476 */
4477
multi_scatters(const int * list,const DATASET * dset,gretlopt opt)4478 int multi_scatters (const int *list, const DATASET *dset,
4479 gretlopt opt)
4480 {
4481 GptFlags flags = 0;
4482 int xvar = 0, yvar = 0;
4483 const double *x = NULL;
4484 const double *y = NULL;
4485 const double *obs = NULL;
4486 int rows, cols, tseries = 0;
4487 int use_timefmt = 0;
4488 int *plotlist = NULL;
4489 int pos, nplots = 0;
4490 FILE *fp = NULL;
4491 int i, t, err = 0;
4492
4493 if (opt & OPT_O) {
4494 flags |= GPT_LINES;
4495 }
4496
4497 pos = gretl_list_separator_position(list);
4498
4499 if (pos == 0) {
4500 /* plot against time or index */
4501 plotlist = gretl_list_copy(list);
4502 flags |= GPT_LINES;
4503 if (dataset_is_time_series(dset)) {
4504 tseries = 1;
4505 if (calendar_data(dset)) {
4506 use_timefmt = 1;
4507 }
4508 }
4509 obs = gretl_plotx(dset, use_timefmt ? OPT_T : OPT_S);
4510 if (obs == NULL) {
4511 return E_ALLOC;
4512 }
4513 } else if (pos > 2) {
4514 /* plot several yvars against one xvar */
4515 plotlist = gretl_list_new(pos - 1);
4516 xvar = list[list[0]];
4517 x = dset->Z[xvar];
4518 } else {
4519 /* plot one yvar against several xvars */
4520 plotlist = gretl_list_new(list[0] - pos);
4521 yvar = list[1];
4522 y = dset->Z[yvar];
4523 }
4524
4525 if (plotlist == NULL) {
4526 return E_ALLOC;
4527 }
4528
4529 if (yvar) {
4530 for (i=1; i<=plotlist[0]; i++) {
4531 plotlist[i] = list[i + pos];
4532 }
4533 } else if (xvar) {
4534 for (i=1; i<pos; i++) {
4535 plotlist[i] = list[i];
4536 }
4537 }
4538
4539 /* max 16 plots */
4540 if (plotlist[0] > 16) {
4541 plotlist[0] = 16;
4542 }
4543
4544 nplots = plotlist[0];
4545
4546 if (nplots > 1) {
4547 get_multiplot_layout(nplots, tseries, &rows, &cols);
4548 if (use_timefmt) {
4549 gp_small_font_size = nplots > 2 ? 6 : 0;
4550 } else {
4551 maybe_set_small_font(nplots);
4552 }
4553 if (nplots > 12) {
4554 flags |= GPT_XXL;
4555 } else if (nplots > 9) {
4556 flags |= GPT_XL;
4557 }
4558 }
4559
4560 fp = open_plot_input_file(PLOT_MULTI_SCATTER, flags, &err);
4561 if (err) {
4562 return err;
4563 }
4564
4565 if (nplots > 1) {
4566 fprintf(fp, "set multiplot layout %d,%d\n", rows, cols);
4567 }
4568 fputs("set nokey\n", fp);
4569
4570 if (opt & OPT_K) {
4571 /* --tweaks=foo */
4572 print_gnuplot_literal_lines(NULL, SCATTERS, opt, fp);
4573 }
4574
4575 gretl_push_c_numeric_locale();
4576
4577 if (use_timefmt) {
4578 fprintf(fp, "set xrange [%.12g:%.12g]\n", obs[dset->t1], obs[dset->t2]);
4579 scatters_set_timefmt(dset, obs, fp);
4580 } else if (obs != NULL) {
4581 scatters_time_tics(obs, dset, fp);
4582 } else {
4583 /* avoid having points sticking to the axes */
4584 fputs("set offsets graph 0.02, graph 0.02, graph 0.02, graph 0.02\n", fp);
4585 fputs("set noxtics\nset noytics\n", fp);
4586 }
4587
4588 fputs("set xzeroaxis\n", fp);
4589
4590 for (i=0; i<nplots; i++) {
4591 int j = plotlist[i+1];
4592
4593 if (obs != NULL) {
4594 fputs("set noxlabel\n", fp);
4595 fputs("set noylabel\n", fp);
4596 fprintf(fp, "set title '%s'\n", series_get_graph_name(dset, j));
4597 } else {
4598 fprintf(fp, "set xlabel '%s'\n",
4599 (yvar)? dset->varname[j] :
4600 dset->varname[xvar]);
4601 fprintf(fp, "set ylabel '%s'\n",
4602 (yvar)? dset->varname[yvar] :
4603 dset->varname[j]);
4604 }
4605 fputs("plot '-' using 1:2", fp);
4606 if (flags & GPT_LINES) {
4607 fputs(" with lines", fp);
4608 }
4609 fputc('\n', fp);
4610
4611 for (t=dset->t1; t<=dset->t2; t++) {
4612 double xt = yvar ? dset->Z[j][t] : xvar ? x[t] : obs[t];
4613 double yt = yvar ? y[t] : dset->Z[j][t];
4614
4615 write_gp_dataval(xt, fp, 0);
4616 write_gp_dataval(yt, fp, 1);
4617 }
4618 fputs("e\n", fp);
4619 }
4620
4621 gretl_pop_c_numeric_locale();
4622
4623 if (nplots > 1) {
4624 fputs("unset multiplot\n", fp);
4625 }
4626
4627 free(plotlist);
4628
4629 return finalize_plot_input_file(fp);
4630 }
4631
matrix_plotx_ok(const gretl_matrix * m,const DATASET * dset,int * pt1,int * pt2,int * ppd)4632 static int matrix_plotx_ok (const gretl_matrix *m, const DATASET *dset,
4633 int *pt1, int *pt2, int *ppd)
4634 {
4635 if (dset == NULL) {
4636 return 0;
4637 } else if (m->rows == dset->n) {
4638 return 1;
4639 } else {
4640 int t1 = gretl_matrix_get_t1(m);
4641 int t2 = gretl_matrix_get_t2(m);
4642
4643 if (t2 > t1 && t2 < dset->n) {
4644 *pt1 = t1;
4645 *pt2 = t2;
4646 *ppd = dset->pd;
4647 return 1;
4648 }
4649 }
4650
4651 return 0;
4652 }
4653
matrix_col(const gretl_matrix * m,int j)4654 static const double *matrix_col (const gretl_matrix *m, int j)
4655 {
4656 const double *x = m->val;
4657
4658 return x + (j-1) * m->rows;
4659 }
4660
plot_colname(char * s,const char ** colnames,int j)4661 static void plot_colname (char *s, const char **colnames, int j)
4662 {
4663 if (colnames != NULL) {
4664 const char *name = colnames[j-1];
4665
4666 *s = '\0';
4667 if (strlen(name) >= 16) {
4668 strncat(s, name, 14);
4669 strcat(s, "~");
4670 } else {
4671 strncat(s, name, 15);
4672 }
4673 } else {
4674 sprintf(s, "col %d", j);
4675 }
4676 }
4677
get_obsx(const double * obs,int t,int s)4678 static double get_obsx (const double *obs, int t, int s)
4679 {
4680 return (obs != NULL)? obs[t] : s;
4681 }
4682
4683 /**
4684 * matrix_scatters:
4685 * @m: matrix containing data to plot.
4686 * @list: list of columns to plot, or NULL.
4687 * @dset: dataset pointer, or NULL.
4688 * @opt: can include %OPT_O to use lines, %OPT_U to
4689 * direct output to a named file.
4690 *
4691 * Writes a gnuplot plot file to display up to 16 small graphs
4692 * based on the data in @m, and calls gnuplot to make
4693 * the graph.
4694 *
4695 * Returns: 0 on successful completion, error code on error.
4696 */
4697
matrix_scatters(const gretl_matrix * m,const int * list,const DATASET * dset,gretlopt opt)4698 int matrix_scatters (const gretl_matrix *m, const int *list,
4699 const DATASET *dset, gretlopt opt)
4700 {
4701 GptFlags flags = 0;
4702 const double *x = NULL;
4703 const double *y = NULL;
4704 const double *obs = NULL;
4705 const char **colnames = NULL;
4706 FILE *fp = NULL;
4707 int *plotlist = NULL;
4708 int need_list = 0;
4709 int rows, cols;
4710 int xcol = 0, ycol = 0;
4711 int t1 = 0, t2 = 0, pd = 1;
4712 int pos = 0, nplots = 0;
4713 int simple_obs = 0;
4714 int i, t, err = 0;
4715
4716 if (gretl_is_null_matrix(m)) {
4717 return E_DATA;
4718 }
4719
4720 if (opt & OPT_O) {
4721 flags |= GPT_LINES;
4722 }
4723
4724 if (list != NULL) {
4725 for (i=1; i<=list[0]; i++) {
4726 if (list[i] == LISTSEP) {
4727 pos = i;
4728 } else if (list[i] < 1 || list[i] > m->cols) {
4729 err = E_INVARG;
4730 break;
4731 }
4732 }
4733 }
4734
4735 if (err) {
4736 return err;
4737 }
4738
4739 t1 = 0;
4740 t2 = m->rows - 1;
4741
4742 if (pos == 0) {
4743 /* plot against time or index */
4744 if (matrix_plotx_ok(m, dset, &t1, &t2, &pd)) {
4745 obs = gretl_plotx(dset, OPT_NONE);
4746 if (obs == NULL) {
4747 return E_ALLOC;
4748 }
4749 } else {
4750 simple_obs = 1;
4751 }
4752 if (list != NULL && list[0] > 0) {
4753 need_list = 1;
4754 plotlist = gretl_list_copy(list);
4755 }
4756 flags |= GPT_LINES;
4757 } else if (pos > 2) {
4758 /* plot several yvars against one xvar */
4759 need_list = 1;
4760 plotlist = gretl_list_new(pos - 1);
4761 xcol = list[list[0]];
4762 x = matrix_col(m, xcol);
4763 } else {
4764 /* plot one yvar against several xvars */
4765 need_list = 1;
4766 plotlist = gretl_list_new(list[0] - pos);
4767 ycol = list[1];
4768 y = matrix_col(m, ycol);
4769 }
4770
4771 if (need_list && plotlist == NULL) {
4772 return E_ALLOC;
4773 }
4774
4775 if (plotlist != NULL) {
4776 if (y != NULL) {
4777 for (i=1; i<=plotlist[0]; i++) {
4778 plotlist[i] = list[i + pos];
4779 }
4780 } else if (x != NULL) {
4781 for (i=1; i<pos; i++) {
4782 plotlist[i] = list[i];
4783 }
4784 }
4785 /* max 16 plots */
4786 if (plotlist[0] > 16) {
4787 plotlist[0] = 16;
4788 }
4789 nplots = plotlist[0];
4790 } else {
4791 nplots = (m->cols > 16)? 16 : m->cols;
4792 }
4793
4794 get_multiplot_layout(nplots, 0, &rows, &cols);
4795 maybe_set_small_font(nplots);
4796
4797 if (nplots > 12) {
4798 flags |= GPT_XXL;
4799 } else if (nplots > 9) {
4800 flags |= GPT_XL;
4801 }
4802
4803 fp = open_plot_input_file(PLOT_MULTI_SCATTER, flags, &err);
4804 if (err) {
4805 return err;
4806 }
4807
4808 colnames = gretl_matrix_get_colnames(m);
4809
4810 fprintf(fp, "set multiplot layout %d,%d\n", rows, cols);
4811 fputs("set xzeroaxis\n", fp);
4812 fputs("set nokey\n", fp);
4813
4814 gretl_push_c_numeric_locale();
4815
4816 if (obs != NULL) {
4817 double startdate = obs[t1];
4818 double enddate = obs[t2];
4819 int incr, T = t2 - t1 + 1;
4820
4821 fprintf(fp, "set xrange [%g:%g]\n", floor(startdate), ceil(enddate));
4822
4823 incr = (pd == 1)? (T / 6) : (T / (4 * pd));
4824 if (incr > 0) {
4825 fprintf(fp, "set xtics %g, %d\n", ceil(startdate), incr);
4826 }
4827 } else if (simple_obs) {
4828 int incr = m->rows / 6;
4829
4830 fprintf(fp, "set xrange [0:%d]\n", m->rows - 1);
4831 if (incr > 0) {
4832 fprintf(fp, "set xtics 0, %d\n", incr);
4833 }
4834 } else {
4835 fputs("set noxtics\nset noytics\n", fp);
4836 }
4837
4838 if (obs != NULL || simple_obs) {
4839 fputs("set noxlabel\n", fp);
4840 fputs("set noylabel\n", fp);
4841 }
4842
4843 for (i=0; i<nplots; i++) {
4844 int j = (plotlist == NULL)? (i+1) : plotlist[i+1];
4845 const double *zj = matrix_col(m, j);
4846 char label[16];
4847
4848 if (obs != NULL || simple_obs) {
4849 plot_colname(label, colnames, j);
4850 fprintf(fp, "set title '%s'\n", label);
4851 } else {
4852 plot_colname(label, colnames, (y != NULL)? j : xcol);
4853 fprintf(fp, "set xlabel '%s'\n", label);
4854 plot_colname(label, colnames, (y != NULL)? ycol : j);
4855 fprintf(fp, "set ylabel '%s'\n", label);
4856 }
4857
4858 fputs("plot '-' using 1:2", fp);
4859 if (flags & GPT_LINES) {
4860 fputs(" with lines", fp);
4861 }
4862 fputc('\n', fp);
4863
4864 for (t=t1; t<=t2; t++) {
4865 int s = t - t1;
4866 double xt = ycol ? zj[s] : xcol ? x[s] : get_obsx(obs, t, s);
4867 double yt = (y != NULL)? y[s] : zj[s];
4868
4869 write_gp_dataval(xt, fp, 0);
4870 write_gp_dataval(yt, fp, 1);
4871 }
4872 fputs("e\n", fp);
4873 }
4874
4875 gretl_pop_c_numeric_locale();
4876
4877 fputs("unset multiplot\n", fp);
4878
4879 free(plotlist);
4880
4881 return finalize_plot_input_file(fp);
4882 }
4883
get_3d_input_file(int * err)4884 static FILE *get_3d_input_file (int *err)
4885 {
4886 FILE *fp = NULL;
4887 char fname[MAXLEN];
4888
4889 sprintf(fname, "%sgpttmp.plt", gretl_dotdir());
4890 fp = gretl_fopen(fname, "w");
4891
4892 if (fp == NULL) {
4893 *err = E_FOPEN;
4894 } else {
4895 gretl_set_path_by_name("plotfile", fname);
4896 }
4897
4898 return fp;
4899 }
4900
maybe_get_surface(const int * list,DATASET * dset,gretlopt opt)4901 static gchar *maybe_get_surface (const int *list,
4902 DATASET *dset,
4903 gretlopt opt)
4904 {
4905 MODEL smod;
4906 double umin, umax, vmin, vmax;
4907 int olslist[5];
4908 gchar *ret = NULL;
4909
4910 olslist[0] = 4;
4911 olslist[1] = list[3];
4912 olslist[2] = 0;
4913 olslist[3] = list[2];
4914 olslist[4] = list[1];
4915
4916 gretl_minmax(dset->t1, dset->t2, dset->Z[list[2]], &umin, &umax);
4917 gretl_minmax(dset->t1, dset->t2, dset->Z[list[1]], &vmin, &vmax);
4918
4919 smod = lsq(olslist, dset, OLS, OPT_A);
4920
4921 if (!smod.errcode && !na(smod.fstt) &&
4922 (snedecor_cdf_comp(smod.dfn, smod.dfd, smod.fstt) < .10 || (opt & OPT_A))) {
4923 double uadj = (umax - umin) * 0.02;
4924 double vadj = (vmax - vmin) * 0.02;
4925
4926 ret = g_strdup_printf("[u=%g:%g] [v=%g:%g] "
4927 "%g+(%g)*u+(%g)*v notitle",
4928 umin - uadj, umax + uadj,
4929 vmin - vadj, vmax + vadj,
4930 smod.coeff[0], smod.coeff[1],
4931 smod.coeff[2]);
4932 }
4933
4934 clear_model(&smod);
4935
4936 return ret;
4937 }
4938
4939 /**
4940 * gnuplot_3d:
4941 * @list: list of variables to plot, by ID number: Y, X, Z
4942 * @literal: literal command(s) to pass to gnuplot (or NULL)
4943 * @dset: pointer to dataset.
4944 * @opt: may include OPT_A to force display of fitted surface;
4945 * may include OPT_I to force an interactive (rotatable) plot.
4946 * Note that OPT_I may be removed on output if a suitable
4947 * gnuplot terminal is not present.
4948 *
4949 * Writes a gnuplot plot file to display a 3D plot (Z on
4950 * the vertical axis, X and Y on base plane).
4951 *
4952 * Returns: 0 on successful completion, error code on error.
4953 */
4954
gnuplot_3d(int * list,const char * literal,DATASET * dset,gretlopt * opt)4955 int gnuplot_3d (int *list, const char *literal,
4956 DATASET *dset, gretlopt *opt)
4957 {
4958 FILE *fp = NULL;
4959 int t, t1 = dset->t1, t2 = dset->t2;
4960 int save_t1 = dset->t1, save_t2 = dset->t2;
4961 int lo = list[0];
4962 int datlist[4];
4963 int interactive = (*opt & OPT_I);
4964 const char *term = NULL;
4965 gchar *surface = NULL;
4966 int err = 0;
4967
4968 if (lo != 3) {
4969 fprintf(stderr, "gnuplot_3d needs three variables (only)\n");
4970 return E_DATA;
4971 }
4972
4973 list_adjust_sample(list, &t1, &t2, dset, NULL);
4974
4975 /* if resulting sample range is empty, complain */
4976 if (t1 >= t2) {
4977 return E_MISSDATA;
4978 }
4979
4980 #ifndef WIN32
4981 if (interactive) {
4982 /* On Windows we let the gnuplot terminal default to
4983 "win"; on other systems we need a suitable
4984 terminal for interactive 3-D display.
4985 */
4986 if (gnuplot_has_wxt()) {
4987 term = "wxt size 640,420 noenhanced";
4988 } else if (gnuplot_has_x11()) {
4989 term = "x11";
4990 } else if (gnuplot_has_qt()) {
4991 term = "qt";
4992 } else {
4993 *opt &= ~OPT_I;
4994 interactive = 0;
4995 }
4996 }
4997 #endif
4998
4999 if (interactive) {
5000 fp = get_3d_input_file(&err);
5001 } else {
5002 fp = open_plot_input_file(PLOT_3D, 0, &err);
5003 }
5004
5005 if (err) {
5006 return err;
5007 }
5008
5009 dset->t1 = t1;
5010 dset->t2 = t2;
5011
5012 if (interactive) {
5013 if (term != NULL) {
5014 fprintf(fp, "set term %s\n", term);
5015 }
5016 write_plot_line_styles(PLOT_3D, fp);
5017 }
5018
5019 gretl_push_c_numeric_locale();
5020
5021 print_axis_label('x', series_get_graph_name(dset, list[2]), fp);
5022 print_axis_label('y', series_get_graph_name(dset, list[1]), fp);
5023 print_axis_label('z', series_get_graph_name(dset, list[3]), fp);
5024
5025 gnuplot_missval_string(fp);
5026
5027 print_gnuplot_literal_lines(literal, GNUPLOT, *opt, fp);
5028
5029 surface = maybe_get_surface(list, dset, *opt);
5030
5031 if (surface != NULL) {
5032 fprintf(fp, "splot %s, \\\n'-' notitle w p\n", surface);
5033 g_free(surface);
5034 } else {
5035 fputs("splot '-' notitle w p\n", fp);
5036 }
5037
5038 datlist[0] = 3;
5039 datlist[1] = list[2];
5040 datlist[2] = list[1];
5041 datlist[3] = list[3];
5042
5043 for (t=t1; t<=t2; t++) {
5044 const char *label = NULL;
5045
5046 if (dset->markers) {
5047 label = dset->S[t];
5048 }
5049 printvars(fp, t, datlist, dset, NULL, label, 0.0);
5050 }
5051 fputs("e\n", fp);
5052
5053 gretl_pop_c_numeric_locale();
5054
5055 dset->t1 = save_t1;
5056 dset->t2 = save_t2;
5057
5058 if (interactive) {
5059 fputs("pause mouse close\n", fp);
5060 fclose(fp);
5061 } else {
5062 err = finalize_plot_input_file(fp);
5063 }
5064
5065 return err;
5066 }
5067
5068 /**
5069 * open_3d_plot_input_file:
5070 * @iact: on input, non-zero if an interactive plot is
5071 * preferred, 0 otherwise; on output, non-zero if interactive
5072 * status can be supported, 0 otherwise.
5073 *
5074 * Writes a gnuplot plot file to display a 3D plot
5075 * (interactive if requested and feasible).
5076 *
5077 * Returns: FILE pointer on success, NULL on error.
5078 */
5079
open_3d_plot_input_file(int * iact)5080 FILE *open_3d_plot_input_file (int *iact)
5081 {
5082 const char *term = NULL;
5083 FILE *fp = NULL;
5084 int err = 0;
5085
5086 if (*iact != 0) {
5087 #ifndef WIN32
5088 /* On Windows we let the gnuplot terminal default to
5089 "win"; on other operating systems we need a suitable
5090 terminal for interactive 3-D display.
5091 */
5092 if (gnuplot_has_wxt()) {
5093 term = "wxt size 640,420 noenhanced";
5094 } else if (gnuplot_has_x11()) {
5095 term = "x11";
5096 } else if (gnuplot_has_qt()) {
5097 term = "qt";
5098 } else {
5099 /* can't do it? */
5100 *iact = 0;
5101 }
5102 #endif
5103 }
5104
5105 if (*iact != 0) {
5106 fp = get_3d_input_file(&err);
5107 } else {
5108 fp = open_plot_input_file(PLOT_3D, 0, &err);
5109 }
5110
5111 if (*iact) {
5112 if (term != NULL) {
5113 fprintf(fp, "set term %s\n", term);
5114 }
5115 write_plot_line_styles(PLOT_3D, fp);
5116 }
5117
5118 return fp;
5119 }
5120
make_freq_test_label(int teststat,double v,double pv)5121 static gchar *make_freq_test_label (int teststat, double v, double pv)
5122 {
5123 gchar *s;
5124
5125 gretl_pop_c_numeric_locale();
5126 if (teststat == GRETL_STAT_Z) {
5127 s = g_strdup_printf("z = %.3f [%.4f]", v, pv);
5128 } else if (teststat == GRETL_STAT_NORMAL_CHISQ) {
5129 s = g_strdup_printf("%s(2) = %.3f [%.4f]", _("Chi-square"), v, pv);
5130 }
5131 gretl_push_c_numeric_locale();
5132
5133 return s;
5134 }
5135
make_freq_dist_label(int dist,double x,double y)5136 static gchar *make_freq_dist_label (int dist, double x, double y)
5137 {
5138 gchar *s;
5139 char c, test[10];
5140
5141 gretl_pop_c_numeric_locale();
5142 sprintf(test, "%g", 0.5);
5143 c = strchr(test, ',') ? ' ' : ',';
5144
5145 if (dist == D_NORMAL) {
5146 s = g_strdup_printf("N(%.5g%c%.5g)", x, c, y);
5147 } else if (dist == D_GAMMA) {
5148 s = g_strdup_printf("gamma(%.5g%c%.5g)", x, c, y);
5149 }
5150 gretl_push_c_numeric_locale();
5151
5152 return s;
5153 }
5154
5155 /* Below: a fix for the case where the y-range is by default
5156 degenerate, in which case gnuplot produces a graph OK, but
5157 issues a warning and returns non-zero.
5158 */
5159
maybe_set_yrange(FreqDist * freq,double lambda,FILE * fp)5160 static void maybe_set_yrange (FreqDist *freq, double lambda, FILE *fp)
5161 {
5162 double ymin = 1.0e+200;
5163 double ymax = -1.0e+200;
5164 int i;
5165
5166 for (i=0; i<freq->numbins; i++) {
5167 if (freq->f[i] > ymax) {
5168 ymax = freq->f[i];
5169 }
5170 if (freq->f[i] < ymin) {
5171 ymin = freq->f[i];
5172 }
5173 }
5174
5175 if (ymax == ymin) {
5176 fprintf(fp, "set yrange [%.10g:%.10g]\n", ymax * lambda * 0.99,
5177 ymax * lambda * 1.01);
5178 } else {
5179 fprintf(fp, "set yrange [0.0:%.10g]\n", ymax * lambda * 1.1);
5180 }
5181 }
5182
discrete_minskip(FreqDist * freq)5183 static double discrete_minskip (FreqDist *freq)
5184 {
5185 double s, ms = freq->midpt[1] - freq->midpt[0];
5186 int i;
5187
5188 for (i=2; i<freq->numbins; i++) {
5189 s = freq->midpt[i] - freq->midpt[i-1];
5190 if (s < ms) {
5191 ms = s;
5192 }
5193 }
5194
5195 return ms;
5196 }
5197
5198 /**
5199 * plot_freq:
5200 * @freq: pointer to frequency distribution struct.
5201 * @dist: probability distribution code.
5202 *
5203 * Plot the actual frequency distribution for a variable versus a
5204 * theoretical distribution: Gaussian, gamma or none.
5205 *
5206 * Returns: 0 on successful completion, error code on error.
5207 */
5208
plot_freq(FreqDist * freq,DistCode dist,gretlopt opt)5209 int plot_freq (FreqDist *freq, DistCode dist, gretlopt opt)
5210 {
5211 double alpha = 0.0, beta = 0.0, lambda = 1.0;
5212 FILE *fp = NULL;
5213 int i, K = freq->numbins;
5214 char withstr[32] = {0};
5215 gchar *label = NULL;
5216 double plotmin = 0.0, plotmax = 0.0;
5217 double barwidth;
5218 const double *endpt;
5219 int plottype, use_boxes = 1;
5220 char **S = NULL;
5221 int ns = 0, real_ns = 0;
5222 int err = 0;
5223
5224 if (K == 0) {
5225 return E_DATA;
5226 }
5227
5228 if (K == 1) {
5229 gretl_errmsg_sprintf(_("'%s' is a constant"), freq->varname);
5230 return E_DATA;
5231 }
5232
5233 if (freq->strvals) {
5234 dist = 0; /* just to be safe */
5235 }
5236
5237 if (dist == D_NORMAL) {
5238 plottype = PLOT_FREQ_NORMAL;
5239 } else if (dist == D_GAMMA) {
5240 plottype = PLOT_FREQ_GAMMA;
5241 } else if (freq->discrete) {
5242 plottype = PLOT_FREQ_DISCRETE;
5243 } else {
5244 plottype = PLOT_FREQ_SIMPLE;
5245 }
5246
5247 fp = open_plot_input_file(plottype, 0, &err);
5248 if (err) {
5249 return err;
5250 }
5251
5252 #if GP_DEBUG
5253 fprintf(stderr, "*** plot_freq called\n");
5254 #endif
5255
5256 if (freq->strvals) {
5257 endpt = NULL;
5258 barwidth = 1;
5259 use_boxes = 0;
5260 } else if (freq->discrete) {
5261 endpt = freq->midpt;
5262 barwidth = discrete_minskip(freq);
5263 use_boxes = 0;
5264 } else {
5265 /* equally sized bins, width to be determined */
5266 endpt = freq->endpt;
5267 barwidth = freq->endpt[K-1] - freq->endpt[K-2];
5268 }
5269
5270 S = literal_strings_from_opt(FREQ, &ns, &real_ns);
5271
5272 gretl_push_c_numeric_locale();
5273
5274 if (dist) {
5275 int nlit = 2 + 2 * (!na(freq->test)) + real_ns;
5276
5277 lambda = 1.0 / (freq->n * barwidth);
5278
5279 if (dist == D_NORMAL) {
5280 fprintf(fp, "# literal lines = %d\n", nlit);
5281 fprintf(fp, "sigma = %g\n", freq->sdx);
5282 fprintf(fp, "mu = %g\n", freq->xbar);
5283
5284 plotmin = endpt[0] - barwidth;
5285 if (plotmin > freq->xbar - 3.3 * freq->sdx) {
5286 plotmin = freq->xbar - 3.3 * freq->sdx;
5287 }
5288 plotmax = endpt[K-1] + barwidth;
5289 if (plotmax < freq->xbar + 3.3 * freq->sdx) {
5290 plotmax = freq->xbar + 3.3 * freq->sdx;
5291 }
5292 if (!na(freq->test)) {
5293 fprintf(fp, "set label \"%s:\" at graph .03, graph .97 front\n",
5294 _("Test statistic for normality"));
5295 label = make_freq_test_label(GRETL_STAT_NORMAL_CHISQ, freq->test,
5296 chisq_cdf_comp(2, freq->test));
5297 fprintf(fp, "set label '%s' at graph .03, graph .93 front\n",
5298 label);
5299 g_free(label);
5300 }
5301 if (real_ns > 0) {
5302 print_extra_literal_lines(S, ns, fp);
5303 }
5304 } else if (dist == D_GAMMA) {
5305 double var = freq->sdx * freq->sdx;
5306
5307 /* scale param = variance/mean */
5308 beta = var / freq->xbar;
5309 /* shape param = mean/scale */
5310 alpha = freq->xbar / beta;
5311
5312 fprintf(fp, "# literal lines = %d\n", nlit);
5313 fprintf(fp, "beta = %g\n", beta);
5314 fprintf(fp, "alpha = %g\n", alpha);
5315 plotmin = 0.0;
5316 plotmax = freq->xbar + 4.0 * freq->sdx;
5317
5318 if (!na(freq->test)) {
5319 fprintf(fp, "set label '%s:' at graph .03, graph .97 front\n",
5320 _("Test statistic for gamma"));
5321 label = make_freq_test_label(GRETL_STAT_Z, freq->test,
5322 normal_pvalue_2(freq->test));
5323 fprintf(fp, "set label '%s' at graph .03, graph .93 front\n",
5324 label);
5325 g_free(label);
5326 }
5327 if (real_ns > 0) {
5328 print_extra_literal_lines(S, ns, fp);
5329 }
5330 }
5331
5332 /* adjust min, max if needed */
5333 if (freq->midpt[0] < plotmin) {
5334 plotmin = freq->midpt[0];
5335 }
5336 if (freq->midpt[K-1] > plotmax) {
5337 plotmax = freq->midpt[K-1];
5338 }
5339
5340 fprintf(fp, "set xrange [%.10g:%.10g]\n", plotmin, plotmax);
5341 fputs("set key right top\n", fp);
5342 } else {
5343 /* plain frequency plot (no theoretical distribution shown) */
5344 lambda = 1.0 / freq->n;
5345 if (freq->strvals) {
5346 plotmin = 0.5;
5347 plotmax = K + 0.5;
5348 } else {
5349 plotmin = freq->midpt[0] - barwidth;
5350 plotmax = freq->midpt[K-1] + barwidth;
5351 }
5352 fprintf(fp, "set xrange [%.10g:%.10g]\n", plotmin, plotmax);
5353 maybe_set_yrange(freq, lambda, fp);
5354 fputs("set nokey\n", fp);
5355
5356 if (real_ns > 0) {
5357 fprintf(fp, "# literal lines = %d\n", real_ns);
5358 print_extra_literal_lines(S, ns, fp);
5359 }
5360 }
5361
5362 if (isnan(lambda)) {
5363 if (fp != NULL) {
5364 fclose(fp);
5365 }
5366 return 1;
5367 }
5368
5369 if (freq->strvals) {
5370 fprintf(fp, "set title \"%s: relative frequencies\"\n",
5371 freq->varname);
5372 } else {
5373 fprintf(fp, "set xlabel '%s'\n", freq->varname);
5374 if (dist) {
5375 fprintf(fp, "set ylabel '%s'\n", _("Density"));
5376 } else {
5377 fprintf(fp, "set ylabel '%s'\n", _("Relative frequency"));
5378 }
5379 }
5380
5381 if (freq->strvals) {
5382 fputs("set xtics rotate by -45\n", fp);
5383 fputs("set xtics (", fp);
5384 for (i=0; i<K; i++) {
5385 label = g_strdup(freq->S[i]);
5386 gretl_utf8_truncate(label, 6);
5387 fprintf(fp, "\"%s\" %d", label, i+1);
5388 if (i < K-1) {
5389 fputs(", ", fp);
5390 }
5391 g_free(label);
5392 }
5393 fputs(")\n", fp);
5394 } else if (freq->discrete > 1 && K < 10 && fabs(freq->midpt[K-1]) < 1000) {
5395 /* few values, all integers: force integer tic marks */
5396 fprintf(fp, "set xtics %.0f, 1, %.0f\n", freq->midpt[0],
5397 freq->midpt[K-1]);
5398 }
5399
5400 /* plot instructions */
5401 if (use_boxes) {
5402 fputs("set style fill solid 0.6\n", fp);
5403 strcpy(withstr, "w boxes");
5404 } else {
5405 strcpy(withstr, "w impulses lw 3");
5406 }
5407
5408 if (!dist) {
5409 fprintf(fp, "plot '-' using 1:2 %s\n", withstr);
5410 } else if (dist == D_NORMAL) {
5411 label = make_freq_dist_label(dist, freq->xbar, freq->sdx);
5412 fputs("plot \\\n", fp);
5413 fprintf(fp, "'-' using 1:2 title \"%s\" %s, \\\n"
5414 "1.0/(sqrt(2.0*pi)*sigma)*exp(-.5*((x-mu)/sigma)**2) "
5415 "title \"%s\" w lines\n",
5416 _("relative frequency"), withstr, label);
5417 g_free(label);
5418 } else if (dist == D_GAMMA) {
5419 label = make_freq_dist_label(dist, alpha, beta);
5420 fputs("plot \\\n", fp);
5421 fprintf(fp, "'-' using 1:2 title '%s' %s, \\\n"
5422 "x**(alpha-1.0)*exp(-x/beta)/(exp(lgamma(alpha))*(beta**alpha)) "
5423 "title \"%s\" w lines\n",
5424 _("relative frequency"), withstr, label);
5425 g_free(label);
5426 }
5427
5428 for (i=0; i<K; i++) {
5429 if (freq->midpt == NULL) {
5430 fprintf(fp, "%d %.10g\n", i + 1, lambda * freq->f[i]);
5431 } else {
5432 fprintf(fp, "%.10g %.10g\n", freq->midpt[i], lambda * freq->f[i]);
5433 }
5434 }
5435
5436 fputs("e\n", fp);
5437
5438 gretl_pop_c_numeric_locale();
5439
5440 return finalize_plot_input_file(fp);
5441 }
5442
5443 /**
5444 * plot_corrmat:
5445 * @corr: pointer to correlation matrix struct.
5446 * @opt: can use OPT_T for triangular representation.
5447 *
5448 * Produces a heatmap plot based on a correlation matrix.
5449 *
5450 * Returns: 0 on successful completion, error code on error.
5451 */
5452
plot_corrmat(VMatrix * corr,gretlopt opt)5453 int plot_corrmat (VMatrix *corr, gretlopt opt)
5454 {
5455 FILE *fp;
5456 double rcrit = 0.0;
5457 int i, j, df, n, idx;
5458 int allpos = 1;
5459 int err = 0;
5460
5461 fp = open_plot_input_file(PLOT_HEATMAP, 0, &err);
5462 if (err) {
5463 return err;
5464 }
5465
5466 n = corr->dim;
5467
5468 /* are all the correlations non-negative? */
5469 for (i=0; i<n; i++) {
5470 for (j=i+1; j<n; j++) {
5471 idx = ijton(i, j, n);
5472 if (corr->vec[idx] < 0) {
5473 allpos = 0;
5474 break;
5475 }
5476 }
5477 }
5478
5479 df = corr->n - 2;
5480 if (df > 1) {
5481 /* determine 20% critical value */
5482 double tc = student_critval(df, 0.10);
5483 double t2 = tc * tc;
5484
5485 rcrit = sqrt(t2 / (t2 + df));
5486 }
5487
5488 gretl_push_c_numeric_locale();
5489
5490 fprintf(fp, "set title '%s'\n", _("Correlation matrix"));
5491 fputs("set nokey\n", fp);
5492 fputs("set tics nomirror\n", fp);
5493
5494 if (allpos) {
5495 fputs("set cbrange [0:1]\n", fp);
5496 if (rcrit > 0) {
5497 fprintf(fp, "set palette defined (0 'white', %.4f 'white', 1 'red')\n",
5498 rcrit);
5499 } else {
5500 fputs("set palette defined (0 'white', 1 'red')\n", fp);
5501 }
5502 } else {
5503 fputs("set cbrange [-1:1]\n", fp);
5504 if (rcrit > 0) {
5505 fprintf(fp, "set palette defined (-1 'blue', %.4f 'white', %.4f 'white', 1 'red')\n",
5506 -rcrit, rcrit);
5507 } else {
5508 fputs("set palette defined (-1 'blue', 0 'white', 1 'red')\n", fp);
5509 }
5510 }
5511
5512 if (opt & OPT_T) {
5513 fputs("set border 3\n", fp);
5514 }
5515
5516 /* for grid lines */
5517 fputs("set x2tics 1 format '' scale 0,0.001\n", fp);
5518 fputs("set y2tics 1 format '' scale 0,0.001\n", fp);
5519 fputs("set mx2tics 2\n", fp);
5520 fputs("set my2tics 2\n", fp);
5521
5522 /* y-axis tics */
5523 fputs("set ytics (", fp);
5524 for (i=0; i<n; i++) {
5525 fprintf(fp, "\"%s\" %d", corr->names[i], n-i-1);
5526 if (i < n - 1) {
5527 fputs(", ", fp);
5528 }
5529 }
5530 fputs(") out\n", fp);
5531
5532 /* x-axis tics */
5533 fputs("set xtics (", fp);
5534 for (i=0; i<n; i++) {
5535 fprintf(fp, "\"%s\" %d", corr->names[i], i);
5536 if (i < n - 1) {
5537 fputs(", ", fp);
5538 }
5539 }
5540 fputs(") out\n", fp);
5541 fputs("set xtics rotate by 45 right\n", fp);
5542
5543 /* note: "set link" requires gnuplot 5 */
5544 fputs("set autoscale fix\n", fp);
5545 fputs("set link x\n", fp);
5546 fputs("set link y\n", fp);
5547 fputs("set grid front mx2tics my2tics lw 2 lt -1 lc rgb 'white'\n", fp);
5548
5549 gnuplot_missval_string(fp);
5550 fprintf(fp, "printcorr = %d\n", n <= 16 ? 1 : 0);
5551
5552 fputs("# start inline data\n", fp);
5553 fputs("$data << EOD\n", fp);
5554 for (i=0; i<n; i++) {
5555 for (j=0; j<n; j++) {
5556 if ((opt & OPT_T) && j > n-i-1) {
5557 write_gp_dataval(NADBL, fp, 0);
5558 } else {
5559 idx = ijton(n-i-1, j, n);
5560 fprintf(fp, "%.4f ", corr->vec[idx]);
5561 }
5562 }
5563 fputc('\n', fp);
5564 }
5565 fputs("EOD\n", fp);
5566 fputs("# end inline data\n", fp);
5567 fputs("if (printcorr) {\n", fp);
5568 fputs("plot $data matrix with image, $data matrix using 1:2:", fp);
5569 if (opt & OPT_T) {
5570 fputs("($3!=$3 ? \"\" : sprintf(\"%.1f\",$3)) with labels\n", fp);
5571 } else {
5572 fputs("(sprintf(\"%.1f\",$3)) with labels\n", fp);
5573 }
5574 fputs("} else {\n", fp);
5575 fputs("plot $data matrix with image\n", fp);
5576 fputs("}\n", fp);
5577
5578 gretl_pop_c_numeric_locale();
5579
5580 return finalize_plot_input_file(fp);
5581 }
5582
5583 /* print the y-axis data in the context of a forecast
5584 with errors plot
5585 */
5586
fcast_print_y_data(const double * x,const double * y,int t0,int t1,int t2,FILE * fp)5587 static void fcast_print_y_data (const double *x,
5588 const double *y,
5589 int t0, int t1, int t2,
5590 FILE *fp)
5591 {
5592 int i, t, n = t2 - t0 + 1;
5593 double yt;
5594
5595 for (i=0; i<n; i++) {
5596 t = t0 + i;
5597 yt = t < t1 ? NADBL : y[t];
5598 fprintf(fp, "%.10g ", x[t]);
5599 write_gp_dataval(yt, fp, 1);
5600 }
5601
5602 fputs("e\n", fp);
5603 }
5604
print_user_y_data(const double * x,const double * y,int t1,int t2,FILE * fp)5605 static void print_user_y_data (const double *x,
5606 const double *y,
5607 int t1, int t2,
5608 FILE *fp)
5609 {
5610 int t;
5611
5612 for (t=t1; t<=t2; t++) {
5613 fprintf(fp, "%.10g ", x[t]);
5614 write_gp_dataval(y[t], fp, 1);
5615 }
5616
5617 fputs("e\n", fp);
5618 }
5619
5620 enum {
5621 CONF_BARS,
5622 CONF_FILL,
5623 CONF_LOW,
5624 CONF_HIGH
5625 };
5626
print_confband_data(const double * x,const double * y,const double * e,int t0,int t1,int t2,int mode,FILE * fp)5627 static void print_confband_data (const double *x,
5628 const double *y,
5629 const double *e,
5630 int t0, int t1, int t2,
5631 int mode, FILE *fp)
5632 {
5633 int i, t, n = t2 - t0 + 1;
5634 double xt;
5635
5636 for (i=0; i<n; i++) {
5637 t = t0 + i;
5638 xt = x[t];
5639 if (t < t1 || na(y[t]) || na(e[t])) {
5640 if (mode == CONF_LOW || mode == CONF_HIGH) {
5641 fprintf(fp, "%.10g %s\n", xt, gpna);
5642 } else {
5643 fprintf(fp, "%.10g %s %s\n", xt, gpna, gpna);
5644 }
5645 } else if (mode == CONF_FILL) {
5646 fprintf(fp, "%.10g %.10g %.10g\n", xt, y[t] - e[t], y[t] + e[t]);
5647 } else if (mode == CONF_LOW) {
5648 fprintf(fp, "%.10g %.10g\n", xt, y[t] - e[t]);
5649 } else if (mode == CONF_HIGH) {
5650 fprintf(fp, "%.10g %.10g\n", xt, y[t] + e[t]);
5651 } else {
5652 fprintf(fp, "%.10g %.10g %.10g\n", xt, y[t], e[t]);
5653 }
5654 }
5655
5656 fputs("e\n", fp);
5657 }
5658
5659 #if 0 /* old, may want to reuse */
5660
5661 static void print_user_band_data (const double *x,
5662 const double *b1,
5663 const double *b2,
5664 int t1, int t2,
5665 int mode, FILE *fp)
5666 {
5667 int t;
5668
5669 for (t=t1; t<=t2; t++) {
5670 if (mode == CONF_FILL) {
5671 fprintf(fp, "%.10g %.10g %.10g\n", x[t], b1[t], b2[t]);
5672 } else {
5673 fprintf(fp, "%.10g %.10g\n", x[t], b1[t]);
5674 }
5675 }
5676
5677 fputs("e\n", fp);
5678
5679 if (mode != CONF_FILL) {
5680 for (t=t1; t<=t2; t++) {
5681 fprintf(fp, "%.10g %.10g\n", x[t], b2[t]);
5682 }
5683 fputs("e\n", fp);
5684 }
5685 }
5686
5687 #endif /* old */
5688
print_user_pm_data(const double * x,const double * c,const double * w,int t1,int t2,FILE * fp)5689 static void print_user_pm_data (const double *x,
5690 const double *c,
5691 const double *w,
5692 int t1, int t2,
5693 FILE *fp)
5694 {
5695 int t;
5696
5697 for (t=t1; t<=t2; t++) {
5698 if (na(c[t]) || na(w[t])) {
5699 fprintf(fp, "%.10g %s %s\n", x[t], gpna, gpna);
5700 } else {
5701 fprintf(fp, "%.10g %.10g %.10g\n", x[t], c[t], w[t]);
5702 }
5703 }
5704
5705 fputs("e\n", fp);
5706 }
5707
print_x_confband_data(const double * x,const double * y,const double * se,const int * order,double tval,int t1,int t2,int mode,FILE * fp)5708 static void print_x_confband_data (const double *x, const double *y,
5709 const double *se, const int *order,
5710 double tval, int t1, int t2,
5711 int mode, FILE *fp)
5712 {
5713 int i, t, n = t2 - t1 + 1;
5714 double et;
5715
5716 for (i=0; i<n; i++) {
5717 t = order[i];
5718 if (na(y[t]) || na(se[t])) {
5719 if (!na(x[t])) {
5720 fprintf(fp, "%.10g %s\n", x[t], gpna);
5721 }
5722 } else {
5723 et = tval * se[t];
5724 if (mode == CONF_LOW) {
5725 fprintf(fp, "%.10g %.10g\n", x[t], y[t] - et);
5726 } else if (mode == CONF_HIGH) {
5727 fprintf(fp, "%.10g %.10g\n", x[t], y[t] + et);
5728 }
5729 }
5730 }
5731
5732 fputs("e\n", fp);
5733 }
5734
5735 struct fsorter {
5736 int obs;
5737 double y;
5738 };
5739
compare_fs(const void * a,const void * b)5740 static int compare_fs (const void *a, const void *b)
5741 {
5742 const struct fsorter *fa = a;
5743 const struct fsorter *fb = b;
5744
5745 return (fa->y > fb->y) - (fa->y < fb->y);
5746 }
5747
print_filledcurve_line(const char * title,const char * rgb,FILE * fp)5748 static void print_filledcurve_line (const char *title,
5749 const char *rgb,
5750 FILE *fp)
5751 {
5752 char cstr[10];
5753
5754 if (rgb != NULL && *rgb != '\0') {
5755 *cstr = '\0';
5756 strncat(cstr, rgb, 9);
5757 } else {
5758 print_rgb_hash(cstr, get_shadecolor());
5759 }
5760
5761 if (title == NULL) {
5762 fprintf(fp, "'-' using 1:2:3 notitle lc rgb \"%s\" w filledcurve, \\\n",
5763 cstr);
5764 } else {
5765 fprintf(fp, "'-' using 1:2:3 title '%s' lc rgb \"%s\" w filledcurve, \\\n",
5766 title, cstr);
5767 }
5768 }
5769
print_pm_filledcurve_line(double factor,const char * title,const char * rgb,FILE * fp)5770 static void print_pm_filledcurve_line (double factor,
5771 const char *title,
5772 const char *rgb,
5773 FILE *fp)
5774 {
5775 char cstr[10];
5776
5777 if (rgb != NULL && *rgb != '\0') {
5778 *cstr = '\0';
5779 strncat(cstr, rgb, 9);
5780 } else {
5781 print_rgb_hash(cstr, get_shadecolor());
5782 }
5783
5784 if (title == NULL) {
5785 fprintf(fp, "'-' using 1:($2-%g*$3):($2+%g*$3) "
5786 "notitle lc rgb \"%s\" w filledcurve, \\\n",
5787 factor, factor, cstr);
5788 } else {
5789 fprintf(fp, "'-' using 1:($2-%g*$3):($2+%g*$3) "
5790 "title '%s' lc rgb \"%s\" w filledcurve, \\\n",
5791 factor, factor, title, cstr);
5792 }
5793 }
5794
5795 /* note: if @opt includes OPT_H, that says to show fitted
5796 values for the pre-forecast range
5797 */
5798
plot_fcast_errs(const FITRESID * fr,const double * maxerr,const DATASET * dset,gretlopt opt)5799 int plot_fcast_errs (const FITRESID *fr, const double *maxerr,
5800 const DATASET *dset, gretlopt opt)
5801 {
5802 FILE *fp = NULL;
5803 const double *obs = NULL;
5804 GptFlags flags = 0;
5805 double xmin, xmax, xrange;
5806 int depvar_present = 0;
5807 int use_fill = 0, use_lines = 0;
5808 int do_errs = (maxerr != NULL);
5809 gchar *cistr = NULL;
5810 int t2 = fr->t2;
5811 int t1, yhmin;
5812 int t, n, err = 0;
5813
5814 /* note: yhmin is the first obs at which to start plotting y-hat */
5815 if (do_errs) {
5816 t1 = fr->t0;
5817 yhmin = (opt & OPT_H)? fr->t0 : fr->t1;
5818 } else {
5819 t1 = (fr->t0 >= 0)? fr->t0 : 0;
5820 /* was: yhmin = t1; */
5821 yhmin = (opt & OPT_H)? t1 : fr->t1;
5822 }
5823
5824 /* don't graph empty trailing portion of forecast */
5825 for (t=fr->t2; t>=t1; t--) {
5826 if (na(fr->actual[t]) && na(fr->fitted[t])) {
5827 t2--;
5828 } else {
5829 break;
5830 }
5831 }
5832
5833 n = t2 - t1 + 1;
5834
5835 if (n < 3) {
5836 /* we won't draw a graph for 2 data points or less */
5837 return 1;
5838 }
5839
5840 obs = gretl_plotx(dset, OPT_NONE);
5841 if (obs == NULL) {
5842 return E_ALLOC;
5843 }
5844
5845 fp = open_plot_input_file(PLOT_FORECAST, flags, &err);
5846 if (err) {
5847 return err;
5848 }
5849
5850 /* check that we have any values for the actual var */
5851 for (t=t1; t<=t2; t++) {
5852 if (!na(fr->actual[t])) {
5853 depvar_present = 1;
5854 break;
5855 }
5856 }
5857
5858 if (do_errs) {
5859 if (opt & OPT_F) {
5860 use_fill = 1;
5861 } else if (opt & OPT_L) {
5862 use_lines = 1;
5863 }
5864 }
5865
5866 gretl_minmax(t1, t2, obs, &xmin, &xmax);
5867 xrange = xmax - xmin;
5868 xmin -= xrange * .025;
5869 xmax += xrange * .025;
5870
5871 gretl_push_c_numeric_locale();
5872 fprintf(fp, "set xrange [%.10g:%.10g]\n", xmin, xmax);
5873 gretl_pop_c_numeric_locale();
5874
5875 gnuplot_missval_string(fp);
5876
5877 if (dataset_is_time_series(dset)) {
5878 fprintf(fp, "# timeseries %d\n", dset->pd);
5879 }
5880
5881 if (do_errs && !use_fill && !use_lines && n > 150) {
5882 use_fill = 1;
5883 }
5884
5885 fputs("set key left top\n", fp);
5886 fputs("set xzeroaxis\n", fp);
5887 fputs("plot \\\n", fp);
5888
5889 if (do_errs) {
5890 cistr = g_strdup_printf(_("%g percent interval"), 100 * (1 - fr->alpha));
5891 }
5892
5893 if (use_fill) {
5894 /* plot the confidence band first so the other lines
5895 come out on top */
5896 if (do_errs) {
5897 print_filledcurve_line(cistr, NULL, fp);
5898 }
5899 if (depvar_present) {
5900 fprintf(fp, "'-' using 1:2 title '%s' w lines lt 1, \\\n",
5901 fr->depvar);
5902 }
5903 fprintf(fp, "'-' using 1:2 title '%s' w lines lt 2\n", _("forecast"));
5904 } else {
5905 /* plot confidence bands last */
5906 if (depvar_present) {
5907 fprintf(fp, "'-' using 1:2 title '%s' w lines, \\\n",
5908 fr->depvar);
5909 }
5910 fprintf(fp, "'-' using 1:2 title '%s' w lines", _("forecast"));
5911 if (do_errs) {
5912 if (use_lines) {
5913 fprintf(fp, ", \\\n'-' using 1:2 title '%s' w lines, \\\n",
5914 cistr);
5915 fputs("'-' using 1:2 notitle '%s' w lines lt 3\n", fp);
5916 } else {
5917 fprintf(fp, ", \\\n'-' using 1:2:3 title '%s' w errorbars\n",
5918 cistr);
5919 }
5920 } else {
5921 fputc('\n', fp);
5922 }
5923 }
5924
5925 g_free(cistr);
5926
5927 gretl_push_c_numeric_locale();
5928
5929 /* write out the inline data, the order depending on whether
5930 or not we're using fill style for the confidence bands
5931 */
5932
5933 if (use_fill) {
5934 if (do_errs) {
5935 print_confband_data(obs, fr->fitted, maxerr,
5936 t1, yhmin, t2, CONF_FILL, fp);
5937 }
5938 if (depvar_present) {
5939 fcast_print_y_data(obs, fr->actual, t1, t1, t2, fp);
5940 }
5941 fcast_print_y_data(obs, fr->fitted, t1, yhmin, t2, fp);
5942 } else {
5943 if (depvar_present) {
5944 fcast_print_y_data(obs, fr->actual, t1, t1, t2, fp);
5945 }
5946 fcast_print_y_data(obs, fr->fitted, t1, yhmin, t2, fp);
5947 if (do_errs) {
5948 if (use_lines) {
5949 print_confband_data(obs, fr->fitted, maxerr,
5950 t1, yhmin, t2, CONF_LOW, fp);
5951 print_confband_data(obs, fr->fitted, maxerr,
5952 t1, yhmin, t2, CONF_HIGH, fp);
5953 } else {
5954 print_confband_data(obs, fr->fitted, maxerr,
5955 t1, yhmin, t2, CONF_BARS, fp);
5956 }
5957 }
5958 }
5959
5960 gretl_pop_c_numeric_locale();
5961
5962 return finalize_plot_input_file(fp);
5963 }
5964
5965 enum {
5966 BAND_LINE,
5967 BAND_FILL,
5968 BAND_DASH,
5969 BAND_BARS,
5970 BAND_STEP
5971 };
5972
5973 struct band_pm {
5974 int center;
5975 int width;
5976 double factor;
5977 int bdummy;
5978 };
5979
5980 /* Handle the special case where we get to the band-plot code
5981 from a "plot" block in which the data to be plotted (and
5982 hence also the band specification) are given in matrix
5983 form. By this point the plot-data have been converted to
5984 (temporary) DATASET form; here we retrieve the band-spec
5985 matrix, check it for conformability, and stick the two
5986 extra columns onto the dataset (borrowing pointers into
5987 the matrix content).
5988 */
5989
process_band_matrix(const int * list,DATASET * dset,struct band_pm * pm,int ** plist)5990 static int process_band_matrix (const int *list,
5991 DATASET *dset,
5992 struct band_pm *pm,
5993 int **plist)
5994 {
5995 const char *s = get_optval_string(PLOT, OPT_N);
5996 gretl_matrix *m = NULL;
5997 gchar **S;
5998 int i = 0;
5999 int err = 0;
6000
6001 if (s == NULL) {
6002 return E_INVARG;
6003 }
6004
6005 S = g_strsplit(s, ",", -1);
6006
6007 while (S != NULL && S[i] != NULL && !err) {
6008 if (i == 0) {
6009 m = get_matrix_by_name(S[i]);
6010 if (m == NULL || m->cols != 2 || m->rows != dset->n) {
6011 /* missing or non-conformable */
6012 err = invalid_field_error(S[i]);
6013 } else {
6014 /* the last two series in expanded dataset */
6015 pm->center = dset->v;
6016 pm->width = dset->v + 1;
6017 }
6018 } else if (i == 1) {
6019 /* spec for width multiplier: optional */
6020 if (numeric_string(S[i])) {
6021 pm->factor = dot_atof(S[i]);
6022 } else if (gretl_is_scalar(S[i])) {
6023 pm->factor = gretl_scalar_get_value(S[i], &err);
6024 } else {
6025 err = invalid_field_error(S[i]);
6026 }
6027 } else {
6028 /* we got too many comma-separated terms */
6029 err = invalid_field_error(S[i]);
6030 }
6031 i++;
6032 }
6033
6034 g_strfreev(S);
6035
6036 if (!err && (pm->factor < 0 || na(pm->factor))) {
6037 err = E_INVARG;
6038 }
6039
6040 if (!err) {
6041 /* enlarge the dset->Z array */
6042 int newv = dset->v + 2;
6043 double **tmp = realloc(dset->Z, newv * sizeof *tmp);
6044
6045 if (tmp == NULL) {
6046 err = E_ALLOC;
6047 } else {
6048 /* note: we don't need varnames here */
6049 dset->Z = tmp;
6050 dset->Z[dset->v] = m->val;
6051 dset->Z[dset->v+1] = m->val + m->rows;
6052 dset->v += 2;
6053 }
6054 }
6055
6056 if (!err) {
6057 *plist = gretl_list_copy(list);
6058 gretl_list_append_term(plist, pm->center);
6059 gretl_list_append_term(plist, pm->width);
6060 }
6061
6062 return err;
6063 }
6064
6065 /* Handle the band plus-minus option for all cases apart
6066 from the special one handled just above. Here we require
6067 two comma-separated series identifiers for center and
6068 width.
6069 */
6070
parse_band_pm_option(const int * list,const DATASET * dset,gretlopt opt,struct band_pm * pm,int ** plist)6071 static int parse_band_pm_option (const int *list,
6072 const DATASET *dset,
6073 gretlopt opt,
6074 struct band_pm *pm,
6075 int **plist)
6076 {
6077 const char *s = get_optval_string(plot_ci, OPT_N);
6078 gchar **S;
6079 int cpos = 0, wpos = 0;
6080 int v, pos, i = 0;
6081 int err = 0;
6082
6083 if (s == NULL) {
6084 return E_INVARG;
6085 }
6086
6087 if (strchr(s, ',') == NULL) {
6088 /* a single field: try for "recession bars" */
6089 v = current_series_index(dset, s);
6090 if (v >= 0 && v < dset->v) {
6091 if (gretl_isdummy(dset->t1, dset->t2, dset->Z[v])) {
6092 pm->bdummy = v;
6093 } else {
6094 err = E_INVARG;
6095 fprintf(stderr, "%s: not a dummy variable\n",
6096 dset->varname[v]);
6097 }
6098 } else {
6099 err = E_INVARG;
6100 }
6101 return err;
6102 }
6103
6104 /* at this point, can't be a recession-style band */
6105 S = g_strsplit(s, ",", -1);
6106
6107 while (S != NULL && S[i] != NULL && !err) {
6108 if (i < 2) {
6109 /* specs for the "center" and "width" series: required */
6110 if (opt & OPT_X) {
6111 /* special for matrix-derived dataset */
6112 v = (i == 0)? dset->v - 2 : dset->v - 1;
6113 } else if (integer_string(S[i])) {
6114 /* var ID number? */
6115 v = atoi(S[i]);
6116 } else {
6117 /* varname? */
6118 v = current_series_index(dset, S[i]);
6119 }
6120 if (v >= 0 && v < dset->v) {
6121 pos = in_gretl_list(list, v);
6122 if (i == 0) {
6123 pm->center = v;
6124 cpos = pos;
6125 } else {
6126 pm->width = v;
6127 wpos = pos;
6128 }
6129 } else {
6130 err = invalid_field_error(S[i]);
6131 }
6132 } else if (i == 2) {
6133 /* spec for width multiplier: optional */
6134 if (numeric_string(S[i])) {
6135 pm->factor = dot_atof(S[i]);
6136 } else if (gretl_is_scalar(S[i])) {
6137 pm->factor = gretl_scalar_get_value(S[i], &err);
6138 } else {
6139 /* FIXME support named vector */
6140 err = invalid_field_error(S[i]);
6141 }
6142 } else {
6143 /* we got too many comma-separated terms */
6144 err = invalid_field_error(S[i]);
6145 }
6146 i++;
6147 }
6148
6149 g_strfreev(S);
6150
6151 #if 0
6152 fprintf(stderr, "pm err = %d\n", err);
6153 fprintf(stderr, "pm center = %d (pos %d)\n", pm->center, cpos);
6154 fprintf(stderr, "pm width = %d (pos %d)\n", pm->width, wpos);
6155 fprintf(stderr, "pm factor = %g\n", pm->factor);
6156 #endif
6157
6158 if (!err) {
6159 if (pm->center < 0 || pm->width < 0 ||
6160 pm->factor < 0 || na(pm->factor)) {
6161 err = E_INVARG;
6162 }
6163 }
6164
6165 if (!err && (cpos == 0 || wpos == 0)) {
6166 /* stick the "extra" series into *plist so we
6167 can check all series for NAs
6168 */
6169 *plist = gretl_list_copy(list);
6170 if (cpos == 0) {
6171 gretl_list_append_term(plist, pm->center);
6172 }
6173 if (wpos == 0) {
6174 gretl_list_append_term(plist, pm->width);
6175 }
6176 }
6177
6178 return err;
6179 }
6180
parse_gnuplot_color(const char * s,char * targ)6181 int parse_gnuplot_color (const char *s, char *targ)
6182 {
6183 int hexcheck = 0;
6184 int err = 0;
6185
6186 if (*s == '0') {
6187 /* should be 0xRRGGBB */
6188 if (strlen(s) != 8) {
6189 err = invalid_field_error(s);
6190 } else {
6191 sprintf(targ, "#%s", s + 2);
6192 hexcheck = 1;
6193 }
6194 } else if (*s == '#') {
6195 /* should be #RRGGBB */
6196 if (strlen(s) != 7) {
6197 err = invalid_field_error(s);
6198 } else {
6199 strcpy(targ, s);
6200 hexcheck = 1;
6201 }
6202 } else {
6203 /* should be gnuplot colorname: look it up */
6204 if (strlen(s) < 3 || strlen(s) > 17) {
6205 err = invalid_field_error(s);
6206 } else {
6207 char fname[FILENAME_MAX];
6208 FILE *fp;
6209
6210 sprintf(fname, "%sdata%cgnuplot%cgpcolors.txt",
6211 gretl_home(), SLASH, SLASH);
6212 fp = gretl_fopen(fname, "r");
6213
6214 if (fp == NULL) {
6215 err = E_FOPEN;
6216 } else {
6217 char line[32], cname[18], rgb[8];
6218
6219 while (fgets(line, sizeof line, fp)) {
6220 if (sscanf(line, "%s %s", cname, rgb) == 2 &&
6221 strcmp(s, cname) == 0) {
6222 sprintf(targ, "#%s", rgb);
6223 break;
6224 }
6225 }
6226 fclose(fp);
6227 if (*targ != '#') {
6228 err = invalid_field_error(s);
6229 }
6230 }
6231 }
6232 }
6233
6234 if (hexcheck) {
6235 char *test = NULL;
6236
6237 strtoul(targ + 1, &test, 16);
6238 if (*test != '\0') {
6239 err = invalid_field_error(s);
6240 }
6241 }
6242
6243 return err;
6244 }
6245
6246 /* We're looking here for any one of three patterns:
6247
6248 <style>
6249 <style>,<color>
6250 <color>
6251
6252 where <style> should be "fill", "dash" or "line" (the
6253 default) and <color> should be a hex string such as
6254 "#00ff00" or "0x00ff00".
6255 */
6256
parse_band_style_option(struct band_pm * pm,int * style,char * rgb)6257 static int parse_band_style_option (struct band_pm *pm,
6258 int *style, char *rgb)
6259 {
6260 const char *s = get_optval_string(plot_ci, OPT_J);
6261 int err = 0;
6262
6263 if (s != NULL) {
6264 const char *p = strchr(s, ',');
6265
6266 if (pm->bdummy && *s != ',') {
6267 /* must be just a color */
6268 err = parse_gnuplot_color(s, rgb);
6269 } else if (*s == ',') {
6270 /* skipping field 1, going straight to color */
6271 err = parse_gnuplot_color(s + 1, rgb);
6272 } else if (p == NULL) {
6273 /* just got field 1, style spec */
6274 if (!strcmp(s, "fill")) {
6275 *style = BAND_FILL;
6276 } else if (!strcmp(s, "dash")) {
6277 *style = BAND_DASH;
6278 } else if (!strcmp(s, "line")) {
6279 *style = BAND_LINE;
6280 } else if (!strcmp(s, "bars")) {
6281 *style = BAND_BARS;
6282 } else if (!strcmp(s, "step")) {
6283 *style = BAND_STEP;
6284 } else {
6285 err = invalid_field_error(s);
6286 }
6287 } else {
6288 /* embedded comma: style + color */
6289 if (strlen(s) < 8) {
6290 err = invalid_field_error(s);
6291 } else if (!strncmp(s, "fill,", 5)) {
6292 *style = BAND_FILL;
6293 } else if (!strncmp(s, "dash,", 5)) {
6294 *style = BAND_DASH;
6295 } else if (!strncmp(s, "line,", 5)) {
6296 *style = BAND_LINE;
6297 } else if (!strncmp(s, "bars,", 5)) {
6298 *style = BAND_BARS;
6299 } else if (!strncmp(s, "step,", 5)) {
6300 *style = BAND_STEP;
6301 } else {
6302 err = invalid_field_error(s);
6303 }
6304 if (!err) {
6305 err = parse_gnuplot_color(s + 5, rgb);
6306 }
6307 }
6308 }
6309
6310 return err;
6311 }
6312
6313 /* write "recession bars" as gnuplot rectangle objects, using
6314 the dummy variable @d for on/off information
6315 */
6316
write_rectangles(gnuplot_info * gi,char * rgb,const double * d,int t1,int t2,DATASET * dset,FILE * fp)6317 static int write_rectangles (gnuplot_info *gi,
6318 char *rgb,
6319 const double *d,
6320 int t1, int t2,
6321 DATASET *dset,
6322 FILE *fp)
6323 {
6324 char stobs[16], endobs[16];
6325 int bar_on = 0, obj = 1;
6326 int t, err = 0;
6327
6328 if (gi->x == NULL) {
6329 return E_DATA;
6330 }
6331
6332 if (*rgb == '\0') {
6333 strcpy(rgb, "#dddddd");
6334 }
6335
6336 *stobs = *endobs = '\0';
6337
6338 for (t=t1; t<=t2; t++) {
6339 if (na(d[t])) {
6340 err = E_MISSDATA;
6341 break;
6342 }
6343 if (bar_on && d[t] == 0) {
6344 /* finalize a bar */
6345 sprintf(endobs, "%g", gi->x[t]);
6346 fprintf(fp, "set object %d rectangle from %s, graph 0 to %s, graph 1 back "
6347 "fillstyle solid 0.5 noborder fc rgb \"%s\"\n",
6348 obj++, stobs, endobs, rgb);
6349 bar_on = 0;
6350 } else if (!bar_on && d[t] != 0) {
6351 /* start a bar */
6352 sprintf(stobs, "%g", gi->x[t]);
6353 bar_on = 1;
6354 }
6355 }
6356
6357 if (bar_on) {
6358 /* terminate an unfinished bar */
6359 sprintf(endobs, "%g", gi->x[t2]);
6360 fprintf(fp, "set object rectangle from %s, graph 0 to %s, graph 1 back "
6361 "fillstyle solid 0.5 noborder fc rgb \"%s\"\n",
6362 stobs, endobs, rgb);
6363 }
6364
6365 return err;
6366 }
6367
band_straddles_zero(const double * c,const double * w,double factor,int t1,int t2)6368 static int band_straddles_zero (const double *c,
6369 const double *w,
6370 double factor,
6371 int t1, int t2)
6372 {
6373 int t, lt0 = 0, gt0 = 0;
6374 double b1, b2;
6375
6376 for (t=t1; t<=t2; t++) {
6377 b1 = c[t] - w[t] * factor;
6378 b2 = c[t] + w[t] * factor;
6379 if (b1 < 0 || b2 < 0) {
6380 lt0 = 1;
6381 }
6382 if (b1 > 0 || b2 > 0) {
6383 gt0 = 1;
6384 }
6385 if (lt0 && gt0) {
6386 return 1;
6387 }
6388 }
6389
6390 return 0;
6391 }
6392
plot_with_band(int mode,gnuplot_info * gi,const char * literal,DATASET * dset,gretlopt opt)6393 static int plot_with_band (int mode, gnuplot_info *gi,
6394 const char *literal,
6395 DATASET *dset,
6396 gretlopt opt)
6397 {
6398 struct band_pm pm = {-1, -1, 1.0, 0};
6399 FILE *fp = NULL;
6400 const double *x = NULL;
6401 const double *y = NULL;
6402 const double *c = NULL;
6403 const double *w = NULL;
6404 const double *d = NULL;
6405 char yname[MAXDISP];
6406 char xname[MAXDISP];
6407 char rgb[10] = {0};
6408 char wspec[16] = {0};
6409 int *biglist = NULL;
6410 int style = BAND_LINE;
6411 int show_zero = 0;
6412 int t1 = dset->t1;
6413 int t2 = dset->t2;
6414 int i, n_yvars = 0;
6415 int err = 0;
6416
6417 if (mode == BP_BLOCKMAT) {
6418 /* Coming from a "plot" block in matrix mode: in this case the
6419 band should be given in the form of a named matrix with
6420 two columns holding center and width, respectively.
6421 */
6422 err = process_band_matrix(gi->list, dset, &pm, &biglist);
6423 } else {
6424 err = parse_band_pm_option(gi->list, dset, opt, &pm, &biglist);
6425 }
6426
6427 if (!err && (opt & OPT_J)) {
6428 err = parse_band_style_option(&pm, &style, rgb);
6429 }
6430
6431 if (!err) {
6432 if (biglist != NULL) {
6433 err = graph_list_adjust_sample(biglist, gi, dset, 1);
6434 } else {
6435 err = graph_list_adjust_sample(gi->list, gi, dset, 1);
6436 }
6437 if (!err) {
6438 t1 = gi->t1;
6439 t2 = gi->t2;
6440 }
6441 }
6442
6443 free(biglist);
6444
6445 if (err) {
6446 return err;
6447 }
6448
6449 if (gi->flags & (GPT_TS | GPT_IDX)) {
6450 x = gi->x;
6451 *xname = '\0';
6452 if (gi->flags & GPT_TS) {
6453 gi->flags |= GPT_LETTERBOX;
6454 }
6455 } else {
6456 int xno = gi->list[gi->list[0]];
6457
6458 x = dset->Z[xno];
6459 strcpy(xname, series_get_graph_name(dset, xno));
6460 }
6461
6462 n_yvars = gi->list[0] - 1;
6463
6464 fp = open_plot_input_file(PLOT_BAND, gi->flags, &err);
6465 if (err) {
6466 return err;
6467 }
6468
6469 /* assemble the data we'll need */
6470 if (pm.bdummy) {
6471 d = dset->Z[pm.bdummy];
6472 } else {
6473 c = dset->Z[pm.center];
6474 w = dset->Z[pm.width];
6475 show_zero = band_straddles_zero(c, w, pm.factor, t1, t2);
6476 }
6477
6478 if (gi->flags & GPT_TS) {
6479 PRN *prn = gretl_print_new_with_stream(fp);
6480
6481 make_time_tics(gi, dset, 0, NULL, prn);
6482 gretl_print_detach_stream(prn);
6483 gretl_print_destroy(prn);
6484 }
6485
6486 if (n_yvars == 1) {
6487 fputs("set nokey\n", fp);
6488 strcpy(yname, series_get_graph_name(dset, gi->list[1]));
6489 fprintf(fp, "set ylabel \"%s\"\n", yname);
6490 }
6491 if (*xname != '\0') {
6492 fprintf(fp, "set xlabel \"%s\"\n", xname);
6493 }
6494 if (show_zero && style != BAND_FILL) {
6495 fputs("set xzeroaxis\n", fp);
6496 }
6497
6498 gretl_push_c_numeric_locale();
6499
6500 if (gi->x != NULL) {
6501 /* FIXME case of gi->x == NULL? */
6502 print_x_range(gi, fp);
6503 }
6504
6505 print_gnuplot_literal_lines(literal, GNUPLOT, OPT_NONE, fp);
6506
6507 if (pm.bdummy) {
6508 /* write out the rectangles */
6509 write_rectangles(gi, rgb, d, t1, t2, dset, fp);
6510 }
6511
6512 if (pm.bdummy) {
6513 int oddman = 0;
6514
6515 if (!(opt & OPT_Y)) {
6516 check_for_yscale(gi, (const double **) dset->Z, &oddman);
6517 if (gi->flags & GPT_Y2AXIS) {
6518 fputs("set ytics nomirror\n", fp);
6519 fputs("set y2tics\n", fp);
6520 }
6521 }
6522
6523 fputs("plot \\\n", fp);
6524
6525 /* plot the actual data */
6526 for (i=1; i<=n_yvars; i++) {
6527 const char *iname = series_get_graph_name(dset, gi->list[i]);
6528
6529 set_withstr(gi, i, wspec);
6530 if (gi->flags & GPT_Y2AXIS) {
6531 fprintf(fp, "'-' using 1:2 axes %s title \"%s (%s)\" %s lt %d",
6532 (i == oddman)? "x1y2" : "x1y1", iname,
6533 (i == oddman)? _("right") : _("left"),
6534 wspec, i);
6535 } else {
6536 fprintf(fp, "'-' using 1:2 title \"%s\" %s lt %d", iname, wspec, i);
6537 }
6538 if (i < n_yvars) {
6539 fputs(", \\\n", fp);
6540 } else {
6541 fputc('\n', fp);
6542 }
6543 }
6544 /* and write the data block */
6545 for (i=0; i<n_yvars; i++) {
6546 y = dset->Z[gi->list[i+1]];
6547 print_user_y_data(x, y, t1, t2, fp);
6548 }
6549 goto finish;
6550 }
6551
6552 fputs("plot \\\n", fp);
6553
6554 if (style == BAND_FILL) {
6555 /* plot the confidence band first, so the other lines
6556 come out on top */
6557 print_pm_filledcurve_line(pm.factor, NULL, rgb, fp);
6558 if (show_zero) {
6559 fputs("0 notitle w lines lt 0, \\\n", fp);
6560 }
6561 /* plot the non-band data */
6562 for (i=1; i<=n_yvars; i++) {
6563 const char *iname = series_get_graph_name(dset, gi->list[i]);
6564
6565 set_withstr(gi, i, wspec);
6566 fprintf(fp, "'-' using 1:2 title '%s' %s lt %d", iname, wspec, i);
6567 if (i == n_yvars) {
6568 fputc('\n', fp);
6569 } else {
6570 fputs(", \\\n", fp);
6571 }
6572 }
6573 } else {
6574 char lspec[24], dspec[8];
6575
6576 *lspec = *dspec = '\0';
6577
6578 /* plot the non-band data first */
6579 for (i=1; i<=n_yvars; i++) {
6580 const char *iname = series_get_graph_name(dset, gi->list[i]);
6581
6582 set_withstr(gi, i, wspec);
6583 fprintf(fp, "'-' using 1:2 title '%s' %s lt %d, \\\n", iname, wspec, i);
6584 }
6585 if (*rgb != '\0') {
6586 sprintf(lspec, "lc rgb \"%s\"", rgb);
6587 } else {
6588 sprintf(lspec, "lt %d", n_yvars + 1);
6589 }
6590 if (style == BAND_DASH) {
6591 strcpy(dspec, " dt 2");
6592 }
6593 /* then the confidence band */
6594 if (style == BAND_BARS) {
6595 fprintf(fp, "'-' using 1:2:(%g*$3) w errorbars %s%s\n",
6596 pm.factor, lspec, dspec);
6597 } else {
6598 char *wstr = style == BAND_STEP ? "steps" : "lines";
6599
6600 fprintf(fp, "'-' using 1:($2-%g*$3) notitle w %s %s%s, \\\n",
6601 pm.factor, wstr, lspec, dspec);
6602 fprintf(fp, "'-' using 1:($2+%g*$3) notitle w %s %s%s\n",
6603 pm.factor, wstr, lspec, dspec);
6604 }
6605 }
6606
6607 /* write out the inline data, the order depending on whether
6608 or not we're using fill style for the band
6609 */
6610
6611 if (style == BAND_FILL) {
6612 print_user_pm_data(x, c, w, t1, t2, fp);
6613 for (i=0; i<n_yvars; i++) {
6614 y = dset->Z[gi->list[i+1]];
6615 print_user_y_data(x, y, t1, t2, fp);
6616 }
6617 } else {
6618 for (i=0; i<n_yvars; i++) {
6619 y = dset->Z[gi->list[i+1]];
6620 print_user_y_data(x, y, t1, t2, fp);
6621 }
6622 print_user_pm_data(x, c, w, t1, t2, fp);
6623 if (style != BAND_BARS) {
6624 print_user_pm_data(x, c, w, t1, t2, fp);
6625 }
6626 }
6627
6628 finish:
6629
6630 gretl_pop_c_numeric_locale();
6631
6632 err = finalize_plot_input_file(fp);
6633 clear_gpinfo(gi);
6634
6635 if (mode == BP_BLOCKMAT) {
6636 /* hide the two extra dataset columns
6637 representing the band */
6638 dset->v -= 2;
6639 }
6640
6641 return err;
6642 }
6643
get_x_sorted_order(const FITRESID * fr,const double * x,int t1,int * pt2)6644 static int *get_x_sorted_order (const FITRESID *fr,
6645 const double *x,
6646 int t1, int *pt2)
6647 {
6648 int *order = NULL;
6649 struct fsorter *fs;
6650 int nmiss = 0;
6651 int t2 = *pt2;
6652 int n = t2 - t1 + 1;
6653 int i, t;
6654
6655 for (t=t1; t<=t2; t++) {
6656 if (na(fr->actual[t])) {
6657 nmiss++;
6658 }
6659 }
6660
6661 fs = malloc(n * sizeof *fs);
6662 if (fs == NULL) {
6663 return NULL;
6664 }
6665
6666 order = malloc(n * sizeof *order);
6667 if (order == NULL) {
6668 free(fs);
6669 return NULL;
6670 }
6671
6672 for (i=0, t=t1; t<=t2; t++, i++) {
6673 fs[i].obs = t;
6674 fs[i].y = x[t];
6675 }
6676
6677 qsort(fs, n, sizeof *fs, compare_fs);
6678
6679 for (i=0; i<n; i++) {
6680 order[i] = fs[i].obs;
6681 }
6682
6683 free(fs);
6684
6685 if (nmiss > 0) {
6686 /* chop off trailing NAs */
6687 *pt2 = (n - nmiss) + t1 - 1;
6688 }
6689
6690 return order;
6691 }
6692
print_x_ordered_data(const double * x,const double * y,const int * order,int t1,int t2,FILE * fp)6693 static void print_x_ordered_data (const double *x, const double *y,
6694 const int *order, int t1, int t2,
6695 FILE *fp)
6696 {
6697 int i, t, n = t2 - t1 + 1;
6698
6699 for (i=0; i<n; i++) {
6700 t = order[i];
6701 if (na(x[t])) {
6702 continue;
6703 } else if (na(y[t])) {
6704 fprintf(fp, "%.10g %s\n", x[t], gpna);
6705 } else {
6706 fprintf(fp, "%.10g %.10g\n", x[t], y[t]);
6707 }
6708 }
6709
6710 fputs("e\n", fp);
6711 }
6712
6713 /* Plotting routine for a simple regression where we want to show
6714 actual and forecast y, plus confidence bands, against x.
6715 We use lines to indicate the confidence bands.
6716 */
6717
plot_simple_fcast_bands(const MODEL * pmod,const FITRESID * fr,const DATASET * dset,gretlopt opt)6718 int plot_simple_fcast_bands (const MODEL *pmod,
6719 const FITRESID *fr,
6720 const DATASET *dset,
6721 gretlopt opt)
6722 {
6723 FILE *fp = NULL;
6724 const double *x = NULL;
6725 int *order = NULL;
6726 GptFlags flags = 0;
6727 double a, xmin, xmax, xrange, tval;
6728 int xv = pmod->list[3];
6729 gchar *cistr;
6730 int t2 = fr->t2;
6731 int t1, yhmin;
6732 int t, n, err = 0;
6733
6734 /* note: yhmin is the first obs at which to start plotting y-hat */
6735 t1 = fr->t0;
6736 yhmin = (opt & OPT_H)? fr->t0 : fr->t1;
6737
6738 /* don't graph empty trailing portion of forecast */
6739 for (t=fr->t2; t>=t1; t--) {
6740 if (na(fr->actual[t]) && na(fr->fitted[t])) {
6741 t2--;
6742 } else {
6743 break;
6744 }
6745 }
6746
6747 n = t2 - t1 + 1;
6748
6749 if (n < 3) {
6750 /* won't draw a graph for 2 data points or less */
6751 return 1;
6752 }
6753
6754 x = dset->Z[xv];
6755
6756 order = get_x_sorted_order(fr, x, t1, &t2);
6757 if (order == NULL) {
6758 return E_ALLOC;
6759 }
6760
6761 fp = open_plot_input_file(PLOT_FORECAST, flags, &err);
6762 if (err) {
6763 return err;
6764 }
6765
6766 gretl_minmax(t1, t2, x, &xmin, &xmax);
6767 xrange = xmax - xmin;
6768 xmin -= xrange * .025;
6769 xmax += xrange * .025;
6770
6771 gretl_push_c_numeric_locale();
6772 fprintf(fp, "set xrange [%.10g:%.10g]\n", xmin, xmax);
6773 gretl_pop_c_numeric_locale();
6774
6775 gnuplot_missval_string(fp);
6776
6777 fprintf(fp, "set xlabel \"%s\"\n", dset->varname[xv]);
6778 fprintf(fp, "set ylabel \"%s\"\n", fr->depvar);
6779
6780 fputs("set key left top\n", fp);
6781 fputs("plot \\\n", fp);
6782
6783 a = 100 * (1 - fr->alpha);
6784 tval = student_critval(fr->df, fr->alpha / 2);
6785
6786 if (opt & OPT_M) {
6787 cistr = g_strdup_printf(_("%g%% interval for mean"), a);
6788 } else {
6789 cistr = g_strdup_printf(_("%g percent interval"), a);
6790 }
6791
6792 fputs("'-' using 1:2 notitle w points, \\\n", fp);
6793 fputs("'-' using 1:2 notitle w lines, \\\n", fp);
6794 fprintf(fp, "'-' using 1:2 title '%s' w lines, \\\n", cistr);
6795 fputs("'-' using 1:2 notitle '%s' w lines lt 3\n", fp);
6796 g_free(cistr);
6797
6798 gretl_push_c_numeric_locale();
6799
6800 print_x_ordered_data(x, fr->actual, order, t1, t2, fp);
6801 print_x_ordered_data(x, fr->fitted, order, yhmin, t2, fp);
6802 print_x_confband_data(x, fr->fitted, fr->sderr, order,
6803 tval, yhmin, t2, CONF_LOW, fp);
6804 print_x_confband_data(x, fr->fitted, fr->sderr, order,
6805 tval, yhmin, t2, CONF_HIGH, fp);
6806
6807 gretl_pop_c_numeric_locale();
6808
6809 free(order);
6810
6811 return finalize_plot_input_file(fp);
6812 }
6813
6814 #ifndef min
6815 # define min(x,y) (((x)<(y))? (x):(y))
6816 #endif
6817
6818 #ifndef max
6819 # define max(x,y) (((x)>(y))? (x):(y))
6820 #endif
6821
plot_tau_sequence(const MODEL * pmod,const DATASET * dset,int k)6822 int plot_tau_sequence (const MODEL *pmod, const DATASET *dset,
6823 int k)
6824 {
6825 FILE *fp;
6826 gretl_matrix *tau = gretl_model_get_data(pmod, "rq_tauvec");
6827 gretl_matrix *B = gretl_model_get_data(pmod, "rq_sequence");
6828 double tau_i, bi, se, blo, bhi;
6829 double alpha, cval, tcrit, olsband;
6830 double ymin[2], ymax[2];
6831 gchar *tmp;
6832 int ntau, bcols;
6833 int i, j, err = 0;
6834
6835 if (tau == NULL || B == NULL) {
6836 return E_DATA;
6837 }
6838
6839 ntau = gretl_vector_get_length(tau);
6840 if (ntau == 0) {
6841 return E_DATA;
6842 }
6843
6844 fp = open_plot_input_file(PLOT_RQ_TAU, 0, &err);
6845 if (err) {
6846 return err;
6847 }
6848
6849 bcols = gretl_matrix_cols(B);
6850
6851 alpha = gretl_model_get_double(pmod, "rq_alpha");
6852 if (na(alpha)) {
6853 alpha = .05;
6854 }
6855
6856 cval = 100 * (1 - alpha);
6857 tcrit = student_cdf_inverse(pmod->dfd, 1 - alpha/2);
6858 olsband = tcrit * pmod->sderr[k];
6859
6860 /* Try to figure best placement of key */
6861
6862 j = k * ntau;
6863 if (bcols == 3) {
6864 blo = gretl_matrix_get(B, j, 1);
6865 bhi = gretl_matrix_get(B, j, 2);
6866 } else {
6867 bi = gretl_matrix_get(B, j, 0);
6868 se = gretl_matrix_get(B, j, 1);
6869 blo = bi - tcrit * se;
6870 bhi = bi + tcrit * se;
6871 }
6872 ymin[0] = min(blo, pmod->coeff[k] - olsband);
6873 ymax[0] = max(bhi, pmod->coeff[k] + olsband);
6874
6875 j += ntau - 1;
6876 if (bcols == 3) {
6877 blo = gretl_matrix_get(B, j, 1);
6878 bhi = gretl_matrix_get(B, j, 2);
6879 } else {
6880 bi = gretl_matrix_get(B, j, 0);
6881 se = gretl_matrix_get(B, j, 1);
6882 blo = bi - tcrit * se;
6883 bhi = bi + tcrit * se;
6884 }
6885 ymin[1] = min(blo, pmod->coeff[k] - olsband);
6886 ymax[1] = max(bhi, pmod->coeff[k] + olsband);
6887
6888 fputs("set xrange [0.0:1.0]\n", fp);
6889 fputs("set xlabel 'tau'\n", fp);
6890
6891 tmp = g_strdup_printf(_("Coefficient on %s"),
6892 series_get_graph_name(dset, pmod->list[k+2]));
6893 fprintf(fp, "set title \"%s\"\n", tmp);
6894 g_free(tmp);
6895
6896 fputs("set style fill solid 0.5\n", fp);
6897
6898 if (ymax[0] < .88 * ymax[1]) {
6899 fputs("set key left top\n", fp);
6900 } else if (ymax[1] < .88 * ymax[0]) {
6901 fputs("set key right top\n", fp);
6902 } else if (ymin[0] < .88 * ymin[1]) {
6903 fputs("set key right bottom\n", fp);
6904 } else {
6905 fputs("set key left bottom\n", fp);
6906 }
6907
6908 fputs("plot \\\n", fp);
6909
6910 /* plot the rq confidence band first so the other lines
6911 come out on top */
6912 print_filledcurve_line(NULL, NULL, fp);
6913
6914 /* rq estimates */
6915 tmp = g_strdup_printf(_("Quantile estimates with %g%% band"), cval);
6916 fprintf(fp, "'-' using 1:2 title '%s' w lp, \\\n", tmp);
6917 g_free(tmp);
6918
6919 /* numeric output coming up! */
6920 gretl_push_c_numeric_locale();
6921
6922 /* ols estimate plus (1 - alpha) band */
6923 tmp = g_strdup_printf(_("OLS estimate with %g%% band"), cval);
6924 fprintf(fp, "%g title '%s' w l, \\\n", pmod->coeff[k], tmp);
6925 g_free(tmp);
6926 fprintf(fp, "%g notitle w l dt 2, \\\n", pmod->coeff[k] + olsband);
6927 fprintf(fp, "%g notitle w l dt 2\n", pmod->coeff[k] - olsband);
6928
6929 /* write out the interval values */
6930
6931 for (i=0, j=k*ntau; i<ntau; i++, j++) {
6932 tau_i = gretl_vector_get(tau, i);
6933 if (bcols == 3) {
6934 blo = gretl_matrix_get(B, j, 1);
6935 bhi = gretl_matrix_get(B, j, 2);
6936 } else {
6937 bi = gretl_matrix_get(B, j, 0);
6938 se = gretl_matrix_get(B, j, 1);
6939 blo = bi - tcrit * se;
6940 bhi = bi + tcrit * se;
6941 }
6942 fprintf(fp, "%.10g %.10g %.10g\n", tau_i, blo, bhi);
6943 }
6944 fputs("e\n", fp);
6945
6946 for (i=0, j=k*ntau; i<ntau; i++, j++) {
6947 tau_i = gretl_vector_get(tau, i);
6948 bi = gretl_matrix_get(B, j, 0);
6949 fprintf(fp, "%.10g %.10g\n", tau_i, bi);
6950 }
6951 fputs("e\n", fp);
6952
6953 gretl_pop_c_numeric_locale();
6954
6955 return finalize_plot_input_file(fp);
6956 }
6957
garch_resid_plot(const MODEL * pmod,const DATASET * dset)6958 int garch_resid_plot (const MODEL *pmod, const DATASET *dset)
6959 {
6960 FILE *fp = NULL;
6961 const double *obs;
6962 const double *h;
6963 double sd2;
6964 int t, err = 0;
6965
6966 h = gretl_model_get_data(pmod, "garch_h");
6967 if (h == NULL) {
6968 return E_DATA;
6969 }
6970
6971 obs = gretl_plotx(dset, OPT_NONE);
6972 if (obs == NULL) {
6973 return E_ALLOC;
6974 }
6975
6976 fp = open_plot_input_file(PLOT_GARCH, 0, &err);
6977 if (err) {
6978 return err;
6979 }
6980
6981 fputs("set key left top\n", fp);
6982
6983 fprintf(fp, "plot \\\n'-' using 1:2 title '%s' w lines, \\\n"
6984 "'-' using 1:2 title '%s' w lines lt 2, \\\n"
6985 "'-' using 1:2 notitle w lines lt 2\n",
6986 _("residual"), _("+- sqrt(h(t))"));
6987
6988 gretl_push_c_numeric_locale();
6989
6990 for (t=pmod->t1; t<=pmod->t2; t++) {
6991 fprintf(fp, "%.10g %.10g\n", obs[t], pmod->uhat[t]);
6992 }
6993 fputs("e\n", fp);
6994
6995 for (t=pmod->t1; t<=pmod->t2; t++) {
6996 sd2 = -sqrt(h[t]);
6997 fprintf(fp, "%.10g %.10g\n", obs[t], sd2);
6998 }
6999 fputs("e\n", fp);
7000
7001 for (t=pmod->t1; t<=pmod->t2; t++) {
7002 sd2 = sqrt(h[t]);
7003 fprintf(fp, "%.10g %.10g\n", obs[t], sd2);
7004 }
7005 fputs("e\n", fp);
7006
7007 gretl_pop_c_numeric_locale();
7008
7009 return finalize_plot_input_file(fp);
7010 }
7011
rmplot(const int * list,DATASET * dset,gretlopt opt,PRN * prn)7012 int rmplot (const int *list, DATASET *dset,
7013 gretlopt opt, PRN *prn)
7014 {
7015 int (*range_mean_graph) (int, const DATASET *,
7016 gretlopt, PRN *);
7017
7018 range_mean_graph = get_plugin_function("range_mean_graph");
7019 if (range_mean_graph == NULL) {
7020 return 1;
7021 }
7022
7023 return range_mean_graph(list[1], dset, opt, prn);
7024 }
7025
hurstplot(const int * list,DATASET * dset,gretlopt opt,PRN * prn)7026 int hurstplot (const int *list, DATASET *dset, gretlopt opt, PRN *prn)
7027 {
7028 int (*hurst_exponent) (int, const DATASET *, gretlopt, PRN *);
7029
7030 hurst_exponent = get_plugin_function("hurst_exponent");
7031 if (hurst_exponent == NULL) {
7032 return 1;
7033 }
7034
7035 return hurst_exponent(list[1], dset, opt, prn);
7036 }
7037
get_multiplot_layout(int n,int tseries,int * rows,int * cols)7038 static void get_multiplot_layout (int n, int tseries,
7039 int *rows, int *cols)
7040 {
7041 if (n < 3) {
7042 if (tseries) {
7043 *cols = 1;
7044 *rows = 2;
7045 } else {
7046 *cols = 2;
7047 *rows = 1;
7048 }
7049 } else if (n < 5) {
7050 *cols = *rows = 2;
7051 } else if (n < 7) {
7052 *cols = 3;
7053 *rows = 2;
7054 } else if (n < 10) {
7055 *cols = *rows = 3;
7056 } else if (n < 13) {
7057 *cols = 4;
7058 *rows = 3;
7059 } else if (n < 17) {
7060 *cols = *rows = 4;
7061 } else {
7062 *cols = *rows = 0;
7063 }
7064 }
7065
panel_ytic_width(double ymin,double ymax)7066 static int panel_ytic_width (double ymin, double ymax)
7067 {
7068 char s1[16], s2[16];
7069 int n1, n2;
7070
7071 if (ymin < 0 && ymax > 0) {
7072 sprintf(s1, "% g", ymin);
7073 sprintf(s2, "% g", ymax);
7074 } else {
7075 sprintf(s1, "%g", ymin);
7076 sprintf(s2, "%g", ymax);
7077 }
7078
7079 n1 = strlen(s1);
7080 n2 = strlen(s2);
7081
7082 return (n1 > n2)? n1 : n2;
7083 }
7084
7085 /* Panel: produce a time-series plot for the group mean of the
7086 series in question.
7087 */
7088
panel_means_ts_plot(const int vnum,const DATASET * dset,gretlopt opt)7089 static int panel_means_ts_plot (const int vnum,
7090 const DATASET *dset,
7091 gretlopt opt)
7092 {
7093 DATASET *gset;
7094 int nunits, T = dset->pd;
7095 int list[2] = {1, 1};
7096 gchar *literal = NULL;
7097 gchar *title = NULL;
7098 int i, t, s, s0;
7099 int err = 0;
7100
7101 nunits = panel_sample_size(dset);
7102
7103 gset = create_auxiliary_dataset(2, T, 0);
7104 if (gset == NULL) {
7105 return E_ALLOC;
7106 }
7107
7108 strcpy(gset->varname[1], dset->varname[vnum]);
7109 series_set_display_name(gset, 1, series_get_display_name(dset, vnum));
7110
7111 if (dset->panel_pd > 0) {
7112 /* add time series info to @gset */
7113 gset->structure = TIME_SERIES;
7114 gset->pd = dset->panel_pd;
7115 gset->sd0 = dset->panel_sd0;
7116 }
7117
7118 s0 = dset->t1;
7119
7120 for (t=0; t<T; t++) {
7121 double xit, xsum = 0.0;
7122 int n = 0;
7123
7124 for (i=0; i<nunits; i++) {
7125 s = s0 + i * T + t;
7126 xit = dset->Z[vnum][s];
7127 if (!na(xit)) {
7128 xsum += xit;
7129 n++;
7130 }
7131 }
7132 gset->Z[1][t] = (n == 0)? NADBL : xsum / n;
7133 }
7134
7135 opt |= (OPT_O | OPT_T); /* use lines, time series */
7136
7137 title = g_strdup_printf(_("mean %s"),
7138 series_get_graph_name(dset, vnum));
7139 literal = g_strdup_printf("set ylabel \"%s\" ; set xlabel ;",
7140 title);
7141 err = gnuplot(list, literal, gset, opt);
7142
7143 g_free(title);
7144 g_free(literal);
7145 destroy_dataset(gset);
7146
7147 return err;
7148 }
7149
panel_means_XY_scatter(const int * list,const DATASET * dset,gretlopt opt)7150 int panel_means_XY_scatter (const int *list, const DATASET *dset,
7151 gretlopt opt)
7152 {
7153 DATASET *gset;
7154 int N, T = dset->pd;
7155 int glist[3] = {2, 1, 2};
7156 gchar *literal = NULL;
7157 int grpnames = 0;
7158 int yvar, xvar;
7159 int i, t, s;
7160 int err = 0;
7161
7162 if (list == NULL || list[0] != 2) {
7163 return E_DATA;
7164 }
7165
7166 N = panel_sample_size(dset);
7167
7168 gset = create_auxiliary_dataset(3, N, 0);
7169 if (gset == NULL) {
7170 return E_ALLOC;
7171 }
7172
7173 /* If we have valid panel group names, use them
7174 as obs markers here */
7175 grpnames = panel_group_names_ok(dset, 0);
7176 if (grpnames) {
7177 dataset_allocate_obs_markers(gset);
7178 }
7179
7180 yvar = list[1];
7181 xvar = list[2];
7182
7183 strcpy(gset->varname[1], dset->varname[yvar]);
7184 series_set_display_name(gset, 1, series_get_display_name(dset, yvar));
7185
7186 strcpy(gset->varname[2], dset->varname[xvar]);
7187 series_set_display_name(gset, 2, series_get_display_name(dset, xvar));
7188
7189 s = dset->t1;
7190
7191 for (i=0; i<N; i++) {
7192 double yit, ysum = 0.0;
7193 double xit, xsum = 0.0;
7194 int ny = 0, nx = 0;
7195 int s0 = s;
7196
7197 for (t=0; t<T; t++) {
7198 yit = dset->Z[yvar][s];
7199 xit = dset->Z[xvar][s];
7200 if (!na(yit)) {
7201 ysum += yit;
7202 ny++;
7203 }
7204 if (!na(xit)) {
7205 xsum += xit;
7206 nx++;
7207 }
7208 s++;
7209 }
7210 gset->Z[1][i] = ny == 0 ? NADBL : ysum / ny;
7211 gset->Z[2][i] = nx == 0 ? NADBL : xsum / nx;
7212 if (gset->S != NULL) {
7213 strcpy(gset->S[i], get_panel_group_name(dset, s0));
7214 }
7215 }
7216
7217 literal = g_strdup_printf("set title \"%s\";", _("Group means"));
7218 err = gnuplot(glist, literal, gset, opt);
7219
7220 g_free(literal);
7221 destroy_dataset(gset);
7222
7223 return err;
7224 }
7225
copy_string_stripped(char * targ,const char * src,int strip)7226 static void copy_string_stripped (char *targ, const char *src,
7227 int strip)
7228 {
7229 char *tmp = gretl_strdup(src);
7230 size_t len = strlen(tmp) - strip;
7231
7232 strcpy(targ, gretl_utf8_truncate(tmp, len));
7233 free(tmp);
7234 }
7235
7236 /* Here we're trying to find out if the observation labels
7237 for a panel dataset are such that they uniquely identify
7238 the units/individuals (e.g. country or city names,
7239 repeated for each time-series observation on the given
7240 unit).
7241 */
7242
dataset_has_panel_labels(const DATASET * dset,int maxlen,int * use,int * strip)7243 static int dataset_has_panel_labels (const DATASET *dset,
7244 int maxlen, int *use,
7245 int *strip)
7246 {
7247 int t, u, ubak = -1;
7248 int len, lmax = 0, fail = 0;
7249 int ret = 0;
7250
7251 if (dset->S == NULL) {
7252 return 0;
7253 }
7254
7255 for (t=dset->t1; t<=dset->t2 && !fail; t++) {
7256 u = t / dset->pd;
7257 if (u == ubak && strcmp(dset->S[t], dset->S[t-1])) {
7258 /* same unit, different label: no */
7259 fail = 1;
7260 } else if (ubak >= 0 && u != ubak &&
7261 !strcmp(dset->S[t], dset->S[t-1])) {
7262 /* different unit, same label: no */
7263 fail = 2;
7264 }
7265 if (!fail) {
7266 len = strlen(dset->S[t]);
7267 if (len > lmax) {
7268 lmax = len;
7269 }
7270 }
7271 ubak = u;
7272 }
7273
7274 if (!fail) {
7275 /* the full obs labels satisfy the criterion,
7276 but are they perhaps too long? */
7277 if (maxlen > 0 && lmax > maxlen) {
7278 ret = 0;
7279 } else {
7280 ret = 1;
7281 }
7282 } else if (fail == 1) {
7283 /* Try for a leading portion of the obs labels: for
7284 example we might have AUS1990, AUS1991, ...
7285 followed by USA1990, USA1991, ... or some such.
7286 We try to identify a trailing portion of the obs
7287 string that varies by time, and which should be
7288 omitted in forming "panel labels".
7289 */
7290 const char *s;
7291 int i, n, len2t, len2 = 0;
7292 int obslen = 0;
7293
7294 fail = 0;
7295 for (t=dset->t1; t<=dset->t2 && !fail; t++) {
7296 s = dset->S[t];
7297 n = strlen(s);
7298 len2t = 0;
7299 for (i=n-1; i>0; i--) {
7300 if (isdigit(s[i]) || s[i] == ':' ||
7301 s[i] == '-' || s[i] == '_') {
7302 len2t++;
7303 } else {
7304 break;
7305 }
7306 }
7307 if (len2t == 0) {
7308 /* no "tail" string (e.g. year) */
7309 fail = 1;
7310 } else if (len2 == 0) {
7311 /* starting */
7312 len2 = len2t;
7313 obslen = n;
7314 } else if (len2t != len2) {
7315 /* the "tails" don't have a common length */
7316 fail = 1;
7317 } else if (n != obslen) {
7318 /* the obs strings are of differing lengths */
7319 obslen = 0;
7320 }
7321 }
7322
7323 if (!fail) {
7324 char s0[OBSLEN], s1[OBSLEN];
7325
7326 if (obslen > 0) {
7327 *use = obslen - len2;
7328 } else {
7329 *strip = len2;
7330 }
7331 /* now check that the leading portion really
7332 is in common for each unit/individual
7333 */
7334 *s0 = '\0';
7335 ubak = -1;
7336 for (t=dset->t1; t<=dset->t2 && !fail; t++) {
7337 u = t / dset->pd;
7338 *s1 = '\0';
7339 if (*use > 0) {
7340 strncat(s1, dset->S[t], *use);
7341 } else {
7342 copy_string_stripped(s1, dset->S[t], *strip);
7343 }
7344 if (u == ubak && strcmp(s1, s0)) {
7345 /* same unit, different label: no */
7346 fail = 1;
7347 } else if (ubak >= 0 && u != ubak && !strcmp(s1, s0)) {
7348 /* different unit, same label: no */
7349 fail = 2;
7350 }
7351 if (!fail && maxlen > 0 && strlen(s1) > maxlen) {
7352 fail = 3;
7353 }
7354 strcpy(s0, s1);
7355 ubak = u;
7356 }
7357 if (fail) {
7358 *use = *strip = 0;
7359 } else {
7360 ret = 1;
7361 }
7362 }
7363 }
7364
7365 /* There's a loophole above: unit m might have the same
7366 label as some other unit, although we've checked that
7367 it doesn't have the same label as unit m - 1. But
7368 that seems ike a corner case and I can't be bothered
7369 checking for it right now.
7370 */
7371
7372 return ret;
7373 }
7374
7375 /* Panel: plot one series using separate lines for each
7376 cross-sectional unit. The individuals' series are overlaid, in the
7377 same manner as a plot of several distinct time series. To do
7378 this we construct on the fly a notional time-series dataset.
7379
7380 But note: if it turns out the series in question is invariant
7381 across groups, just show a single line.
7382 */
7383
panel_overlay_ts_plot(const int vnum,const DATASET * dset,gretlopt opt)7384 static int panel_overlay_ts_plot (const int vnum,
7385 const DATASET *dset,
7386 gretlopt opt)
7387 {
7388 DATASET *gset;
7389 int u0, nunits, T = dset->pd;
7390 int *list = NULL;
7391 gchar *literal = NULL;
7392 gchar *title = NULL;
7393 const double *obs = NULL;
7394 series_table *gst = NULL;
7395 const char *sval;
7396 int vg = 0;
7397 int nv, panel_labels = 0;
7398 int maxlen = 0;
7399 int single_series;
7400 int use = 0, strip = 0;
7401 int i, t, s, s0;
7402 int err = 0;
7403
7404 single_series = series_is_group_invariant(dset, vnum);
7405
7406 if (single_series) {
7407 nunits = 1;
7408 } else {
7409 nunits = panel_sample_size(dset);
7410 }
7411
7412 nv = nunits + 2;
7413 u0 = dset->t1 / T;
7414
7415 gset = create_auxiliary_dataset(nv, T, 0);
7416 if (gset == NULL) {
7417 return E_ALLOC;
7418 }
7419
7420 if (dset->panel_pd > 0) {
7421 /* add time series info to @gset */
7422 gset->structure = TIME_SERIES;
7423 gset->pd = dset->panel_pd;
7424 gset->sd0 = dset->panel_sd0;
7425 }
7426
7427 obs = gretl_plotx(gset, OPT_P);
7428 if (obs == NULL) {
7429 return E_ALLOC;
7430 }
7431
7432 list = gretl_consecutive_list_new(1, nv - 1);
7433 if (list == NULL) {
7434 destroy_dataset(gset);
7435 return E_ALLOC;
7436 }
7437
7438 if (nunits > 80) {
7439 /* FIXME calibrate this properly */
7440 maxlen = 3;
7441 }
7442
7443 if (!single_series) {
7444 gst = get_panel_group_table(dset, maxlen, &vg);
7445 if (gst == NULL && dset->S != NULL) {
7446 /* maybe we have obs markers that are usable */
7447 panel_labels =
7448 dataset_has_panel_labels(dset, maxlen, &use, &strip);
7449 }
7450 }
7451
7452 s0 = dset->t1;
7453
7454 for (i=0; i<nunits; i++) {
7455 s = s0 + i * T;
7456 if (single_series) {
7457 strcpy(gset->varname[i+1], dset->varname[vnum]);
7458 } else if (gst != NULL) {
7459 /* look up the string for this unit/group */
7460 sval = series_table_get_string(gst, dset->Z[vg][s]);
7461 if (sval != NULL) {
7462 strncat(gset->varname[i+1], sval, VNAMELEN-1);
7463 } else {
7464 sprintf(gset->varname[i+1], "%d", u0+i+1);
7465 }
7466 } else if (panel_labels) {
7467 if (use > 0) {
7468 strncat(gset->varname[i+1], dset->S[s], use);
7469 } else if (strip > 0) {
7470 copy_string_stripped(gset->varname[i+1], dset->S[s], strip);
7471 } else {
7472 strcpy(gset->varname[i+1], dset->S[s]);
7473 }
7474 } else {
7475 sprintf(gset->varname[i+1], "%d", u0+i+1);
7476 }
7477 for (t=0; t<T; t++) {
7478 gset->Z[i+1][t] = dset->Z[vnum][s++];
7479 }
7480 }
7481
7482 for (t=0; t<T; t++) {
7483 gset->Z[nv-1][t] = obs[t];
7484 }
7485
7486 if (nunits > 9 && T < 50) {
7487 opt |= OPT_P; /* lines/points */
7488 } else {
7489 opt |= OPT_O; /* use lines */
7490 }
7491
7492 if (single_series) {
7493 opt |= OPT_S; /* suppress-fitted */
7494 } else {
7495 const char *gname = series_get_graph_name(dset, vnum);
7496 const char *vname = panel_group_names_varname(dset);
7497
7498 if (vname != NULL) {
7499 title = g_strdup_printf("%s by %s", gname, vname);
7500 } else {
7501 title = g_strdup_printf("%s by group", gname);
7502 }
7503 literal = g_strdup_printf("set title \"%s\" ; set xlabel ;", title);
7504 }
7505
7506 if (nunits > 80) {
7507 /* set file-scope global */
7508 xwide = 1;
7509 }
7510
7511 err = gnuplot(list, literal, gset, opt);
7512
7513 xwide = 0;
7514 g_free(title);
7515 g_free(literal);
7516 destroy_dataset(gset);
7517 free(list);
7518
7519 return err;
7520 }
7521
7522 /* Panel: plot one variable as a time series, with separate plots for
7523 each cross-sectional unit. By default we arrange the plots in a
7524 grid, but if OPT_V is given we make each plot full width and
7525 stack the plots vertically on the "page".
7526 */
7527
panel_grid_ts_plot(int vnum,const DATASET * dset,gretlopt opt)7528 static int panel_grid_ts_plot (int vnum, const DATASET *dset,
7529 gretlopt opt)
7530 {
7531 FILE *fp = NULL;
7532 int w, rows, cols;
7533 const double *y, *x = NULL;
7534 const char *vname;
7535 char uname[OBSLEN];
7536 double xt, yt, ymin, ymax, incr;
7537 int u0, nunits, T = dset->pd;
7538 int n_ok_units = 0;
7539 int panel_labels = 0;
7540 int use = 0, strip = 0;
7541 int *badlist = NULL;
7542 int i, s, t, t0;
7543 int err = 0;
7544
7545 n_ok_units = nunits = panel_sample_size(dset);
7546 u0 = dset->t1 / dset->pd;
7547 y = dset->Z[vnum];
7548
7549 /* check for "blank" units */
7550 t0 = dset->t1;
7551 for (i=0; i<nunits; i++) {
7552 int ok = 0;
7553
7554 for (t=0; t<T; t++) {
7555 if (!na(y[t+t0])) {
7556 ok = 1;
7557 break;
7558 }
7559 }
7560 if (!ok) {
7561 badlist = gretl_list_append_term(&badlist, i);
7562 n_ok_units--;
7563 }
7564 t0 += T;
7565 }
7566
7567 if (n_ok_units < 2) {
7568 free(badlist);
7569 return E_MISSDATA;
7570 }
7571
7572 if (opt & OPT_V) {
7573 int xvar = plausible_panel_time_var(dset);
7574
7575 if (xvar > 0) {
7576 x = dset->Z[xvar];
7577 }
7578 cols = 1;
7579 rows = n_ok_units;
7580 } else {
7581 get_multiplot_layout(n_ok_units, 0, &rows, &cols);
7582 }
7583
7584 if (rows == 0 || cols == 0) {
7585 return E_DATA;
7586 }
7587
7588 maybe_set_small_font(nunits);
7589
7590 fp = open_plot_input_file(PLOT_PANEL, 0, &err);
7591 if (err) {
7592 return err;
7593 }
7594
7595 if (dset->S != NULL) {
7596 panel_labels = dataset_has_panel_labels(dset, 0, &use, &strip);
7597 }
7598
7599 vname = dset->varname[vnum];
7600 gretl_minmax(dset->t1, dset->t2, y, &ymin, &ymax);
7601 w = panel_ytic_width(ymin, ymax);
7602
7603 fputs("set key left top\n", fp);
7604 gnuplot_missval_string(fp);
7605 fputs("set xtics nomirror\n", fp);
7606 fputs("set ytics nomirror\n", fp);
7607 fprintf(fp, "set format y \"%%%dg\"\n", w);
7608 fprintf(fp, "set multiplot layout %d,%d\n", rows, cols);
7609
7610 if (opt & OPT_V) {
7611 fputs("set noxlabel\n", fp);
7612 } else {
7613 fprintf(fp, "set xlabel '%s'\n", _("time"));
7614 }
7615
7616 fputs("set xzeroaxis\n", fp);
7617
7618 gretl_push_c_numeric_locale();
7619
7620 t0 = dset->t1;
7621 for (i=0; i<nunits; i++) {
7622 if (in_gretl_list(badlist, i)) {
7623 t0 += T;
7624 continue;
7625 }
7626 if (panel_labels) {
7627 *uname = '\0';
7628 s = (u0 + i) * dset->pd;
7629 if (use > 0) {
7630 strncat(uname, dset->S[s], use);
7631 } else if (strip > 0) {
7632 copy_string_stripped(uname, dset->S[s], strip);
7633 } else {
7634 strcpy(uname, dset->S[s]);
7635 }
7636 } else {
7637 sprintf(uname, "%d", u0+i+1);
7638 }
7639 if (opt & OPT_V) {
7640 gretl_minmax(t0, t0 + T - 1, y, &ymin, &ymax);
7641 incr = (ymax - ymin) / 2.0;
7642 fprintf(fp, "set ytics %g\n", incr);
7643 fprintf(fp, "set ylabel '%s (%s)'\n", vname, uname);
7644 } else {
7645 fprintf(fp, "set title '%s (%s)'\n", vname, uname);
7646 }
7647
7648 fputs("plot \\\n'-' using 1:2 notitle w lines\n", fp);
7649
7650 for (t=0; t<T; t++) {
7651 if (x != NULL) {
7652 xt = x[t+t0];
7653 } else {
7654 xt = t + 1;
7655 }
7656 yt = y[t+t0];
7657 if (na(yt)) {
7658 fprintf(fp, "%g %s\n", xt, gpna);
7659 } else {
7660 fprintf(fp, "%g %.10g\n", xt, yt);
7661 }
7662 }
7663 fputs("e\n", fp);
7664 t0 += T;
7665 }
7666
7667 gretl_pop_c_numeric_locale();
7668
7669 fputs("unset multiplot\n", fp);
7670
7671 free(badlist);
7672
7673 return finalize_plot_input_file(fp);
7674 }
7675
gretl_panel_ts_plot(int vnum,DATASET * dset,gretlopt opt)7676 int gretl_panel_ts_plot (int vnum, DATASET *dset, gretlopt opt)
7677 {
7678 if (opt & OPT_S) {
7679 return panel_grid_ts_plot(vnum, dset, opt);
7680 } else if (opt & OPT_M) {
7681 /* group means */
7682 opt &= ~OPT_M;
7683 opt |= OPT_S;
7684 return panel_means_ts_plot(vnum, dset, opt);
7685 } else {
7686 return panel_overlay_ts_plot(vnum, dset, opt);
7687 }
7688 }
7689
7690 /* The following implements the script command "panplot" */
7691
cli_panel_plot(const int * list,const char * literal,const DATASET * dset,gretlopt opt)7692 int cli_panel_plot (const int *list, const char *literal,
7693 const DATASET *dset, gretlopt opt)
7694 {
7695 int N, vnum = list[1];
7696 int err;
7697
7698 /* condition on multi_unit_panel_sample() ? */
7699
7700 if (!dataset_is_panel(dset)) {
7701 gretl_errmsg_set(_("This command needs panel data"));
7702 err = E_DATA;
7703 } else {
7704 err = incompatible_options(opt, OPT_M | OPT_V | OPT_S |
7705 OPT_D | OPT_A | OPT_B | OPT_C);
7706 }
7707 if (err) {
7708 return err;
7709 }
7710
7711 N = panel_sample_size(dset);
7712
7713 /* check for too many groups */
7714 if ((opt & (OPT_V | OPT_S)) && N > 130) {
7715 err = E_BADOPT;
7716 } else if ((opt & OPT_B) && N > 150) {
7717 err = E_BADOPT;
7718 } else if ((opt & OPT_D) && N > 16) {
7719 err = E_BADOPT;
7720 } else if ((opt & OPT_A) && N > 6) {
7721 err = E_BADOPT;
7722 }
7723 if (err) {
7724 gretl_errmsg_set("Too many groups for the specified plot");
7725 return err;
7726 }
7727
7728 /* select a default if no panplot-specific option given */
7729 if (!(opt & (OPT_M | OPT_V | OPT_S | OPT_D |
7730 OPT_A | OPT_B | OPT_C))) {
7731 if (N <= 130) {
7732 opt |= OPT_V; /* --overlay */
7733 } else if (N <= 150) {
7734 opt |= OPT_B; /* --boxplots */
7735 } else {
7736 opt |= OPT_M; /* --means */
7737 }
7738 }
7739
7740 if (opt & OPT_U) {
7741 /* handle output spec? */
7742 const char *s = get_optval_string(PANPLOT, OPT_U);
7743 int pci = (opt & (OPT_B | OPT_C)) ? BXPLOT : GNUPLOT;
7744
7745 if (s != NULL) {
7746 set_optval_string(pci, OPT_U, s);
7747 }
7748 }
7749
7750 if (opt & OPT_M) {
7751 /* --means */
7752 fprintf(stderr, "panplot OPT_M: --means\n");
7753 opt &= ~OPT_M;
7754 opt |= OPT_S;
7755 err = panel_means_ts_plot(vnum, dset, opt);
7756 } else if (opt & OPT_V) {
7757 /* --overlay */
7758 fprintf(stderr, "panplot OPT_V: --overlay\n");
7759 opt &= ~OPT_V;
7760 err = panel_overlay_ts_plot(vnum, dset, opt);
7761 } else if (opt & OPT_S) {
7762 /* --sequence */
7763 fprintf(stderr, "panplot OPT_S: --sequence\n");
7764 opt &= ~OPT_S;
7765 err = gnuplot(list, literal, dset, opt | OPT_O | OPT_T);
7766 } else if (opt & OPT_D) {
7767 /* --grid */
7768 fprintf(stderr, "panplot OPT_D: --grid\n");
7769 opt &= ~OPT_D;
7770 err = panel_grid_ts_plot(vnum, dset, opt);
7771 } else if (opt & OPT_A) {
7772 /* --stack */
7773 fprintf(stderr, "panplot OPT_A: --stack\n");
7774 opt &= ~OPT_A;
7775 err = panel_grid_ts_plot(vnum, dset, opt | OPT_S | OPT_V);
7776 } else if (opt & OPT_B) {
7777 /* --boxplots */
7778 fprintf(stderr, "panplot OPT_B: --boxplots\n");
7779 opt &= ~OPT_B;
7780 err = boxplots(list, literal, dset, opt | OPT_P);
7781 } else if (opt & OPT_C) {
7782 /* --boxplot */
7783 fprintf(stderr, "panplot OPT_C: --boxplot\n");
7784 opt &= ~OPT_C;
7785 err = boxplots(list, literal, dset, opt);
7786 }
7787
7788 fprintf(stderr, "panplot: vnum=%d, N=%d, err=%d\n", vnum, N, err);
7789
7790 return err;
7791 }
7792
data_straddle_zero(const gretl_matrix * m)7793 static int data_straddle_zero (const gretl_matrix *m)
7794 {
7795 int t, lt0 = 0, gt0 = 0;
7796
7797 for (t=0; t<m->rows; t++) {
7798 if (gretl_matrix_get(m, t, 1) < 0) {
7799 lt0 = 1;
7800 }
7801 if (gretl_matrix_get(m, t, 2) > 0) {
7802 gt0 = 1;
7803 }
7804 if (lt0 && gt0) {
7805 return 1;
7806 }
7807 }
7808
7809 return 0;
7810 }
7811
real_irf_print_plot(const gretl_matrix * resp,const char * targname,const char * shockname,const char * perlabel,double alpha,int confint,int use_fill,FILE * fp)7812 static void real_irf_print_plot (const gretl_matrix *resp,
7813 const char *targname,
7814 const char *shockname,
7815 const char *perlabel,
7816 double alpha,
7817 int confint,
7818 int use_fill,
7819 FILE *fp)
7820 {
7821 int periods = gretl_matrix_rows(resp);
7822 gchar *title = NULL;
7823 int t;
7824
7825 if (!confint) {
7826 fputs("# impulse response plot\n", fp);
7827 }
7828
7829 if (confint) {
7830 fputs("set key left top\n", fp);
7831 title = g_strdup_printf(_("response of %s to a shock in %s, "
7832 "with bootstrap confidence interval"),
7833 targname, shockname);
7834 } else {
7835 fputs("set nokey\n", fp);
7836 title = g_strdup_printf(_("response of %s to a shock in %s"),
7837 targname, shockname);
7838 }
7839
7840 fprintf(fp, "set xlabel '%s'\n", perlabel);
7841 fputs("set xzeroaxis\n", fp);
7842 fprintf(fp, "set xrange [-1:%d]\n", periods);
7843 fprintf(fp, "set title '%s'\n", title);
7844 g_free(title);
7845
7846 if (confint) {
7847 double ql = alpha / 2;
7848 double qh = 1.0 - ql;
7849
7850 fputs("plot \\\n", fp);
7851 if (use_fill) {
7852 title = g_strdup_printf(_("%g percent confidence band"), 100 * (1 - alpha));
7853 print_filledcurve_line(title, NULL, fp);
7854 g_free(title);
7855 if (data_straddle_zero(resp)) {
7856 fputs("0 notitle w lines lt 0, \\\n", fp);
7857 }
7858 fprintf(fp, "'-' using 1:2 title '%s' w lines lt 1\n", _("point estimate"));
7859 } else {
7860 fprintf(fp, "'-' using 1:2 title '%s' w lines, \\\n",
7861 _("point estimate"));
7862 title = g_strdup_printf(_("%g and %g quantiles"), ql, qh);
7863 fprintf(fp, "'-' using 1:2:3:4 title '%s' w errorbars\n", title);
7864 g_free(title);
7865 }
7866 } else {
7867 fputs("plot \\\n'-' using 1:2 w lines\n", fp);
7868 }
7869
7870 gretl_push_c_numeric_locale();
7871
7872 if (confint && use_fill) {
7873 for (t=0; t<periods; t++) {
7874 fprintf(fp, "%d %.10g %.10g\n", t,
7875 gretl_matrix_get(resp, t, 1),
7876 gretl_matrix_get(resp, t, 2));
7877 }
7878 fputs("e\n", fp);
7879 }
7880
7881 for (t=0; t<periods; t++) {
7882 fprintf(fp, "%d %.10g\n", t, gretl_matrix_get(resp, t, 0));
7883 }
7884 fputs("e\n", fp);
7885
7886 if (confint && !use_fill) {
7887 for (t=0; t<periods; t++) {
7888 fprintf(fp, "%d %.10g %.10g %.10g\n", t,
7889 gretl_matrix_get(resp, t, 0),
7890 gretl_matrix_get(resp, t, 1),
7891 gretl_matrix_get(resp, t, 2));
7892 }
7893 fputs("e\n", fp);
7894 }
7895
7896 gretl_pop_c_numeric_locale();
7897 }
7898
7899 int
gretl_VAR_plot_impulse_response(GRETL_VAR * var,int targ,int shock,int periods,double alpha,const DATASET * dset,gretlopt opt)7900 gretl_VAR_plot_impulse_response (GRETL_VAR *var,
7901 int targ, int shock,
7902 int periods, double alpha,
7903 const DATASET *dset,
7904 gretlopt opt)
7905 {
7906 int use_fill = !(opt & OPT_E);
7907 gretl_matrix *resp;
7908 int err = 0;
7909
7910 if (alpha != 0 && (alpha < 0.01 || alpha > 0.5)) {
7911 return E_DATA;
7912 }
7913
7914 resp = gretl_VAR_get_impulse_response(var, targ, shock, periods,
7915 alpha, dset, &err);
7916
7917 if (!err) {
7918 int vtarg = gretl_VAR_get_variable_number(var, targ);
7919 int vshock = gretl_VAR_get_variable_number(var, shock);
7920 int confint = (resp->cols > 1);
7921 FILE *fp;
7922
7923 fp = open_plot_input_file((confint)? PLOT_IRFBOOT : PLOT_REGULAR, 0, &err);
7924 if (!err) {
7925 real_irf_print_plot(resp, dset->varname[vtarg],
7926 dset->varname[vshock],
7927 dataset_period_label(dset),
7928 alpha, confint, use_fill,
7929 fp);
7930 err = finalize_plot_input_file(fp);
7931 }
7932 gretl_matrix_free(resp);
7933 }
7934
7935 return err;
7936 }
7937
gretl_VAR_plot_FEVD(GRETL_VAR * var,int targ,int periods,const DATASET * dset,gretlopt opt)7938 int gretl_VAR_plot_FEVD (GRETL_VAR *var, int targ, int periods,
7939 const DATASET *dset, gretlopt opt)
7940 {
7941 FILE *fp = NULL;
7942 gretl_matrix *V;
7943 gchar *title;
7944 int i, t, v, histo;
7945 PlotType ptype;
7946 int err = 0;
7947
7948 V = gretl_VAR_get_FEVD_matrix(var, targ, -1, periods, dset, &err);
7949 if (V == NULL) {
7950 return E_ALLOC;
7951 }
7952
7953 histo = (opt & OPT_H)? 1 : 0;
7954 ptype = histo ? PLOT_STACKED_BAR : PLOT_REGULAR;
7955
7956 fp = open_plot_input_file(ptype, 0, &err);
7957 if (err) {
7958 gretl_matrix_free(V);
7959 return err;
7960 }
7961
7962 v = gretl_VAR_get_variable_number(var, targ);
7963
7964 fprintf(fp, "set xlabel '%s'\n", dataset_period_label(dset));
7965 title = g_strdup_printf(_("forecast variance decomposition for %s"),
7966 dset->varname[v]);
7967 fprintf(fp, "set title '%s'\n", title);
7968 g_free(title);
7969
7970 if (histo) {
7971 fputs("set key outside\n", fp);
7972 fputs("# literal lines = 3\n", fp);
7973 fputs("set style fill solid 0.35\n", fp);
7974 fputs("set style histogram rowstacked\n", fp);
7975 fputs("set style data histogram\n", fp);
7976 fprintf(fp, "set xrange [-1:%d]\n", periods);
7977 } else {
7978 fputs("set key left top\n", fp);
7979 fputs("set xzeroaxis\n", fp);
7980 }
7981
7982 fputs("set yrange [0:100]\n", fp);
7983 fputs("plot \\\n", fp);
7984
7985 for (i=0; i<var->neqns; i++) {
7986 v = gretl_VAR_get_variable_number(var, i);
7987 if (histo) {
7988 fprintf(fp, "'-' using 2 title \"%s\"", dset->varname[v]);
7989 } else {
7990 fprintf(fp, "'-' using 1:2 title \"%s\" w lines", dset->varname[v]);
7991 }
7992 if (i < var->neqns - 1) {
7993 fputs(", \\\n", fp);
7994 } else {
7995 fputc('\n', fp);
7996 }
7997 }
7998
7999 gretl_push_c_numeric_locale();
8000
8001 for (i=0; i<var->neqns; i++) {
8002 for (t=0; t<periods; t++) {
8003 fprintf(fp, "%d %.4f\n", t, 100 * gretl_matrix_get(V, t, i));
8004 }
8005 fputs("e\n", fp);
8006 }
8007
8008 gretl_pop_c_numeric_locale();
8009
8010 gretl_matrix_free(V);
8011
8012 return finalize_plot_input_file(fp);
8013 }
8014
8015 #define NEW_IRF 1
8016
gretl_VAR_plot_multiple_irf(GRETL_VAR * var,int periods,double alpha,const DATASET * dset,gretlopt opt)8017 int gretl_VAR_plot_multiple_irf (GRETL_VAR *var,
8018 int periods, double alpha,
8019 const DATASET *dset,
8020 gretlopt opt)
8021 {
8022 FILE *fp = NULL;
8023 GptFlags flags = 0;
8024 int confint = 0;
8025 int use_fill = !(opt & OPT_E);
8026 gchar *title = NULL;
8027 int n = var->neqns;
8028 int nplots = n * n;
8029 int vtarg, vshock;
8030 #if NEW_IRF
8031 gretl_matrix *R = NULL;
8032 int Rcol, Rstep;
8033 #endif
8034 int t, i, j;
8035 int err = 0;
8036
8037 maybe_set_small_font(nplots);
8038
8039 if (nplots > 12) {
8040 flags |= GPT_XXL;
8041 } else if (nplots > 9) {
8042 flags |= GPT_XL;
8043 }
8044
8045 fp = open_plot_input_file(PLOT_MULTI_IRF, flags, &err);
8046 if (err) {
8047 return err;
8048 }
8049
8050 fprintf(fp, "set multiplot layout %d,%d\n", n, n);
8051
8052 if (n < 4) {
8053 fprintf(fp, "set xlabel '%s'\n", dataset_period_label(dset));
8054 } else {
8055 fputs("set noxlabel\n", fp);
8056 }
8057
8058 fputs("set xzeroaxis\n", fp);
8059 fprintf(fp, "set xrange [-1:%d]\n", periods);
8060
8061 gretl_push_c_numeric_locale();
8062
8063 /* Use facility to get all impulse responses
8064 via one call
8065 */
8066 #if NEW_IRF
8067 R = gretl_VAR_get_impulse_response(var, -1, -1, periods,
8068 alpha, dset, &err);
8069 if (!err && R->cols > nplots) {
8070 confint = 1;
8071 }
8072 Rcol = 0;
8073 Rstep = confint ? 3 : 1;
8074
8075 for (i=0; i<n && !err; i++) {
8076 vtarg = gretl_VAR_get_variable_number(var, i);
8077
8078 for (j=0; j<n; j++) {
8079 vshock = gretl_VAR_get_variable_number(var, j);
8080
8081 if (i == 0 && j == 0) {
8082 /* the first plot */
8083 if (confint) {
8084 fputs("set key left top\n", fp);
8085 } else {
8086 fputs("set nokey\n", fp);
8087 }
8088 }
8089 title = g_strdup_printf("%s -> %s", dset->varname[vshock],
8090 dset->varname[vtarg]);
8091 fprintf(fp, "set title '%s'\n", title);
8092 g_free(title);
8093
8094 fputs("plot \\\n", fp);
8095 if (confint && use_fill) {
8096 print_filledcurve_line(NULL, NULL, fp);
8097 fputs("'-' using 1:2 notitle w lines lt 1\n", fp);
8098 } else if (confint) {
8099 fputs("'-' using 1:2 notitle w lines, \\\n", fp);
8100 fputs("'-' using 1:2:3:4 notitle w errorbars\n", fp);
8101 } else {
8102 fputs("'-' using 1:2 notitle w lines\n", fp);
8103 }
8104
8105 if (confint && use_fill) {
8106 for (t=0; t<periods; t++) {
8107 fprintf(fp, "%d %.10g %.10g\n", t,
8108 gretl_matrix_get(R, t, Rcol+1),
8109 gretl_matrix_get(R, t, Rcol+2));
8110 }
8111 fputs("e\n", fp);
8112 }
8113
8114 for (t=0; t<periods; t++) {
8115 fprintf(fp, "%d %.10g\n", t, gretl_matrix_get(R, t, Rcol));
8116 }
8117 fputs("e\n", fp);
8118
8119 if (confint && !use_fill) {
8120 for (t=0; t<periods; t++) {
8121 fprintf(fp, "%d %.10g %.10g %.10g\n", t,
8122 gretl_matrix_get(R, t, Rcol),
8123 gretl_matrix_get(R, t, Rcol+1),
8124 gretl_matrix_get(R, t, Rcol+2));
8125 }
8126 fputs("e\n", fp);
8127 }
8128 Rcol += Rstep;
8129 }
8130 }
8131 gretl_matrix_free(R);
8132 #else /* old IRF method */
8133 for (i=0; i<n && !err; i++) {
8134 vtarg = gretl_VAR_get_variable_number(var, i);
8135
8136 for (j=0; j<n; j++) {
8137 gretl_matrix *resp;
8138
8139 resp = gretl_VAR_get_impulse_response(var, i, j, periods,
8140 alpha, dset, &err);
8141 if (err) {
8142 break;
8143 }
8144
8145 if (i == 0 && j == 0) {
8146 /* the first plot */
8147 if (gretl_matrix_cols(resp) > 1) {
8148 confint = 1;
8149 fputs("set key left top\n", fp);
8150 } else {
8151 fputs("set nokey\n", fp);
8152 }
8153 }
8154
8155 vshock = gretl_VAR_get_variable_number(var, j);
8156 fprintf(fp, "set title '%s -> %s'\n", dset->varname[vshock],
8157 dset->varname[vtarg]);
8158
8159 fputs("plot \\\n", fp);
8160
8161 if (confint && use_fill) {
8162 print_filledcurve_line(NULL, NULL, fp);
8163 fputs("'-' using 1:2 notitle w lines lt 1\n", fp);
8164 } else if (confint) {
8165 fputs("'-' using 1:2 notitle w lines, \\\n", fp);
8166 fputs("'-' using 1:2:3:4 notitle w errorbars\n", fp);
8167 } else {
8168 fputs("'-' using 1:2 notitle w lines\n", fp);
8169 }
8170
8171 if (confint && use_fill) {
8172 for (t=0; t<periods; t++) {
8173 fprintf(fp, "%d %.10g %.10g\n", t,
8174 gretl_matrix_get(resp, t, 1),
8175 gretl_matrix_get(resp, t, 2));
8176 }
8177 fputs("e\n", fp);
8178 }
8179
8180 for (t=0; t<periods; t++) {
8181 fprintf(fp, "%d %.10g\n", t, gretl_matrix_get(resp, t, 0));
8182 }
8183 fputs("e\n", fp);
8184
8185 if (confint && !use_fill) {
8186 for (t=0; t<periods; t++) {
8187 fprintf(fp, "%d %.10g %.10g %.10g\n", t,
8188 gretl_matrix_get(resp, t, 0),
8189 gretl_matrix_get(resp, t, 1),
8190 gretl_matrix_get(resp, t, 2));
8191 }
8192 fputs("e\n", fp);
8193 }
8194
8195 gretl_matrix_free(resp);
8196 }
8197 }
8198 #endif /* NEW_IRF or not */
8199
8200 gretl_pop_c_numeric_locale();
8201
8202 if (err) {
8203 fclose(fp);
8204 return err;
8205 }
8206
8207 fputs("unset multiplot\n", fp);
8208
8209 return finalize_plot_input_file(fp);
8210 }
8211
gretl_system_residual_plot(void * p,int ci,int eqn,const DATASET * dset)8212 int gretl_system_residual_plot (void *p, int ci, int eqn, const DATASET *dset)
8213 {
8214 GRETL_VAR *var = NULL;
8215 equation_system *sys = NULL;
8216 const gretl_matrix *E = NULL;
8217 FILE *fp = NULL;
8218 const double *obs;
8219 char lwstr[8];
8220 int single = 0;
8221 int nvars, nobs;
8222 int i, v, t, t1;
8223 int imin, imax;
8224 int err = 0;
8225
8226 if (ci == VAR || ci == VECM) {
8227 var = (GRETL_VAR *) p;
8228 E = gretl_VAR_get_residual_matrix(var);
8229 } else if (ci == SYSTEM) {
8230 sys = (equation_system *) p;
8231 E = sys->E;
8232 }
8233
8234 if (E == NULL) {
8235 return E_DATA;
8236 }
8237
8238 nvars = gretl_matrix_cols(E);
8239 nobs = gretl_matrix_rows(E);
8240 t1 = gretl_matrix_get_t1(E);
8241
8242 if (eqn > 0 && eqn <= nvars) {
8243 imin = eqn - 1;
8244 imax = imin + 1;
8245 single = 1;
8246 } else {
8247 imin = 0;
8248 imax = nvars;
8249 single = (nvars == 1);
8250 }
8251
8252 fp = open_plot_input_file(PLOT_REGULAR, 0, &err);
8253 if (err) {
8254 return err;
8255 }
8256
8257 obs = gretl_plotx(dset, OPT_NONE);
8258
8259 if (quarterly_or_monthly(dset)) {
8260 fprintf(fp, "# timeseries %d\n", dset->pd);
8261 }
8262
8263 if (!single) {
8264 fputs("# system residual plot\n", fp);
8265 }
8266
8267 fputs("set key left top\n", fp);
8268 fputs("set xzeroaxis\n", fp);
8269 if (ci == VAR) {
8270 fprintf(fp, "set title '%s'\n", _("VAR residuals"));
8271 } else {
8272 fprintf(fp, "set title '%s'\n", _("System residuals"));
8273 }
8274
8275 set_lwstr(NULL, 0, lwstr);
8276
8277 if (single) {
8278 fputs("plot ", fp);
8279 } else {
8280 fputs("plot \\\n", fp);
8281 }
8282
8283 for (i=imin; i<imax; i++) {
8284 if (var != NULL) {
8285 v = gretl_VAR_get_variable_number(var, i);
8286 } else {
8287 v = system_get_depvar(sys, i);
8288 }
8289 fprintf(fp, "'-' using 1:2 title '%s' w lines%s",
8290 dset->varname[v], lwstr);
8291 if (i == imax - 1) {
8292 fputc('\n', fp);
8293 } else {
8294 fputs(", \\\n", fp);
8295 }
8296 }
8297
8298 gretl_push_c_numeric_locale();
8299
8300 for (i=imin; i<imax; i++) {
8301 for (t=0; t<nobs; t++) {
8302 double eti = gretl_matrix_get(E, t, i);
8303
8304 if (obs != NULL) {
8305 fprintf(fp, "%g %.10g\n", obs[t+t1], eti);
8306 } else {
8307 fprintf(fp, "%d %.10g\n", t+1, eti);
8308 }
8309 }
8310 fputs("e\n", fp);
8311 }
8312
8313 gretl_pop_c_numeric_locale();
8314
8315 return finalize_plot_input_file(fp);
8316 }
8317
gretl_VECM_combined_EC_plot(GRETL_VAR * var,const DATASET * dset)8318 int gretl_VECM_combined_EC_plot (GRETL_VAR *var,
8319 const DATASET *dset)
8320 {
8321 const gretl_matrix *EC = NULL;
8322 FILE *fp = NULL;
8323 const double *obs;
8324 int nvars, nobs;
8325 int i, t, t1;
8326 int err = 0;
8327
8328 EC = VECM_get_EC_matrix(var, dset, &err);
8329 if (err) {
8330 return err;
8331 }
8332
8333 t1 = gretl_matrix_get_t1(EC);
8334
8335 fp = open_plot_input_file(PLOT_REGULAR, 0, &err);
8336 if (err) {
8337 return err;
8338 }
8339
8340 obs = gretl_plotx(dset, OPT_NONE);
8341
8342 nvars = gretl_matrix_cols(EC);
8343 nobs = gretl_matrix_rows(EC);
8344
8345 fputs("# VECM EC plot\n", fp);
8346 fputs("set key left top\n", fp);
8347 fputs("set xzeroaxis\n", fp);
8348 if (nvars > 1) {
8349 fprintf(fp, "set title '%s'\n", _("EC terms"));
8350 } else {
8351 fprintf(fp, "set title '%s'\n", _("EC term"));
8352 }
8353
8354 fputs("plot \\\n", fp);
8355 for (i=0; i<nvars; i++) {
8356 if (nvars > 1) {
8357 fprintf(fp, "'-' using 1:2 title 'EC %d' w lines", i + 1);
8358 } else {
8359 fprintf(fp, "'-' using 1:2 notitle w lines");
8360 }
8361 if (i == nvars - 1) {
8362 fputc('\n', fp);
8363 } else {
8364 fputs(", \\\n", fp);
8365 }
8366 }
8367
8368 gretl_push_c_numeric_locale();
8369
8370 for (i=0; i<nvars; i++) {
8371 for (t=0; t<nobs; t++) {
8372 double eti = gretl_matrix_get(EC, t, i);
8373
8374 if (obs != NULL) {
8375 fprintf(fp, "%g %.10g\n", obs[t+t1], eti);
8376 } else {
8377 fprintf(fp, "%d %.10g\n", t+1, eti);
8378 }
8379 }
8380 fputs("e\n", fp);
8381 }
8382
8383 gretl_pop_c_numeric_locale();
8384
8385 return finalize_plot_input_file(fp);
8386 }
8387
gretl_system_residual_mplot(void * p,int ci,const DATASET * dset)8388 int gretl_system_residual_mplot (void *p, int ci, const DATASET *dset)
8389 {
8390 const gretl_matrix *E = NULL;
8391 GRETL_VAR *var = NULL;
8392 equation_system *sys = NULL;
8393 FILE *fp = NULL;
8394 const double *obs;
8395 double startdate;
8396 double xmin, xmax, xrange;
8397 int nvars, nobs, incr;
8398 int i, v, t, t1;
8399 int err = 0;
8400
8401 if (ci == VAR || ci == VECM) {
8402 var = (GRETL_VAR *) p;
8403 E = gretl_VAR_get_residual_matrix(var);
8404 } else if (ci == SYSTEM) {
8405 sys = (equation_system *) p;
8406 E = sys->E;
8407 }
8408
8409 if (E == NULL) {
8410 return E_DATA;
8411 }
8412
8413 nvars = gretl_matrix_cols(E);
8414 if (nvars > 6) {
8415 return 1;
8416 }
8417
8418 obs = gretl_plotx(dset, OPT_NONE);
8419 if (obs == NULL) {
8420 return E_ALLOC;
8421 }
8422
8423 nobs = gretl_matrix_rows(E);
8424 t1 = gretl_matrix_get_t1(E);
8425
8426 fp = open_plot_input_file(PLOT_MULTI_SCATTER, 0, &err);
8427 if (err) {
8428 return err;
8429 }
8430
8431 fprintf(fp, "set multiplot layout %d,1\n", nvars);
8432 fputs("set nokey\n", fp);
8433 fputs("set xzeroaxis\n", fp);
8434 fputs("set noxlabel\n", fp);
8435 fputs("set noylabel\n", fp);
8436
8437 gretl_push_c_numeric_locale();
8438
8439 startdate = obs[t1];
8440 incr = nobs / (2 * dset->pd);
8441 if (incr > 0) {
8442 fprintf(fp, "set xtics %g, %d\n", ceil(startdate), incr);
8443 }
8444
8445 gretl_minmax(t1, t1 + nobs - 1, obs, &xmin, &xmax);
8446 xrange = xmax - xmin;
8447 xmin -= xrange * .025;
8448 xmax += xrange * .025;
8449 fprintf(fp, "set xrange [%.10g:%.10g]\n", xmin, xmax);
8450
8451 for (i=0; i<nvars; i++) {
8452 if (var != NULL) {
8453 v = gretl_VAR_get_variable_number(var, i);
8454 } else {
8455 v = system_get_depvar(sys, i);
8456 }
8457
8458 fprintf(fp, "set title '%s'\n", dset->varname[v]);
8459 fputs("plot '-' using 1:2 with lines\n", fp);
8460
8461 for (t=0; t<nobs; t++) {
8462 double eti;
8463
8464 fprintf(fp, "%.10g\t", obs[t+t1]);
8465 eti = gretl_matrix_get(E, t, i);
8466 write_gp_dataval(eti, fp, 1);
8467 }
8468 fputs("e\n", fp);
8469 }
8470
8471 gretl_pop_c_numeric_locale();
8472 fputs("unset multiplot\n", fp);
8473
8474 return finalize_plot_input_file(fp);
8475 }
8476
gretl_VAR_roots_plot(GRETL_VAR * var)8477 int gretl_VAR_roots_plot (GRETL_VAR *var)
8478 {
8479 const gretl_matrix *lam;
8480 FILE *fp = NULL;
8481 double x, y;
8482 double px, py;
8483 int i, n, err = 0;
8484
8485 lam = gretl_VAR_get_roots(var, &err);
8486 if (err) {
8487 return err;
8488 }
8489
8490 fp = open_plot_input_file(PLOT_ROOTS, 0, &err);
8491 if (err) {
8492 return err;
8493 }
8494
8495 n = gretl_matrix_rows(lam);
8496
8497 fprintf(fp, "set title '%s'\n",
8498 _("VAR inverse roots in relation to the unit circle"));
8499 fputs("unset border\n", fp);
8500 fputs("unset key\n", fp);
8501 fputs("set xzeroaxis\n", fp);
8502 fputs("set yzeroaxis\n", fp);
8503 fputs("unset xtics\n", fp);
8504 fputs("unset ytics\n", fp);
8505 fputs("set size square\n", fp);
8506 fputs("set polar\n", fp);
8507 fputs("plot 1 w lines, \\\n'-' using 1:2 w points pt 7\n", fp);
8508
8509 gretl_push_c_numeric_locale();
8510
8511 for (i=0; i<n; i++) {
8512 x = gretl_matrix_get(lam, i, 0);
8513 y = gretl_matrix_get(lam, i, 1);
8514 /* in polar form */
8515 px = atan2(y, x);
8516 py = sqrt(x * x + y * y);
8517 fprintf(fp, "%.8f %.8f # %.4f,%.4f\n", px, py, x, y);
8518 }
8519
8520 gretl_pop_c_numeric_locale();
8521
8522 fputs("e\n", fp);
8523
8524 return finalize_plot_input_file(fp);
8525 }
8526
8527 /**
8528 * confidence_ellipse_plot:
8529 * @V: 2x2 covariance matrix.
8530 * @b: 2-vector containing point estimates
8531 * @tcrit: critical t-value for 1 - alpha confidence.
8532 * @Fcrit: critical F-value for 1 - alpha confidence.
8533 * @alpha: nominal non-coverage, as decimal.
8534 * @iname: name of first parameter.
8535 * @jname: name of second parameter.
8536 *
8537 * Plots a 95% confidence ellipse for the parameter estimates
8538 * in @b with covariance @V.
8539 *
8540 * Returns: 0 on success, non-zero on error.
8541 */
8542
confidence_ellipse_plot(gretl_matrix * V,double * b,double tcrit,double Fcrit,double alpha,const char * iname,const char * jname)8543 int confidence_ellipse_plot (gretl_matrix *V, double *b,
8544 double tcrit, double Fcrit, double alpha,
8545 const char *iname, const char *jname)
8546 {
8547 FILE *fp = NULL;
8548 double maxerr[2];
8549 double xcoeff[2];
8550 double ycoeff[2];
8551 double cval = 100 * (1 - alpha);
8552 gretl_matrix *e = NULL;
8553 gchar *title;
8554 int i, err = 0;
8555
8556 maxerr[0] = tcrit * sqrt(gretl_matrix_get(V, 0, 0));
8557 maxerr[1] = tcrit * sqrt(gretl_matrix_get(V, 1, 1));
8558
8559 err = gretl_invert_symmetric_matrix(V);
8560 if (err) {
8561 return err;
8562 }
8563
8564 e = gretl_symmetric_matrix_eigenvals(V, 1, &err);
8565 if (err) {
8566 return err;
8567 }
8568
8569 for (i=0; i<2; i++) {
8570 e->val[i] = sqrt(1.0 / e->val[i] * Fcrit);
8571 xcoeff[i] = e->val[i] * gretl_matrix_get(V, 0, i);
8572 ycoeff[i] = e->val[i] * gretl_matrix_get(V, 1, i);
8573 }
8574
8575 gretl_matrix_free(e);
8576
8577 fp = open_plot_input_file(PLOT_ELLIPSE, 0, &err);
8578 if (err) {
8579 return err;
8580 }
8581
8582 title = g_strdup_printf(_("%g%% confidence ellipse and %g%% marginal intervals"),
8583 cval, cval);
8584 fprintf(fp, "set title '%s'\n", title);
8585 g_free(title);
8586
8587 fputs("# literal lines = 9\n", fp);
8588 fputs("set parametric\n", fp);
8589 fputs("set xzeroaxis\n", fp);
8590 fputs("set yzeroaxis\n", fp);
8591
8592 fprintf(fp, "set xlabel '%s'\n", iname);
8593 fprintf(fp, "set ylabel '%s'\n", jname);
8594 fprintf(fp, "set label '%.3g, %.3g' at ", b[0], b[1]);
8595
8596 gretl_push_c_numeric_locale();
8597
8598 fprintf(fp, "%g,%g point lt 2 pt 1 offset 3,3\n", b[0], b[1]);
8599
8600 fprintf(fp, "x(t) = %g*cos(t)%+g*sin(t)%+g\n", xcoeff[0], xcoeff[1], b[0]);
8601 fprintf(fp, "y(t) = %g*cos(t)%+g*sin(t)%+g\n", ycoeff[0], ycoeff[1], b[1]);
8602
8603 fputs("plot x(t), y(t) notitle, \\\n", fp);
8604 fprintf(fp, "%g, y(t) notitle w lines lt 2, \\\n", b[0] - maxerr[0]);
8605 fprintf(fp, "%g, y(t) notitle w lines lt 2, \\\n", b[0] + maxerr[0]);
8606 fprintf(fp, "x(t), %g notitle w lines lt 2, \\\n", b[1] - maxerr[1]);
8607 fprintf(fp, "x(t), %g notitle w lines lt 2\n", b[1] + maxerr[1]);
8608
8609 gretl_pop_c_numeric_locale();
8610
8611 return finalize_plot_input_file(fp);
8612 }
8613
corrgm_min_max(const double * acf,const double * pacf,int m,double pm,double * ymin,double * ymax)8614 static void corrgm_min_max (const double *acf, const double *pacf,
8615 int m, double pm, double *ymin, double *ymax)
8616 {
8617 int k;
8618
8619 /* the range should include the plus/minus bands, but
8620 should not go outside (-1, 1) */
8621 *ymax = pm * 1.2;
8622 if (*ymax > 1) *ymax = 1;
8623 *ymin = -pm * 1.2;
8624 if (*ymin < -1) *ymin = -1;
8625
8626 /* adjust based on min and max of ACF, PACF */
8627 for (k=0; k<m; k++) {
8628 if (acf[k] > *ymax) {
8629 *ymax = acf[k];
8630 } else if (acf[k] < *ymin) {
8631 *ymin = acf[k];
8632 }
8633 if (pacf[k] > *ymax) {
8634 *ymax = pacf[k];
8635 } else if (pacf[k] < *ymin) {
8636 *ymin = pacf[k];
8637 }
8638 }
8639
8640 if (*ymax > 0.5) {
8641 *ymax = 1;
8642 } else {
8643 *ymax *= 1.2;
8644 }
8645
8646 if (*ymin < -0.5) {
8647 *ymin = -1;
8648 } else {
8649 *ymin *= 1.2;
8650 }
8651
8652 /* make the range symmetrical */
8653 if (fabs(*ymin) > *ymax) {
8654 *ymax = -*ymin;
8655 } else if (*ymax > fabs(*ymin)) {
8656 *ymin = -*ymax;
8657 }
8658 }
8659
real_correlogram_print_plot(const char * vname,const double * acf,const double * pacf,const gretl_matrix * PM,int m,double pm,gretlopt opt,FILE * fp)8660 static int real_correlogram_print_plot (const char *vname,
8661 const double *acf,
8662 const double *pacf,
8663 const gretl_matrix *PM,
8664 int m, double pm,
8665 gretlopt opt,
8666 FILE *fp)
8667 {
8668 /* xgettext:no-c-format */
8669 const char *PM_title = N_("95% interval");
8670 char pm_title[16];
8671 double ymin, ymax;
8672 int k;
8673
8674 sprintf(pm_title, "%.2f/T^%.1f", 1.96, 0.5);
8675
8676 corrgm_min_max(acf, pacf, m, pm, &ymin, &ymax);
8677
8678 gretl_push_c_numeric_locale();
8679
8680 /* create two separate plots, if both are OK */
8681 if (pacf != NULL) {
8682 fputs("set size 1.0,1.0\nset multiplot\nset size 1.0,0.48\n", fp);
8683 }
8684 fputs("set xzeroaxis\n", fp);
8685 print_keypos_string(GP_KEY_RIGHT_TOP, fp);
8686 fprintf(fp, "set xlabel '%s'\n", _("lag"));
8687
8688 fprintf(fp, "set yrange [%.2f:%.2f]\n", ymin, ymax);
8689
8690 /* upper plot: Autocorrelation Function or ACF */
8691 if (pacf != NULL) {
8692 fputs("set origin 0.0,0.50\n", fp);
8693 }
8694 if (opt & OPT_R) {
8695 fprintf(fp, "set title '%s'\n", _("Residual ACF"));
8696 } else {
8697 fprintf(fp, "set title '%s %s'\n", _("ACF for"), vname);
8698 }
8699 fprintf(fp, "set xrange [0:%d]\n", m + 1);
8700 if (PM != NULL) {
8701 fprintf(fp, "plot \\\n"
8702 "'-' using 1:2 notitle w impulses lw 5, \\\n"
8703 "'-' title '%s' w lines lt 2, \\\n"
8704 "'-' notitle w lines lt 2\n", _(PM_title));
8705 } else {
8706 fprintf(fp, "plot \\\n"
8707 "'-' using 1:2 notitle w impulses lw 5, \\\n"
8708 "%g title '+- %s' lt 2, \\\n"
8709 "%g notitle lt 2\n", pm, pm_title, -pm);
8710 }
8711 for (k=0; k<m; k++) {
8712 fprintf(fp, "%d %g\n", k + 1, acf[k]);
8713 }
8714 fputs("e\n", fp);
8715 if (PM != NULL) {
8716 /* Bartlett-type confidence band data */
8717 for (k=0; k<m; k++) {
8718 fprintf(fp, "%d %g\n", k + 1, gretl_matrix_get(PM, k, 1));
8719 }
8720 fputs("e\n", fp);
8721 for (k=0; k<m; k++) {
8722 fprintf(fp, "%d -%g\n", k + 1, gretl_matrix_get(PM, k, 1));
8723 }
8724 fputs("e\n", fp);
8725 }
8726
8727 if (pacf != NULL) {
8728 /* lower plot: Partial Autocorrelation Function or PACF */
8729 fputs("set origin 0.0,0.0\n", fp);
8730 if (opt & OPT_R) {
8731 fprintf(fp, "set title '%s'\n", _("Residual PACF"));
8732 } else {
8733 fprintf(fp, "set title '%s %s'\n", _("PACF for"), vname);
8734 }
8735 fprintf(fp, "set xrange [0:%d]\n", m + 1);
8736 fprintf(fp, "plot \\\n"
8737 "'-' using 1:2 notitle w impulses lw 5, \\\n"
8738 "%g title '+- %s' lt 2, \\\n"
8739 "%g notitle lt 2\n", pm, pm_title, -pm);
8740 for (k=0; k<m; k++) {
8741 fprintf(fp, "%d %g\n", k + 1, pacf[k]);
8742 }
8743 fputs("e\n", fp);
8744 }
8745
8746 if (pacf != NULL) {
8747 fputs("unset multiplot\n", fp);
8748 }
8749
8750 gretl_pop_c_numeric_locale();
8751
8752 return 0;
8753 }
8754
correlogram_plot(const char * vname,const double * acf,const double * pacf,const gretl_matrix * PM,int m,double pm,gretlopt opt)8755 int correlogram_plot (const char *vname,
8756 const double *acf,
8757 const double *pacf,
8758 const gretl_matrix *PM,
8759 int m, double pm,
8760 gretlopt opt)
8761 {
8762 FILE *fp;
8763 int err = 0;
8764
8765 fp = open_plot_input_file(PLOT_CORRELOGRAM, 0, &err);
8766
8767 if (!err) {
8768 real_correlogram_print_plot(vname, acf, pacf,
8769 PM, m, pm, opt, fp);
8770 err = finalize_plot_input_file(fp);
8771 }
8772
8773 return err;
8774 }
8775
roundup_mod(int i,double x)8776 static int roundup_mod (int i, double x)
8777 {
8778 return (int) ceil((double) x * i);
8779 }
8780
8781 /* options: OPT_R use radians as unit
8782 OPT_D use degrees as unit
8783 OPT_L use log scale
8784 */
8785
real_pergm_plot(const char * vname,int T,int L,const double * x,gretlopt opt,FILE * fp)8786 static int real_pergm_plot (const char *vname,
8787 int T, int L,
8788 const double *x,
8789 gretlopt opt,
8790 FILE *fp)
8791 {
8792 char s[80];
8793 double ft;
8794 int T2 = T / 2;
8795 int k, t, err = 0;
8796
8797 fputs("set xtics nomirror\n", fp);
8798
8799 fprintf(fp, "set x2label '%s'\n", _("periods"));
8800 fprintf(fp, "set x2range [0:%d]\n", roundup_mod(T, 2.0));
8801
8802 fputs("set x2tics (", fp);
8803 k = T2 / 6;
8804 for (t = 1; t <= T2; t += k) {
8805 fprintf(fp, "\"%.1f\" %d, ", (double) T / t, 4 * t);
8806 }
8807 fprintf(fp, "\"\" %d)\n", 2 * T);
8808
8809 if (opt & OPT_R) {
8810 fprintf(fp, "set xlabel '%s'\n", _("radians"));
8811 } else if (opt & OPT_D) {
8812 fprintf(fp, "set xlabel '%s'\n", _("degrees"));
8813 } else {
8814 fprintf(fp, "set xlabel '%s'\n", _("scaled frequency"));
8815 }
8816
8817 fputs("set xzeroaxis\n", fp);
8818 fputs("set nokey\n", fp);
8819
8820 /* open gnuplot title string */
8821 fputs("set title '", fp);
8822
8823 if (vname == NULL) {
8824 fputs(_("Residual spectrum"), fp);
8825 } else {
8826 sprintf(s, _("Spectrum of %s"), vname);
8827 fputs(s, fp);
8828 }
8829
8830 if (opt & OPT_O) {
8831 fputs(" (", fp);
8832 fprintf(fp, _("Bartlett window, length %d"), L);
8833 fputc(')', fp);
8834 }
8835
8836 if (opt & OPT_L) {
8837 fputs(" (", fp);
8838 fputs(_("log scale"), fp);
8839 fputc(')', fp);
8840 }
8841
8842 /* close gnuplot title string */
8843 fputs("'\n", fp);
8844
8845 gretl_push_c_numeric_locale();
8846
8847 if (opt & OPT_R) {
8848 /* frequency scale in radians */
8849 fputs("set xrange [0:3.1416]\n", fp);
8850 } else if (opt & OPT_D) {
8851 /* frequency scale in degrees */
8852 fputs("set xrange [0:180]\n", fp);
8853 } else {
8854 /* data-scaled frequency */
8855 fprintf(fp, "set xrange [0:%d]\n", roundup_mod(T, 0.5));
8856 }
8857
8858 if (!(opt & OPT_L)) {
8859 fprintf(fp, "set yrange [0:%g]\n", 1.2 * gretl_max(0, T/2, x));
8860 }
8861
8862 if (opt & OPT_R) {
8863 fputs("set xtics (\"0\" 0, \"π/4\" pi/4, \"π/2\" pi/2, "
8864 "\"3π/4\" 3*pi/4, \"π\" pi)\n", fp);
8865 }
8866
8867 fputs("plot '-' using 1:2 w lines\n", fp);
8868
8869 for (t=1; t<=T2; t++) {
8870 if (opt & OPT_R) {
8871 ft = M_PI * (double) t / T2;
8872 } else if (opt & OPT_D) {
8873 ft = 180 * (double) t / T2;
8874 } else {
8875 ft = t;
8876 }
8877 fprintf(fp, "%g %g\n", ft, (opt & OPT_L)? log(x[t]) : x[t]);
8878 }
8879 fputs("e\n", fp);
8880
8881 gretl_pop_c_numeric_locale();
8882
8883 return err;
8884 }
8885
periodogram_plot(const char * vname,int T,int L,const double * x,gretlopt opt)8886 int periodogram_plot (const char *vname,
8887 int T, int L, const double *x,
8888 gretlopt opt)
8889 {
8890 FILE *fp;
8891 int err = 0;
8892
8893 fp = open_plot_input_file(PLOT_PERIODOGRAM, 0, &err);
8894
8895 if (!err) {
8896 real_pergm_plot(vname, T, L, x, opt, fp);
8897 err = finalize_plot_input_file(fp);
8898 }
8899
8900 return err;
8901 }
8902
arma_spectrum_plot(MODEL * pmod,const DATASET * dset,gretlopt opt)8903 int arma_spectrum_plot (MODEL *pmod, const DATASET *dset,
8904 gretlopt opt)
8905 {
8906 gretl_matrix *pdata = NULL;
8907 FILE *fp;
8908 int err = 0;
8909
8910 pdata = arma_spectrum_plot_data(pmod, dset, &err);
8911 if (err) {
8912 return err;
8913 }
8914
8915 fp = open_plot_input_file(PLOT_PERIODOGRAM, 0, &err);
8916
8917 if (!err) {
8918 double px, pRe, pIm, scale = pmod->nobs * M_2PI;
8919 int i, grid = pdata->rows;
8920
8921 gretl_push_c_numeric_locale();
8922
8923 fprintf(fp, "set xrange [0:%g]\n", M_PI);
8924 switch (dset->pd) {
8925 case 12:
8926 fputs("set xtics (\"0\" 0, \"π/6\" pi/6, "
8927 "\"π/3\" pi/3, \"π/2\" pi/2, \"2π/3\" 2*pi/3, "
8928 "\"5π/6\" 5*pi/6, \"π\" pi)\n", fp);
8929 break;
8930 case 6:
8931 fputs("set xtics (\"0\" 0, \"π/3\" pi/3, "
8932 "\"2π/3\" 2*pi/3, \"π\" pi)\n", fp);
8933 break;
8934 case 5:
8935 fputs("set xtics (\"0\" 0, \"π/5\" pi/5, "
8936 "\"2π/5\" 2*pi/5, \"3π/5\" 3*pi/5, "
8937 "\"4π/5\" 4*pi/5, \"π\" pi)\n", fp);
8938 break;
8939 default:
8940 fputs("set xtics (\"0\" 0, \"π/4\" pi/4, \"π/2\" pi/2, "
8941 "\"3π/4\" 3*pi/4, \"π\" pi)\n", fp);
8942 }
8943 fprintf(fp, "set title \"%s (%s)\"\n", _("Sample periodogram vs ARMA Spectrum"),
8944 _("log scale"));
8945 fprintf(fp, "plot '-' using 1:2 w lines title '%s' lw 2, \\\n", _("spectrum"));
8946 fprintf(fp, "'-' using 1:2 w lines title '%s' lw 0.5\n", _("periodogram"));
8947
8948 for (i=0; i<grid; i++) {
8949 fprintf(fp, "%7.5f %12.7f\n", gretl_matrix_get(pdata, i, 0),
8950 log(gretl_matrix_get(pdata, i, 1)));
8951 }
8952 fputs("e\n", fp);
8953
8954 for (i=0; i<grid; i++) {
8955 pRe = gretl_matrix_get(pdata, i, 2);
8956 pIm = gretl_matrix_get(pdata, i, 3);
8957 px = (pRe * pRe + pIm * pIm) / scale;
8958 fprintf(fp, "%7.5f %12.7f\n", gretl_matrix_get(pdata, i, 0), log(px));
8959 }
8960 fputs("e\n", fp);
8961
8962 gretl_pop_c_numeric_locale();
8963 err = finalize_plot_input_file(fp);
8964 }
8965
8966 return err;
8967 }
8968
8969 #define MAKKONEN_POS 0
8970
8971 /* Probability of non-exceedance of the kth value in a set of n
8972 rank-ordered values. See L. Makkonen, 'Bringing Closure to the
8973 Plotting Position Controversy', Communications in Statistics -
8974 Theory and Methods, vol 37, January 2008, for an argument in favor
8975 of using k / (n + 1); but also see many uses of (k - 1/2) / n in
8976 the literature.
8977 */
8978
plotpos(int k,int n)8979 static double plotpos (int k, int n)
8980 {
8981 #if MAKKONEN_POS
8982 return k / (n + 1.0);
8983 #else
8984 return (k - 0.5) / n;
8985 #endif
8986 }
8987
quantile_interp(const double * y,int n,double ftarg)8988 static double quantile_interp (const double *y, int n,
8989 double ftarg)
8990 {
8991 double f, ret = NADBL;
8992 int i;
8993
8994 for (i=0; i<n; i++) {
8995 f = plotpos(i+1, n);
8996 if (f >= ftarg) {
8997 if (f > ftarg && i > 0) {
8998 double f0 = plotpos(i, n);
8999 double d = (ftarg - f0) / (f - f0);
9000
9001 ret = (1-d) * y[i-1] + d * y[i];
9002 } else {
9003 ret = y[i];
9004 }
9005 break;
9006 }
9007 }
9008
9009 return ret;
9010 }
9011
qq_plot_two_series(const int * list,const DATASET * dset)9012 static int qq_plot_two_series (const int *list,
9013 const DATASET *dset)
9014 {
9015 double *x = NULL;
9016 double *y = NULL;
9017 double f, qx, qy;
9018 FILE *fp = NULL;
9019 int vx = list[1];
9020 int vy = list[2];
9021 int nx = 10, ny = 10;
9022 int i, n, err = 0;
9023
9024 x = gretl_sorted_series(vx, dset, OPT_NONE, &nx, &err);
9025
9026 if (!err) {
9027 y = gretl_sorted_series(vy, dset, OPT_NONE, &ny, &err);
9028 if (err) {
9029 free(x);
9030 x = NULL;
9031 }
9032 }
9033
9034 if (!err) {
9035 /* take the smaller sample as basis */
9036 n = (nx > ny)? ny : nx;
9037 }
9038
9039 if (!err) {
9040 fp = open_plot_input_file(PLOT_QQ, 0, &err);
9041 }
9042
9043 if (err) {
9044 free(x);
9045 free(y);
9046 return err;
9047 }
9048
9049 fprintf(fp, "set title \"%s\"\n", _("Q-Q plot"));
9050 gnuplot_missval_string(fp);
9051 fputs("set key top left\n", fp);
9052 fprintf(fp, "set xlabel \"%s\"\n", series_get_graph_name(dset, vx));
9053 fprintf(fp, "set ylabel \"%s\"\n", series_get_graph_name(dset, vy));
9054 fputs("plot \\\n", fp);
9055 fputs(" '-' using 1:2 notitle w points, \\\n", fp);
9056 fputs(" x notitle w lines\n", fp);
9057
9058 gretl_push_c_numeric_locale();
9059
9060 for (i=0; i<n; i++) {
9061 f = plotpos(i+1, n);
9062
9063 if (nx == ny) {
9064 qx = x[i];
9065 qy = y[i];
9066 } else if (nx == n) {
9067 qx = x[i];
9068 qy = quantile_interp(y, ny, f);
9069 } else {
9070 qx = quantile_interp(x, nx, f);
9071 qy = y[i];
9072 }
9073
9074 if (!na(qx) && !na(qy)) {
9075 fprintf(fp, "%.12g %.12g\n", qx, qy);
9076 }
9077 }
9078
9079 fputs("e\n", fp);
9080
9081 gretl_pop_c_numeric_locale();
9082
9083 free(x);
9084 free(y);
9085
9086 return finalize_plot_input_file(fp);
9087 }
9088
normal_qq_plot(const int * list,const DATASET * dset,gretlopt opt)9089 static int normal_qq_plot (const int *list,
9090 const DATASET *dset,
9091 gretlopt opt)
9092 {
9093 GptFlags flags = 0;
9094 gchar *title = NULL;
9095 int zscores = 0;
9096 double ym = 0, ys = 1;
9097 double p, qx, qy;
9098 double *y = NULL;
9099 FILE *fp = NULL;
9100 int v = list[1];
9101 int i, n = 20;
9102 int err = 0;
9103
9104 y = gretl_sorted_series(v, dset, OPT_NONE, &n, &err);
9105
9106 if (!err && y[0] == y[n-1]) {
9107 gretl_errmsg_sprintf(_("%s is a constant"), dset->varname[v]);
9108 err = E_DATA;
9109 }
9110
9111 if (err) {
9112 return err;
9113 }
9114
9115 if (opt & OPT_Z) {
9116 /* standardize the data */
9117 zscores = 1;
9118 }
9119
9120 if (!(opt & OPT_R)) {
9121 ym = gretl_mean(0, n-1, y);
9122 ys = gretl_stddev(0, n-1, y);
9123
9124 if (zscores) {
9125 /* standardize y */
9126 for (i=0; i<n; i++) {
9127 y[i] = (y[i] - ym) / ys;
9128 }
9129 }
9130 }
9131
9132 if (opt & OPT_G) {
9133 flags = GPT_ICON;
9134 }
9135
9136 fp = open_plot_input_file(PLOT_QQ, flags, &err);
9137 if (err) {
9138 free(y);
9139 return err;
9140 }
9141
9142 title = g_strdup_printf(_("Q-Q plot for %s"), series_get_graph_name(dset, v));
9143 fprintf(fp, "set title \"%s\"\n", title);
9144 g_free(title);
9145 gnuplot_missval_string(fp);
9146 fprintf(fp, "set xlabel \"%s\"\n", _("Normal quantiles"));
9147
9148 if (opt & OPT_R) {
9149 fputs("set nokey\n", fp);
9150 fputs("plot \\\n", fp);
9151 fputs(" '-' using 1:2 notitle w points\n", fp);
9152 } else {
9153 fputs("set key top left\n", fp);
9154 fputs("plot \\\n", fp);
9155 fputs(" '-' using 1:2 notitle w points, \\\n", fp);
9156 fputs(" x title \"y = x\" w lines\n", fp);
9157 }
9158
9159 gretl_push_c_numeric_locale();
9160
9161 for (i=0; i<n; i++) {
9162 p = plotpos(i+1, n);
9163 /* empirical quantile */
9164 qy = y[i];
9165 /* normal quantile */
9166 qx = normal_critval(1 - p);
9167 if (!na(qx) && !zscores && !(opt & OPT_R)) {
9168 qx = ys * qx + ym;
9169 }
9170 if (!na(qx) && !na(qy)) {
9171 fprintf(fp, "%.12g %.12g\n", qx, qy);
9172 }
9173 }
9174
9175 fputs("e\n", fp);
9176
9177 gretl_pop_c_numeric_locale();
9178
9179 free(y);
9180
9181 return finalize_plot_input_file(fp);
9182 }
9183
qq_plot(const int * list,const DATASET * dset,gretlopt opt)9184 int qq_plot (const int *list, const DATASET *dset, gretlopt opt)
9185 {
9186 int err;
9187
9188 if (list[0] == 1) {
9189 /* one series against normal */
9190 err = normal_qq_plot(list, dset, opt);
9191 } else if (list[0] == 2) {
9192 /* two empirical series */
9193 err = qq_plot_two_series(list, dset);
9194 } else {
9195 err = E_DATA;
9196 }
9197
9198 return err;
9199 }
9200
pd_from_compfac(const DATASET * dset,int compfac,char * stobs)9201 static int pd_from_compfac (const DATASET *dset,
9202 int compfac,
9203 char *stobs)
9204 {
9205 int pd = -1;
9206
9207 if (dset->pd == 1 && (compfac == 12 || compfac == 4)) {
9208 /* annual from monthly or quarterly */
9209 pd = compfac;
9210 } else if (dset->pd == 4 && compfac == 3) {
9211 /* quarterly from monthly */
9212 pd = 12;
9213 } else if (dset->pd == 4) {
9214 /* maybe quarterly from daily? */
9215 if (compfac >= 60 && compfac <= 69) {
9216 pd = 5;
9217 } else if (compfac >= 71 && compfac <= 81) {
9218 pd = 6;
9219 } else if (compfac >= 82 && compfac <= 93) {
9220 return 7;
9221 }
9222 } else if (dset->pd == 12) {
9223 /* maybe monthly from daily? */
9224 if (compfac >= 20 && compfac <= 23) {
9225 pd = 5;
9226 } else if (compfac >= 24 && compfac <= 27) {
9227 pd = 6;
9228 } else if (compfac >= 28 && compfac <= 31) {
9229 pd = 7;
9230 }
9231 }
9232
9233 if (pd > 0) {
9234 char *p, tmp[OBSLEN];
9235 int y, q, m;
9236
9237 ntolabel(tmp, dset->t1, dset);
9238 y = atoi(tmp);
9239 p = strchr(tmp, ':');
9240
9241 if ((dset->pd == 4 || dset->pd == 12) && p == NULL) {
9242 return -1;
9243 }
9244
9245 if (dset->pd == 1) {
9246 if (pd == 4) {
9247 sprintf(stobs, "%d:1", y);
9248 } else if (pd == 12) {
9249 sprintf(stobs, "%d:01", y);
9250 }
9251 } else if (dset->pd == 4) {
9252 q = atoi(p + 1);
9253 m = (q==1)? 1 : (q==2)? 4 : (q==3)? 7 : 10;
9254 if (pd == 12) {
9255 sprintf(stobs, "%d:%02d", y, m);
9256 } else {
9257 /* daily */
9258 sprintf(stobs, "%d-%02d-01", y, m);
9259 }
9260 } else if (dset->pd == 12) {
9261 /* daily */
9262 m = atoi(p + 1);
9263 sprintf(stobs, "%d-%02d-01", y, m);
9264 }
9265 }
9266
9267 return pd;
9268 }
9269
transcribe_graph_name(DATASET * targ,int i,const DATASET * src,int j)9270 static void transcribe_graph_name (DATASET *targ, int i,
9271 const DATASET *src, int j)
9272 {
9273 const char *s = series_get_display_name(src, j);
9274
9275 if (s != NULL && *s != '\0') {
9276 series_record_display_name(targ, i, s);
9277 }
9278 }
9279
9280 /* high-frequency plot for MIDAS */
9281
hf_plot(const int * list,const char * literal,const DATASET * dset,gretlopt opt)9282 int hf_plot (const int *list, const char *literal,
9283 const DATASET *dset, gretlopt opt)
9284 {
9285 DATASET *hset;
9286 double xit;
9287 char stobs[OBSLEN];
9288 int *gplist = NULL;
9289 int *hflist = NULL;
9290 int *lflist = NULL;
9291 gchar *mylit = NULL;
9292 char *p;
9293 gretlopt plotopt = OPT_T;
9294 int plotpd = 0;
9295 int nv, nlf = 0;
9296 int cfac;
9297 int i, s, t, T;
9298 int err;
9299
9300 if (list == NULL || list[0] < 3) {
9301 return E_INVARG;
9302 } else if (!dataset_is_time_series(dset)) {
9303 return E_PDWRONG;
9304 }
9305
9306 if (gretl_list_has_separator(list)) {
9307 err = gretl_list_split_on_separator(list, &hflist, &lflist);
9308 if (err) {
9309 return err;
9310 } else {
9311 cfac = hflist[0];
9312 nlf = lflist[0];
9313 nv = 2 + nlf;
9314 }
9315 } else {
9316 cfac = list[0];
9317 nv = 2;
9318 }
9319
9320 T = sample_size(dset) * cfac;
9321
9322 hset = create_auxiliary_dataset(nv, T, OPT_NONE);
9323 if (hset == NULL) {
9324 return E_ALLOC;
9325 }
9326
9327 /* set the hf series name */
9328 strcpy(hset->varname[1], dset->varname[list[1]]);
9329 p = strrchr(hset->varname[1], '_');
9330 if (p != NULL) {
9331 *p = '\0';
9332 }
9333 transcribe_graph_name(hset, 1, dset, list[1]);
9334
9335 s = 0;
9336 /* transcribe high-frequency data */
9337 for (t=dset->t1; t<=dset->t2; t++) {
9338 for (i=cfac; i>0; i--) {
9339 xit = dset->Z[list[i]][t];
9340 hset->Z[1][s++] = xit;
9341 }
9342 }
9343
9344 if (lflist != NULL) {
9345 /* add low-frequency term(s), if any */
9346 for (i=1; i<=nlf; i++) {
9347 int vi = lflist[i];
9348
9349 strcpy(hset->varname[i+1], dset->varname[vi]);
9350 transcribe_graph_name(hset, i+1, dset, vi);
9351 for (s=0; s<hset->n; s++) {
9352 hset->Z[i+1][s] = NADBL;
9353 }
9354 s = 0;
9355 for (t=dset->t1; t<=dset->t2; t++) {
9356 xit = dset->Z[vi][t];
9357 hset->Z[i+1][s] = xit;
9358 s += cfac;
9359 }
9360 }
9361 }
9362
9363 gplist = gretl_consecutive_list_new(1, nv - 1);
9364
9365 if (lflist != NULL) {
9366 free(lflist);
9367 lflist = gretl_consecutive_list_new(2, nv - 1);
9368 }
9369
9370 /* try to set a suitable time-series interpretation
9371 on the data to be plotted
9372 */
9373 plotpd = pd_from_compfac(dset, cfac, stobs);
9374 if (plotpd > 0) {
9375 char numstr[12];
9376
9377 sprintf(numstr, "%d", plotpd);
9378 set_obs(numstr, stobs, hset, OPT_T);
9379 }
9380
9381 if (opt & OPT_O) {
9382 plotopt |= OPT_O;
9383 }
9384 if (opt & OPT_U) {
9385 plotopt |= OPT_U;
9386 }
9387
9388 if (literal == NULL) {
9389 const char *pdstr = midas_pdstr(dset, cfac);
9390 gchar *title;
9391
9392 title = g_strdup_printf("%s (%s)", hset->varname[1], _(pdstr));
9393 mylit = g_strdup_printf("{ set ylabel ''; set title '%s'; }", title);
9394 g_free(title);
9395 }
9396
9397 set_effective_plot_ci(HFPLOT);
9398 na_skiplist = lflist; /* file-scope global */
9399 err = gnuplot(gplist, literal != NULL ? literal : mylit,
9400 hset, plotopt);
9401 na_skiplist = NULL;
9402 set_effective_plot_ci(GNUPLOT);
9403
9404 free(gplist);
9405 free(hflist);
9406 free(lflist);
9407 g_free(mylit);
9408
9409 destroy_dataset(hset);
9410
9411 return err;
9412 }
9413
9414 /**
9415 * xy_plot_with_control:
9416 * @list: list of variables by ID number: Y, X, control.
9417 * @literal: extra gnuplot commands or %NULL.
9418 * @dset: dataset struct.
9419 * @opt: can add "gnuplot" options.
9420 *
9421 * Constructs a scatterplot of modified Y against modified X,
9422 * where the modification consists in taking the residuals from
9423 * OLS regression of the variable in question on the control variable,
9424 * a la Frisch-Waugh-Lovell.
9425 *
9426 * Returns: 0 on success, non-zero on error.
9427 */
9428
xy_plot_with_control(const int * list,const char * literal,const DATASET * dset,gretlopt opt)9429 int xy_plot_with_control (const int *list, const char *literal,
9430 const DATASET *dset, gretlopt opt)
9431 {
9432 int t1 = dset->t1, t2 = dset->t2;
9433 int mlist[4] = {3, 0, 0, 0};
9434 char dname[MAXDISP];
9435 MODEL mod;
9436 DATASET *gset = NULL;
9437 int vy, vx, vz;
9438 int s, t, T;
9439 int missvals = 0;
9440 int err = 0;
9441
9442 if (list == NULL || list[0] != 3) {
9443 return E_DATA;
9444 }
9445
9446 vy = list[1];
9447 vx = list[2];
9448 vz = list[3];
9449
9450 list_adjust_sample(list, &t1, &t2, dset, &missvals);
9451
9452 /* maximum usable observations */
9453 T = t2 - t1 + 1 - missvals;
9454
9455 if (T < 3) {
9456 return E_DF;
9457 }
9458
9459 /* create temporary dataset */
9460
9461 gset = create_auxiliary_dataset(4, T, 0);
9462 if (gset == NULL) {
9463 return E_ALLOC;
9464 }
9465
9466 sprintf(dname, _("adjusted %s"), dset->varname[vy]);
9467 series_set_display_name(gset, 1, dname);
9468
9469 sprintf(dname, _("adjusted %s"), dset->varname[vx]);
9470 series_set_display_name(gset, 2, dname);
9471
9472 s = 0;
9473 for (t=t1; t<=t2; t++) {
9474 if (!na(dset->Z[vy][t]) && !na(dset->Z[vx][t]) && !na(dset->Z[vz][t])) {
9475 gset->Z[1][s] = dset->Z[vy][t];
9476 gset->Z[2][s] = dset->Z[vx][t];
9477 gset->Z[3][s] = dset->Z[vz][t];
9478 s++;
9479 }
9480 }
9481
9482 /* regress Y (1) on Z (3) and save the residuals in series 1 */
9483
9484 mlist[1] = 1;
9485 mlist[3] = 3;
9486 mod = lsq(mlist, gset, OLS, OPT_A);
9487 err = mod.errcode;
9488 if (err) {
9489 clear_model(&mod);
9490 goto bailout;
9491 } else {
9492 for (t=0; t<mod.nobs; t++) {
9493 gset->Z[1][t] = mod.uhat[t];
9494 }
9495 clear_model(&mod);
9496 }
9497
9498 /* regress X (2) on Z and save the residuals in series 2 */
9499
9500 mlist[1] = 2;
9501 mod = lsq(mlist, gset, OLS, OPT_A);
9502 err = mod.errcode;
9503 if (err) {
9504 clear_model(&mod);
9505 goto bailout;
9506 } else {
9507 for (t=0; t<mod.nobs; t++) {
9508 gset->Z[2][t] = mod.uhat[t];
9509 }
9510 clear_model(&mod);
9511 }
9512
9513 /* call for scatter of Y-residuals against X-residuals */
9514
9515 mlist[0] = 2;
9516 mlist[1] = 1;
9517 mlist[2] = 2;
9518 err = gnuplot(mlist, literal, gset, opt | OPT_C);
9519
9520 bailout:
9521
9522 /* trash the temporary dataset */
9523 destroy_dataset(gset);
9524
9525 return err;
9526 }
9527
is_auto_fit_string(const char * s)9528 int is_auto_fit_string (const char *s)
9529 {
9530 /* FIXME? */
9531 if (strstr(s, "automatic fit")) return 1;
9532 if (strstr(s, _("with least squares fit"))) return 1;
9533 return 0;
9534 }
9535
9536 /**
9537 * gnuplot_process_file:
9538 * @opt: may include %OPT_U for output to specified file.
9539 * @prn: gretl printing struct.
9540 *
9541 * Respond to the "gnuplot" command with %OPT_I, to specify
9542 * that input should be taken from a user-created gnuplot
9543 * command file.
9544 *
9545 * Returns: 0 on success, or if ignored; otherwise error code.
9546 */
9547
gnuplot_process_file(gretlopt opt,PRN * prn)9548 int gnuplot_process_file (gretlopt opt, PRN *prn)
9549 {
9550 const char *inname = get_optval_string(plot_ci, OPT_I);
9551 FILE *fp, *fq;
9552 int err = 0;
9553
9554 if (inname == NULL || *inname == '\0') {
9555 return E_DATA;
9556 }
9557
9558 /* open the user-generated file for reading */
9559 fp = gretl_fopen(inname, "r");
9560 if (fp == NULL) {
9561 return E_FOPEN;
9562 }
9563
9564 /* open our own file for writing */
9565 fq = open_plot_input_file(PLOT_USER, 0, &err);
9566
9567 if (err) {
9568 fclose(fp);
9569 } else {
9570 char line[1024];
9571
9572 while (fgets(line, sizeof line, fp)) {
9573 fputs(line, fq);
9574 }
9575
9576 fclose(fp);
9577 err = finalize_plot_input_file(fq);
9578 }
9579
9580 return err;
9581 }
9582
date_from_gnuplot_time(char * targ,size_t tsize,const char * fmt,double x)9583 void date_from_gnuplot_time (char *targ, size_t tsize,
9584 const char *fmt, double x)
9585 {
9586 #ifdef WIN32
9587 time_t etime = (time_t) x;
9588
9589 strftime(targ, tsize, fmt, localtime(&etime));
9590 #else
9591 struct tm t = {0};
9592 time_t etime = (time_t) x;
9593
9594 localtime_r(&etime, &t);
9595 strftime(targ, tsize, fmt, &t);
9596 #endif
9597 }
9598
gnuplot_time_from_date(const char * s,const char * fmt)9599 double gnuplot_time_from_date (const char *s, const char *fmt)
9600 {
9601 double x = NADBL;
9602
9603 if (fmt != NULL) {
9604 if (strcmp(fmt, "%s") == 0) {
9605 /* already in seconds since epoch start */
9606 x = atof(s);
9607 } else if (*fmt != '\0') {
9608 struct tm t = {0};
9609 time_t etime;
9610 char *test;
9611
9612 test = strptime(s, fmt, &t);
9613 if (test != NULL && *test == '\0') {
9614 /* conversion went OK */
9615 etime = mktime(&t);
9616 x = (double) etime;
9617 }
9618 }
9619 }
9620
9621 return x;
9622 }
9623
9624 /* geoplot functions */
9625
9626 /* stretch_limits(): allow a little extra space in the X and Y
9627 dimensions so that the map doesn't entirely fill the plot
9628 area; the range is scaled by the factor (1 + 2*@margin).
9629 */
9630
stretch_limits(double * targ,const gretl_matrix * minmax,int col,double margin)9631 static void stretch_limits (double *targ, const gretl_matrix *minmax,
9632 int col, double margin)
9633 {
9634 double lo = gretl_matrix_get(minmax, 0, col);
9635 double hi = gretl_matrix_get(minmax, 1, col);
9636 double mid = 0.5 * (lo + hi);
9637 double hlf = 0.5 * (hi - lo) * (1 + 2*margin);
9638
9639 targ[0] = mid - hlf;
9640 targ[1] = mid + hlf;
9641 }
9642
inline_map_data(const char * datfile,FILE * fp)9643 static int inline_map_data (const char *datfile, FILE *fp)
9644 {
9645 char buf[8192];
9646 FILE *fsrc;
9647 size_t n;
9648
9649 fsrc = gretl_fopen(datfile, "rb");
9650 if (fsrc == NULL) {
9651 gretl_errmsg_sprintf(_("Couldn't open %s"), datfile);
9652 return E_FOPEN;
9653 }
9654
9655 fputs("$MapData << EOD\n", fp);
9656 while ((n = fread(buf, 1, sizeof buf, fsrc)) > 0) {
9657 fwrite(buf, 1, n, fp);
9658 }
9659 fputs("EOD\n", fp);
9660
9661 fclose(fsrc);
9662 gretl_remove(datfile); /* not needed any more */
9663
9664 return 0;
9665 }
9666
geoplot_dimensions(double * xlim,double * ylim,int height,int have_payload,int * non_standard)9667 static gretl_matrix *geoplot_dimensions (double *xlim,
9668 double *ylim,
9669 int height,
9670 int have_payload,
9671 int *non_standard)
9672 {
9673 gretl_matrix *ret = gretl_matrix_alloc(1, 2);
9674 double xyr = (xlim[1] - xlim[0]) / (ylim[1] - ylim[0]);
9675 int width;
9676
9677 if (*non_standard == 0) {
9678 if (fabs(ylim[0]) > 180 || fabs(ylim[1]) > 180 ||
9679 fabs(xlim[0]) > 360 || fabs(xlim[1]) > 360) {
9680 /* Quick and dirty check in the absence of prior
9681 information that the X, Y data are not in degrees
9682 of latitude and longitude.
9683 */
9684 fprintf(stderr, "alt coordinates: X %g to %g, Y %g to %g\n",
9685 xlim[0], xlim[1], ylim[0], ylim[1]);
9686 *non_standard = 1;
9687 }
9688 }
9689
9690 if (*non_standard == 0) {
9691 /* We'll calculate a width-to-height ratio which varies
9692 inversely with the (mid-point of) latitude so that we don't
9693 don't get severe stretching in the x dimension when showing
9694 an area far from the equator. In effect this is a cheap and
9695 cheerful version of Mercator.
9696 */
9697 double ymid = (ylim[0] + ylim[1]) / 2;
9698
9699 xyr *= cos(ymid * M_PI/180);
9700 } else {
9701 fprintf(stderr, "non-default projection\n");
9702 }
9703
9704 if (have_payload) {
9705 /* 1.05 is to compensate for the colorbox */
9706 width = floor(xyr * height * 1.05);
9707 } else {
9708 width = floor(xyr * height);
9709 }
9710
9711 set_special_plot_size(width, height);
9712
9713 ret->val[0] = width;
9714 ret->val[1] = height;
9715
9716 return ret;
9717 }
9718
fputs_literal(const char * s,FILE * fp)9719 static void fputs_literal (const char *s, FILE *fp)
9720 {
9721 gchar *tmp = g_strdup(s);
9722
9723 fputs(g_strchomp(tmp), fp);
9724 fputc('\n', fp);
9725 g_free(tmp);
9726 }
9727
simple_print_palette(const char * p,FILE * fp)9728 static void simple_print_palette (const char *p, FILE *fp)
9729 {
9730 if (!strcmp(p, "blues")) {
9731 fputs("set palette defined (0 '#D4E4F2', 1 'steelblue')\n", fp);
9732 } else if (!strcmp(p, "oranges")) {
9733 fputs("set palette defined (0 '#E9D9B5', 1 'dark-orange')\n", fp);
9734 } else if (!strcmp(p, "green-to-red")) {
9735 fputs("set palette defined (0 '#58996E', 1 '#E1D99A', 2 '#C0414C')\n", fp);
9736 } else {
9737 fprintf(fp, "%s\n", p);
9738 }
9739 }
9740
tricky_print_palette(const char * p,const double * zlim,FILE * fp)9741 static void tricky_print_palette (const char *p,
9742 const double *zlim,
9743 FILE *fp)
9744 {
9745 const char *colors[3][3] = {
9746 { "#D4E4F2", "steelblue", NULL }, /* "blues" */
9747 { "#E9D9B5", "dark-orange", NULL }, /* "oranges" */
9748 { "#58996E", "#E1D99A", "#C0414C" } /* "green-to-red" */
9749 };
9750 int i = 3;
9751
9752 if (p == NULL) {
9753 i = 3;
9754 } else if (!strcmp(p, "blues")) {
9755 i = 0;
9756 } else if (!strcmp(p, "oranges")) {
9757 i = 1;
9758 } else if (!strcmp(p, "green-to-red")) {
9759 i = 2;
9760 }
9761
9762 /* FIXME: maybe allow specification of NA fill color? */
9763
9764 fprintf(fp, "set palette defined (%.8g 'gray', ", zlim[0] - 0.002);
9765
9766 if (i == 3) {
9767 const char *hc[] = {
9768 "#000000", "#7202F3", "#A11096",
9769 "#C63700", "#E48300", "#FFFF00"
9770 };
9771 double step = (zlim[1] - zlim[0] + 0.001) / 5;
9772 double z = zlim[0] - 0.001;
9773 int j;
9774
9775 for (j=0; j<6; j++) {
9776 fprintf(fp, "%.8g '%s'", z, hc[j]);
9777 fputs(j == 1 ? ", \\\n" : j < 5 ? ", " : ")\n", fp);
9778 z += step;
9779 }
9780 } else {
9781 fprintf(fp, "%.8g '%s', ", zlim[0] - 0.001, colors[i][0]);
9782 if (i < 2) {
9783 fprintf(fp, "%.8g '%s')\n", zlim[1], colors[i][1]);
9784 } else {
9785 fprintf(fp, "%.8g '%s', %.8g '%s')\n", (zlim[1] - zlim[0]) / 2,
9786 colors[i][1], zlim[1], colors[i][2]);
9787 }
9788 }
9789
9790 /* for this to work, cbrange has to be set using zlim */
9791 fprintf(fp, "set cbrange [%.8g:%.8g]\n", zlim[0] - .001, zlim[1]);
9792 }
9793
handle_palette(gretl_bundle * opts,const gretl_matrix * zrange,int na_action,FILE * fp)9794 static void handle_palette (gretl_bundle *opts,
9795 const gretl_matrix *zrange,
9796 int na_action,
9797 FILE *fp)
9798 {
9799 const double *zlim = zrange->val;
9800 const char *p;
9801
9802 p = gretl_bundle_get_string(opts, "palette", NULL);
9803
9804 if (na_action == NA_FILL) {
9805 tricky_print_palette(p, zlim, fp);
9806 /* cbrange handled */
9807 return;
9808 } else if (p != NULL) {
9809 simple_print_palette(p, fp);
9810 }
9811
9812 fprintf(fp, "set cbrange [%g:%g]\n", zlim[0], zlim[1]);
9813 }
9814
set_plot_limits(gretl_bundle * opts,const gretl_matrix * bbox,double * xlim,double * ylim,double margin)9815 static void set_plot_limits (gretl_bundle *opts,
9816 const gretl_matrix *bbox,
9817 double *xlim, double *ylim,
9818 double margin)
9819 {
9820 const gretl_matrix *mxy, *mx, *my;
9821
9822 mxy = gretl_bundle_get_matrix(opts, "mxy__", NULL);
9823 if (mxy != NULL) {
9824 xlim[0] = mxy->val[0];
9825 xlim[1] = mxy->val[1];
9826 ylim[0] = mxy->val[2];
9827 ylim[1] = mxy->val[3];
9828 gretl_bundle_delete_data(opts, "mxy__");
9829 return;
9830 }
9831
9832 mx = gretl_bundle_get_matrix(opts, "xrange", NULL);
9833 if (mx != NULL && gretl_vector_get_length(mx) == 2) {
9834 xlim[0] = mx->val[0];
9835 xlim[1] = mx->val[1];
9836 } else {
9837 stretch_limits(xlim, bbox, 0, margin);
9838 }
9839
9840 my = gretl_bundle_get_matrix(opts, "yrange", NULL);
9841 if (my != NULL && gretl_vector_get_length(my) == 2) {
9842 ylim[0] = my->val[0];
9843 ylim[1] = my->val[1];
9844 } else {
9845 stretch_limits(ylim, bbox, 1, margin);
9846 }
9847 }
9848
map_linecolor(const char * optlc,int have_payload,int na_action)9849 static const char *map_linecolor (const char *optlc,
9850 int have_payload,
9851 int na_action)
9852 {
9853 if (optlc != NULL) {
9854 /* respect the user's choice */
9855 return optlc;
9856 } else if (have_payload) {
9857 return (na_action == NA_OUTLINE)? "gray" : "white";
9858 } else {
9859 /* outlines only */
9860 return "black";
9861 }
9862 }
9863
9864 /* called from the geoplot plugin to finalize a map */
9865
write_map_gp_file(const char * plotfile,int plotfile_is_image,const char * datfile,const gretl_matrix * bbox,const gretl_matrix * zrange,gretl_bundle * opts,int non_standard,int na_action,int show)9866 int write_map_gp_file (const char *plotfile,
9867 int plotfile_is_image,
9868 const char *datfile,
9869 const gretl_matrix *bbox,
9870 const gretl_matrix *zrange,
9871 gretl_bundle *opts,
9872 int non_standard,
9873 int na_action,
9874 int show)
9875 {
9876 double xlim[2], ylim[2];
9877 gretl_matrix *dims = NULL;
9878 const char *optlc = NULL;
9879 const char *sval;
9880 FILE *fp = NULL;
9881 gchar *datasrc = NULL;
9882 double linewidth = 1.0;
9883 double margin = 0.02;
9884 int have_payload = 0;
9885 int use_arg0 = 0;
9886 int height = 600;
9887 int border = 1;
9888 int notics = 1;
9889 int err = 0;
9890
9891 if (zrange != NULL) {
9892 have_payload = 1;
9893 } else if (opts == NULL) {
9894 /* the simple outlines case */
9895 border = 1;
9896 notics = 0;
9897 }
9898
9899 if (opts != NULL) {
9900 set_plot_limits(opts, bbox, xlim, ylim, margin);
9901 } else {
9902 stretch_limits(xlim, bbox, 0, margin);
9903 stretch_limits(ylim, bbox, 1, margin);
9904 }
9905
9906 if (gretl_bundle_has_key(opts, "height")) {
9907 height = gretl_bundle_get_scalar(opts, "height", &err);
9908 if (show && height <= 0) {
9909 height = 600;
9910 }
9911 }
9912
9913 gretl_push_c_numeric_locale();
9914
9915 if (height > 0) {
9916 dims = geoplot_dimensions(xlim, ylim, height, have_payload,
9917 &non_standard);
9918 }
9919 if (show) {
9920 set_optval_string(GNUPLOT, OPT_U, "display");
9921 if (plotfile != NULL) {
9922 iact_gpfile = (char *) plotfile;
9923 }
9924 } else if (plotfile_is_image) {
9925 set_optval_string(GNUPLOT, OPT_U, plotfile);
9926 }
9927
9928 fp = open_plot_input_file(PLOT_GEOMAP, 0, &err);
9929 if (err) {
9930 return err;
9931 }
9932
9933 fprintf(fp, "# geoplot %g %g\n", dims->val[0], dims->val[1]);
9934
9935 fputs("unset key\n", fp);
9936
9937 if (have_payload) {
9938 handle_palette(opts, zrange, na_action, fp);
9939 }
9940
9941 fprintf(fp, "set xrange [%g:%g]\n", xlim[0], xlim[1]);
9942 fprintf(fp, "set yrange [%g:%g]\n", ylim[0], ylim[1]);
9943
9944 if (gretl_bundle_has_key(opts, "title")) {
9945 sval = gretl_bundle_get_string(opts, "title", NULL);
9946 if (sval != NULL) {
9947 fprintf(fp, "set title \"%s\"\n", sval);
9948 }
9949 }
9950
9951 if (gretl_bundle_get_int(opts, "tics", NULL)) {
9952 notics = 0;
9953 }
9954 if (notics) {
9955 fputs("set noxtics\n", fp);
9956 fputs("set noytics\n", fp);
9957 }
9958
9959 if (gretl_bundle_get_int(opts, "logscale", NULL)) {
9960 fputs("set logscale cb\n", fp);
9961 }
9962
9963 if (gretl_bundle_has_key(opts, "border")) {
9964 /* allow override of default */
9965 border = gretl_bundle_get_int(opts, "border", NULL);
9966 }
9967
9968 if (border == 0) {
9969 fputs("unset border\n", fp);
9970 }
9971
9972 if ((sval = gretl_bundle_get_string(opts, "literal", NULL))) {
9973 fputs_literal(sval, fp);
9974 }
9975
9976 if (gretl_bundle_has_key(opts, "linewidth")) {
9977 double lw = gretl_bundle_get_scalar(opts, "linewidth", &err);
9978
9979 if (!err && lw >= 0) {
9980 if (have_payload) {
9981 linewidth = lw;
9982 } else if (lw >= 0.1) {
9983 linewidth = lw;
9984 }
9985 }
9986 }
9987 if (gretl_bundle_has_key(opts, "linecolor")) {
9988 sval = gretl_bundle_get_string(opts, "linecolor", &err);
9989 if (!err) {
9990 optlc = sval;
9991 }
9992 }
9993
9994 gnuplot_missval_string(fp);
9995
9996 if (gretl_bundle_get_int(opts, "inlined", NULL)) {
9997 err = inline_map_data(datfile, fp);
9998 if (!err) {
9999 datasrc = g_strdup("$MapData");
10000 }
10001 } else if (plotfile_is_image) {
10002 /* @plotfile and @datfile are both disposable, no need
10003 to bother about name alignment
10004 */
10005 datasrc = g_strdup_printf("\"%s\"", datfile);
10006 } else if (plotfile != NULL) {
10007 /* the names of @plotfile and @datfile will already be
10008 correctly aligned
10009 */
10010 use_arg0 = 1;
10011 } else {
10012 /* rename @datfile to match the auto-named plot file */
10013 gchar *tmp = g_strdup_printf("%s.dat", gretl_plotfile());
10014
10015 gretl_copy_file(datfile, tmp);
10016 gretl_remove(datfile);
10017 g_free(tmp);
10018 use_arg0 = 1;
10019 }
10020
10021 if (use_arg0) {
10022 fputs("datafile = sprintf(\"%s.dat\", ARG0)\n", fp);
10023 datasrc = g_strdup("datafile");
10024 }
10025
10026 if (!err) {
10027 const char *lc = map_linecolor(optlc, have_payload, na_action);
10028 gchar *bline = NULL;
10029
10030 if (have_payload) {
10031 if (linewidth == 0) {
10032 fprintf(fp, "plot for [i=0:*] %s index i with filledcurves fc palette\n",
10033 datasrc);
10034 } else {
10035 bline = g_strdup_printf("lc '%s' lw %g", lc, linewidth);
10036 fprintf(fp, "plot for [i=0:*] %s index i with filledcurves fc palette, \\\n",
10037 datasrc);
10038 fprintf(fp, " %s using 1:2 with lines %s\n", datasrc, bline);
10039 }
10040 } else {
10041 bline = g_strdup_printf("lc '%s' lw %g", lc, linewidth);
10042 fprintf(fp, "plot %s using 1:2 with lines %s\n", datasrc, bline);
10043 }
10044 g_free(bline);
10045 }
10046
10047 g_free(datasrc);
10048
10049 err = finalize_plot_input_file(fp);
10050 if (!err) {
10051 if (show && gretl_in_gui_mode()) {
10052 if (gretl_bundle_get_int(opts, "gui_auto", NULL)) {
10053 gretl_bundle_set_string(opts, "plotfile", gretl_plotfile());
10054 gretl_bundle_set_matrix(opts, "dims", dims);
10055 } else {
10056 manufacture_gui_callback(GNUPLOT);
10057 }
10058 }
10059 }
10060
10061 gretl_pop_c_numeric_locale();
10062
10063 gretl_matrix_free(dims);
10064
10065 return err;
10066 }
10067
10068 /* Transcribe geoplot map file from @src to @dest, allowing for
10069 the possibility that data contained in a separate datafile
10070 have to be inlined. If @datname is NULL it is assumed that
10071 the datafile will be named as @src, with ".dat" appended.
10072 */
10073
transcribe_geoplot_file(const char * src,const char * dest,const char * datname)10074 int transcribe_geoplot_file (const char *src,
10075 const char *dest,
10076 const char *datname)
10077 {
10078 FILE *f1 = NULL, *f2 = NULL;
10079 const char *mapdata = "$MapData";
10080 char buf[8196];
10081 int integrate = -1;
10082 int n, err = 0;
10083
10084 f1 = gretl_fopen(src, "rb");
10085 f2 = gretl_fopen(dest, "wb");
10086
10087 if (f1 == NULL || f2 == NULL) {
10088 err = E_FOPEN;
10089 goto bailout;
10090 }
10091
10092 while (integrate < 0 && fgets(buf, sizeof buf, f1)) {
10093 if (strstr(buf, mapdata)) {
10094 integrate = 0;
10095 } else if (!strncmp(buf, "datafile =", 10)) {
10096 integrate = 1;
10097 } else {
10098 fputs(buf, f2);
10099 }
10100 }
10101
10102 if (integrate == 1) {
10103 /* open the datafile and inject its content */
10104 gchar *s, *dattmp = NULL;
10105 FILE *fdat = NULL;
10106 int i;
10107
10108 if (datname != NULL) {
10109 fdat = gretl_fopen(datname, "rb");
10110 } else {
10111 dattmp = g_strdup_printf("%s.dat", src);
10112 fdat = gretl_fopen(dattmp, "rb");
10113 g_free(dattmp);
10114 }
10115
10116 if (fdat == NULL) {
10117 err = E_FOPEN;
10118 } else {
10119 /* inject data */
10120 fprintf(f2, "%s << EOD\n", mapdata);
10121 while ((n = fread(buf, 1, sizeof buf, fdat)) > 0) {
10122 fwrite(buf, 1, n, f2);
10123 }
10124 fputs("EOD\n", f2);
10125 fclose(fdat);
10126 buf[0] = '\0';
10127
10128 /* and transcribe the remainder of @src */
10129 while (fgets(buf, sizeof buf, f1)) {
10130 if ((s = strstr(buf, "datafile")) != NULL) {
10131 for (i=0; i<8; i++) {
10132 s[i] = mapdata[i];
10133 }
10134 }
10135 fputs(buf, f2);
10136 }
10137 }
10138 } else if (integrate == 0) {
10139 /* integration not needed */
10140 while ((n = fread(buf, 1, sizeof buf, f1)) > 0) {
10141 fwrite(buf, 1, n, f2);
10142 }
10143 } else {
10144 /* ?? */
10145 err = E_DATA;
10146 }
10147
10148 bailout:
10149
10150 if (f1 != NULL) fclose(f1);
10151 if (f2 != NULL) fclose(f2);
10152
10153 return err;
10154 }
10155
10156 /* called from the interpolate plugin */
10157
write_tdisagg_plot(const gretl_matrix * YY,int mult,const char * title,DATASET * dset)10158 int write_tdisagg_plot (const gretl_matrix *YY, int mult,
10159 const char *title, DATASET *dset)
10160 {
10161 const double *obs = NULL;
10162 char mstr[16] = {0};
10163 int t, T = YY->rows;
10164 double y0t;
10165 FILE *fp;
10166 int err = 0;
10167
10168 set_optval_string(GNUPLOT, OPT_U, "display");
10169 fp = open_plot_input_file(PLOT_REGULAR, GPT_LETTERBOX, &err);
10170 if (err) {
10171 return err;
10172 }
10173
10174 if (dset != NULL) {
10175 fprintf(fp, "# timeseries %d (letterbox)\n", dset->pd);
10176 obs = gretl_plotx(dset, OPT_NONE);
10177 } else {
10178 fputs("# timeseries 1 (letterbox)\n", fp);
10179 }
10180 fputs("set key left top\n", fp);
10181 fputs("set xzeroaxis\n", fp);
10182 if (title != NULL) {
10183 fprintf(fp, "set title \"%s\"\n", title);
10184 }
10185
10186 gretl_push_c_numeric_locale();
10187
10188 if (obs != NULL) {
10189 double d1 = obs[dset->t1];
10190 double d2 = obs[dset->t2];
10191
10192 fprintf(fp, "set xrange [%g:%g]\n", floor(d1), ceil(d2));
10193 }
10194
10195 gnuplot_missval_string(fp);
10196 fputs("# start inline data\n", fp);
10197 fputs("$data << EOD\n", fp);
10198 for (t=0; t<T; t++) {
10199 if (obs != NULL) {
10200 fprintf(fp, "%g ", obs[t+dset->t1]);
10201 } else {
10202 fprintf(fp, "%d ", t + 1);
10203 }
10204 y0t = gretl_matrix_get(YY, t, 0);
10205 if (na(y0t)) {
10206 fputs("? ", fp);
10207 } else {
10208 fprintf(fp, "%.10g ", y0t);
10209 }
10210 fprintf(fp, "%.10g\n", gretl_matrix_get(YY, t, 1));
10211 }
10212 fputs("EOD\n", fp);
10213
10214 if (mult > 1) {
10215 sprintf(mstr, " * %d", mult);
10216 }
10217
10218 fprintf(fp, "plot $data using 1:2 title \"%s\" w steps, \\\n",
10219 _("original data"));
10220 fprintf(fp, " $data using 1:3 title \"%s%s\" w lines\n",
10221 _("final series"), mstr);
10222
10223 err = finalize_plot_input_file(fp);
10224
10225 if (!err && gretl_in_gui_mode()) {
10226 manufacture_gui_callback(GNUPLOT);
10227 }
10228
10229 gretl_pop_c_numeric_locale();
10230
10231 return err;
10232 }
10233