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