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 /* library.c for gretl -- main interface to libgretl functions */
21
22 #include "gretl.h"
23 #include "var.h"
24 #include "johansen.h"
25 #include "textbuf.h"
26 #include "gpt_control.h"
27 #include "graph_page.h"
28 #include "console.h"
29 #include "system.h"
30 #include "gretl_restrict.h"
31 #include "gretl_func.h"
32 #include "monte_carlo.h"
33 #include "forecast.h"
34 #include "dbwrite.h"
35 #include "menustate.h"
36 #include "dlgutils.h"
37 #include "ssheet.h"
38 #include "toolbar.h"
39 #include "treeutils.h"
40 #include "lib_private.h"
41 #include "cmd_private.h"
42 #include "flow_control.h"
43 #include "libset.h"
44 #include "libglue.h"
45 #include "objstack.h"
46 #include "gretl_xml.h"
47 #include "gretl_panel.h"
48 #include "gretl_midas.h"
49 #include "gretl_foreign.h"
50 #include "gretl_help.h"
51 #include "gretl_zip.h"
52 #include "uservar.h"
53 #include "gretl_string_table.h"
54 #include "csvdata.h"
55 #include "matrix_extra.h"
56 #include "gretl_typemap.h"
57 #include "gretl_www.h"
58 #include "texprint.h"
59 #include "bootstrap.h"
60 #include "fileselect.h"
61 #include "database.h"
62 #include "winstack.h"
63 #include "guiprint.h"
64 #include "varinfo.h"
65 #include "fncall.h"
66
67 #ifdef G_OS_WIN32
68 # include <io.h>
69 # include "gretlwin32.h"
70 #else
71 # include <unistd.h>
72 # include <sys/stat.h>
73 #endif
74
75 #include "session.h"
76 #include "selector.h"
77 #include "boxplots.h"
78 #include "series_view.h"
79 #include "objectsave.h"
80 #include "datafiles.h"
81 #include "model_table.h"
82 #include "cmdstack.h"
83 #include "filelists.h"
84 #include "fnsave.h"
85 #include "dbread.h"
86
87 #define CMD_DEBUG 0
88
89 /* file scope state variables */
90 static CMD libcmd;
91 static char libline[MAXLINE];
92 static int original_n;
93 static int gui_main_exec;
94
get_lib_cmdline(void)95 char *get_lib_cmdline (void)
96 {
97 return libline;
98 }
99
get_lib_cmd(void)100 CMD *get_lib_cmd (void)
101 {
102 return &libcmd;
103 }
104
lib_cmd_destroy_context(void)105 void lib_cmd_destroy_context (void)
106 {
107 gretl_cmd_destroy_context(&libcmd);
108 }
109
set_original_n(int n)110 void set_original_n (int n)
111 {
112 original_n = n;
113 }
114
get_original_n(void)115 int get_original_n (void)
116 {
117 return original_n;
118 }
119
120 /* the following two functions are called from gretl.c,
121 at start-up and at exit respectively */
122
library_command_init(void)123 void library_command_init (void)
124 {
125 gretl_cmd_init(&libcmd);
126 }
127
library_command_free(void)128 void library_command_free (void)
129 {
130 gretl_cmd_free(&libcmd);
131 }
132
gui_graph_handler(int err)133 void gui_graph_handler (int err)
134 {
135 if (err) {
136 gui_errmsg(err);
137 } else {
138 register_graph();
139 }
140 }
141
142 /* the following three functions are used to write
143 a command line into the static string @libline
144 */
145
lib_command_sprintf(const char * template,...)146 int lib_command_sprintf (const char *template, ...)
147 {
148 va_list args;
149 int len;
150
151 memset(libline, 0, MAXLINE);
152
153 va_start(args, template);
154 len = g_vsnprintf(libline, MAXLINE, template, args);
155 va_end(args);
156
157 if (len > MAXLINE) {
158 warnbox_printf(_("Maximum length of command line "
159 "(%d bytes) exceeded"), MAXLINE);
160 }
161
162 return len;
163 }
164
lib_command_strcpy(const char * s)165 int lib_command_strcpy (const char *s)
166 {
167 memset(libline, 0, MAXLINE);
168 strncat(libline, s, MAXLINE - 1);
169
170 return 0;
171 }
172
lib_command_strcat(const char * s)173 int lib_command_strcat (const char *s)
174 {
175 int n = MAXLINE - strlen(libline) - 1;
176
177 if (n > 0) {
178 strncat(libline, s, n);
179 }
180
181 return 0;
182 }
183
user_fopen(const char * fname,char * fullname,PRN ** pprn)184 int user_fopen (const char *fname, char *fullname, PRN **pprn)
185 {
186 int err = 0;
187
188 strcpy(fullname, gretl_dotdir());
189 strcat(fullname, fname);
190
191 *pprn = gretl_print_new_with_filename(fullname, &err);
192
193 if (err) {
194 gui_errmsg(err);
195 }
196
197 return err;
198 }
199
bufopen(PRN ** pprn)200 gint bufopen (PRN **pprn)
201 {
202 static int has_minus = -1;
203 int err = 0;
204
205 *pprn = gretl_print_new(GRETL_PRINT_BUFFER, &err);
206
207 if (err) {
208 gui_errmsg(err);
209 } else {
210 if (has_minus < 0) {
211 /* check for Unicode minus sign, U+2212 */
212 has_minus = font_has_symbol(fixed_font, 0x2212);
213 }
214
215 if (has_minus > 0) {
216 gretl_print_set_has_minus(*pprn);
217 }
218 }
219
220 return err;
221 }
222
cmd_to_buf(CMD * cmd,const char * line)223 static char *cmd_to_buf (CMD *cmd, const char *line)
224 {
225 PRN *cmdprn = NULL;
226 char *buf = NULL;
227
228 bufopen(&cmdprn);
229
230 if (cmdprn != NULL) {
231 gretl_record_command(cmd, line, cmdprn);
232 buf = gretl_print_steal_buffer(cmdprn);
233 gretl_print_destroy(cmdprn);
234 }
235
236 return buf;
237 }
238
239 /* -- A note on recording commands --
240
241 Wherever it's appropriate, we want to record the CLI equivalent of
242 actions performed via the gretl GUI. There are two variant methods
243 for doing this, depending on the complexity of the command. These
244 methods share the same first step, namely:
245
246 Step 1: The functions lib_command_{strcpy|strcat|sprintf} are used
247 to write the relevant command into the static string @libline,
248 which lives in this file, library.c. This stores the command line
249 but does not yet write it into the command log.
250
251 The SIMPLER command-recording variant then uses
252 record_command_verbatim() to arrange for the string stored in
253 @libline to be written to the log. (Note that this shouldn't be
254 done until it's known that the GUI action in question was
255 successful; we don't want to write failed commands into the log.)
256
257 The MORE COMPLEX variant uses parse_lib_command() followed by
258 record_lib_command(). The first of these functions runs the stored
259 @libline through the libgretl command parser, and the second calls
260 the libgretl function gretl_record_command() to produce the
261 "canonical form" of the command, which is then entered in the
262 command log.
263
264 Why bother with the more complex variant? First, parsing the
265 command line may expose an error which we'll then be able to
266 catch. In addition, gretl_record_command() automatically breaks
267 overly long lines, making for better legibility.
268
269 IMPORTANT: when the second command-logging method is used,
270 parse_lib_command() must always be called before
271 record_lib_command(). The correct "echoing" of a command depends on
272 the gretl CMD structure @libcmd being filled out appropriately by
273 the parser, and moreover wrong use of record_lib_command() can
274 produce a segfault in certain conditions.
275
276 Typically, between calling parse_lib_command and record_lib_command
277 we check to see if the action is successful; once again, we'd like
278 to avoid logging failed commands.
279
280 Final point: at present we're not actually logging all the GUI
281 actions that have a CLI counterpart. A useful task for a "rainy
282 day" would be to find unrecorded actions and add some more logging
283 code.
284 */
285
286 /* To have the command flagged as associated with a particular
287 model, give the model's ID member a argument; otherwise
288 give 0.
289 */
290
real_record_lib_command(int model_ID)291 static int real_record_lib_command (int model_ID)
292 {
293 char *buf;
294 int err = 0;
295
296 /* @libcmd must be filled out using parse_lib_command()
297 before we get here: see the long note above
298 */
299
300 #if CMD_DEBUG
301 fprintf(stderr, "record_lib_command:\n");
302 fprintf(stderr, " libcmd.ci: %d\n", libcmd.ci);
303 fprintf(stderr, " libcmd.param: '%s'\n", libcmd.param);
304 fprintf(stderr, " libcmd.opt: %d\n", (int) libcmd.opt);
305 fprintf(stderr, " line: '%s'\n", libline);
306 #endif
307
308 buf = cmd_to_buf(&libcmd, libline);
309
310 if (buf == NULL) {
311 err = 1;
312 } else {
313 #if CMD_DEBUG
314 fprintf(stderr, "from gretl_record_command: buf='%s'\n", buf);
315 #endif
316 if (model_ID > 0) {
317 err = add_model_command_to_stack(buf, model_ID, 1);
318 } else {
319 err = add_command_to_stack(buf, 1);
320 }
321 free(buf);
322 }
323
324 return err;
325 }
326
327 /* log a command in @libline that has been pre-parsed */
328
record_lib_command(void)329 static int record_lib_command (void)
330 {
331 return real_record_lib_command(0);
332 }
333
334 /* variant of the above for commands that pertain to a
335 given model
336 */
337
record_model_command(int model_ID)338 static int record_model_command (int model_ID)
339 {
340 return real_record_lib_command(model_ID);
341 }
342
343 /* log a "simple" command when we already know that it
344 worked OK; doesn't require that parse_lib_command
345 has been called
346 */
347
record_command_verbatim(void)348 int record_command_verbatim (void)
349 {
350 return add_command_to_stack(libline, 0);
351 }
352
353 /* variant of the above for commands that pertain to a
354 given model
355 */
356
record_model_command_verbatim(int model_ID)357 int record_model_command_verbatim (int model_ID)
358 {
359 return add_model_command_to_stack(libline, model_ID, 0);
360 }
361
362 /* parses @libline and fills out @libcmd, but does
363 not of itself record (or execute) the command
364 */
365
parse_lib_command(void)366 static int parse_lib_command (void)
367 {
368 int err;
369
370 #if CMD_DEBUG
371 fprintf(stderr, "parse_lib_command: '%s'\n", libline);
372 #endif
373
374 err = parse_gui_command(libline, &libcmd, dataset);
375 if (err) {
376 gui_errmsg(err);
377 }
378
379 return err;
380 }
381
382 /* checks command line @s for errors, and if OK returns
383 an allocated copy of the command list */
384
command_list_from_string(const char * s,int * err)385 int *command_list_from_string (const char *s, int *err)
386 {
387 int *list = NULL;
388
389 list = generate_list(s, dataset, err);
390
391 if (*err) {
392 gui_errmsg(*err);
393 }
394
395 return list;
396 }
397
gui_exact_fit_check(MODEL * pmod)398 static int gui_exact_fit_check (MODEL *pmod)
399 {
400 if (pmod->rsq == 1.0) {
401 infobox(_("The model exhibits an exact linear fit"));
402 return 1;
403 }
404
405 return 0;
406 }
407
add_or_replace_series(double * x,const char * vname,const char * descrip,int flag)408 static int add_or_replace_series (double *x,
409 const char *vname,
410 const char *descrip,
411 int flag)
412 {
413 int v = series_index(dataset, vname);
414 int err = 0;
415
416 if (v > 0 && v < dataset->v) {
417 /* replacing */
418 err = dataset_replace_series(dataset, v, x,
419 descrip, flag);
420 } else {
421 /* adding */
422 if (flag == DS_GRAB_VALUES) {
423 err = dataset_add_allocated_series(dataset, x);
424 } else {
425 err = dataset_add_series(dataset, 1);
426 }
427 if (err) {
428 gui_errmsg(err);
429 } else {
430 v = dataset->v - 1;
431 strcpy(dataset->varname[v], vname);
432 series_record_label(dataset, v, descrip);
433 if (flag == DS_COPY_VALUES) {
434 int t;
435
436 for (t=0; t<dataset->n; t++) {
437 dataset->Z[v][t] = x[t];
438 }
439 }
440 }
441 }
442
443 return err;
444 }
445
add_or_replace_series_data(const double * x,int t1,int t2,const char * vname,const char * descrip)446 static int add_or_replace_series_data (const double *x,
447 int t1, int t2,
448 const char *vname,
449 const char *descrip)
450 {
451 int v = series_index(dataset, vname);
452 int err = 0;
453
454 if (v > 0 && v < dataset->v) {
455 /* replacing */
456 err = dataset_replace_series_data(dataset, v,
457 x, t1, t2,
458 descrip);
459 } else {
460 /* adding */
461 int t, s = 0;
462
463 err = dataset_add_series(dataset, 1);
464 if (err) {
465 gui_errmsg(err);
466 } else {
467 v = dataset->v - 1;
468 strcpy(dataset->varname[v], vname);
469 series_record_label(dataset, v, descrip);
470 for (t=0; t<dataset->n; t++) {
471 if (t >= t1 && t <= t2) {
472 dataset->Z[v][t] = x[s++];
473 } else {
474 dataset->Z[v][t] = NADBL;
475 }
476 }
477 }
478 }
479
480 return err;
481 }
482
add_mahalanobis_data(windata_t * vwin)483 void add_mahalanobis_data (windata_t *vwin)
484 {
485 MahalDist *md = (MahalDist *) vwin->data;
486 const double *dx;
487 const int *mlist;
488 char *liststr;
489 char vname[VNAMELEN];
490 gchar *descrip = NULL;
491 int cancel = 0;
492 int err = 0;
493
494 if (md == NULL) {
495 errbox(_("Error adding variables"));
496 return;
497 }
498
499 dx = mahal_dist_get_distances(md);
500 mlist = mahal_dist_get_varlist(md);
501 if (dx == NULL || mlist == NULL) {
502 errbox(_("Error adding variables"));
503 return;
504 }
505
506 strcpy(vname, "mdist");
507 descrip = g_strdup(_("Mahalanobis distances"));
508
509 name_new_series_dialog(vname, &descrip, vwin, &cancel);
510
511 if (cancel) {
512 g_free(descrip);
513 return;
514 }
515
516 err = add_or_replace_series((double *) dx, vname, descrip,
517 DS_COPY_VALUES);
518 g_free(descrip);
519
520 if (!err) {
521 liststr = gretl_list_to_string(mlist, dataset, &err);
522 if (liststr != NULL) {
523 lib_command_sprintf("mahal%s --save", liststr);
524 record_command_verbatim();
525 free(liststr);
526 }
527 }
528 }
529
add_pca_data(windata_t * vwin)530 void add_pca_data (windata_t *vwin)
531 {
532 VMatrix *cmat = (VMatrix *) vwin->data;
533 int oldv = dataset->v;
534 int err;
535
536 err = call_pca_plugin(cmat, dataset, OPT_D, NULL);
537
538 if (err) {
539 gui_errmsg(err);
540 } else if (dataset->v > oldv) {
541 int addv = dataset->v - oldv;
542 gretlopt opt = (addv == cmat->dim)? OPT_A : OPT_O;
543 char *liststr;
544
545 liststr = gretl_list_to_string(cmat->list, dataset, &err);
546 if (liststr != NULL) {
547 lib_command_sprintf("pca%s%s", liststr, print_flags(opt, PCA));
548 record_command_verbatim();
549 free(liststr);
550 }
551 }
552 }
553
EC_num_from_action(GtkAction * action,int * j)554 static void EC_num_from_action (GtkAction *action, int *j)
555 {
556 const gchar *s = gtk_action_get_name(action);
557
558 sscanf(s, "%*s %d", j);
559 }
560
VECM_add_EC_data(GtkAction * action,gpointer p)561 void VECM_add_EC_data (GtkAction *action, gpointer p)
562 {
563 windata_t *vwin = (windata_t *) p;
564 GRETL_VAR *var = (GRETL_VAR *) vwin->data;
565 double *x = NULL;
566 char vname[VNAMELEN];
567 gchar *descrip = NULL;
568 int id = gretl_VECM_id(var);
569 int j, cancel = 0;
570 int err = 0;
571
572 EC_num_from_action(action, &j);
573 x = gretl_VECM_get_EC(var, j, dataset, &err);
574 if (err) {
575 gui_errmsg(err);
576 return;
577 }
578
579 j++;
580 sprintf(vname, "EC%d", j);
581 descrip = g_strdup_printf(_("error correction term %d from VECM %d"), j, id);
582 name_new_series_dialog(vname, &descrip, vwin, &cancel);
583 if (cancel) {
584 free(x);
585 g_free(descrip);
586 return;
587 }
588
589 err = add_or_replace_series(x, vname, descrip, DS_GRAB_VALUES);
590 g_free(descrip);
591
592 if (err) {
593 free(x);
594 } else {
595 populate_varlist();
596 mark_dataset_as_modified();
597 }
598 }
599
600 /* note: called from add_data_callback() */
601
add_fcast_data(windata_t * vwin,ModelDataIndex idx)602 void add_fcast_data (windata_t *vwin, ModelDataIndex idx)
603 {
604 FITRESID *fr = (FITRESID *) vwin->data;
605 char vname[VNAMELEN];
606 gchar *descrip = NULL;
607 int cancel = 0;
608 int err = 0;
609
610 strcpy(vname, fr->depvar);
611 gretl_trunc(vname, 12);
612
613 if (idx == M_FCSE) {
614 strcat(vname, "_se");
615 descrip = g_strdup_printf(_("forecast std errors of %s"), fr->depvar);
616 } else {
617 strcat(vname, "_hat");
618 descrip = g_strdup_printf(_("forecast of %s"), fr->depvar);
619 }
620
621 name_new_series_dialog(vname, &descrip, vwin, &cancel);
622 if (cancel) {
623 g_free(descrip);
624 return;
625 }
626
627 err = add_or_replace_series(idx == M_FCSE ? fr->sderr : fr->fitted,
628 vname, descrip, DS_COPY_VALUES);
629 g_free(descrip);
630
631 if (!err) {
632 char stobs[OBSLEN], endobs[OBSLEN];
633
634 ntolabel(stobs, fr->t1, dataset);
635 ntolabel(endobs, fr->t2, dataset);
636 if (idx == M_FCSE) {
637 lib_command_sprintf("fcast %s %s --quiet", stobs, endobs);
638 record_model_command_verbatim(fr->model_ID);
639 lib_command_sprintf("series %s = $fcse", vname);
640 record_model_command_verbatim(fr->model_ID);
641 } else {
642 lib_command_sprintf("fcast %s %s %s", stobs, endobs, vname);
643 record_model_command_verbatim(fr->model_ID);
644 }
645 refresh_data();
646 }
647 }
648
selected_varname(void)649 static const char *selected_varname (void)
650 {
651 return dataset->varname[mdata_active_var()];
652 }
653
get_summary_stats_option(gretlopt * popt,GtkWidget * parent)654 static int get_summary_stats_option (gretlopt *popt,
655 GtkWidget *parent)
656 {
657 static int deflt = 0;
658 const char *opts[] = {
659 N_("Show main statistics"),
660 N_("Show full statistics")
661 };
662 int resp;
663
664 resp = radio_dialog(NULL, NULL, opts, 2, deflt,
665 0, parent);
666
667 if (resp >= 0) {
668 deflt = resp;
669 }
670
671 if (resp == 0) {
672 *popt = OPT_S;
673 }
674
675 return resp;
676 }
677
do_menu_op(int ci,const char * liststr,gretlopt opt,GtkWidget * parent)678 void do_menu_op (int ci, const char *liststr, gretlopt opt,
679 GtkWidget *parent)
680 {
681 PRN *prn;
682 gchar *title = NULL;
683 gpointer obj = NULL;
684 gint hsize = 78, vsize = 380;
685 const char *flagstr = NULL;
686 int err = 0;
687
688 if (ci == CORR || ci == PCA || ci == XTAB) {
689 flagstr = print_flags(opt, ci);
690 }
691
692 if (ci == ALL_SUMMARY || ci == SUMMARY) {
693 /* all series or listed series */
694 int resp = get_summary_stats_option(&opt, parent);
695
696 if (resp == GRETL_CANCEL) return;
697 }
698
699 if (ci == ALL_CORR) {
700 /* correlation matrix, all series */
701 lib_command_strcpy("corr");
702 title = g_strdup_printf("gretl: %s", _("correlation matrix"));
703 ci = CORR;
704 } else if (ci == ALL_SUMMARY) {
705 /* summary stats, all series or list */
706 if (opt & OPT_S) {
707 lib_command_strcpy("summary --simple");
708 } else {
709 lib_command_strcpy("summary");
710 }
711 title = g_strdup_printf("gretl: %s", _("summary statistics"));
712 ci = SUMMARY;
713 } else if (ci == VAR_SUMMARY) {
714 /* summary stats, single series */
715 lib_command_sprintf("summary %s", selected_varname());
716 title = g_strdup_printf("gretl: %s%s", _("summary stats: "),
717 selected_varname());
718 ci = SUMMARY;
719 vsize = 300;
720 } else if (ci == NORMTEST) {
721 /* normality test, single series */
722 lib_command_sprintf("normtest %s --all", selected_varname());
723 title = g_strdup_printf("gretl: %s", _("normality test"));
724 vsize = 300;
725 } else if (liststr == NULL) {
726 /* beyond here we need a list */
727 err = E_DATA;
728 } else {
729 switch (ci) {
730 case CORR:
731 lib_command_sprintf("corr%s%s", liststr, flagstr);
732 title = g_strdup_printf("gretl: %s", _("correlation matrix"));
733 break;
734 case PCA:
735 lib_command_sprintf("pca%s%s", liststr, flagstr);
736 title = g_strdup_printf("gretl: %s", _("principal components"));
737 break;
738 case MAHAL:
739 lib_command_sprintf("mahal%s", liststr);
740 hsize = 60;
741 title = g_strdup_printf("gretl: %s", _("Mahalanobis distances"));
742 break;
743 case XTAB:
744 lib_command_sprintf("xtab %s%s", liststr, flagstr);
745 title = g_strdup_printf("gretl: %s", _("cross tabulation"));
746 vsize = 340;
747 break;
748 case SUMMARY:
749 if (opt & OPT_S) {
750 lib_command_sprintf("summary%s --simple", liststr);
751 } else {
752 lib_command_sprintf("summary%s", liststr);
753 }
754 title = g_strdup_printf("gretl: %s", _("summary statistics"));
755 break;
756 default:
757 break;
758 }
759 }
760
761 if (err || parse_lib_command() || bufopen(&prn)) {
762 g_free(title);
763 return;
764 }
765
766 if (libcmd.list == NULL) {
767 libcmd.list = full_var_list(dataset, NULL);
768 if (libcmd.list == NULL) {
769 g_free(title);
770 return;
771 }
772 }
773
774 switch (ci) {
775 case CORR:
776 case PCA:
777 obj = corrlist(ci, libcmd.list, dataset, opt, &err);
778 if (!err) {
779 if (ci == CORR) {
780 print_corrmat(obj, dataset, prn);
781 } else {
782 err = call_pca_plugin((VMatrix *) obj, dataset,
783 OPT_NONE, prn);
784 }
785 }
786 break;
787 case XTAB:
788 if (libcmd.list[0] == 2) {
789 obj = single_crosstab(libcmd.list, dataset, opt,
790 prn, &err);
791 } else {
792 err = crosstab(libcmd.list, dataset, opt, prn);
793 ci = PRINT;
794 }
795 break;
796 case MAHAL:
797 if (libcmd.list[0] <= 4) {
798 opt = OPT_V;
799 }
800 obj = get_mahal_distances(libcmd.list, dataset, opt,
801 prn, &err);
802 break;
803 case SUMMARY:
804 obj = get_summary(libcmd.list, dataset, opt, prn, &err);
805 if (!err) {
806 print_summary(obj, dataset, prn);
807 }
808 break;
809 case NORMTEST:
810 err = gretl_normality_test(libcmd.list[1], dataset,
811 OPT_A, prn);
812 ci = PRINT;
813 break;
814 }
815
816 if (err) {
817 gui_errmsg(err);
818 gretl_print_destroy(prn);
819 } else {
820 record_lib_command();
821 view_buffer(prn, hsize, vsize, title, ci, obj);
822 }
823
824 g_free(title);
825 }
826
menu_op_wrapper(selector * sr)827 int menu_op_wrapper (selector *sr)
828 {
829 const char *buf = selector_list(sr);
830 int ci = selector_code(sr);
831 gretlopt opt = selector_get_opts(sr);
832 int err = 0;
833
834 if (buf == NULL) {
835 err = 1;
836 } else {
837 do_menu_op(ci, buf, opt, NULL);
838 }
839
840 return err;
841 }
842
menu_op_ci(GtkAction * action)843 static int menu_op_ci (GtkAction *action)
844 {
845 const char *s = gtk_action_get_name(action);
846 int ci = gretl_command_number(s);
847
848 if (ci == 0 && !strcmp(s, "VarSummary")) {
849 ci = VAR_SUMMARY;
850 }
851
852 return ci;
853 }
854
menu_op_action(GtkAction * action,gpointer p)855 void menu_op_action (GtkAction *action, gpointer p)
856 {
857 int ci = menu_op_ci(action);
858
859 if (ci == VAR_SUMMARY || ci == NORMTEST) {
860 /* a single-variable action */
861 do_menu_op(ci, NULL, OPT_NONE, NULL);
862 } else {
863 /* potentially a multi-variable option */
864 const char *str = NULL;
865 gchar *title;
866
867 if (ci == PCA) {
868 str = N_("Principal Components Analysis");
869 } else if (ci == MAHAL) {
870 str = N_("Mahalanobis distances");
871 } else if (ci == SUMMARY) {
872 str = N_("summary statistics");
873 } else if (ci == CORR) {
874 str = N_("correlation matrix");
875 } else if (ci == XTAB) {
876 str = N_("cross tabulation");
877 }
878
879 title = gretl_window_title(_(str));
880 simple_selection(ci, title, menu_op_wrapper, NULL);
881 g_free(title);
882 }
883 }
884
do_coint(selector * sr)885 int do_coint (selector *sr)
886 {
887 const char *buf = selector_list(sr);
888 int action = selector_code(sr);
889 GRETL_VAR *jvar = NULL;
890 const char *flagstr = NULL;
891 PRN *prn;
892 int err = 0;
893
894 if (buf == NULL) {
895 return 1;
896 }
897
898 libcmd.opt = selector_get_opts(sr);
899
900 if (action == COINT && (libcmd.opt & OPT_E)) {
901 /* try for a parameter to the --test-down option */
902 const char *s = selector_get_extra_data(sr);
903
904 if (s != NULL) {
905 push_option_param(action, OPT_E, gretl_strdup(s));
906 }
907 }
908
909 flagstr = print_flags(libcmd.opt, action);
910
911 if (action == COINT) {
912 lib_command_sprintf("coint %s%s", buf, flagstr);
913 } else {
914 lib_command_sprintf("johansen %s%s", buf, flagstr);
915 }
916
917 if (parse_lib_command() || bufopen(&prn)) {
918 return 1;
919 }
920
921 if (action == COINT) {
922 err = engle_granger_test(libcmd.order, libcmd.list, dataset,
923 libcmd.opt, prn);
924 } else {
925 jvar = johansen_test(libcmd.order, libcmd.list, dataset,
926 libcmd.opt, prn);
927 if (jvar == NULL) {
928 err = E_DATA;
929 } else if ((err = jvar->err)) {
930 gretl_VAR_free(jvar);
931 }
932 }
933
934 if (err) {
935 gui_errmsg(err);
936 gretl_print_destroy(prn);
937 } else {
938 record_lib_command();
939 view_buffer(prn, 78, 400, _("gretl: cointegration test"),
940 action, (action == COINT2)? jvar : NULL);
941 }
942
943 return err;
944 }
945
ok_obs_in_series(int v)946 static int ok_obs_in_series (int v)
947 {
948 int t, t1, t2;
949
950 for (t=dataset->t1; t<dataset->t2; t++) {
951 if (!na(dataset->Z[v][t])) break;
952 }
953
954 t1 = t;
955
956 for (t=dataset->t2; t>=dataset->t1; t--) {
957 if (!na(dataset->Z[v][t])) break;
958 }
959
960 t2 = t;
961
962 return t2 - t1 + 1;
963 }
964
switch_test_down_opt(GtkComboBox * combo,int * option)965 static void switch_test_down_opt (GtkComboBox *combo,
966 int *option)
967 {
968 *option = gtk_combo_box_get_active(combo);
969 }
970
adf_test_down_selector(int ci,int * option)971 static GtkWidget *adf_test_down_selector (int ci, int *option)
972 {
973 GtkWidget *hbox, *label, *combo;
974
975 hbox = gtk_hbox_new(FALSE, 5);
976 label = gtk_label_new(_("criterion"));
977 gtk_box_pack_start(GTK_BOX(hbox), label, FALSE, FALSE, 5);
978 combo = gtk_combo_box_text_new();
979 gtk_box_pack_start(GTK_BOX(hbox), combo, FALSE, FALSE, 5);
980 if (ci == DFGLS) {
981 combo_box_append_text(combo, _("modified AIC"));
982 combo_box_append_text(combo, _("modified BIC"));
983 } else {
984 combo_box_append_text(combo, _("AIC"));
985 combo_box_append_text(combo, _("BIC"));
986 combo_box_append_text(combo, _("t-statistic"));
987 }
988 gtk_combo_box_set_active(GTK_COMBO_BOX(combo), *option);
989 g_signal_connect(G_OBJECT(combo), "changed",
990 G_CALLBACK(switch_test_down_opt),
991 option);
992
993 return hbox;
994 }
995
adf_get_options(const char * title,int panel,int omax,int * order,gretlopt * popt)996 static int adf_get_options (const char *title, int panel,
997 int omax, int *order,
998 gretlopt *popt)
999 {
1000 const char *ts_opts[] = {
1001 /* checkbox items */
1002 N_("test down from maximum lag order"),
1003 N_("test without constant"),
1004 N_("with constant"),
1005 N_("with constant and trend"),
1006 N_("with constant, trend and trend squared"),
1007 N_("include seasonal dummies"),
1008 N_("show regression results"),
1009 /* non-panel: radio items */
1010 N_("use level of variable"),
1011 N_("use first difference of variable")
1012 };
1013 const char *panel_opts[] = {
1014 /* radio-button items */
1015 N_("with constant"),
1016 N_("with constant and trend"),
1017 /* checkbox items */
1018 N_("test down from maximum lag order"),
1019 N_("use first difference of variable"),
1020 N_("show individual test results")
1021 };
1022 static int ts_active[] = { 1, 0, 1, 1, 0, 0, 0 };
1023 static int panel_active[] = { 0, 0, 1 };
1024 const char **opts = panel ? panel_opts : ts_opts;
1025 int *active = panel ? panel_active : ts_active;
1026 int nchecks = panel ? 3 : 7;
1027 int nradios = panel ? -2 : 2;
1028 int check_min = panel ? 0 : 1;
1029 int check_max = panel ? 0 : 5;
1030 int pantrend = 0;
1031 int difference = 0;
1032 int *radio_var = panel ? &pantrend : &difference;
1033 int save_seas = ts_active[5];
1034 GtkWidget *tdown;
1035 static int test_down_opt = 0;
1036 gretlopt opt = OPT_NONE;
1037 int retval;
1038
1039 if (!panel && dataset->pd == 1) {
1040 /* disallow seasonal dummies option */
1041 ts_active[5] = -1;
1042 }
1043
1044 tdown = adf_test_down_selector(ADF, &test_down_opt);
1045 set_checks_dialog_extra(0, tdown);
1046
1047 /* note: making nradios < 0 places the radio buttons before the
1048 check boxes in the dialog box produced by checks_dialog()
1049 */
1050
1051 retval = checks_dialog(_(title), NULL,
1052 opts, nchecks, active,
1053 check_min, check_max,
1054 nradios, radio_var, order,
1055 _("Lag order for ADF test:"),
1056 0, omax, panel ? 0 : ADF, NULL);
1057
1058 if (retval == 0) {
1059 if (panel) {
1060 if (active[0]) opt |= OPT_E; /* test down */
1061 if (active[1]) opt |= OPT_F; /* difference */
1062 if (active[2]) opt |= OPT_V; /* verbose */
1063 if (pantrend) opt |= OPT_T;
1064 } else {
1065 if (active[0]) opt |= OPT_E;
1066 if (active[1]) opt |= OPT_N;
1067 if (active[2]) opt |= OPT_C;
1068 if (active[3]) opt |= OPT_T;
1069 if (active[4]) opt |= OPT_R; /* quad trend */
1070 if (active[5] > 0) opt |= OPT_D; /* seasonals */
1071 if (active[6]) opt |= OPT_V; /* verbosity */
1072 if (difference) opt |= OPT_F;
1073 }
1074 *popt = opt;
1075 }
1076
1077 if (opt & OPT_E) {
1078 if (test_down_opt == 0) {
1079 /* AIC */
1080 set_optval_string(ADF, OPT_E, "AIC");
1081 } else if (test_down_opt == 1) {
1082 /* BIC */
1083 set_optval_string(ADF, OPT_E, "BIC");
1084 } else {
1085 set_optval_string(ADF, OPT_E, "tstat");
1086 }
1087 }
1088
1089 if (ts_active[5] < 0) {
1090 ts_active[5] = save_seas;
1091 }
1092
1093 return retval;
1094 }
1095
dfgls_get_options(const char * title,int panel,int omax,int * order,gretlopt * popt)1096 static int dfgls_get_options (const char *title, int panel,
1097 int omax, int *order,
1098 gretlopt *popt)
1099 {
1100 const char *ts_opts[] = {
1101 /* checkbox items */
1102 N_("test down from maximum lag order"),
1103 N_("use Perron-Qu method"),
1104 N_("include a trend"),
1105 N_("show regression results"),
1106 /* radio-button items */
1107 N_("use level of variable"),
1108 N_("use first difference of variable")
1109 };
1110 const char *panel_opts[] = {
1111 /* checkbox items */
1112 N_("include a trend"),
1113 N_("use first difference of variable"),
1114 N_("show individual test results")
1115 };
1116 static int ts_active[] = { 1, 1, 0, 0 };
1117 static int panel_active[] = { 0, 0, 1 };
1118 const char **opts = panel ? panel_opts : ts_opts;
1119 int *active = panel ? panel_active : ts_active;
1120 int nchecks = panel ? 3 : 4;
1121 int nradios = panel ? 0 : 2;
1122 int difference = 0;
1123 int *radio_var = panel ? NULL : &difference;
1124 gretlopt opt = OPT_G; /* --gls */
1125 GtkWidget *tdown;
1126 static int test_down_opt = 0;
1127 int retval;
1128
1129 tdown = adf_test_down_selector(DFGLS, &test_down_opt);
1130 set_checks_dialog_extra(0, tdown);
1131
1132 retval = checks_dialog(_(title), NULL,
1133 opts, nchecks, active, 0, 0,
1134 nradios, radio_var, order,
1135 _("Lag order for ADF test:"),
1136 0, omax, panel? 0 : DFGLS, NULL);
1137
1138 if (retval == 0) {
1139 /* OK */
1140 if (panel) {
1141 if (active[0]) opt |= OPT_T;
1142 if (active[1]) opt |= OPT_F;
1143 if (active[2]) opt |= OPT_V;
1144 } else {
1145 if (active[0]) {
1146 opt |= OPT_E;
1147 if (active[1]) opt |= OPT_U;
1148 }
1149 if (active[2]) opt |= OPT_T;
1150 if (active[3]) opt |= OPT_V;
1151 if (difference) opt |= OPT_F;
1152 }
1153 if (!(opt & OPT_T)) opt |= OPT_C;
1154
1155 *popt = opt;
1156 }
1157
1158 if (opt & OPT_E) {
1159 if (test_down_opt == 0) {
1160 /* AIC */
1161 set_optval_string(ADF, OPT_E, "AIC");
1162 } else if (test_down_opt == 1) {
1163 /* BIC */
1164 set_optval_string(ADF, OPT_E, "BIC");
1165 } else {
1166 set_optval_string(ADF, OPT_E, "tstat");
1167 }
1168 }
1169
1170 return retval;
1171 }
1172
kpss_get_options(const char * title,int panel,int omax,int * order,gretlopt * popt)1173 static int kpss_get_options (const char *title, int panel,
1174 int omax, int *order,
1175 gretlopt *popt)
1176 {
1177 const char *ts_opts[] = {
1178 /* checkbox items */
1179 N_("include a trend"),
1180 N_("include seasonal dummies"),
1181 N_("show regression results"),
1182 /* radio-button items */
1183 N_("use level of variable"),
1184 N_("use first difference of variable")
1185 };
1186 const char *panel_opts[] = {
1187 /* checkbox items */
1188 N_("include a trend"),
1189 N_("use first difference of variable"),
1190 N_("show individual test results")
1191 };
1192 static int ts_active[] = { 0, 0, 0 };
1193 static int panel_active[] = { 0, 0, 1 };
1194 const char **opts = panel ? panel_opts : ts_opts;
1195 int *active = panel ? panel_active : ts_active;
1196 int nchecks = 3;
1197 int nradios = panel ? 0 : 2;
1198 int difference = 0;
1199 int *rvar = panel ? NULL : &difference;
1200 gretlopt opt = OPT_NONE;
1201 int save_seas = ts_active[1];
1202 int retval;
1203
1204 if (!panel && dataset->pd == 1) {
1205 /* disallow seasonal dummies option */
1206 ts_active[1] = -1;
1207 }
1208
1209 retval = checks_dialog(_(title), NULL,
1210 opts, nchecks, active, 0, 0,
1211 nradios, rvar, order,
1212 _("Lag order for KPSS test:"),
1213 0, omax, panel ? 0 : KPSS, NULL);
1214
1215 if (retval == 0) {
1216 /* OK */
1217 if (panel) {
1218 if (active[0]) opt |= OPT_T;
1219 if (active[1]) opt |= OPT_F; /* difference */
1220 if (active[2]) opt |= OPT_V; /* verbose */
1221 } else {
1222 if (active[0]) opt |= OPT_T;
1223 if (active[1] > 0) opt |= OPT_D;
1224 if (active[2]) opt |= OPT_V;
1225 if (difference) opt |= OPT_F;
1226 }
1227 *popt = opt;
1228 }
1229
1230 if (ts_active[1] < 0) {
1231 ts_active[1] = save_seas;
1232 }
1233
1234 return retval;
1235 }
1236
levin_lin_get_options(const char * title,int panel,int omax,int * order,gretlopt * popt)1237 static int levin_lin_get_options (const char *title, int panel,
1238 int omax, int *order,
1239 gretlopt *popt)
1240 {
1241 const char *opts[] = {
1242 /* check-box item */
1243 N_("show individual results"),
1244 /* radio-button items */
1245 N_("test without constant"),
1246 N_("with constant"),
1247 N_("with constant and trend")
1248 };
1249 static int llc_case = 1;
1250 static int active = 1;
1251 gretlopt opt = OPT_NONE;
1252 int retval;
1253
1254 retval = checks_dialog(_(title), NULL,
1255 opts, 1, &active, 0, 0,
1256 3, &llc_case, order,
1257 _("Lag order for ADF test:"),
1258 0, omax, LEVINLIN, NULL);
1259
1260 if (retval == 0) {
1261 /* OK */
1262 if (llc_case == 0) opt |= OPT_N; /* no const */
1263 if (llc_case == 2) opt |= OPT_T; /* trend */
1264 if (active) opt |= OPT_V; /* verbose */
1265 *popt = opt;
1266 }
1267
1268 return retval;
1269 }
1270
unit_root_test(int ci)1271 void unit_root_test (int ci)
1272 {
1273 /* save the user's settings, per session */
1274 static int ts_order = -1;
1275 static int panel_order = 0;
1276 const char *titles[] = {
1277 N_("gretl: ADF test"),
1278 N_("gretl: ADF-GLS test"),
1279 N_("gretl: KPSS test"),
1280 N_("gretl: Levin-Lin-Chu test")
1281 };
1282 const char *title;
1283 gretlopt opt = OPT_NONE;
1284 int panel = dataset_is_panel(dataset);
1285 int order, omax, okT, v = mdata_active_var();
1286 PRN *prn;
1287 int err;
1288
1289 if (panel) {
1290 okT = dataset->pd;
1291 order = panel_order;
1292 } else {
1293 okT = ok_obs_in_series(v);
1294 }
1295
1296 omax = okT / 2;
1297
1298 if (ci == KPSS) {
1299 order = 4.0 * pow(okT / 100.0, 0.25);
1300 } else if (!panel) {
1301 if (ts_order >= 0) {
1302 order = ts_order;
1303 } else {
1304 /* default to L_{12}: see G. W. Schwert, "Tests for Unit Roots:
1305 A Monte Carlo Investigation", Journal of Business and
1306 Economic Statistics, 7(2), 1989, pp. 5-17.
1307 */
1308 order = 12.0 * pow(okT/100.0, 0.25);
1309 }
1310 }
1311
1312 /* hand off to a specific function to gather the
1313 relevant options for the given sort of test
1314 */
1315
1316 if (ci == ADF) {
1317 title = titles[0];
1318 err = adf_get_options(title, panel, omax, &order, &opt);
1319 } else if (ci == DFGLS) {
1320 title = titles[1];
1321 err = dfgls_get_options(title, panel, omax, &order, &opt);
1322 } else if (ci == KPSS) {
1323 title = titles[2];
1324 err = kpss_get_options(title, panel, omax, &order, &opt);
1325 } else {
1326 title = titles[3];
1327 err = levin_lin_get_options(title, panel, omax, &order, &opt);
1328 }
1329
1330 if (err < 0) {
1331 /* canceled */
1332 return;
1333 }
1334
1335 if (order == 0 && (opt & OPT_E)) {
1336 /* scrub the test-down option, if present */
1337 opt &= ~OPT_E;
1338 }
1339
1340 if (bufopen(&prn)) {
1341 return;
1342 }
1343
1344 if (ci == ADF || ci == DFGLS || ci == KPSS) {
1345 int vlist[2] = {1, v};
1346
1347 if (ci == KPSS) {
1348 err = kpss_test(order, vlist, dataset, opt, prn);
1349 } else {
1350 err = adf_test(order, vlist, dataset, opt, prn);
1351 }
1352 } else {
1353 int plist[2] = {1, order};
1354
1355 err = levin_lin_test(v, plist, dataset, opt, prn);
1356 }
1357
1358 if (err) {
1359 gui_errmsg(err);
1360 gretl_print_destroy(prn);
1361 } else {
1362 int rci = (ci == DFGLS)? ADF : ci;
1363
1364 lib_command_sprintf("%s %d %s%s", gretl_command_word(rci),
1365 order, dataset->varname[v],
1366 print_flags(opt, rci));
1367 record_command_verbatim();
1368
1369 if (panel) {
1370 panel_order = order;
1371 } else if (ci == ADF || ci == DFGLS) {
1372 ts_order = order;
1373 }
1374
1375 view_buffer(prn, 78, 350, title, ci, NULL);
1376 }
1377 }
1378
ur_code(const gchar * s)1379 static int ur_code (const gchar *s)
1380 {
1381 if (!strcmp(s, "dfgls")) {
1382 return DFGLS;
1383 } else {
1384 return gretl_command_number(s);
1385 }
1386 }
1387
ur_callback(GtkAction * action)1388 void ur_callback (GtkAction *action)
1389 {
1390 int ci = ur_code(gtk_action_get_name(action));
1391
1392 unit_root_test(ci);
1393 }
1394
1395 /* cross-correlogram: if two variables are selected in the main
1396 window we use those, otherwise we present a selection dialog
1397 (with a max of two selected variables) and use that
1398 selection */
1399
do_xcorrgm(selector * sr)1400 int do_xcorrgm (selector *sr)
1401 {
1402 const char *sbuf = NULL;
1403 char *mbuf = NULL;
1404 gchar *title;
1405 PRN *prn;
1406 int order = 0;
1407 int err = 0;
1408
1409 if (sr != NULL) {
1410 sbuf = selector_list(sr);
1411 } else {
1412 mbuf = main_window_selection_as_string();
1413 }
1414
1415 if (sbuf == NULL && mbuf == NULL) {
1416 return 1;
1417 }
1418
1419 title = gretl_window_title(_("cross-correlogram"));
1420
1421 order = default_lag_order(dataset);
1422 if (order > dataset->n / 4) {
1423 order = dataset->n / 4;
1424 }
1425
1426 err = spin_dialog(title, NULL, &order, _("Lag order:"),
1427 1, dataset->n / 4, 0, NULL);
1428 if (err < 0) {
1429 /* canceled */
1430 free(mbuf);
1431 g_free(title);
1432 return 0;
1433 }
1434
1435 if (sbuf != NULL) {
1436 lib_command_sprintf("xcorrgm%s %d", sbuf, order);
1437 } else {
1438 lib_command_sprintf("xcorrgm%s %d", mbuf, order);
1439 free(mbuf);
1440 }
1441
1442 if (parse_lib_command() || bufopen(&prn)) {
1443 err = 1;
1444 } else {
1445 err = xcorrgram(libcmd.list, order, dataset,
1446 OPT_NONE, prn);
1447 if (err) {
1448 gui_errmsg(err);
1449 gretl_print_destroy(prn);
1450 } else {
1451 record_lib_command();
1452 view_buffer(prn, 60, 300, title, XCORRGM, NULL);
1453 register_graph();
1454 }
1455 }
1456
1457 g_free(title);
1458
1459 return err;
1460 }
1461
dataset_info(void)1462 void dataset_info (void)
1463 {
1464 if (dataset->descrip == NULL) {
1465 if (yes_no_dialog(_("gretl: add info"),
1466 _("The data file contains no informative comments.\n"
1467 "Would you like to add some now?"),
1468 NULL) == GRETL_YES) {
1469 edit_buffer(&dataset->descrip, 80, 400, _("gretl: edit data info"),
1470 EDIT_HEADER);
1471 }
1472 } else if (data_status & BOOK_DATA) {
1473 char *buf = g_strdup(dataset->descrip);
1474 PRN *prn;
1475
1476 if (buf != NULL) {
1477 prn = gretl_print_new_with_buffer(buf);
1478 view_buffer(prn, 80, 400, _("gretl: data info"), INFO, NULL);
1479 }
1480 } else {
1481 edit_buffer(&dataset->descrip, 80, 400, _("gretl: edit data info"),
1482 EDIT_HEADER);
1483 }
1484 }
1485
gui_errmsg(int errcode)1486 void gui_errmsg (int errcode)
1487 {
1488 if (errcode == E_STOP) {
1489 gui_warnmsg(errcode);
1490 } else {
1491 const char *msg = errmsg_get_with_default(errcode);
1492
1493 if (msg != NULL && *msg != '\0') {
1494 errbox(msg);
1495 /* avoid duplicating this error message */
1496 gretl_error_clear();
1497 } else {
1498 errbox(_("Unspecified error"));
1499 }
1500 }
1501 }
1502
gui_warnmsg(int errcode)1503 void gui_warnmsg (int errcode)
1504 {
1505 const char *msg = NULL;
1506
1507 if (errcode > 0) {
1508 msg = errmsg_get_with_default(errcode);
1509 } else {
1510 msg = gretl_warnmsg_get();
1511 }
1512
1513 if (msg != NULL && *msg != '\0') {
1514 warnbox(msg);
1515 }
1516 }
1517
perma_sample_options(const char * param,int * list,DATASET * dset,gretlopt opt,PRN * prn,int * n_dropped,int * cancel)1518 static int perma_sample_options (const char *param, int *list,
1519 DATASET *dset, gretlopt opt,
1520 PRN *prn, int *n_dropped,
1521 int *cancel)
1522 {
1523 /* we have a saved-models problem with the specified
1524 permanent subsample -- what to do?
1525 */
1526 gchar *msg;
1527 int resp;
1528 int err = 0;
1529
1530 msg =
1531 g_strdup_printf(_("Changing the dataset in this way will "
1532 "result in the deletion\nof %d model(s) "
1533 "from this gretl session.\n\n"
1534 "You may wish to say No here and save the "
1535 "session first.\n\n"
1536 "Do you want to go ahead with the "
1537 "subsampling now?"),
1538 *n_dropped);
1539
1540 resp = yes_no_dialog(NULL, msg, NULL);
1541 g_free(msg);
1542
1543 if (resp == GRETL_YES) {
1544 *n_dropped = 0;
1545 if (opt == OPT_T && param == NULL) {
1546 /* freezing current restriction */
1547 err = perma_sample(dset, opt, prn, NULL);
1548 } else {
1549 err = restrict_sample(param, list, dataset, NULL,
1550 opt | OPT_F, prn, n_dropped);
1551 }
1552 if (!err) {
1553 mark_session_changed();
1554 }
1555 } else {
1556 *cancel = 1;
1557 }
1558
1559 return err;
1560 }
1561
1562 /* OPT_M drop all obs with missing data values
1563 OPT_A drop obs with no valid data
1564 OPT_W drop weekends
1565 OPT_O sample using dummy variable
1566 OPT_R sample using boolean expression
1567 OPT_N random sub-sample
1568 OPT_C replace current restriction
1569
1570 OPT_T restriction is permanent
1571 OPT_U use current restriction
1572 */
1573
bool_subsample(const char * param,gretlopt opt,GtkWidget * dialog)1574 int bool_subsample (const char *param, gretlopt opt,
1575 GtkWidget *dialog)
1576 {
1577 const char *msg;
1578 PRN *prn;
1579 int n_dropped = 0;
1580 int err = 0;
1581
1582 if (bufopen(&prn)) {
1583 return 1;
1584 }
1585
1586 if ((opt & OPT_T) && (opt & OPT_U)) {
1587 /* freezing current restriction */
1588 err = perma_sample(dataset, OPT_T, prn, &n_dropped);
1589 } else {
1590 err = restrict_sample(param, NULL, dataset, NULL,
1591 opt, prn, &n_dropped);
1592 }
1593
1594 if (err == E_CANCEL && (opt & OPT_T)) {
1595 int cancel = 0;
1596
1597 err = perma_sample_options(param, NULL, dataset,
1598 opt, prn, &n_dropped,
1599 &cancel);
1600 if (cancel) {
1601 gretl_print_destroy(prn);
1602 return 0;
1603 }
1604 }
1605
1606 msg = gretl_print_get_buffer(prn);
1607
1608 if (err) {
1609 errmsg_plus(err, msg);
1610 } else {
1611 if (dialog != NULL) {
1612 gtk_widget_hide(dialog);
1613 }
1614 if (msg != NULL && *msg != '\0') {
1615 infobox(msg);
1616 } else if (n_dropped > 0) {
1617 infobox_printf(_("Dropped %d observations"), n_dropped);
1618 }
1619 if (opt & OPT_T) {
1620 mark_dataset_as_modified();
1621 } else {
1622 set_sample_label(dataset);
1623 }
1624 }
1625
1626 gretl_print_destroy(prn);
1627
1628 return err;
1629 }
1630
perma_sample_callback(void)1631 void perma_sample_callback (void)
1632 {
1633 bool_subsample(NULL, OPT_T | OPT_U, NULL);
1634 }
1635
any_missing(void)1636 static int any_missing (void)
1637 {
1638 int i, t;
1639
1640 for (i=1; i<dataset->v; i++) {
1641 if (!series_is_hidden(dataset, i)) {
1642 for (t=0; t<dataset->n; t++) {
1643 if (na(dataset->Z[i][t])) {
1644 return 1;
1645 }
1646 }
1647 }
1648 }
1649
1650 return 0;
1651 }
1652
any_all_missing(void)1653 static int any_all_missing (void)
1654 {
1655 int vt = current_series_index(dataset, "time");
1656 int vi = current_series_index(dataset, "index");
1657 int i, t, allmiss, nv = 0;
1658
1659 for (i=1; i<dataset->v; i++) {
1660 if (!series_is_hidden(dataset, i) &&
1661 i != vt && i != vi) {
1662 nv++;
1663 }
1664 }
1665
1666 if (nv < 2) {
1667 return 0;
1668 }
1669
1670 for (t=0; t<dataset->n; t++) {
1671 allmiss = 1;
1672 for (i=1; i<dataset->v; i++) {
1673 if (!series_is_hidden(dataset, i) &&
1674 i != vt && i != vi &&
1675 !na(dataset->Z[i][t])) {
1676 allmiss = 0;
1677 break;
1678 }
1679 }
1680 if (allmiss) {
1681 return 1;
1682 }
1683 }
1684
1685 return 0;
1686 }
1687
drop_missing_data(void)1688 void drop_missing_data (void)
1689 {
1690 int permanent = 0;
1691 gretlopt opt = OPT_M;
1692 int resp = 0;
1693
1694 if (!any_missing_user_values(dataset)) {
1695 infobox(_("No missing data values"));
1696 return;
1697 }
1698
1699 if (any_all_missing()) {
1700 const char *opts[] = {
1701 N_("Drop rows with at least one missing value"),
1702 N_("Drop rows that have no valid data")
1703 };
1704 int deflt = 0;
1705
1706 if (complex_subsampled()) {
1707 resp = radio_dialog("gretl", _("Drop missing data"),
1708 opts, 2, deflt, 0, NULL);
1709 } else {
1710 resp = radio_dialog_with_check("gretl", _("Drop missing data"),
1711 opts, 2, deflt, 0,
1712 &permanent,
1713 _("Make this permanent"),
1714 NULL);
1715 }
1716 if (resp == 1) {
1717 opt = OPT_A;
1718 }
1719 } else if (!complex_subsampled()) {
1720 const char *opts[] = {
1721 N_("Make this permanent"),
1722 NULL
1723 };
1724
1725 resp = checks_only_dialog("gretl",
1726 _("Drop observations with missing values"),
1727 opts, 1, &permanent, 0, NULL);
1728 }
1729
1730 if (resp == 0 || resp == 1) {
1731 int err;
1732
1733 if (permanent) {
1734 opt |= OPT_T; /* --permanent */
1735 }
1736 err = bool_subsample(NULL, opt, NULL);
1737 if (!err) {
1738 lib_command_sprintf("smpl%s", print_flags(opt, SMPL));
1739 record_command_verbatim();
1740 }
1741 }
1742 }
1743
count_missing(void)1744 void count_missing (void)
1745 {
1746 const char *opts[] = {
1747 N_("Show count of missing values at each observation"),
1748 NULL
1749 };
1750 gretlopt opt;
1751 int resp, active;
1752 int mc, err = 0;
1753 PRN *prn;
1754
1755 if (!any_missing()) {
1756 infobox(_("No missing data values"));
1757 return;
1758 }
1759
1760 active = (dataset->n < 1000);
1761
1762 resp = checks_only_dialog(_("gretl: missing values info"), NULL,
1763 opts, 1, &active, 0, NULL);
1764
1765 if (canceled(resp) || bufopen(&prn)) {
1766 return;
1767 }
1768
1769 opt = (active)? (OPT_V | OPT_A) : OPT_A;
1770 mc = count_missing_values(dataset, opt, prn, &err);
1771
1772 if (!err && mc > 0) {
1773 view_buffer(prn, 78, 300, _("gretl: missing values info"),
1774 SMPL, NULL);
1775 } else {
1776 if (err) {
1777 gui_errmsg(err);
1778 } else {
1779 infobox(_("No missing data values"));
1780 }
1781 gretl_print_destroy(prn);
1782 }
1783 }
1784
do_add_markers(const char * fname)1785 void do_add_markers (const char *fname)
1786 {
1787 int err = add_obs_markers_from_file(dataset, fname);
1788
1789 if (err) {
1790 gui_errmsg(err);
1791 } else {
1792 lib_command_sprintf("markers --from-file=\"%s\"", fname);
1793 record_command_verbatim();
1794 mark_dataset_as_modified();
1795 }
1796 }
1797
do_save_markers(const char * fname)1798 int do_save_markers (const char *fname)
1799 {
1800 FILE *fp;
1801 int i;
1802
1803 if (dataset->S == NULL) {
1804 return E_DATA;
1805 }
1806
1807 fp = gretl_fopen(fname, "w");
1808
1809 if (fp == NULL) {
1810 file_write_errbox(fname);
1811 return E_FOPEN;
1812 }
1813
1814 for (i=0; i<dataset->n; i++) {
1815 fprintf(fp, "%s\n", dataset->S[i]);
1816 }
1817
1818 fclose(fp);
1819
1820 lib_command_sprintf("markers --to-file=\"%s\"", fname);
1821 record_command_verbatim();
1822
1823 return 0;
1824 }
1825
1826 /* called from main window Data menu */
1827
markers_callback(void)1828 void markers_callback (void)
1829 {
1830 if (dataset->S != NULL) {
1831 /* we have markers in place */
1832 const char *opts[] = {
1833 N_("Export the markers to file"),
1834 N_("Remove the markers")
1835 };
1836 int resp;
1837
1838 resp = radio_dialog("gretl", _("The dataset has observation markers.\n"
1839 "Would you like to:"),
1840 opts, 2, 0, 0, NULL);
1841 if (resp == 0) {
1842 file_selector(SAVE_MARKERS, FSEL_DATA_NONE, NULL);
1843 } else if (resp == 1) {
1844 dataset_destroy_obs_markers(dataset);
1845 mark_dataset_as_modified();
1846 lib_command_strcpy("markers --delete");
1847 record_command_verbatim();
1848 }
1849 } else {
1850 if (yes_no_dialog("gretl",
1851 _("The dataset has no observation markers.\n"
1852 "Add some from file now?"),
1853 NULL) == GRETL_YES) {
1854 file_selector(OPEN_MARKERS, FSEL_DATA_NONE, NULL);
1855 }
1856 }
1857 }
1858
do_add_labels(const char * fname)1859 void do_add_labels (const char *fname)
1860 {
1861 int err = add_var_labels_from_file(dataset, fname);
1862
1863 if (err) {
1864 gui_errmsg(err);
1865 } else {
1866 lib_command_sprintf("labels --from-file=\"%s\"", fname);
1867 record_command_verbatim();
1868 refresh_data();
1869 mark_dataset_as_modified();
1870 }
1871 }
1872
do_save_labels(const char * fname)1873 int do_save_labels (const char *fname)
1874 {
1875 int err = save_var_labels_to_file(dataset, fname);
1876
1877 if (err) {
1878 file_write_errbox(fname);
1879 } else {
1880 lib_command_sprintf("labels --to-file=\"%s\"", fname);
1881 record_command_verbatim();
1882 }
1883
1884 return err;
1885 }
1886
gui_remove_var_labels(void)1887 static void gui_remove_var_labels (void)
1888 {
1889 int i;
1890
1891 for (i=1; i<dataset->v; i++) {
1892 series_set_label(dataset, i, "");
1893 }
1894
1895 lib_command_strcpy("labels --delete");
1896 record_command_verbatim();
1897 populate_varlist();
1898 mark_dataset_as_modified();
1899 }
1900
labels_callback(void)1901 void labels_callback (void)
1902 {
1903 if (dataset_has_var_labels(dataset)) {
1904 /* we have (some) labels in place */
1905 const char *opts[] = {
1906 N_("Export the labels to file"),
1907 N_("Remove the labels")
1908 };
1909 int resp;
1910
1911 resp = radio_dialog("gretl", _("The dataset has variable labels.\n"
1912 "Would you like to:"),
1913 opts, 2, 0, SAVE_LABELS, NULL);
1914 if (resp == 0) {
1915 file_selector(SAVE_LABELS, FSEL_DATA_NONE, NULL);
1916 } else if (resp == 1) {
1917 gui_remove_var_labels();
1918 }
1919 } else {
1920 if (yes_no_help_dialog(_("The dataset has no variable labels.\n"
1921 "Add some from file now?"), OPEN_LABELS,
1922 GRETL_YES) == GRETL_YES) {
1923 file_selector(OPEN_LABELS, FSEL_DATA_NONE, NULL);
1924 }
1925 }
1926 }
1927
out_of_sample_info(int add_ok,int * t2)1928 int out_of_sample_info (int add_ok, int *t2)
1929 {
1930 const char *can_add =
1931 N_("There are no observations available for forecasting\n"
1932 "out of sample. You can add some observations now\n"
1933 "if you wish.");
1934 int err = 0;
1935
1936 if (add_ok) {
1937 int n = add_obs_dialog(_(can_add), 0, OPT_NONE, NULL);
1938
1939 if (n < 0) {
1940 err = 1;
1941 } else if (n > 0) {
1942 set_original_n(dataset->n);
1943 err = dataset_add_observations(dataset, n, OPT_A);
1944 if (err) {
1945 gui_errmsg(err);
1946 } else {
1947 lib_command_sprintf("dataset addobs %d", n);
1948 record_command_verbatim();
1949 mark_dataset_as_modified();
1950 drop_obs_state(TRUE);
1951 *t2 += n;
1952 }
1953 }
1954 } else {
1955 infobox(_("There are no observations available for forecasting\n"
1956 "out of sample. If you wish, you can add observations\n"
1957 "(Data menu, Add observations), or you can shorten the sample\n"
1958 "range over which the model is estimated (Sample menu)."));
1959 }
1960
1961 return err;
1962 }
1963
gui_do_forecast(GtkAction * action,gpointer p)1964 void gui_do_forecast (GtkAction *action, gpointer p)
1965 {
1966 static gretlopt gopt = OPT_P | OPT_H;
1967 windata_t *vwin = (windata_t *) p;
1968 MODEL *pmod = vwin->data;
1969 char startobs[OBSLEN], endobs[OBSLEN];
1970 int t2, t1 = 0;
1971 int flags = 0;
1972 int premax, pre_n = 0;
1973 int t1min = 0;
1974 int recursive = 0, k = 1, *kptr;
1975 int dt2 = dataset->n - 1;
1976 int st2 = dataset->n - 1;
1977 gretlopt opt = OPT_NONE;
1978 double conf = 0.95;
1979 FITRESID *fr;
1980 PRN *prn = NULL;
1981 int resp, err = 0;
1982
1983 err = model_sample_problem(pmod, dataset);
1984 if (err) {
1985 gui_errmsg(err);
1986 return;
1987 }
1988
1989 /* try to figure which options might be applicable */
1990 forecast_options_for_model(pmod, dataset, &flags,
1991 &dt2, &st2);
1992
1993 if (flags & (FC_DYNAMIC_OK | FC_AUTO_OK)) {
1994 t2 = dt2;
1995 } else {
1996 t2 = st2;
1997 }
1998
1999 /* if no out-of-sample obs are available in case of time-
2000 series data, alert the user */
2001 if (t2 <= pmod->t2 && dataset_is_time_series(dataset)) {
2002 err = out_of_sample_info(flags & FC_ADDOBS_OK, &t2);
2003 if (err) {
2004 return;
2005 }
2006 }
2007
2008 /* max number of pre-forecast obs in "best case" */
2009 premax = dataset->n - 1;
2010
2011 /* if there are spare obs available, default to an
2012 out-of-sample forecast */
2013 if (t2 > pmod->t2) {
2014 t1 = pmod->t2 + 1;
2015 pre_n = pmod->t2 / 2;
2016 if (pre_n > 100) {
2017 pre_n = 100;
2018 }
2019 if (pmod->ci == GARCH) {
2020 /* force out-of-sample fcast */
2021 t1min = t1;
2022 }
2023 } else {
2024 pre_n = 0;
2025 }
2026
2027 if (flags & FC_INTEGRATE_OK) {
2028 kptr = NULL;
2029 } else {
2030 kptr = &k;
2031 }
2032
2033 resp = forecast_dialog(t1min, t2, &t1,
2034 0, t2, &t2, kptr,
2035 0, premax, &pre_n,
2036 flags, &gopt, &conf,
2037 pmod, vwin_toplevel(vwin));
2038
2039 if (canceled(resp)) {
2040 gopt = OPT_P | OPT_H;
2041 return;
2042 }
2043
2044 if (resp == 1) {
2045 opt = OPT_D;
2046 } else if (resp == 2) {
2047 opt = OPT_S;
2048 } else if (resp == 3) {
2049 recursive = 1;
2050 }
2051
2052 if (gopt & OPT_I) {
2053 /* transfer OPT_I (integrate forecast) from graph
2054 to general options */
2055 opt |= OPT_I;
2056 gopt &= ~OPT_I;
2057 }
2058
2059 if (gopt & OPT_M) {
2060 /* OPT_M (show interval for mean): copy to opt */
2061 opt |= OPT_M;
2062 }
2063
2064 if (recursive) {
2065 fr = recursive_OLS_k_step_fcast(pmod, dataset,
2066 t1, t2, k, pre_n,
2067 &err);
2068 } else {
2069 ntolabel(startobs, t1, dataset);
2070 ntolabel(endobs, t2, dataset);
2071 lib_command_sprintf("fcast %s %s%s", startobs, endobs,
2072 print_flags(opt, FCAST));
2073 if (parse_lib_command()) {
2074 return;
2075 }
2076 fr = get_forecast(pmod, t1, t2, pre_n, dataset,
2077 opt, &err);
2078 if (!err) {
2079 record_lib_command();
2080 }
2081 }
2082
2083 if (err) {
2084 gui_errmsg(err);
2085 } else {
2086 err = bufopen(&prn);
2087 }
2088
2089 if (!err) {
2090 int ols_special = 0;
2091 int width = 78;
2092
2093 if (recursive) {
2094 err = text_print_fit_resid(fr, dataset, prn);
2095 } else {
2096 if (dataset_is_cross_section(dataset)) {
2097 ols_special = gretl_is_simple_OLS(pmod);
2098 }
2099 if (LIMDEP(pmod->ci) || ols_special) {
2100 /* don't generate plot via text_print_forecast() */
2101 gopt &= ~OPT_P;
2102 } else {
2103 gopt |= OPT_P;
2104 }
2105 fr->alpha = 1 - conf;
2106 err = text_print_forecast(fr, dataset, gopt, prn);
2107 }
2108
2109 if (ols_special) {
2110 err = plot_simple_fcast_bands(pmod, fr,
2111 dataset,
2112 gopt);
2113 gopt |= OPT_P;
2114 }
2115 if (!err && (gopt & OPT_P)) {
2116 register_graph();
2117 }
2118 if (!recursive && fr->sderr == NULL) {
2119 width = 60;
2120 }
2121 view_buffer_with_parent(vwin, prn, width, 400,
2122 _("gretl: forecasts"),
2123 FCAST, fr);
2124 }
2125
2126 /* don't remember the "mean" option */
2127 gopt &= ~OPT_M;
2128 }
2129
do_bootstrap(GtkAction * action,gpointer p)2130 void do_bootstrap (GtkAction *action, gpointer p)
2131 {
2132 windata_t *vwin = (windata_t *) p;
2133 MODEL *pmod = vwin->data;
2134 gretlopt opt = OPT_NONE;
2135 double alpha = 0.05;
2136 int B = 1000;
2137 int k = 0;
2138 PRN *prn;
2139 int resp, err;
2140
2141 err = model_sample_problem(pmod, dataset);
2142 if (err) {
2143 gui_errmsg(err);
2144 return;
2145 }
2146
2147 resp = bootstrap_dialog(vwin, &k, &B, &opt);
2148
2149 if (canceled(resp) || bufopen(&prn)) {
2150 return;
2151 }
2152
2153 err = bootstrap_analysis(pmod, k, B, alpha, dataset, opt, prn);
2154
2155 if (err) {
2156 gui_errmsg(err);
2157 gretl_print_destroy(prn);
2158 } else {
2159 windata_t *w;
2160
2161 w = view_buffer_with_parent(vwin, prn, 78, 300,
2162 _("gretl: bootstrap analysis"),
2163 PRINT, NULL);
2164 if (opt & OPT_G) {
2165 register_graph();
2166 }
2167 if (opt & OPT_A) {
2168 file_selector(SAVE_BOOT_DATA, FSEL_DATA_VWIN, w);
2169 }
2170 }
2171 }
2172
do_coeff_sum(selector * sr)2173 int do_coeff_sum (selector *sr)
2174 {
2175 windata_t *vwin = selector_get_data(sr);
2176 const char *buf = selector_list(sr);
2177 MODEL *pmod = vwin->data;
2178 PRN *prn;
2179 int err = 0;
2180
2181 if (buf == NULL) {
2182 return 0;
2183 }
2184
2185 lib_command_sprintf("coeffsum %s", buf);
2186
2187 if (parse_lib_command() || bufopen(&prn)) {
2188 return 1;
2189 }
2190
2191 err = gretl_sum_test(libcmd.list, pmod, dataset, OPT_NONE, prn);
2192
2193 if (err) {
2194 gui_errmsg(err);
2195 gretl_print_destroy(prn);
2196 } else {
2197 gchar *title = gretl_window_title(_("Sum of coefficients"));
2198
2199 record_model_command(pmod->ID);
2200 view_buffer_with_parent(vwin, prn, 78, 200, title,
2201 COEFFSUM, NULL);
2202 g_free(title);
2203 }
2204
2205 return err;
2206 }
2207
2208 static DATASET *
maybe_get_model_data(MODEL * pmod,gretlopt opt,int * err)2209 maybe_get_model_data (MODEL *pmod, gretlopt opt, int *err)
2210 {
2211 DATASET *dset = NULL;
2212
2213 if (gretl_is_between_model(pmod)) {
2214 if (pmod->dataset != NULL) {
2215 dset = pmod->dataset;
2216 } else {
2217 gretl_errmsg_set("The group-means dataset is not available");
2218 *err = E_DATA;
2219 gui_errmsg(*err);
2220 }
2221 } else if (model_sample_problem(pmod, dataset)) {
2222 *err = add_dataset_to_model(pmod, dataset, opt);
2223 if (*err) {
2224 gui_errmsg(*err);
2225 } else {
2226 dset = pmod->dataset;
2227 }
2228 } else {
2229 dset = dataset;
2230 *err = 0;
2231 }
2232
2233 return dset;
2234 }
2235
trim_dataset(MODEL * pmod,int origv)2236 static void trim_dataset (MODEL *pmod, int origv)
2237 {
2238 if (pmod != NULL && pmod->dataset != NULL) {
2239 if (!gretl_is_between_model(pmod)) {
2240 destroy_dataset(pmod->dataset);
2241 pmod->dataset = NULL;
2242 }
2243 } else if (origv > 0) {
2244 dataset_drop_last_variables(dataset, dataset->v - origv);
2245 }
2246 }
2247
print_test_to_window(const MODEL * pmod,GtkWidget * w)2248 static void print_test_to_window (const MODEL *pmod, GtkWidget *w)
2249 {
2250 if (w != NULL) {
2251 GtkTextBuffer *buf = gtk_text_view_get_buffer(GTK_TEXT_VIEW(w));
2252 GtkTextIter iter, ibak;
2253 const char *txt;
2254 PRN *prn;
2255
2256 if (bufopen(&prn)) return;
2257
2258 gretl_model_print_last_test(pmod, prn);
2259 txt = gretl_print_get_buffer(prn);
2260 gtk_text_buffer_get_end_iter(buf, &iter);
2261
2262 ibak = iter;
2263 if (gtk_text_iter_backward_chars(&ibak, 2)) {
2264 gchar *tmp = gtk_text_buffer_get_text(buf, &ibak, &iter, FALSE);
2265
2266 if (strcmp(tmp, "\n\n")) {
2267 gtk_text_buffer_insert(buf, &iter, "\n", -1);
2268 }
2269 g_free(tmp);
2270 }
2271
2272 gtk_text_buffer_insert(buf, &iter, txt, -1);
2273 gretl_print_destroy(prn);
2274 }
2275 }
2276
update_model_tests(windata_t * vwin)2277 static void update_model_tests (windata_t *vwin)
2278 {
2279 MODEL *pmod = (MODEL *) vwin->data;
2280
2281 #if 0
2282 fprintf(stderr, "update_model_tests: pmod->ntests = %d,\n"
2283 " vwin->n_model_tests = %d\n", pmod->ntests, vwin->n_model_tests);
2284 #endif
2285
2286 if (pmod->ntests > vwin->n_model_tests) {
2287 print_test_to_window(pmod, vwin->text);
2288 vwin->n_model_tests += 1;
2289 }
2290 }
2291
do_add_omit(selector * sr)2292 int do_add_omit (selector *sr)
2293 {
2294 windata_t *vwin = selector_get_data(sr);
2295 const char *buf = selector_list(sr);
2296 int ci = selector_code(sr);
2297 gretlopt opt = OPT_S | selector_get_opts(sr);
2298 int auto_omit = (ci == OMIT && (opt & OPT_A));
2299 const char *flagstr = NULL;
2300 MODEL *pmod, *newmod = NULL;
2301 DATASET *dset = dataset;
2302 PRN *prn;
2303 int err = 0;
2304
2305 if (buf == NULL && !auto_omit) {
2306 warnbox(_("No variables are selected"));
2307 return 1;
2308 }
2309
2310 pmod = vwin->data;
2311
2312 if (ci == OMIT && (opt & OPT_W)) {
2313 ; /* Wald test */
2314 } else {
2315 gretlopt data_opt = (ci == ADD)? OPT_F : OPT_NONE;
2316
2317 dset = maybe_get_model_data(pmod, data_opt, &err);
2318 if (err) {
2319 return err;
2320 }
2321 }
2322
2323 flagstr = print_flags(opt, ci);
2324
2325 if (ci == ADD) {
2326 lib_command_sprintf("add%s%s", buf, flagstr);
2327 } else if (buf == NULL) {
2328 lib_command_sprintf("omit%s", flagstr);
2329 } else {
2330 lib_command_sprintf("omit%s%s", buf, flagstr);
2331 }
2332
2333 if (parse_lib_command() || bufopen(&prn)) {
2334 return 1;
2335 }
2336
2337 if (ci == ADD && (opt & OPT_L)) {
2338 err = add_test(pmod, libcmd.list, dset, opt, prn);
2339 } else if (ci == OMIT && (opt & OPT_W)) {
2340 err = omit_test(pmod, libcmd.list, dset, opt, prn);
2341 } else {
2342 newmod = gretl_model_new();
2343 if (newmod == NULL) {
2344 err = E_ALLOC;
2345 } else if (ci == ADD) {
2346 err = add_test_full(pmod, newmod, libcmd.list,
2347 dset, opt, prn);
2348 } else {
2349 err = omit_test_full(pmod, newmod, libcmd.list,
2350 dset, opt, prn);
2351 }
2352 }
2353
2354 if (err) {
2355 if (err == E_NOOMIT) {
2356 const char *msg = errmsg_get_with_default(err);
2357
2358 warnbox(msg);
2359 err = 0;
2360 } else {
2361 gui_errmsg(err);
2362 }
2363 gretl_print_destroy(prn);
2364 gretl_model_free(newmod);
2365 } else {
2366 update_model_tests(vwin);
2367 record_model_command(pmod->ID);
2368
2369 if (newmod != NULL && newmod->ncoeff > 0) {
2370 /* record sub-sample info (if any) with the model */
2371 if (pmod->dataset != NULL) {
2372 newmod->submask = copy_subsample_mask(pmod->submask, &err);
2373 } else {
2374 attach_subsample_to_model(newmod, dataset);
2375 }
2376 printmodel(newmod, dataset, OPT_NONE, prn);
2377 view_model(prn, newmod, NULL);
2378 } else {
2379 const char *omit_title = NULL;
2380
2381 if (newmod != NULL) {
2382 omit_title = N_("gretl: sequential omit test");
2383 gretl_model_free(newmod);
2384 } else {
2385 omit_title = N_("gretl: Wald omit test");
2386 }
2387 view_buffer_with_parent(vwin, prn, 78, 400,
2388 (ci == OMIT)? _(omit_title) :
2389 _("gretl: LM test"),
2390 PRINT, NULL);
2391 }
2392 }
2393
2394 trim_dataset(pmod, 0);
2395
2396 return err;
2397 }
2398
do_VAR_omit(selector * sr)2399 int do_VAR_omit (selector *sr)
2400 {
2401 windata_t *vwin = selector_get_data(sr);
2402 const char *buf = selector_list(sr);
2403 gretlopt opt = selector_get_opts(sr);
2404 GRETL_VAR *var = vwin->data;
2405 GRETL_VAR *vnew = NULL;
2406 int *omitlist;
2407 PRN *prn;
2408 int err = 0;
2409
2410 /* Here we're omitting one or more exogenous terms, other than an
2411 auto-added trend or seasonals. The selector gives the option of
2412 just a Wald test (OPT_W) or estimation of the reduced model.
2413 */
2414
2415 if (buf == NULL) {
2416 return 1;
2417 }
2418
2419 if (bufopen(&prn)) {
2420 return 1;
2421 }
2422
2423 omitlist = command_list_from_string(buf, &err);
2424
2425 if (!err) {
2426 if (opt & OPT_W) {
2427 err = gretl_VAR_wald_omit_test(var, omitlist, dataset,
2428 OPT_NONE, prn);
2429 } else {
2430 vnew = gretl_VAR_omit_test(var, omitlist, dataset,
2431 OPT_NONE, prn, &err);
2432 }
2433 free(omitlist);
2434 }
2435
2436 if (err) {
2437 gui_errmsg(err);
2438 gretl_print_destroy(prn);
2439 } else if (opt & OPT_W) {
2440 lib_command_sprintf("omit%s --test-only", buf);
2441 record_command_verbatim();
2442 view_buffer(prn, 78, 200, _("gretl: Wald omit test"),
2443 PRINT, NULL);
2444 } else {
2445 lib_command_sprintf("omit%s", buf);
2446 record_command_verbatim();
2447 view_buffer(prn, 78, 450, _("gretl: vector autoregression"),
2448 VAR, vnew);
2449 }
2450
2451 return err;
2452 }
2453
VAR_omit_auto(GtkAction * action,gpointer p)2454 void VAR_omit_auto (GtkAction *action, gpointer p)
2455 {
2456 const gchar *aname = gtk_action_get_name(action);
2457 windata_t *vwin = (windata_t *) p;
2458 GRETL_VAR *var = vwin->data;
2459 gretlopt opt;
2460 PRN *prn;
2461 int err;
2462
2463 /* Here we're omitting an "auto-added" term: either
2464 a trend or a set of seasonal dummies.
2465 */
2466
2467 if (bufopen(&prn)) {
2468 return;
2469 }
2470
2471 if (!strcmp(aname, "VarOmitTrend")) {
2472 opt = OPT_T;
2473 } else {
2474 opt = OPT_E;
2475 }
2476
2477 err = gretl_VAR_wald_omit_test(var, NULL, dataset,
2478 opt, prn);
2479 if (err) {
2480 gui_errmsg(err);
2481 gretl_print_destroy(prn);
2482 } else {
2483 lib_command_sprintf("omit --%s --test-only", (opt & OPT_T)?
2484 "trend" : "seasonals");
2485 record_command_verbatim();
2486 view_buffer(prn, 78, 200, _("gretl: Wald omit test"),
2487 PRINT, NULL);
2488 }
2489 }
2490
do_confidence_region(selector * sr)2491 int do_confidence_region (selector *sr)
2492 {
2493 windata_t *vwin = selector_get_data(sr);
2494 const char *buf = selector_list(sr);
2495 MODEL *pmod;
2496 char *mask = NULL;
2497 char iname[VNAMELEN];
2498 char jname[VNAMELEN];
2499 gretl_matrix *V = NULL;
2500 int v[2];
2501 double b[2];
2502 double tcrit, Fcrit, alpha;
2503 int err = 0;
2504
2505 if (buf == NULL || sscanf(buf, "%lf %d %d", &alpha, &v[0], &v[1]) != 3) {
2506 return 1;
2507 }
2508
2509 pmod = (MODEL *) vwin->data;
2510 if (pmod == NULL) {
2511 gui_errmsg(E_DATA);
2512 return 0;
2513 }
2514
2515 mask = calloc(pmod->ncoeff, 1);
2516 if (mask == NULL) {
2517 nomem();
2518 return 0;
2519 }
2520
2521 mask[v[0]] = mask[v[1]] = 1;
2522
2523 V = gretl_vcv_matrix_from_model(pmod, mask, &err);
2524 if (err) {
2525 free(mask);
2526 return 0;
2527 }
2528
2529 b[0] = pmod->coeff[v[0]];
2530 b[1] = pmod->coeff[v[1]];
2531
2532 tcrit = student_cdf_inverse(pmod->dfd, 1 - alpha / 2);
2533 Fcrit = 2.0 * snedecor_critval(2, pmod->dfd, alpha);
2534
2535 gretl_model_get_param_name(pmod, dataset, v[0], iname);
2536 gretl_model_get_param_name(pmod, dataset, v[1], jname);
2537
2538 err = confidence_ellipse_plot(V, b, tcrit, Fcrit, alpha,
2539 iname, jname);
2540 gui_graph_handler(err);
2541
2542 gretl_matrix_free(V);
2543 free(mask);
2544
2545 return 0;
2546 }
2547
modtest_get_opt(GtkAction * action)2548 static gretlopt modtest_get_opt (GtkAction *action)
2549 {
2550 const gchar *s = gtk_action_get_name(action);
2551
2552 if (strchr(s, ':')) {
2553 char c, word[9];
2554
2555 sscanf(s, "%8[^:]:%c", word, &c);
2556 return opt_from_flag((unsigned char) c);
2557 } else if (!strcmp(s, "White")) {
2558 return OPT_W;
2559 } else if (!strcmp(s, "WhiteSquares")) {
2560 return OPT_X;
2561 } else if (!strcmp(s, "BreuschPagan")) {
2562 return OPT_B;
2563 } else if (!strcmp(s, "Koenker")) {
2564 return (OPT_B | OPT_R);
2565 } else if (!strcmp(s, "Groupwise")) {
2566 return OPT_P;
2567 } else {
2568 return OPT_NONE;
2569 }
2570 }
2571
do_modtest(GtkAction * action,gpointer p)2572 void do_modtest (GtkAction *action, gpointer p)
2573 {
2574 windata_t *vwin = (windata_t *) p;
2575 MODEL *pmod = (MODEL *) vwin->data;
2576 DATASET *dset = dataset;
2577 PRN *prn;
2578 gchar *title = NULL;
2579 gretlopt opt = OPT_NONE;
2580 int err = 0;
2581
2582 if (gui_exact_fit_check(pmod)) {
2583 return;
2584 }
2585
2586 if (bufopen(&prn)) return;
2587
2588 dset = maybe_get_model_data(pmod, OPT_NONE, &err);
2589 if (err) {
2590 gretl_print_destroy(prn);
2591 return;
2592 }
2593
2594 opt = modtest_get_opt(action);
2595
2596 if (opt & (OPT_W | OPT_X | OPT_B)) {
2597 title = g_strdup_printf("%s%s", _("gretl: LM test "),
2598 _("(heteroskedasticity)"));
2599 }
2600
2601 if (opt == OPT_W) {
2602 lib_command_strcpy("modtest --white");
2603 err = whites_test(pmod, dset, OPT_S, prn);
2604 } else if (opt == OPT_X) {
2605 lib_command_strcpy("modtest --white-nocross");
2606 err = whites_test(pmod, dset, OPT_S | OPT_X, prn);
2607 } else if (opt & OPT_B) {
2608 if (opt & OPT_R) {
2609 lib_command_strcpy("modtest --breusch-pagan --robust");
2610 } else {
2611 lib_command_strcpy("modtest --breusch-pagan");
2612 }
2613 err = whites_test(pmod, dset, opt | OPT_S, prn);
2614 } else if (opt == OPT_P) {
2615 title = g_strdup(_("gretl: groupwise heteroskedasticity"));
2616 lib_command_strcpy("modtest --panel");
2617 err = groupwise_hetero_test(pmod, dset, opt | OPT_S, prn);
2618 } else if (opt & (OPT_S | OPT_L)) {
2619 int aux = (opt == OPT_S)? AUX_SQ : AUX_LOG;
2620
2621 title = g_strdup_printf("%s%s", _("gretl: LM test "),
2622 _("(non-linearity)"));
2623 if (aux == AUX_SQ) {
2624 lib_command_strcpy("modtest --squares");
2625 } else {
2626 lib_command_strcpy("modtest --logs");
2627 }
2628 err = nonlinearity_test(pmod, dset, aux, OPT_S, prn);
2629 } else if (opt == OPT_C) {
2630 title = g_strdup(_("gretl: common factor test"));
2631 lib_command_strcpy("modtest --comfac");
2632 err = comfac_test(pmod, dset, OPT_S, prn);
2633 } else if (opt == OPT_D) {
2634 title = g_strdup(_("gretl: cross-sectional dependence"));
2635 lib_command_strcpy("modtest --xdepend");
2636 err = panel_xdepend_test(pmod, dset, OPT_S, prn);
2637 }
2638
2639 if (err) {
2640 gui_errmsg(err);
2641 gretl_print_destroy(prn);
2642 } else {
2643 update_model_tests(vwin);
2644 record_model_command_verbatim(pmod->ID);
2645 view_buffer_with_parent(vwin, prn, 78, 400,
2646 title, MODTEST, NULL);
2647 }
2648
2649 g_free(title);
2650 trim_dataset(pmod, 0);
2651 }
2652
do_arch(GtkAction * action,gpointer p)2653 void do_arch (GtkAction *action, gpointer p)
2654 {
2655 windata_t *vwin = (windata_t *) p;
2656 MODEL *pmod = vwin->data;
2657 PRN *prn;
2658 int order, resp;
2659 int err = 0;
2660
2661 if (gui_exact_fit_check(pmod)) {
2662 return;
2663 }
2664
2665 order = default_lag_order(dataset);
2666
2667 resp = spin_dialog(_("gretl: ARCH test"), NULL,
2668 &order, _("Lag order for ARCH test:"),
2669 1, dataset->n / 2, 0,
2670 vwin_toplevel(vwin));
2671
2672 if (canceled(resp) || bufopen(&prn)) {
2673 return;
2674 }
2675
2676 err = arch_test(pmod, order, dataset, OPT_S, prn);
2677
2678 if (err) {
2679 gui_errmsg(err);
2680 gretl_print_destroy(prn);
2681 } else {
2682 update_model_tests(vwin);
2683 lib_command_sprintf("modtest %d --arch", order);
2684 record_model_command_verbatim(pmod->ID);
2685 view_buffer_with_parent(vwin, prn, 78, 400,
2686 _("gretl: ARCH test"),
2687 MODTEST, NULL);
2688 }
2689 }
2690
do_panel_tests(GtkAction * action,gpointer p)2691 void do_panel_tests (GtkAction *action, gpointer p)
2692 {
2693 windata_t *vwin = (windata_t *) p;
2694 MODEL *pmod = (MODEL *) vwin->data;
2695 PRN *prn;
2696 int err;
2697
2698 err = model_sample_problem(pmod, dataset);
2699 if (err) {
2700 gui_errmsg(err);
2701 return;
2702 }
2703
2704 if (bufopen(&prn)) {
2705 return;
2706 }
2707
2708 err = panel_diagnostics(pmod, dataset, OPT_NONE, prn);
2709
2710 if (err) {
2711 gui_errmsg(err);
2712 gretl_print_destroy(prn);
2713 } else {
2714 view_buffer_with_parent(vwin, prn, 78, 400,
2715 _("gretl: panel model specification"),
2716 PANEL, NULL);
2717 }
2718 }
2719
set_model_id_on_vwin(windata_t * vwin,int ID)2720 static void set_model_id_on_vwin (windata_t *vwin, int ID)
2721 {
2722 widget_set_int(vwin->main, "model_ID", ID);
2723 }
2724
get_model_id_from_vwin(windata_t * vwin)2725 static int get_model_id_from_vwin (windata_t *vwin)
2726 {
2727 return widget_get_int(vwin->main, "model_ID");
2728 }
2729
add_leverage_data(windata_t * vwin)2730 void add_leverage_data (windata_t *vwin)
2731 {
2732 unsigned char (*leverage_data_dialog) (void);
2733 gretl_matrix *m = (gretl_matrix *) vwin->data;
2734 unsigned char flags;
2735 int err;
2736
2737 if (m == NULL) return;
2738
2739 leverage_data_dialog = gui_get_plugin_function("leverage_data_dialog");
2740 if (leverage_data_dialog == NULL) return;
2741
2742 flags = leverage_data_dialog();
2743 if (flags == 0) return;
2744
2745 err = add_leverage_values_to_dataset(dataset, m, OPT_O, flags);
2746
2747 if (err) {
2748 gui_errmsg(err);
2749 } else {
2750 int ID = get_model_id_from_vwin(vwin);
2751
2752 lib_command_strcpy("leverage --save");
2753 record_model_command_verbatim(ID);
2754 }
2755 }
2756
do_leverage(GtkAction * action,gpointer p)2757 void do_leverage (GtkAction *action, gpointer p)
2758 {
2759 windata_t *vwin = (windata_t *) p;
2760 MODEL *pmod = (MODEL *) vwin->data;
2761 gretl_matrix *(*model_leverage) (const MODEL *, DATASET *,
2762 gretlopt, PRN *, int *);
2763 PRN *prn;
2764 gretl_matrix *m;
2765 int err = 0;
2766
2767 if (gui_exact_fit_check(pmod)) {
2768 return;
2769 }
2770
2771 model_leverage = gui_get_plugin_function("model_leverage");
2772 if (model_leverage == NULL) {
2773 return;
2774 }
2775
2776 if (bufopen(&prn)) {
2777 return;
2778 }
2779
2780 m = (*model_leverage)(pmod, dataset, OPT_NONE, prn, &err);
2781
2782 if (err) {
2783 gui_errmsg(err);
2784 gretl_print_destroy(prn);
2785 } else {
2786 windata_t *vbuf;
2787
2788 vbuf = view_buffer_with_parent(vwin, prn, 78, 400,
2789 _("gretl: leverage and influence"),
2790 LEVERAGE, m);
2791 set_model_id_on_vwin(vbuf, pmod->ID);
2792 register_graph();
2793 lib_command_strcpy("leverage");
2794 record_model_command_verbatim(pmod->ID);
2795 }
2796 }
2797
do_collin(GtkAction * action,gpointer p)2798 void do_collin (GtkAction *action, gpointer p)
2799 {
2800 windata_t *vwin = (windata_t *) p;
2801 MODEL *pmod = (MODEL *) vwin->data;
2802 DATASET *dset = NULL;
2803 PRN *prn = NULL;
2804 int show = 0;
2805 int err, verr, berr;
2806
2807 if (bufopen(&prn)) {
2808 return;
2809 }
2810
2811 err = verr = berr = 0;
2812 dset = maybe_get_model_data(pmod, OPT_NONE, &err);
2813
2814 if (!err && model_test_ok(VIF, OPT_NONE, pmod, dset)) {
2815 /* show VIFs if possible */
2816 int (*compute_vifs) (MODEL *, DATASET *, gretlopt, PRN *);
2817
2818 compute_vifs = gui_get_plugin_function("compute_vifs");
2819 if (compute_vifs == NULL) {
2820 verr = E_FOPEN;
2821 } else {
2822 verr = (*compute_vifs)(pmod, dset, OPT_G, prn);
2823 }
2824 if (!verr) {
2825 lib_command_strcpy("vif");
2826 record_model_command_verbatim(pmod->ID);
2827 show = 1;
2828 }
2829 }
2830
2831 if (!err) {
2832 /* BKW analysis? (more generally applicable) */
2833 int (*compute_bkw) (MODEL *, const DATASET *, gretlopt, PRN *);
2834
2835 compute_bkw = get_plugin_function("compute_bkw");
2836 if (compute_bkw == NULL) {
2837 berr = E_FOPEN;
2838 } else {
2839 berr = (*compute_bkw)(pmod, dset, OPT_G, prn);
2840 }
2841 if (!berr) {
2842 lib_command_strcpy("bkw");
2843 record_model_command_verbatim(pmod->ID);
2844 show = 1;
2845 }
2846 }
2847
2848 if (dset != NULL) {
2849 trim_dataset(pmod, 0);
2850 }
2851
2852 if (show) {
2853 view_buffer_with_parent(vwin, prn, 78, 400,
2854 _("gretl: collinearity"),
2855 PRINT, NULL);
2856 } else {
2857 if (!err) {
2858 err = verr ? verr : berr;
2859 }
2860 gui_errmsg(err);
2861 gretl_print_destroy(prn);
2862 }
2863 }
2864
do_gini(void)2865 void do_gini (void)
2866 {
2867 gretlopt opt = OPT_NONE;
2868 PRN *prn;
2869 int v = mdata_active_var();
2870 int err;
2871
2872 if (bufopen(&prn)) {
2873 return;
2874 }
2875
2876 err = gini(v, dataset, opt, prn);
2877
2878 if (err) {
2879 gui_errmsg(err);
2880 gretl_print_destroy(prn);
2881 } else {
2882 gchar *title = gretl_window_title(_("Gini coefficient"));
2883
2884 view_buffer(prn, 78, 200, title, PRINT, NULL);
2885 g_free(title);
2886 register_graph();
2887 }
2888 }
2889
do_qqplot(void)2890 void do_qqplot (void)
2891 {
2892 const char *opts[] = {
2893 N_("use sample mean and variance for normal quantiles"),
2894 N_("standardize the data"),
2895 N_("raw quantiles versus N(0, 1)")
2896 };
2897 int v = mdata_active_var();
2898 gretlopt opt = OPT_NONE;
2899 gchar *title;
2900 int resp;
2901
2902 title = gretl_window_title(_("Q-Q plot"));
2903 resp = radio_dialog(title, _("Normal Q-Q plot"), opts, 3, 0,
2904 QQPLOT, NULL);
2905 g_free(title);
2906
2907 if (canceled(resp)) {
2908 return;
2909 }
2910
2911 if (resp == 1) {
2912 opt |= OPT_Z; /* --z-scores */
2913 } else if (resp == 2) {
2914 opt |= OPT_R; /* --raw */
2915 }
2916
2917 lib_command_sprintf("qqplot %s%s", dataset->varname[v],
2918 print_flags(opt, QQPLOT));
2919
2920 if (parse_lib_command() == 0) {
2921 int list[2] = {1, v};
2922 int err;
2923
2924 err = qq_plot(list, dataset, opt);
2925 gui_graph_handler(err);
2926 if (!err) {
2927 record_lib_command();
2928 }
2929 }
2930 }
2931
do_kernel(void)2932 void do_kernel (void)
2933 {
2934 int (*kernel_density) (const double *, int, double,
2935 const char *, gretlopt);
2936 gretlopt opt = OPT_NONE;
2937 double bw = 1.0;
2938 int v = mdata_active_var();
2939 int T = sample_size(dataset);
2940 int resp, err = 0;
2941
2942 if (T < 30) {
2943 gui_errmsg(E_TOOFEW);
2944 return;
2945 }
2946
2947 resp = density_dialog(v, &bw);
2948 if (canceled(resp)) {
2949 return;
2950 }
2951
2952 if (resp > 0) {
2953 opt |= OPT_O;
2954 }
2955
2956 kernel_density = gui_get_plugin_function("kernel_density");
2957
2958 if (kernel_density != NULL) {
2959 const double *y = dataset->Z[v] + dataset->t1;
2960
2961 err = (*kernel_density)(y, T, bw,
2962 dataset->varname[v],
2963 opt);
2964 gui_graph_handler(err);
2965
2966 if (!err) {
2967 gretl_push_c_numeric_locale();
2968 lib_command_sprintf("matrix kd__ = kdensity(%s, %g, %d)",
2969 dataset->varname[v], bw,
2970 (opt & OPT_O)? 1 : 0);
2971 record_command_verbatim();
2972 lib_command_strcpy("cnameset(kd__, \"value density\")");
2973 record_command_verbatim();
2974 lib_command_strcpy("gnuplot 2 1 --matrix=kd__ --with-lines "
2975 "--fit=none --output=display");
2976 record_command_verbatim();
2977 lib_command_strcpy("delete kd__");
2978 record_command_verbatim();
2979 gretl_pop_c_numeric_locale();
2980 }
2981 }
2982 }
2983
chow_cusum_ci(GtkAction * action)2984 static int chow_cusum_ci (GtkAction *action)
2985 {
2986 const gchar *s = gtk_action_get_name(action);
2987
2988 if (!strcmp(s, "chow"))
2989 return CHOW;
2990 else if (!strcmp(s, "qlrtest"))
2991 return QLRTEST;
2992 else if (!strcmp(s, "cusum"))
2993 return CUSUM;
2994 else if (!strcmp(s, "cusum:r"))
2995 return CUSUMSQ;
2996 else
2997 return CHOW;
2998 }
2999
3000 struct chowparms {
3001 int splitbrk;
3002 int splitdum;
3003 };
3004
real_limited_chow(selector * sr)3005 static int real_limited_chow (selector *sr)
3006 {
3007 windata_t *vwin = selector_get_data(sr);
3008 MODEL *pmod = vwin->data;
3009 gretlopt opt = OPT_S | OPT_L;
3010 struct chowparms *cp;
3011 const char *lstr;
3012 PRN *prn = NULL;
3013 int *clist = NULL;
3014 int err = 0;
3015
3016 cp = g_object_get_data(G_OBJECT(vwin->main), "chowparms");
3017 lstr = selector_list(sr);
3018 if (lstr == NULL) {
3019 warnbox(_("You must select at least one regressor"));
3020 return 1;
3021 }
3022
3023 clist = gretl_list_from_varnames(lstr, dataset, &err);
3024
3025 #if 0
3026 fprintf(stderr, "lstr = '%s'\n", lstr);
3027 printlist(clist, "chow arg list");
3028 #endif
3029
3030 if (!err) {
3031 err = remember_list(clist, "chow_args_", NULL);
3032 if (!err) {
3033 err = push_option_param(CHOW, OPT_L, gretl_strdup("chow_args_"));
3034 }
3035 if (!err) {
3036 lib_command_sprintf("list chow_args_ =%s", lstr);
3037 record_command_verbatim();
3038 }
3039 }
3040
3041 if (err) {
3042 gui_errmsg(err);
3043 } else {
3044 if (cp->splitdum > 0) {
3045 lib_command_sprintf("chow %s --dummy --limit-to=chowargs",
3046 dataset->varname[cp->splitdum]);
3047 opt |= OPT_D;
3048 } else {
3049 char brkstr[OBSLEN];
3050
3051 ntolabel(brkstr, cp->splitbrk, dataset);
3052 lib_command_sprintf("chow %s --limit-to=chow_args_", brkstr);
3053 }
3054 err = bufopen(&prn);
3055 }
3056
3057 if (!err) {
3058 if (opt & OPT_D) {
3059 err = chow_test_from_dummy(cp->splitdum, pmod, dataset, opt, prn);
3060 } else {
3061 err = chow_test(cp->splitbrk, pmod, dataset, opt, prn);
3062 }
3063 if (err) {
3064 gui_errmsg(err);
3065 gretl_print_destroy(prn);
3066 } else {
3067 update_model_tests(vwin);
3068 record_model_command_verbatim(pmod->ID);
3069 view_buffer_with_parent(vwin, prn, 78, 400,
3070 _("gretl: Chow test output"),
3071 CHOW, NULL);
3072 }
3073 }
3074
3075 free(cp);
3076 g_object_set_data(G_OBJECT(vwin->main), "chowparms", NULL);
3077 free(clist);
3078
3079 return 0;
3080 }
3081
do_chow_cusum(GtkAction * action,gpointer p)3082 void do_chow_cusum (GtkAction *action, gpointer p)
3083 {
3084 windata_t *vwin = (windata_t *) p;
3085 MODEL *pmod = vwin->data;
3086 gretlopt opt = OPT_S; /* save test result */
3087 int splitbrk = 0;
3088 int splitdum = 0;
3089 PRN *prn;
3090 int ci, err = 0;
3091
3092 if (pmod->ci != OLS) {
3093 errbox(_("This test only implemented for OLS models"));
3094 return;
3095 }
3096
3097 if (gui_exact_fit_check(pmod)) {
3098 return;
3099 }
3100
3101 ci = chow_cusum_ci(action);
3102
3103 if (ci == CHOW) {
3104 int resp;
3105
3106 splitbrk = pmod->t1 + (pmod->t2 - pmod->t1) / 2;
3107
3108 if (pmod->ncoeff > 2) {
3109 resp = chow_dialog(pmod->t1 + 1, pmod->t2 - 1, &splitbrk,
3110 &splitdum, &opt, vwin_toplevel(vwin));
3111 } else {
3112 resp = chow_dialog(pmod->t1 + 1, pmod->t2 - 1, &splitbrk,
3113 &splitdum, NULL, vwin_toplevel(vwin));
3114 }
3115 if (canceled(resp)) {
3116 return;
3117 }
3118 if (opt & OPT_L) {
3119 struct chowparms *cp = malloc(sizeof *cp);
3120
3121 cp->splitdum = splitdum;
3122 cp->splitbrk = splitbrk;
3123 g_object_set_data(G_OBJECT(vwin->main), "chowparms", cp);
3124 simple_selection_for_viewer(CHOW, _("gretl: chow test"),
3125 real_limited_chow, vwin);
3126 /* execution resumes with real_limited_chow() */
3127 return;
3128 }
3129 }
3130
3131 if (ci == CHOW) {
3132 if (splitdum > 0) {
3133 lib_command_sprintf("chow %s --dummy", dataset->varname[splitdum]);
3134 opt |= OPT_D;
3135 } else {
3136 char brkstr[OBSLEN];
3137
3138 ntolabel(brkstr, splitbrk, dataset);
3139 lib_command_sprintf("chow %s", brkstr);
3140 }
3141 } else if (ci == QLRTEST) {
3142 lib_command_strcpy("qlrtest");
3143 } else if (ci == CUSUM) {
3144 lib_command_strcpy("cusum");
3145 } else if (ci == CUSUMSQ) {
3146 lib_command_strcpy("cusum --squares");
3147 }
3148
3149 if (bufopen(&prn)) {
3150 return;
3151 }
3152
3153 if (ci == CHOW) {
3154 if (opt & OPT_D) {
3155 err = chow_test_from_dummy(splitdum, pmod, dataset, opt, prn);
3156 } else {
3157 err = chow_test(splitbrk, pmod, dataset, opt, prn);
3158 }
3159 } else if (ci == QLRTEST) {
3160 err = QLR_test(pmod, dataset, opt, prn);
3161 } else {
3162 if (ci == CUSUMSQ) {
3163 opt |= OPT_R;
3164 }
3165 err = cusum_test(pmod, dataset, opt, prn);
3166 }
3167
3168 if (err) {
3169 gui_errmsg(err);
3170 gretl_print_destroy(prn);
3171 } else {
3172 if (ci == CUSUM || ci == CUSUMSQ || ci == QLRTEST) {
3173 register_graph();
3174 }
3175
3176 update_model_tests(vwin);
3177 record_model_command_verbatim(pmod->ID);
3178
3179 view_buffer_with_parent(vwin, prn, 78, 400,
3180 (ci == CHOW)?
3181 _("gretl: Chow test output") :
3182 (ci == QLRTEST)?
3183 _("gretl: QLR test output") :
3184 (ci == CUSUM)?
3185 _("gretl: CUSUM test output") :
3186 _("gretl: CUSUMSQ test output"),
3187 ci, NULL);
3188 }
3189 }
3190
do_reset(GtkAction * action,gpointer p)3191 void do_reset (GtkAction *action, gpointer p)
3192 {
3193 windata_t *vwin = (windata_t *) p;
3194 MODEL *pmod = vwin->data;
3195 DATASET *dset;
3196 PRN *prn;
3197 const char *optstrs[] = {
3198 N_("squares and cubes"),
3199 N_("squares only"),
3200 N_("cubes only"),
3201 N_("all variants")
3202 };
3203 gretlopt opt = OPT_S;
3204 int width = 78;
3205 int height = 400;
3206 int resp, err = 0;
3207
3208 if (gui_exact_fit_check(pmod)) {
3209 return;
3210 }
3211
3212 resp = radio_dialog(_("gretl: RESET test"),
3213 _("RESET specification test"),
3214 optstrs, 4, 0, RESET,
3215 vwin_toplevel(vwin));
3216
3217 if (canceled(resp) || bufopen(&prn)) {
3218 return;
3219 }
3220
3221 dset = maybe_get_model_data(pmod, OPT_NONE, &err);
3222 if (err) {
3223 gretl_print_destroy(prn);
3224 return;
3225 }
3226
3227 lib_command_strcpy("reset");
3228
3229 if (resp == 1) {
3230 opt |= OPT_R;
3231 lib_command_strcat(" --squares-only");
3232 } else if (resp == 2) {
3233 lib_command_strcat(" --cubes-only");
3234 opt |= OPT_C;
3235 } else if (resp == 3) {
3236 opt = (OPT_Q | OPT_G);
3237 }
3238
3239 if (opt & OPT_G) {
3240 /* gui special: show short form of all 3 tests */
3241 width = 60;
3242 height = 320;
3243 err = reset_test(pmod, dset, opt, prn);
3244 if (!err) {
3245 err = reset_test(pmod, dset, (opt | OPT_R), prn);
3246 }
3247 if (!err) {
3248 err = reset_test(pmod, dset, (opt | OPT_C), prn);
3249 }
3250 } else {
3251 err = reset_test(pmod, dset, opt, prn);
3252 }
3253
3254 if (err) {
3255 gui_errmsg(err);
3256 gretl_print_destroy(prn);
3257 } else {
3258 if (opt & OPT_S) {
3259 update_model_tests(vwin);
3260 }
3261 record_model_command_verbatim(pmod->ID);
3262 view_buffer_with_parent(vwin, prn, width, height,
3263 _("gretl: RESET test"),
3264 RESET, NULL);
3265 }
3266
3267 trim_dataset(pmod, 0);
3268 }
3269
do_autocorr(GtkAction * action,gpointer p)3270 void do_autocorr (GtkAction *action, gpointer p)
3271 {
3272 windata_t *vwin = (windata_t *) p;
3273 MODEL *pmod = vwin->data;
3274 PRN *prn;
3275 int order = 1;
3276 int resp, err;
3277
3278 if (gui_exact_fit_check(pmod)) {
3279 return;
3280 }
3281
3282 if (dataset_is_panel(dataset)) {
3283 /* first-order test only */
3284 if (bufopen(&prn)) {
3285 return;
3286 }
3287 } else {
3288 order = default_lag_order(dataset);
3289 resp = spin_dialog(_("gretl: autocorrelation"), NULL,
3290 &order, _("Lag order for test:"),
3291 1, dataset->n / 2, 0,
3292 vwin_toplevel(vwin));
3293
3294 if (canceled(resp) || bufopen(&prn)) {
3295 return;
3296 }
3297 }
3298
3299 if (dataset_is_panel(dataset)) {
3300 err = panel_autocorr_test(pmod, dataset, OPT_S, prn);
3301 } else {
3302 err = autocorr_test(pmod, order, dataset, OPT_S, prn);
3303 }
3304
3305 if (err) {
3306 gui_errmsg(err);
3307 gretl_print_destroy(prn);
3308 } else {
3309 gchar *title =
3310 g_strdup_printf(_("gretl: autocorrelation"));
3311
3312 update_model_tests(vwin);
3313 lib_command_sprintf("modtest --autocorr %d", order);
3314 record_model_command_verbatim(pmod->ID);
3315 view_buffer_with_parent(vwin, prn, 78, 400,
3316 title, MODTEST, NULL);
3317 g_free(title);
3318 }
3319 }
3320
do_dwpval(GtkAction * action,gpointer p)3321 void do_dwpval (GtkAction *action, gpointer p)
3322 {
3323 windata_t *vwin = (windata_t *) p;
3324 MODEL *pmod = vwin->data;
3325 PRN *prn;
3326 double pv;
3327 int err = 0;
3328
3329 if (bufopen(&prn)) {
3330 return;
3331 }
3332
3333 pv = get_DW_pvalue_for_model(pmod, dataset, &err);
3334
3335 if (err) {
3336 gui_errmsg(err);
3337 gretl_print_destroy(prn);
3338 } else {
3339 gchar *title = gretl_window_title(_("Durbin-Watson"));
3340 int warn = gretl_model_get_int(pmod, "ldepvar") > 0;
3341
3342 pprintf(prn, "%s = %g\n", _("Durbin-Watson statistic"), pmod->dw);
3343
3344 if (warn) {
3345 pputs(prn, _("Warning: the model contains a lagged "
3346 "dependent variable so DW is biased"));
3347 pputs(prn, "\n\n");
3348 } else {
3349 pputc(prn, '\n');
3350 }
3351 if (na(pv)) {
3352 pputs(prn, _("p-value is \"very small\" (the Imhof integral could not\n"
3353 "be evaluated so a definite value is not available)"));
3354 } else {
3355 pprintf(prn, _("H1: positive autocorrelation\n"));
3356 pprintf(prn, " %s = %g\n", _("p-value"), pv);
3357 pprintf(prn, _("H1: negative autocorrelation\n"));
3358 pprintf(prn, " %s = %g\n", _("p-value"), 1.0 - pv);
3359 }
3360 view_buffer_with_parent(vwin, prn, 78, 200,
3361 title, PRINT, NULL);
3362 g_free(title);
3363 }
3364 }
3365
model_error(MODEL * pmod)3366 static int model_error (MODEL *pmod)
3367 {
3368 int err = 0;
3369
3370 if (pmod->errcode) {
3371 if (pmod->errcode != E_CANCEL) {
3372 gui_errmsg(pmod->errcode);
3373 }
3374 gretl_model_free(pmod);
3375 err = 1;
3376 }
3377
3378 return err;
3379 }
3380
model_output(MODEL * pmod,PRN * prn)3381 static int model_output (MODEL *pmod, PRN *prn)
3382 {
3383 int err = 0;
3384
3385 if (model_error(pmod)) {
3386 err = 1;
3387 } else {
3388 printmodel(pmod, dataset, OPT_NONE, prn);
3389 warnmsg(prn); /* just in case */
3390 }
3391
3392 return err;
3393 }
3394
record_command_block_from_buf(const gchar * buf,const char * startline,const char * endline,int model_ID)3395 static void record_command_block_from_buf (const gchar *buf,
3396 const char *startline,
3397 const char *endline,
3398 int model_ID)
3399 {
3400 bufgets_init(buf);
3401
3402 if (startline != NULL) {
3403 lib_command_strcpy(startline);
3404 if (model_ID > 0) {
3405 record_model_command_verbatim(model_ID);
3406 } else {
3407 record_command_verbatim();
3408 }
3409 }
3410
3411 while (bufgets(libline, MAXLINE, buf)) {
3412 if (string_is_blank(libline)) {
3413 continue;
3414 }
3415 top_n_tail(libline, sizeof libline, NULL);
3416 if (model_ID > 0) {
3417 record_model_command_verbatim(model_ID);
3418 } else {
3419 record_command_verbatim();
3420 }
3421 }
3422
3423 bufgets_finalize(buf);
3424
3425 if (endline != NULL) {
3426 lib_command_strcpy(endline);
3427 if (model_ID > 0) {
3428 record_model_command_verbatim(model_ID);
3429 } else {
3430 record_command_verbatim();
3431 }
3432 }
3433 }
3434
do_restrict(GtkWidget * w,dialog_t * dlg)3435 void do_restrict (GtkWidget *w, dialog_t *dlg)
3436 {
3437 windata_t *vwin = (windata_t *) edit_dialog_get_data(dlg);
3438 gretlopt opt = edit_dialog_get_opt(dlg);
3439 MODEL *pmod = NULL;
3440 equation_system *sys = NULL;
3441 GRETL_VAR *vecm = NULL;
3442 GRETL_VAR *vnew = NULL;
3443 gchar *buf;
3444 PRN *prn;
3445 char bufline[MAXLINE];
3446 gretl_restriction *my_rset = NULL;
3447 int save_t1 = dataset->t1;
3448 int save_t2 = dataset->t2;
3449 int got_start = 0, got_end = 0;
3450 int height = 300;
3451 int err = 0;
3452
3453 if (vwin->role == VIEW_MODEL) {
3454 pmod = (MODEL *) vwin->data;
3455 } else if (vwin->role == VECM) {
3456 vecm = (GRETL_VAR *) vwin->data;
3457 } else if (vwin->role == SYSTEM) {
3458 sys = (equation_system *) vwin->data;
3459 }
3460
3461 if (pmod == NULL && vecm == NULL && sys == NULL) {
3462 edit_dialog_close(dlg);
3463 return;
3464 }
3465
3466 buf = edit_dialog_special_get_text(dlg);
3467 if (buf == NULL) return;
3468
3469 bufgets_init(buf);
3470
3471 while (bufgets(bufline, sizeof bufline, buf) && !err) {
3472 if (string_is_blank(bufline)) {
3473 continue;
3474 }
3475
3476 top_n_tail(bufline, MAXLINE, NULL);
3477
3478 if (!strcmp(bufline, "end restrict")) {
3479 got_end = 1;
3480 break;
3481 } else if (!strncmp(bufline, "restrict", 8)) {
3482 got_start = 1;
3483 }
3484
3485 if (my_rset == NULL) {
3486 if (pmod != NULL) {
3487 my_rset = eqn_restriction_set_start(bufline, pmod,
3488 dataset, opt);
3489 } else if (sys != NULL) {
3490 my_rset = cross_restriction_set_start(bufline, sys);
3491 } else {
3492 my_rset = var_restriction_set_start(bufline, vecm);
3493 }
3494 if (my_rset == NULL) {
3495 err = 1;
3496 gui_errmsg(err);
3497 }
3498 } else {
3499 err = restriction_set_parse_line(my_rset, bufline, dataset);
3500 if (err) {
3501 gui_errmsg(err);
3502 }
3503 }
3504 }
3505
3506 bufgets_finalize(buf);
3507
3508 if (err) {
3509 g_free(buf);
3510 return;
3511 }
3512
3513 edit_dialog_close(dlg);
3514
3515 if (opt & OPT_B) {
3516 gretlopt bootopt = OPT_NONE;
3517 int resp;
3518 int B = 1000;
3519
3520 resp = bootstrap_dialog(vwin, NULL, &B, &bootopt);
3521 if (canceled(resp)) {
3522 /* command context? */
3523 destroy_restriction_set(my_rset);
3524 return;
3525 }
3526 gretl_restriction_set_boot_params(B, bootopt);
3527 }
3528
3529 if (bufopen(&prn)) return;
3530
3531 if (pmod != NULL) {
3532 dataset->t1 = pmod->t1;
3533 dataset->t2 = pmod->t2;
3534 }
3535
3536 if (opt & OPT_F) {
3537 vnew = gretl_restricted_vecm(my_rset, dataset, opt, prn, &err);
3538 } else {
3539 err = gretl_restriction_finalize(my_rset, dataset, OPT_NONE, prn);
3540 }
3541
3542 if (err) {
3543 errmsg(err, prn);
3544 } else {
3545 if (pmod != NULL) {
3546 /* FIXME --boot option */
3547 const char *s0 = got_start ? NULL : "restrict";
3548 const char *s1 = got_end ? NULL : "end restrict";
3549
3550 record_command_block_from_buf(buf, s0, s1, pmod->ID);
3551 } else if (sys != NULL) {
3552 equation_system_estimate(sys, dataset, OPT_NONE, prn);
3553 height = 450;
3554 } else if (vecm != NULL) {
3555 height = 450;
3556 }
3557 }
3558
3559 g_free(buf);
3560
3561 if (vnew != NULL) {
3562 view_buffer(prn, 78, 450, _("gretl: VECM"), VECM, vnew);
3563 } else {
3564 gchar *title = gretl_window_title(_("linear restrictions"));
3565
3566 view_buffer_with_parent(vwin, prn, 78, height, title,
3567 PRINT, NULL);
3568 g_free(title);
3569 }
3570
3571 dataset->t1 = save_t1;
3572 dataset->t2 = save_t2;
3573 }
3574
maybe_grab_system_name(const char * s,char * name)3575 static void maybe_grab_system_name (const char *s, char *name)
3576 {
3577 s = strstr(s, "name=");
3578 if (s != NULL) {
3579 s += 5;
3580 if (*s == '"') {
3581 sscanf(s + 1, "%31[^\"]", name);
3582 } else {
3583 sscanf(s, "%31s", name);
3584 }
3585 }
3586 }
3587
get_sys_method_from_opt(gretlopt * opt)3588 static int get_sys_method_from_opt (gretlopt *opt)
3589 {
3590 int method = *opt;
3591
3592 if (*opt & OPT_V) {
3593 /* extract verbose option */
3594 *opt |= OPT_V;
3595 method &= ~OPT_V;
3596 }
3597
3598 if (*opt & OPT_T) {
3599 /* extract iterate option */
3600 *opt |= OPT_T;
3601 method &= ~OPT_T;
3602 }
3603
3604 return method;
3605 }
3606
gui_handle_equations_line(equation_system * sys,const char * s)3607 static int gui_handle_equations_line (equation_system *sys,
3608 const char *s)
3609 {
3610 char s1[VNAMELEN] = {0};
3611 char s2[VNAMELEN] = {0};
3612 int n, err;
3613
3614 /* extract one or two names to pass as arguments */
3615
3616 n = sscanf(s, "%31s %31s", s1, s2);
3617 if (n == 2) {
3618 err = equation_system_append_multi(sys, s1, s2, dataset);
3619 } else if (n == 1) {
3620 err = equation_system_append_multi(sys, s1, NULL, dataset);
3621 } else {
3622 err = E_ARGS;
3623 }
3624
3625 return err;
3626 }
3627
do_eqn_system(GtkWidget * w,dialog_t * dlg)3628 void do_eqn_system (GtkWidget *w, dialog_t *dlg)
3629 {
3630 equation_system *my_sys = NULL;
3631 gretlopt opt;
3632 gchar *buf;
3633 PRN *prn;
3634 char sysname[32] = {0};
3635 char bufline[MAXLINE];
3636 int *slist = NULL;
3637 char *startline = NULL;
3638 int got_end = 0;
3639 int method, err = 0;
3640
3641 buf = edit_dialog_special_get_text(dlg);
3642 if (buf == NULL) {
3643 return;
3644 }
3645
3646 opt = edit_dialog_get_opt(dlg);
3647 method = get_sys_method_from_opt(&opt);
3648
3649 bufgets_init(buf);
3650 *sysname = 0;
3651
3652 while (bufgets(bufline, sizeof bufline, buf) && !err) {
3653 if (string_is_blank(bufline) || *bufline == '#') {
3654 continue;
3655 }
3656
3657 top_n_tail(bufline, MAXLINE, NULL);
3658
3659 if (!strcmp(bufline, "end system")) {
3660 got_end = 1;
3661 break;
3662 }
3663
3664 if (!strcmp(bufline, "system")) {
3665 /* harmless header line */
3666 continue;
3667 }
3668
3669 if (!strncmp(bufline, "system ", 7)) {
3670 maybe_grab_system_name(bufline, sysname);
3671 continue;
3672 }
3673
3674 if (my_sys == NULL) {
3675 startline = g_strdup_printf("system method=%s",
3676 system_method_short_string(method));
3677 /* FIXME opt? */
3678 my_sys = equation_system_start(startline + 7, NULL,
3679 OPT_NONE, &err);
3680 }
3681
3682 if (err) {
3683 gui_errmsg(err);
3684 break;
3685 }
3686
3687 if (!strncmp(bufline, "equation ", 9)) {
3688 slist = command_list_from_string(bufline + 9, &err);
3689 if (slist != NULL) {
3690 err = equation_system_append(my_sys, slist);
3691 free(slist);
3692 }
3693 } else if (!strncmp(bufline, "equations ", 10)) {
3694 err = gui_handle_equations_line(my_sys, bufline + 10);
3695 } else {
3696 err = system_parse_line(my_sys, bufline, dataset);
3697 }
3698
3699 if (err) {
3700 /* sys is destroyed on error */
3701 gui_errmsg(err);
3702 }
3703 }
3704
3705 bufgets_finalize(buf);
3706
3707 if (err) {
3708 g_free(buf);
3709 return;
3710 }
3711
3712 edit_dialog_close(dlg);
3713
3714 if (bufopen(&prn)) {
3715 g_free(buf);
3716 return;
3717 }
3718
3719 err = equation_system_finalize(my_sys, dataset, opt, prn);
3720 if (err) {
3721 errmsg(err, prn);
3722 } else {
3723 const char *endline = got_end ? NULL : "end system";
3724
3725 record_command_block_from_buf(buf, startline, endline, 0);
3726 if (*sysname != 0) {
3727 my_sys->name = g_strdup(sysname);
3728 }
3729 }
3730
3731 g_free(buf);
3732 g_free(startline);
3733
3734 view_buffer(prn, 78, 450,
3735 (my_sys->name != NULL)? my_sys->name:
3736 _("gretl: simultaneous equations system"),
3737 SYSTEM, my_sys);
3738 }
3739
do_saved_eqn_system(GtkWidget * w,dialog_t * dlg)3740 void do_saved_eqn_system (GtkWidget *w, dialog_t *dlg)
3741 {
3742 equation_system *my_sys;
3743 gretlopt opt;
3744 PRN *prn;
3745 int err = 0;
3746
3747 my_sys = (equation_system *) edit_dialog_get_data(dlg);
3748 if (my_sys == NULL) {
3749 return;
3750 }
3751
3752 opt = edit_dialog_get_opt(dlg);
3753 my_sys->method = get_sys_method_from_opt(&opt);
3754
3755 edit_dialog_close(dlg);
3756
3757 if (bufopen(&prn)) {
3758 return;
3759 }
3760
3761 err = equation_system_estimate(my_sys, dataset,
3762 opt, prn);
3763 if (err) {
3764 errmsg(err, prn);
3765 }
3766
3767 view_buffer(prn, 78, 450, my_sys->name, SYSTEM, my_sys);
3768 }
3769
3770 /* Try for the most informative possible error message
3771 from genr, but also try to avoid duplication. In context,
3772 @plus is (or may be) a specific message from "genr".
3773 */
3774
errmsg_plus(int err,const char * plus)3775 void errmsg_plus (int err, const char *plus)
3776 {
3777 int handled = 0;
3778
3779 if (plus != NULL && *plus != '\0') {
3780 const char *s1 = errmsg_get_with_default(err);
3781 gchar *s2 = g_strstrip(g_strdup(plus));
3782 const char *s3 = NULL;
3783
3784 if (err == E_PARSE && get_local_decpoint() == ',') {
3785 s3 = N_("Please note: the decimal character must be '.'\n"
3786 "in this context");
3787 }
3788
3789 if (*s1 != '\0' && *s2 != '\0' && strcmp(s1, s2)) {
3790 if (s3 != NULL) {
3791 errbox_printf("%s\n\n%s", s1, _(s3));
3792 } else {
3793 errbox_printf("%s\n\n%s", s1, s2);
3794 }
3795 handled = 1;
3796 } else if (*s1 == '\0' && *s2 != '\0') {
3797 if (s3 != NULL) {
3798 errbox_printf("%s\n\n%s", s2, _(s3));
3799 } else {
3800 errbox(s2);
3801 }
3802 handled = 1;
3803 }
3804
3805 g_free(s2);
3806 }
3807
3808 if (!handled) {
3809 /* fallback */
3810 gui_errmsg(err);
3811 }
3812 }
3813
3814 /* The point of the following is to take a line such as
3815 "matrix M = I(5)", with leading type specification,
3816 and to pre-process it as the tokenizer does for "genr"
3817 expressions entered via script or command line. That is,
3818 strip out the type-word (if present) but use the
3819 information it carries to fill out the @gtype argument to
3820 the libgretl generate() function.
3821 */
3822
gui_run_genr(const char * line,DATASET * dset,gretlopt opt,PRN * prn)3823 int gui_run_genr (const char *line, DATASET *dset,
3824 gretlopt opt, PRN *prn)
3825 {
3826 GretlType gtype = GRETL_TYPE_ANY;
3827 char word[32];
3828
3829 if (sscanf(line, "%31s", word)) {
3830 GretlType t = gretl_get_gen_type(word);
3831
3832 if (t > 0) {
3833 gtype = t;
3834 line += strlen(word);
3835 line += strspn(line, " ");
3836 }
3837 }
3838
3839 return generate(line, dset, gtype, opt, prn);
3840 }
3841
finish_genr(MODEL * pmod,dialog_t * dlg,int whole_range)3842 static int finish_genr (MODEL *pmod, dialog_t *dlg,
3843 int whole_range)
3844 {
3845 PRN *prn;
3846 const char *gbuf;
3847 int err = 0;
3848
3849 if (bufopen(&prn)) {
3850 return 1;
3851 }
3852
3853 if (pmod != NULL) {
3854 set_genr_model(pmod, GRETL_OBJ_EQN);
3855 }
3856
3857 if (whole_range) {
3858 int save_t1 = dataset->t1;
3859 int save_t2 = dataset->t2;
3860
3861 dataset->t1 = 0;
3862 dataset->t2 = dataset->n - 1;
3863 err = gui_run_genr(libline, dataset, OPT_NONE, prn);
3864 dataset->t1 = save_t1;
3865 dataset->t2 = save_t2;
3866 } else {
3867 err = gui_run_genr(libline, dataset, OPT_NONE, prn);
3868 }
3869
3870 unset_genr_model();
3871 gbuf = gretl_print_get_buffer(prn);
3872
3873 if (err) {
3874 errmsg_plus(err, gbuf);
3875 } else {
3876 GretlType gentype = genr_get_last_output_type();
3877
3878 if (dlg != NULL) {
3879 edit_dialog_close(dlg);
3880 }
3881
3882 if (pmod != NULL) {
3883 record_model_command_verbatim(pmod->ID);
3884 } else {
3885 record_command_verbatim();
3886 }
3887
3888 if (gentype == GRETL_TYPE_SERIES || gentype == GRETL_TYPE_LIST) {
3889 populate_varlist();
3890 mark_dataset_as_modified();
3891 } else if (gentype == GRETL_TYPE_DOUBLE) {
3892 if (autoicon_on()) {
3893 edit_scalars();
3894 } else {
3895 infobox(gbuf);
3896 }
3897 } else if (gentype == GRETL_TYPE_MATRIX) {
3898 if (autoicon_on()) {
3899 view_session();
3900 } else {
3901 infobox(gbuf);
3902 }
3903 }
3904
3905 maybe_warn();
3906 }
3907
3908 gretl_print_destroy(prn);
3909
3910 return err;
3911 }
3912
3913 /* identify "genr" lines within a block command such
3914 as nls, mle, gmm */
3915
is_genr_line(char * s)3916 static int is_genr_line (char *s)
3917 {
3918 if (!strncmp(s, "genr ", 5) ||
3919 !strncmp(s, "series ", 7) ||
3920 !strncmp(s, "scalar ", 7) ||
3921 !strncmp(s, "matrix ", 7) ||
3922 !strncmp(s, "list ", 5)) {
3923 return 1;
3924 } else if (!strncmp(s, "param ", 6) && strchr(s, '=')) {
3925 gchar *tmp = g_strdup_printf("genr %s", s + 6);
3926
3927 strcpy(s, tmp);
3928 g_free(tmp);
3929 return 1;
3930 } else {
3931 return 0;
3932 }
3933 }
3934
real_do_nonlinear_model(dialog_t * dlg,int ci)3935 static void real_do_nonlinear_model (dialog_t *dlg, int ci)
3936 {
3937 gchar *buf = edit_dialog_special_get_text(dlg);
3938 gretlopt opt = edit_dialog_get_opt(dlg);
3939 char realline[MAXLINE];
3940 char bufline[MAXLINE];
3941 char **lines = NULL;
3942 int n_lines = 0;
3943 int started = 0;
3944 MODEL *pmod = NULL;
3945 const char *cstr;
3946 gchar *endstr = NULL;
3947 PRN *prn = NULL;
3948 int err = 0;
3949
3950 if (buf == NULL) {
3951 return;
3952 }
3953
3954 if (ci == MLE && (opt & OPT_N)) {
3955 /* GUI-special way of passing --robust=hac */
3956 set_optval_string(MLE, OPT_R, "hac");
3957 opt |= OPT_R;
3958 opt &= ~OPT_N;
3959 }
3960
3961 cstr = gretl_command_word(ci);
3962 if (opt != OPT_NONE) {
3963 const char *ostr = print_flags(opt, ci);
3964
3965 endstr = g_strdup_printf("end %s%s", cstr, ostr);
3966 } else {
3967 endstr = g_strdup_printf("end %s", cstr);
3968 }
3969
3970 bufgets_init(buf);
3971 *realline = '\0';
3972
3973 while (bufgets(bufline, sizeof bufline, buf) && !err) {
3974 int len, cont = 0;
3975
3976 if (string_is_blank(bufline) || *bufline == '#') {
3977 *realline = '\0';
3978 continue;
3979 }
3980
3981 /* allow for backslash continuation of lines */
3982 cont = top_n_tail(bufline, sizeof bufline, &err);
3983 if (!err) {
3984 len = strlen(bufline) + strlen(realline);
3985 if (len > MAXLINE - 1) {
3986 err = E_TOOLONG;
3987 }
3988 }
3989
3990 if (err) {
3991 gui_errmsg(err);
3992 break;
3993 }
3994
3995 strcat(realline, bufline);
3996
3997 if (cont) {
3998 continue;
3999 }
4000
4001 if (started && !strncmp(realline, endstr, 7)) {
4002 /* we got, e.g., "end nls" */
4003 break;
4004 }
4005
4006 if (!started && is_genr_line(realline)) {
4007 /* handle possible "genr" lines before the actual
4008 command block: for such lines the recording
4009 or error message is handled by finish_genr
4010 */
4011 lib_command_strcpy(realline);
4012 err = finish_genr(NULL, NULL, 0);
4013 *realline = '\0';
4014 continue; /* on to the next line */
4015 }
4016
4017 if (!started && strncmp(realline, cstr, 3)) {
4018 /* insert, e.g., "nls" if it's not present */
4019 gchar *tmp = g_strdup_printf("%s %s", cstr, realline);
4020
4021 *realline = '\0';
4022 strncat(realline, tmp, MAXLINE - 1);
4023 g_free(tmp);
4024 }
4025
4026 err = nl_parse_line(ci, realline, dataset, NULL);
4027
4028 if (err) {
4029 gui_errmsg(err);
4030 } else {
4031 strings_array_add(&lines, &n_lines, realline);
4032 if (!started) {
4033 started = 1;
4034 }
4035 }
4036
4037 *realline = '\0';
4038 }
4039
4040 bufgets_finalize(buf);
4041 g_free(buf);
4042
4043 if (!err && endstr != NULL) {
4044 /* add "end XXX", including any option flags */
4045 strings_array_add(&lines, &n_lines, endstr);
4046 }
4047 g_free(endstr);
4048
4049 if (!err && bufopen(&prn)) {
4050 err = 1;
4051 }
4052
4053 if (!err) {
4054 pmod = gretl_model_new();
4055 if (pmod == NULL) {
4056 nomem();
4057 err = E_ALLOC;
4058 } else {
4059 *pmod = nl_model(dataset, opt, prn);
4060 err = model_output(pmod, prn);
4061 }
4062 }
4063
4064 if (err) {
4065 gretl_print_destroy(prn);
4066 } else {
4067 if (lines != NULL) {
4068 /* on success, log all the commands */
4069 int i;
4070
4071 for (i=0; i<n_lines; i++) {
4072 add_command_to_stack(lines[i], 0);
4073 }
4074 }
4075 edit_dialog_close(dlg);
4076 attach_subsample_to_model(pmod, dataset);
4077 view_model(prn, pmod, NULL);
4078 }
4079
4080 strings_array_free(lines, n_lines);
4081 }
4082
do_nls_model(GtkWidget * w,dialog_t * dlg)4083 void do_nls_model (GtkWidget *w, dialog_t *dlg)
4084 {
4085 real_do_nonlinear_model(dlg, NLS);
4086 }
4087
do_mle_model(GtkWidget * w,dialog_t * dlg)4088 void do_mle_model (GtkWidget *w, dialog_t *dlg)
4089 {
4090 real_do_nonlinear_model(dlg, MLE);
4091 }
4092
do_gmm_model(GtkWidget * w,dialog_t * dlg)4093 void do_gmm_model (GtkWidget *w, dialog_t *dlg)
4094 {
4095 real_do_nonlinear_model(dlg, GMM);
4096 }
4097
do_straight_anova(void)4098 static int do_straight_anova (void)
4099 {
4100 PRN *prn;
4101 int err;
4102
4103 if (parse_lib_command() || bufopen(&prn)) {
4104 return 1;
4105 }
4106
4107 err = anova(libcmd.list, dataset, libcmd.opt, prn);
4108
4109 if (err) {
4110 gui_errmsg(err);
4111 gretl_print_destroy(prn);
4112 } else {
4113 gchar *title = gretl_window_title(_("ANOVA"));
4114
4115 view_buffer(prn, 78, 400, title, PRINT, NULL);
4116 g_free(title);
4117 record_lib_command();
4118 }
4119
4120 return err;
4121 }
4122
real_do_model(int action)4123 static int real_do_model (int action)
4124 {
4125 int orig_v = dataset->v;
4126 MODEL *pmod;
4127 PRN *prn;
4128 int err = 0;
4129
4130 #if 0
4131 fprintf(stderr, "do_model: libline = '%s'\n", libline);
4132 #endif
4133
4134 if (parse_lib_command() || bufopen(&prn)) {
4135 return 1;
4136 }
4137
4138 pmod = gretl_model_new();
4139 if (pmod == NULL) {
4140 nomem();
4141 gretl_print_destroy(prn);
4142 return 1;
4143 }
4144
4145 switch (action) {
4146
4147 case AR1:
4148 *pmod = ar1_model(libcmd.list, dataset, libcmd.opt | OPT_G, prn);
4149 break;
4150 case OLS:
4151 case WLS:
4152 *pmod = lsq(libcmd.list, dataset, action, libcmd.opt);
4153 break;
4154 case PANEL:
4155 *pmod = panel_model(libcmd.list, dataset, libcmd.opt, prn);
4156 break;
4157 case DPANEL:
4158 /* FIXME ylags, instrument spec */
4159 *pmod = dpd_model(libcmd.list, NULL, NULL, dataset,
4160 libcmd.opt, prn);
4161 break;
4162 case HSK:
4163 *pmod = hsk_model(libcmd.list, dataset, libcmd.opt);
4164 break;
4165 case IVREG:
4166 *pmod = ivreg(libcmd.list, dataset, libcmd.opt);
4167 break;
4168 case AR:
4169 *pmod = ar_model(libcmd.list, dataset, OPT_NONE, prn);
4170 break;
4171 case LOGIT:
4172 case PROBIT:
4173 *pmod = logit_probit(libcmd.list, dataset, action, libcmd.opt,
4174 prn);
4175 break;
4176 case BIPROBIT:
4177 *pmod = biprobit_model(libcmd.list, dataset, libcmd.opt, prn);
4178 break;
4179 case TOBIT:
4180 *pmod = tobit_driver(libcmd.list, dataset, libcmd.opt, prn);
4181 break;
4182 case HECKIT:
4183 *pmod = heckit_model(libcmd.list, dataset, libcmd.opt, prn);
4184 break;
4185 case POISSON:
4186 case NEGBIN:
4187 *pmod = count_model(libcmd.list, action, dataset, libcmd.opt,
4188 prn);
4189 break;
4190 case DURATION:
4191 *pmod = duration_model(libcmd.list, dataset, libcmd.opt,
4192 prn);
4193 break;
4194 case ARMA:
4195 *pmod = arma(libcmd.list, libcmd.auxlist, dataset,
4196 libcmd.opt, prn);
4197 break;
4198 case ARCH:
4199 *pmod = arch_model(libcmd.list, libcmd.order, dataset,
4200 libcmd.opt);
4201 break;
4202 case GARCH:
4203 *pmod = garch(libcmd.list, dataset, libcmd.opt, prn);
4204 break;
4205 case LOGISTIC:
4206 *pmod = logistic_driver(libcmd.list, dataset, libcmd.opt);
4207 break;
4208 case LAD:
4209 *pmod = lad_model(libcmd.list, dataset, libcmd.opt);
4210 break;
4211 case QUANTREG:
4212 *pmod = quantreg_driver(libcmd.param, libcmd.list, dataset,
4213 libcmd.opt, prn);
4214 break;
4215 case INTREG:
4216 *pmod = interval_model(libcmd.list, dataset, libcmd.opt, prn);
4217 break;
4218 case MPOLS:
4219 *pmod = mp_ols(libcmd.list, dataset, libcmd.opt);
4220 break;
4221 case MIDASREG:
4222 *pmod = midas_model(libcmd.list, libcmd.param, dataset,
4223 libcmd.opt, prn);
4224 break;
4225 default:
4226 errbox(_("Sorry, not implemented yet!"));
4227 err = 1;
4228 break;
4229 }
4230
4231 if (!err) {
4232 err = model_output(pmod, prn);
4233 }
4234
4235 if (!err && action == AR1 && (libcmd.opt & OPT_H)) {
4236 register_graph();
4237 }
4238
4239 if (err) {
4240 if (action == GARCH && (libcmd.opt & OPT_V)) {
4241 /* non-convergence info? */
4242 view_buffer(prn, 78, 400, _("gretl: GARCH"), PRINT, NULL);
4243 } else {
4244 gretl_print_destroy(prn);
4245 }
4246 } else {
4247 record_model_command(pmod->ID);
4248 attach_subsample_to_model(pmod, dataset);
4249 view_model(prn, pmod, NULL);
4250 }
4251
4252 if (dataset->v > orig_v) {
4253 refresh_data();
4254 }
4255
4256 return err;
4257 }
4258
compose_midas_listname(gui_midas_spec * si,int i)4259 static void compose_midas_listname (gui_midas_spec *si, int i)
4260 {
4261 char *vname = dataset->varname[si->leadvar];
4262 char *p = strrchr(vname, '_');
4263
4264 *si->listname = '\0';
4265
4266 if (p != NULL && strlen(p) == 3) {
4267 char tmp[VNAMELEN];
4268
4269 strcpy(tmp, vname);
4270 p = strrchr(tmp, '_');
4271 *p = '\0';
4272 if (current_series_index(dataset, tmp) < 0 &&
4273 get_user_var_by_name(tmp) == NULL) {
4274 /* no collision? */
4275 strcpy(si->listname, tmp);
4276 }
4277 }
4278
4279 if (*si->listname == '\0') {
4280 /* fallback */
4281 sprintf(si->listname, "HFL___%d", i+1);
4282 }
4283 }
4284
compose_midas_param(gpointer p,gretlopt * addopt,int * err)4285 static gchar *compose_midas_param (gpointer p,
4286 gretlopt *addopt,
4287 int *err)
4288 {
4289 gui_midas_spec *si, *specs = p;
4290 char *tmp, *buf = NULL;
4291 int *list = NULL;
4292 int nt, any_beta1 = 0;
4293 int umidas = 1;
4294 int i;
4295
4296 if (specs == NULL) {
4297 *err = E_DATA;
4298 return NULL;
4299 }
4300
4301 nt = specs[0].nterms;
4302
4303 for (i=0; i<nt; i++) {
4304 if (specs[i].ptype != MIDAS_U) {
4305 umidas = 0;
4306 }
4307 if (specs[i].ptype == MIDAS_BETA1) {
4308 any_beta1 = 1;
4309 }
4310 }
4311
4312 if (any_beta1) {
4313 if (nt > 1) {
4314 errbox("One-parameter beta term cannot be combined with others");
4315 *err = E_DATA;
4316 return NULL;
4317 } else {
4318 specs[0].ptype = MIDAS_BETA0;
4319 *addopt |= OPT_C;
4320 }
4321 }
4322
4323 for (i=0; i<nt; i++) {
4324 si = &specs[i];
4325 if (si->listname[0] == '\0') {
4326 /* we'll have to construct a list */
4327 int lmax = si->leadvar + si->fratio - 1;
4328
4329 list = gretl_consecutive_list_new(si->leadvar, lmax);
4330 if (nt == 1) {
4331 compose_midas_listname(si, i);
4332 } else {
4333 sprintf(si->listname, "HFL___%d", i+1);
4334 }
4335 remember_list(list, si->listname, NULL);
4336 user_var_privatize_by_name(si->listname);
4337
4338 }
4339 if (umidas) {
4340 tmp = g_strdup_printf("mds(%s,%d,%d,%d)",
4341 si->listname, si->minlag,
4342 si->maxlag, si->ptype);
4343 } else if (si->ptype == MIDAS_BETA0 ||
4344 si->ptype == MIDAS_BETAN ||
4345 si->ptype == MIDAS_U) {
4346 tmp = g_strdup_printf("mds(%s,%d,%d,%d,null)",
4347 si->listname, si->minlag,
4348 si->maxlag, si->ptype);
4349 } else {
4350 tmp = g_strdup_printf("mds(%s,%d,%d,%d,%d)",
4351 si->listname, si->minlag,
4352 si->maxlag, si->ptype,
4353 si->nparm);
4354 }
4355 if (i == 0) {
4356 buf = tmp;
4357 } else {
4358 gchar *tmp2 = g_strjoin(" ", buf, tmp, NULL);
4359
4360 g_free(buf);
4361 g_free(tmp);
4362 buf = tmp2;
4363 }
4364 }
4365
4366 return buf;
4367 }
4368
do_model(selector * sr)4369 int do_model (selector *sr)
4370 {
4371 gretlopt opt, addopt = OPT_NONE;
4372 gpointer extra_data;
4373 char estimator[9];
4374 const char *buf;
4375 const char *flagstr;
4376 gchar *pbuf = NULL;
4377 int ci, err = 0;
4378
4379 if (selector_error(sr)) {
4380 return 1;
4381 }
4382
4383 buf = selector_list(sr);
4384 if (buf == NULL) {
4385 return 1;
4386 }
4387
4388 ci = selector_code(sr);
4389 opt = selector_get_opts(sr);
4390 extra_data = selector_get_extra_data(sr);
4391
4392 /* In some cases, choices which are represented by option flags in
4393 gretl script are represented by ancillary "ci" values in the
4394 GUI model selector (in order to avoid overloading the model
4395 selection dialog with options). Here we have to decode such
4396 values, parsing them out into basic command index value and
4397 associated option.
4398 */
4399
4400 if (ci == OLS && dataset_is_panel(dataset)) {
4401 /* pooled OLS */
4402 ci = PANEL;
4403 addopt = OPT_P;
4404 } else if (ci == MLOGIT) {
4405 /* multinomial logit */
4406 ci = LOGIT;
4407 addopt = OPT_M;
4408 } else if (ci == OLOGIT) {
4409 /* ordered logit */
4410 ci = LOGIT;
4411 } else if (ci == OPROBIT) {
4412 /* ordered probit */
4413 ci = PROBIT;
4414 } else if (ci == REPROBIT) {
4415 /* random-effects probit */
4416 ci = PROBIT;
4417 addopt = OPT_E;
4418 } else if (ci == FE_LOGISTIC) {
4419 ci = LOGISTIC;
4420 addopt = OPT_F;
4421 } else if (ci == IV_LIML || ci == IV_GMM) {
4422 /* single-equation LIML, GMM */
4423 if (ci == IV_LIML) {
4424 addopt = OPT_L;
4425 } else if (ci == IV_GMM) {
4426 addopt = OPT_G;
4427 }
4428 ci = IVREG;
4429 } else if (ci == COUNTMOD) {
4430 if (opt & (OPT_M | OPT_N)) {
4431 ci = NEGBIN;
4432 opt &= ~OPT_N;
4433 } else {
4434 ci = POISSON;
4435 }
4436 } else if (ci == MIDASREG) {
4437 pbuf = compose_midas_param(extra_data, &addopt, &err);
4438 } else if (ci == REGLS) {
4439 return real_do_regls(buf);
4440 }
4441
4442 if (err) {
4443 return err;
4444 }
4445
4446 strcpy(estimator, gretl_command_word(ci));
4447
4448 libcmd.opt = opt | addopt;
4449 flagstr = print_flags(libcmd.opt, ci);
4450 if (pbuf != NULL) {
4451 lib_command_sprintf("%s %s ; %s%s", estimator, buf, pbuf, flagstr);
4452 } else {
4453 lib_command_sprintf("%s %s%s", estimator, buf, flagstr);
4454 }
4455
4456 #if 0
4457 fprintf(stderr, "\nmodel command elements:\n");
4458 fprintf(stderr, "estimator: '%s'\n", estimator);
4459 fprintf(stderr, "selector_list: '%s'\n\n", buf);
4460 #endif
4461
4462 if (ci == ANOVA) {
4463 return do_straight_anova();
4464 } else {
4465 return real_do_model(ci);
4466 }
4467 }
4468
4469 /* callback from selection dialog for two nonparametric
4470 estimators, loess and Nadaraya-Watson
4471 */
4472
do_nonparam_model(selector * sr)4473 int do_nonparam_model (selector *sr)
4474 {
4475 gretl_bundle *bundle = NULL;
4476 double *m = NULL;
4477 const char *s, *buf;
4478 char yname[VNAMELEN];
4479 char xname[VNAMELEN];
4480 const double *y, *x;
4481 gretlopt opt;
4482 int ci, vy, vx;
4483 int i, err = 0;
4484
4485 if (selector_error(sr)) {
4486 return 1;
4487 }
4488
4489 buf = selector_list(sr);
4490 if (buf == NULL || sscanf(buf, "%31s %31s", yname, xname) != 2) {
4491 return 1;
4492 }
4493
4494 ci = selector_code(sr);
4495 opt = selector_get_opts(sr);
4496
4497 /* get the two input series */
4498 vy = current_series_index(dataset, yname);
4499 vx = current_series_index(dataset, xname);
4500 y = dataset->Z[vy];
4501 x = dataset->Z[vx];
4502
4503 /* storage for the fitted series */
4504 m = malloc(dataset->n * sizeof *m);
4505 if (m == NULL) {
4506 err = E_ALLOC;
4507 } else {
4508 for (i=0; i<dataset->n; i++) {
4509 m[i] = NADBL;
4510 }
4511 }
4512
4513 if (!err) {
4514 /* bundle to hold parameters and results */
4515 bundle = gretl_bundle_new();
4516 if (bundle == NULL) {
4517 err = E_ALLOC;
4518 } else {
4519 gretl_bundle_set_string(bundle, "yname", yname);
4520 gretl_bundle_set_string(bundle, "xname", xname);
4521 }
4522 }
4523
4524 if (!err && ci == LOESS) {
4525 int robust = (opt & OPT_R)? 1 : 0;
4526 int d = 1;
4527 double q = 0.5;
4528
4529 /* scan the buffer from the selector for
4530 d and q specifications */
4531 if ((s = strstr(buf, "d=")) != NULL) {
4532 d = atoi(s + 2);
4533 }
4534 if ((s = strstr(buf, "q=")) != NULL) {
4535 q = atof(s + 2);
4536 }
4537
4538 err = gretl_loess(y, x, d, q, robust, dataset, m);
4539 if (!err) {
4540 gretl_bundle_set_string(bundle, "function", "loess");
4541 gretl_bundle_set_int(bundle, "d", d);
4542 gretl_bundle_set_scalar(bundle, "q", q);
4543 gretl_bundle_set_int(bundle, "robust", robust);
4544 gretl_bundle_set_series(bundle, "m", m, dataset->n);
4545 lib_command_sprintf("loess(%s, %s, %d, %g, %d)",
4546 yname, xname, d, q, robust);
4547 record_command_verbatim();
4548 }
4549
4550 } else if (!err && ci == NADARWAT) {
4551 int LOO = (opt & OPT_O)? 1 : 0;
4552 double trim = libset_get_double(NADARWAT_TRIM);
4553 double h = 0; /* automatic */
4554
4555 if ((s = strstr(buf, "h=")) != NULL) {
4556 h = atof(s + 2);
4557 }
4558
4559 err = nadaraya_watson(y, x, h, dataset, LOO, trim, m);
4560 if (!err) {
4561 gretl_bundle_set_string(bundle, "function", "nadarwat");
4562 gretl_bundle_set_scalar(bundle, "h", h);
4563 gretl_bundle_set_int(bundle, "LOO", LOO);
4564 gretl_bundle_set_scalar(bundle, "trim", trim);
4565 gretl_bundle_set_series(bundle, "m", m, dataset->n);
4566 lib_command_sprintf("nadarwat(%s, %s, %g, %d, %g)",
4567 yname, xname, h, LOO, trim);
4568 record_command_verbatim();
4569 }
4570 }
4571
4572 if (err) {
4573 gui_errmsg(err);
4574 } else {
4575 gchar *title;
4576 PRN *prn;
4577
4578 err = bufopen(&prn);
4579 if (!err) {
4580 title = gretl_window_title(ci == LOESS ? _("loess") :
4581 _("Nadaraya-Watson"));
4582 text_print_x_y_fitted(vx, vy, m, dataset, prn);
4583 view_buffer(prn, 78, 450, title, ci, bundle);
4584 g_free(title);
4585 }
4586 }
4587
4588 free(m);
4589
4590 if (err) {
4591 gretl_bundle_destroy(bundle);
4592 }
4593
4594 return 0;
4595 }
4596
nonparam_retrieve_fitted(gretl_bundle * bundle)4597 static double *nonparam_retrieve_fitted (gretl_bundle *bundle)
4598 {
4599 double *m;
4600 int n, err = 0;
4601
4602 m = gretl_bundle_get_series(bundle, "m", &n, &err);
4603
4604 if (err) {
4605 gui_errmsg(err);
4606 } else if (n != dataset->n) {
4607 errbox(_("Series length does not match the dataset"));
4608 }
4609
4610 return m;
4611 }
4612
add_nonparam_data(windata_t * vwin)4613 void add_nonparam_data (windata_t *vwin)
4614 {
4615 gretl_bundle *bundle = vwin->data;
4616 double *m;
4617 int err = 0;
4618
4619 m = nonparam_retrieve_fitted(bundle);
4620
4621 if (m != NULL) {
4622 const char *func = gretl_bundle_get_string(bundle, "function", &err);
4623 const char *yname = gretl_bundle_get_string(bundle, "yname", &err);
4624 const char *xname = gretl_bundle_get_string(bundle, "xname", &err);
4625 char vname[VNAMELEN];
4626 gchar *descrip = NULL;
4627 double q = 0, h = 0, trim = 0;
4628 int d = 0, robust = 0, LOO = 0;
4629 int cancel = 0;
4630
4631 if (!strcmp(func, "loess")) {
4632 d = gretl_bundle_get_int(bundle, "d", &err);
4633 q = gretl_bundle_get_scalar(bundle, "q", &err);
4634 robust = gretl_bundle_get_int(bundle, "robust", &err);
4635 strcpy(vname, "loess_fit");
4636 descrip = g_strdup_printf("loess(%s, %s, %d, %g, %d)",
4637 yname, xname, d, q, robust);
4638 } else {
4639 h = gretl_bundle_get_scalar(bundle, "h", &err);
4640 LOO = gretl_bundle_get_int(bundle, "LOO", &err);
4641 trim = gretl_bundle_get_scalar(bundle, "trim", &err);
4642 strcpy(vname, "nw_fit");
4643 descrip = g_strdup_printf("nadarwat(%s, %s, %g, %d, %g)",
4644 yname, xname, h, LOO, trim);
4645 }
4646
4647 name_new_series_dialog(vname, &descrip, vwin, &cancel);
4648
4649 if (!cancel) {
4650 err = add_or_replace_series(m, vname, descrip, DS_COPY_VALUES);
4651 }
4652 g_free(descrip);
4653
4654 if (!cancel && !err) {
4655 gretl_push_c_numeric_locale();
4656 if (!strcmp(func, "loess")) {
4657 lib_command_sprintf("%s = loess(%s, %s, %d, %g, %d)",
4658 vname, yname, xname, d, q, robust);
4659 } else {
4660 lib_command_sprintf("%s = nadarwat(%s, %s, %g)",
4661 vname, yname, xname, h);
4662 }
4663 record_command_verbatim();
4664 gretl_pop_c_numeric_locale();
4665 }
4666 }
4667 }
4668
do_nonparam_plot(windata_t * vwin)4669 void do_nonparam_plot (windata_t *vwin)
4670 {
4671 gretl_bundle *bundle = vwin->data;
4672 double *m;
4673 int err = 0;
4674
4675 m = nonparam_retrieve_fitted(bundle);
4676
4677 if (m != NULL) {
4678 const char *func = gretl_bundle_get_string(bundle, "function", &err);
4679 const char *yname = gretl_bundle_get_string(bundle, "yname", &err);
4680 const char *xname = gretl_bundle_get_string(bundle, "xname", &err);
4681 int vy = current_series_index(dataset, yname);
4682 int vx = current_series_index(dataset, xname);
4683 char **S = NULL;
4684 gretl_matrix *plotmat, *tmp;
4685 const double *x;
4686 int need_sort = 0;
4687 int i, j, n = sample_size(dataset);
4688
4689 if (vy < 0 || vx < 0) {
4690 gui_errmsg(E_DATA);
4691 return;
4692 }
4693
4694 plotmat = gretl_matrix_alloc(n, 3);
4695 if (plotmat == NULL) {
4696 nomem();
4697 return;
4698 }
4699
4700 for (j=0; j<3; j++) {
4701 x = (j == 0)? dataset->Z[vy] : (j == 1)? m : dataset->Z[vx];
4702 for (i=0; i<n; i++) {
4703 gretl_matrix_set(plotmat, i, j, x[i+dataset->t1]);
4704 if (!need_sort && j == 2 && i > 0 &&
4705 !na(x[i]) && !na(x[i-1]) && x[i] < x[i-1]) {
4706 need_sort = 1;
4707 }
4708 }
4709 }
4710
4711 if (need_sort) {
4712 /* sort by the x column to avoid wrap-back of plot line */
4713 tmp = gretl_matrix_sort_by_column(plotmat, 2, &err);
4714 if (!err) {
4715 gretl_matrix_free(plotmat);
4716 plotmat = tmp;
4717 }
4718 }
4719
4720 if (!err) {
4721 S = strings_array_new_with_length(3, VNAMELEN);
4722 if (S != NULL) {
4723 strcpy(S[0], yname);
4724 strcpy(S[1], _("fitted"));
4725 strcpy(S[2], xname);
4726 gretl_matrix_set_colnames(plotmat, S);
4727 }
4728 }
4729
4730 if (err) {
4731 gui_errmsg(err);
4732 } else {
4733 gchar *literal, *title;
4734
4735 if (!strcmp(func, "loess")) {
4736 title = g_strdup_printf(_("%s versus %s with loess fit"),
4737 yname, xname);
4738 } else {
4739 title = g_strdup_printf(_("%s versus %s with Nadaraya-Watson fit"),
4740 yname, xname);
4741 }
4742 literal = g_strdup_printf("{ set title \"%s\"; }", title);
4743 set_optval_string(GNUPLOT, OPT_O, "fitted");
4744 err = matrix_plot(plotmat, NULL, literal, OPT_O | OPT_G);
4745 gui_graph_handler(err);
4746 g_free(literal);
4747 g_free(title);
4748 }
4749
4750 gretl_matrix_free(plotmat);
4751 }
4752 }
4753
do_vector_model(selector * sr)4754 int do_vector_model (selector *sr)
4755 {
4756 GRETL_VAR *var;
4757 char estimator[9];
4758 const char *buf;
4759 const char *flagstr;
4760 PRN *prn;
4761 int action;
4762 int err = 0;
4763
4764 if (selector_error(sr)) {
4765 return 1;
4766 }
4767
4768 buf = selector_list(sr);
4769 if (buf == NULL) {
4770 return 1;
4771 }
4772
4773 libcmd.opt = selector_get_opts(sr);
4774 action = selector_code(sr);
4775
4776 if (action == VLAGSEL) {
4777 libcmd.opt |= OPT_L;
4778 action = VAR;
4779 }
4780
4781 strcpy(estimator, gretl_command_word(action));
4782 flagstr = print_flags(libcmd.opt, action);
4783 lib_command_sprintf("%s %s%s", estimator, buf, flagstr);
4784
4785 #if 0
4786 fprintf(stderr, "do_vector_model: libline = '%s'\n", libline);
4787 #endif
4788
4789 if (parse_lib_command() || bufopen(&prn)) {
4790 return 1;
4791 }
4792
4793 if (libcmd.order > var_max_order(libcmd.list, dataset)) {
4794 gui_errmsg(E_TOOFEW);
4795 gretl_print_destroy(prn);
4796 return 1;
4797 }
4798
4799 if (action == VAR && !(libcmd.opt & OPT_L)) {
4800 /* regular VAR, not VAR lag selection */
4801 var = gretl_VAR(libcmd.order, libcmd.auxlist, libcmd.list, dataset,
4802 libcmd.opt, prn, &err);
4803 if (!err) {
4804 view_buffer(prn, 78, 450, _("gretl: vector autoregression"),
4805 VAR, var);
4806 }
4807 } else if (action == VAR) {
4808 /* VAR lag selection */
4809 gretl_VAR(libcmd.order, NULL, libcmd.list, dataset,
4810 libcmd.opt, prn, &err);
4811 if (!err) {
4812 view_buffer(prn, 72, 350, _("gretl: VAR lag selection"),
4813 PRINT, NULL);
4814 }
4815 } else if (action == VECM) {
4816 /* Vector Error Correction Model */
4817 var = gretl_VECM(libcmd.order, libcmd.auxint, libcmd.list,
4818 dataset, libcmd.opt, prn, &err);
4819 if (!err) {
4820 view_buffer(prn, 78, 450, _("gretl: VECM"), VECM, var);
4821 }
4822 } else {
4823 err = 1;
4824 }
4825
4826 if (err) {
4827 gui_errmsg(err);
4828 gretl_print_destroy(prn);
4829 } else {
4830 /* note: paired with parse_lib_command() above */
4831 record_lib_command();
4832 }
4833
4834 return err;
4835 }
4836
alt_list_buf(const int * src,int fit,int * err)4837 static char *alt_list_buf (const int *src, int fit,
4838 int *err)
4839 {
4840 char *buf;
4841 int yvar = src[1];
4842 int xvar = src[3];
4843 int list[5];
4844 int addv;
4845
4846 if (fit == PLOT_FIT_QUADRATIC) {
4847 addv = xpxgenr(xvar, xvar, dataset);
4848 } else {
4849 addv = invgenr(xvar, dataset);
4850 }
4851
4852 if (addv < 0) {
4853 nomem();
4854 return NULL;
4855 }
4856
4857 if (fit == PLOT_FIT_QUADRATIC) {
4858 list[0] = 4;
4859 list[1] = yvar;
4860 list[2] = 0;
4861 list[3] = xvar;
4862 list[4] = addv;
4863 } else {
4864 list[0] = 3;
4865 list[1] = yvar;
4866 list[2] = 0;
4867 list[3] = addv;
4868 }
4869
4870 buf = gretl_list_to_string(list, dataset, err);
4871
4872 return buf;
4873 }
4874
4875 /* called from gpt_control.c: the incoming @list should
4876 be of the form {3, Y, 0, X}
4877 */
4878
do_graph_model(const int * list,int fit)4879 void do_graph_model (const int *list, int fit)
4880 {
4881 MODEL *pmod = NULL;
4882 char *buf = NULL;
4883 PRN *prn;
4884 int orig_v = dataset->v;
4885 int err = 0;
4886
4887 if (list == NULL) {
4888 gui_errmsg(E_DATA);
4889 return;
4890 }
4891
4892 if (fit == PLOT_FIT_QUADRATIC || fit == PLOT_FIT_INVERSE) {
4893 buf = alt_list_buf(list, fit, &err);
4894 } else {
4895 buf = gretl_list_to_string(list, dataset, &err);
4896 }
4897
4898 if (err) {
4899 gui_errmsg(err);
4900 return;
4901 }
4902
4903 lib_command_sprintf("ols%s", buf);
4904 free(buf);
4905
4906 if (parse_lib_command() || bufopen(&prn)) {
4907 return;
4908 }
4909
4910 pmod = gretl_model_new();
4911
4912 if (pmod == NULL) {
4913 nomem();
4914 err = E_ALLOC;
4915 } else {
4916 *pmod = lsq(libcmd.list, dataset, OLS, libcmd.opt);
4917 err = model_output(pmod, prn);
4918 }
4919
4920 if (err) {
4921 gretl_print_destroy(prn);
4922 } else {
4923 /* note: paired with parse_lib_command() above */
4924 record_lib_command();
4925 attach_subsample_to_model(pmod, dataset);
4926 view_model(prn, pmod, NULL);
4927 }
4928
4929 if (dataset->v > orig_v) {
4930 refresh_data();
4931 }
4932 }
4933
4934 /* budget version of gretl console */
4935
do_minibuf(GtkWidget * w,dialog_t * dlg)4936 void do_minibuf (GtkWidget *w, dialog_t *dlg)
4937 {
4938 char *buf = gretl_strdup(edit_dialog_get_text(dlg));
4939 ExecState state;
4940 char cword[9];
4941 int ci, err;
4942
4943 if (buf == NULL) {
4944 return;
4945 }
4946
4947 edit_dialog_close(dlg);
4948
4949 sscanf(buf, "%8s", cword);
4950 ci = gretl_command_number(cword);
4951
4952 /* actions we can't/won't handle here (should be more?) */
4953 if (ci == LOOP || ci == RESTRICT || ci == SYSTEM ||
4954 ci == EQUATION || ci == VAR || ci == VECM ||
4955 ci == NLS || ci == MLE || ci == GMM ||
4956 is_model_ref_cmd(ci)) {
4957 dummy_call();
4958 free(buf);
4959 return;
4960 }
4961
4962 if (MODEL_COMMAND(ci)) {
4963 lib_command_strcpy(buf);
4964 real_do_model(ci);
4965 free(buf);
4966 return;
4967 }
4968
4969 gretl_exec_state_init(&state, CONSOLE_EXEC, libline, &libcmd,
4970 model, NULL);
4971 lib_command_strcpy(buf);
4972 free(buf);
4973
4974 console_record_sample(dataset);
4975 err = gui_exec_line(&state, dataset, mdata->main);
4976
4977 if (err) {
4978 gui_errmsg(err);
4979 } else {
4980 /* update variable listing in main window if needed */
4981 if (check_dataset_is_changed(dataset)) {
4982 mark_dataset_as_modified();
4983 populate_varlist();
4984 }
4985 /* update sample info and options if needed */
4986 if (console_sample_changed(dataset)) {
4987 set_sample_label(dataset);
4988 }
4989 }
4990 }
4991
4992 #define REPLACE_COMMA_HACK 1
4993
4994 #if REPLACE_COMMA_HACK
4995
maybe_fix_decimal_comma(const gchar * s)4996 static gchar *maybe_fix_decimal_comma (const gchar *s)
4997 {
4998 gchar *cpy = g_strdup(s);
4999 gchar *p = cpy;
5000 int inbrackets = 0;
5001 int inparens = 0;
5002 int inbraces = 0;
5003 int inquotes = 0;
5004
5005 /* experimental */
5006
5007 while (*p) {
5008 if (*p == '[') {
5009 inbrackets++;
5010 } else if (*p == ']') {
5011 inbrackets--;
5012 } else if (*p == '(') {
5013 inparens++;
5014 } else if (*p == ')') {
5015 inparens--;
5016 } else if (*p == '{') {
5017 inbraces++;
5018 } else if (*p == '}') {
5019 inbraces--;
5020 } else if (*p == '"') {
5021 inquotes = !inquotes;
5022 }
5023 if (*p == ',' && !inparens && !inbrackets &&
5024 !inbraces && !inquotes && isdigit(*(p+1))) {
5025 *p = '.';
5026 }
5027 p++;
5028 }
5029
5030 return cpy;
5031 }
5032
5033 #endif /* REPLACE_COMMA_HACK */
5034
get_genr_string(GtkWidget * entry,dialog_t * dlg)5035 gchar *get_genr_string (GtkWidget *entry, dialog_t *dlg)
5036 {
5037 const gchar *s = NULL;
5038 gchar *gstr = NULL;
5039
5040 if (dlg != NULL) {
5041 s = edit_dialog_get_text(dlg);
5042 } else if (entry != NULL) {
5043 s = gtk_entry_get_text(GTK_ENTRY(entry));
5044 }
5045
5046 if (s != NULL && *s != '\0') {
5047 while (isspace((unsigned char) *s)) s++;
5048 #if REPLACE_COMMA_HACK
5049 if (get_local_decpoint() == ',' && strchr(s, ',') != NULL) {
5050 gstr = maybe_fix_decimal_comma(s);
5051 } else {
5052 gstr = g_strdup(s);
5053 }
5054 #else
5055 gstr = g_strdup(s);
5056 #endif
5057 }
5058
5059 return gstr;
5060 }
5061
is_full_genr_command(const char * s)5062 static int is_full_genr_command (const char *s)
5063 {
5064 int sppos = gretl_charpos(' ', s);
5065
5066 if (sppos > 1 && sppos < 9) {
5067 char word1[9] = {0};
5068
5069 strncat(word1, s, sppos);
5070 if (!strcmp(word1, "genr") || word_is_genr_alias(word1)) {
5071 return 1;
5072 }
5073 }
5074
5075 return 0;
5076 }
5077
do_genr(GtkWidget * w,dialog_t * dlg)5078 void do_genr (GtkWidget *w, dialog_t *dlg)
5079 {
5080 gchar *s = get_genr_string(NULL, dlg);
5081 int err, edit = 0;
5082
5083 if (s == NULL) {
5084 return;
5085 }
5086
5087 if (is_full_genr_command(s)) {
5088 /* don't mess with what the user typed */
5089 lib_command_strcpy(s);
5090 } else if (strchr(s, '=') == NULL) {
5091 if (genr_special_word(s)) {
5092 /* as in "genr time", but without the "genr" */
5093 lib_command_sprintf("genr %s", s);
5094 } else {
5095 /* a bare varname? */
5096 lib_command_sprintf("series %s = NA", s);
5097 edit = 1;
5098 }
5099 } else {
5100 lib_command_strcpy(s);
5101 }
5102
5103 g_free(s);
5104
5105 err = finish_genr(NULL, dlg, 0);
5106
5107 if (edit && !err) {
5108 mdata_select_last_var();
5109 show_spreadsheet(SHEET_EDIT_VARLIST);
5110 }
5111 }
5112
do_selector_genr(GtkWidget * w,dialog_t * dlg)5113 void do_selector_genr (GtkWidget *w, dialog_t *dlg)
5114 {
5115 gchar *s = get_genr_string(NULL, dlg);
5116 gpointer p = edit_dialog_get_data(dlg);
5117 int err, oldv = dataset->v;
5118
5119 if (s == NULL) {
5120 return;
5121 }
5122
5123 if (is_full_genr_command(s)) {
5124 lib_command_strcpy(s);
5125 } else if (strchr(s, '=') == NULL && genr_special_word(s)) {
5126 lib_command_sprintf("genr %s", s);
5127 } else {
5128 lib_command_sprintf("series %s", s);
5129 }
5130
5131 g_free(s);
5132
5133 err = finish_genr(NULL, dlg, 0);
5134
5135 if (!err && dataset->v > oldv) {
5136 selector_register_genr(dataset->v - oldv, p);
5137 }
5138 }
5139
5140 /* callback for defining new series or scalar variable
5141 from the GUI function-call dialog
5142 */
5143
do_fncall_genr(GtkWidget * w,dialog_t * dlg)5144 void do_fncall_genr (GtkWidget *w, dialog_t *dlg)
5145 {
5146 gchar *s = get_genr_string(NULL, dlg);
5147 gpointer p = edit_dialog_get_data(dlg);
5148 int scalargen = 0, oldv = -1;
5149 int type, err;
5150
5151 if (s == NULL) {
5152 return;
5153 }
5154
5155 while (isspace((unsigned char) *s)) s++;
5156
5157 type = widget_get_int(p, "ptype");
5158
5159 if (type == GRETL_TYPE_SERIES) {
5160 if (!strncmp(s, "series", 6)) {
5161 lib_command_strcpy(s);
5162 } else {
5163 lib_command_sprintf("series %s", s);
5164 }
5165 oldv = dataset->v;
5166 } else if (type == GRETL_TYPE_DOUBLE) {
5167 if (!strncmp(s, "scalar", 6)) {
5168 lib_command_strcpy(s);
5169 } else {
5170 lib_command_sprintf("scalar %s", s);
5171 }
5172 oldv = n_user_scalars();
5173 scalargen = 1;
5174 }
5175
5176 g_free(s);
5177
5178 err = finish_genr(NULL, dlg, 0);
5179
5180 if (!err) {
5181 int newv = (scalargen)? n_user_scalars(): dataset->v;
5182
5183 if (oldv >= 0 && newv > oldv) {
5184 fncall_register_genr(newv - oldv, p);
5185 }
5186 }
5187 }
5188
do_model_genr(GtkWidget * w,dialog_t * dlg)5189 void do_model_genr (GtkWidget *w, dialog_t *dlg)
5190 {
5191 gchar *s = get_genr_string(NULL, dlg);
5192 windata_t *vwin = (windata_t *) edit_dialog_get_data(dlg);
5193 MODEL *pmod = vwin->data;
5194
5195 if (s != NULL) {
5196 lib_command_sprintf("%s", s);
5197 finish_genr(pmod, dlg, 0);
5198 g_free(s);
5199 }
5200 }
5201
do_range_dummy_genr(const gchar * buf)5202 void do_range_dummy_genr (const gchar *buf)
5203 {
5204 lib_command_strcpy(buf);
5205 finish_genr(NULL, NULL, 1);
5206 }
5207
real_do_setmiss(double missval,int varno)5208 static int real_do_setmiss (double missval, int varno)
5209 {
5210 int i, t, count = 0;
5211 int start = 1, end = dataset->v;
5212
5213 if (varno) {
5214 start = varno;
5215 end = varno + 1;
5216 }
5217
5218 for (i=start; i<end; i++) {
5219 for (t=0; t<dataset->n; t++) {
5220 if (dataset->Z[i][t] == missval) {
5221 dataset->Z[i][t] = NADBL;
5222 count++;
5223 }
5224 }
5225 }
5226
5227 return count;
5228 }
5229
do_global_setmiss(GtkWidget * w,dialog_t * dlg)5230 void do_global_setmiss (GtkWidget *w, dialog_t *dlg)
5231 {
5232 const gchar *buf;
5233 double missval;
5234 int count, err;
5235
5236 buf = edit_dialog_get_text(dlg);
5237 if (buf == NULL) return;
5238
5239 if ((err = check_atof(buf))) {
5240 gui_errmsg(err);
5241 return;
5242 }
5243
5244 missval = atof(buf);
5245 count = real_do_setmiss(missval, 0);
5246
5247 edit_dialog_close(dlg);
5248
5249 if (count) {
5250 infobox_printf(_("Set %d values to \"missing\""), count);
5251 mark_dataset_as_modified();
5252 } else {
5253 errbox(_("Didn't find any matching observations"));
5254 }
5255 }
5256
do_variable_setmiss(GtkWidget * w,dialog_t * dlg)5257 void do_variable_setmiss (GtkWidget *w, dialog_t *dlg)
5258 {
5259 const gchar *buf;
5260 double missval;
5261 int v = mdata_active_var();
5262 int count, err;
5263
5264 buf = edit_dialog_get_text(dlg);
5265 if (buf == NULL) return;
5266
5267 if ((err = check_atof(buf))) {
5268 gui_errmsg(err);
5269 return;
5270 }
5271
5272 missval = atof(buf);
5273 count = real_do_setmiss(missval, v);
5274
5275 edit_dialog_close(dlg);
5276
5277 if (count) {
5278 infobox_printf(_("Set %d observations to \"missing\""), count);
5279 mark_dataset_as_modified();
5280 } else {
5281 errbox(_("Didn't find any matching observations"));
5282 }
5283 }
5284
do_rename_variable(int v,const char * newname,GtkWidget * parent)5285 int do_rename_variable (int v, const char *newname,
5286 GtkWidget *parent)
5287 {
5288 int err = 0;
5289
5290 if (v < dataset->v && !strcmp(newname, dataset->varname[v])) {
5291 /* no-op (shouldn't happen) */
5292 return 0;
5293 }
5294
5295 if (gretl_is_series(newname, dataset)) {
5296 errbox_printf(_("A series named %s already exists"), newname);
5297 err = E_DATA;
5298 } else {
5299 err = gui_validate_varname(newname, GRETL_TYPE_SERIES, parent);
5300 }
5301
5302 if (!err) {
5303 strcpy(dataset->varname[v], newname);
5304 mark_dataset_as_modified();
5305 lib_command_sprintf("rename %d %s", v, newname);
5306 record_command_verbatim();
5307 }
5308
5309 return err;
5310 }
5311
record_varlabel_change(int v,int desc,int gname)5312 int record_varlabel_change (int v, int desc, int gname)
5313 {
5314 if (desc) {
5315 const char *vlabel = series_get_label(dataset, v);
5316
5317 lib_command_sprintf("setinfo %s --description=\"%s\"",
5318 dataset->varname[v],
5319 vlabel == NULL ? "" : vlabel);
5320 } else if (gname) {
5321 lib_command_sprintf("setinfo %s --graph-name=\"%s\"",
5322 dataset->varname[v],
5323 series_get_display_name(dataset, v));
5324 }
5325
5326 return record_command_verbatim();
5327 }
5328
normal_test(MODEL * pmod,FreqDist * freq)5329 static void normal_test (MODEL *pmod, FreqDist *freq)
5330 {
5331 ModelTest *test = model_test_new(GRETL_TEST_NORMAL);
5332
5333 if (test != NULL) {
5334 model_test_set_teststat(test, GRETL_STAT_NORMAL_CHISQ);
5335 model_test_set_dfn(test, 2);
5336 model_test_set_value(test, freq->test);
5337 model_test_set_pvalue(test, chisq_cdf_comp(2, freq->test));
5338 maybe_add_test_to_model(pmod, test);
5339 }
5340 }
5341
5342 /* we'll roll the BDS nonlinearity test in with the following,
5343 since it requires the same basic setup
5344 */
5345
do_resid_freq(GtkAction * action,gpointer p)5346 void do_resid_freq (GtkAction *action, gpointer p)
5347 {
5348 const gchar *aname = gtk_action_get_name(action);
5349 FreqDist *freq = NULL;
5350 PRN *prn;
5351 windata_t *vwin = (windata_t *) p;
5352 MODEL *pmod = (MODEL *) vwin->data;
5353 DATASET *dset = NULL;
5354 int save_t1 = dataset->t1;
5355 int save_t2 = dataset->t2;
5356 int origv = dataset->v;
5357 int uv, bds = 0;
5358 int err = 0;
5359
5360 if (gui_exact_fit_check(pmod)) {
5361 return;
5362 }
5363
5364 if (bufopen(&prn)) return;
5365
5366 if (!strcmp(aname, "bds")) {
5367 /* BDS test */
5368 bds = 1;
5369 } else if (LIMDEP(pmod->ci)) {
5370 err = gretl_model_get_normality_test(pmod, prn);
5371 if (err) {
5372 gui_errmsg(err);
5373 gretl_print_destroy(prn);
5374 } else {
5375 gchar *title = gretl_window_title(_("normality test"));
5376
5377 view_buffer_with_parent(vwin, prn, 78, 300, title,
5378 PRINT, NULL);
5379 g_free(title);
5380 }
5381 return;
5382 }
5383
5384 dset = maybe_get_model_data(pmod, OPT_G, &err);
5385 if (err) {
5386 gretl_print_destroy(prn);
5387 return;
5388 }
5389
5390 if (dset == dataset) {
5391 dataset->t1 = pmod->t1;
5392 dataset->t2 = pmod->t2;
5393 }
5394
5395 if (!err) {
5396 err = genr_fit_resid(pmod, dset, M_UHAT);
5397 }
5398
5399 if (err) {
5400 gui_errmsg(err);
5401 dataset->t1 = save_t1;
5402 dataset->t2 = save_t2;
5403 gretl_print_destroy(prn);
5404 return;
5405 }
5406
5407 uv = dset->v - 1;
5408 strcpy(dset->varname[uv], "residual");
5409
5410 if (bds) {
5411 bdstest_dialog(uv, vwin_toplevel(vwin));
5412 goto finish;
5413 } else {
5414 /* OPT_Z: compare with normal dist */
5415 freq = get_freq(uv, dset, NADBL, NADBL, 0,
5416 pmod->ncoeff, OPT_Z, &err);
5417 }
5418
5419 if (err) {
5420 gui_errmsg(err);
5421 gretl_print_destroy(prn);
5422 } else {
5423 normal_test(pmod, freq);
5424 update_model_tests(vwin);
5425
5426 lib_command_strcpy("modtest --normality");
5427 record_model_command_verbatim(pmod->ID);
5428
5429 if (!err) {
5430 print_freq(freq, 0, NULL, prn);
5431 view_buffer_with_parent(vwin, prn, 78, 300,
5432 _("gretl: residual dist."),
5433 MODTEST, NULL);
5434 /* show the graph too */
5435 if (plot_freq(freq, D_NORMAL, OPT_NONE) == 0) {
5436 register_graph();
5437 }
5438 }
5439 }
5440
5441 finish:
5442
5443 trim_dataset(pmod, origv);
5444 dataset->t1 = save_t1;
5445 dataset->t2 = save_t2;
5446
5447 free_freq(freq);
5448 }
5449
do_freq_dist(void)5450 void do_freq_dist (void)
5451 {
5452 FreqDist *freq = NULL;
5453 gretlopt opt = OPT_NONE;
5454 int dist = D_NONE;
5455 int v = mdata_active_var();
5456 double fmin = NADBL;
5457 double fwid = NADBL;
5458 gchar *tmp = NULL;
5459 const char *diststr = "";
5460 const double *y;
5461 const char *vname;
5462 int auto_nbins = 0;
5463 int discrete = 0;
5464 int nbins = 0;
5465 int plot = 1;
5466 int err = 0;
5467
5468 y = dataset->Z[v];
5469 vname = dataset->varname[v];
5470
5471 if (gretl_isdummy(dataset->t1, dataset->t2, y)) {
5472 nbins = 3;
5473 } else if (accept_as_discrete(dataset, v, 1)) {
5474 discrete = 1;
5475 }
5476
5477 if (nbins == 0) {
5478 double xmax, xmin;
5479 char *bintxt;
5480 int n, resp;
5481
5482 if (discrete) {
5483 n = gretl_minmax(dataset->t1, dataset->t2, y,
5484 &xmin, &xmax);
5485 if (n == 0) {
5486 err = E_MISSDATA;
5487 }
5488 } else {
5489 err = freq_setup(v, dataset, &n, &xmax, &xmin, &nbins, &fwid);
5490 auto_nbins = nbins;
5491 }
5492
5493 if (err) {
5494 gui_errmsg(err);
5495 return;
5496 }
5497
5498 tmp = g_strdup_printf(_("range %g to %g"), xmin, xmax);
5499 bintxt = g_strdup_printf(_("%s (n = %d, %s)"), vname, n, tmp);
5500 g_free(tmp);
5501 tmp = g_strdup_printf("gretl: %s", _("frequency distribution"));
5502
5503 if (discrete) {
5504 /* minimal dialog */
5505 resp = freq_dialog(tmp, bintxt, NULL, n, NULL, NULL,
5506 xmin, xmax, &dist, &plot);
5507 } else {
5508 /* full dialog */
5509 if (n % 2 == 0) n--;
5510 resp = freq_dialog(tmp, bintxt, &nbins, n, &fmin, &fwid,
5511 xmin, xmax, &dist, &plot);
5512 }
5513
5514 g_free(bintxt);
5515 g_free(tmp);
5516
5517 if (canceled(resp)) {
5518 return;
5519 }
5520
5521 if (dist == D_NORMAL) {
5522 opt = OPT_Z; /* --normal */
5523 diststr = " --normal";
5524 } else if (dist == D_GAMMA) {
5525 opt = OPT_O; /* --gamma */
5526 diststr = " --gamma";
5527 }
5528 }
5529
5530 if (!discrete) {
5531 if (!na(fmin) && !na(fwid)) {
5532 gretl_push_c_numeric_locale();
5533 lib_command_sprintf("freq %s --min=%g --binwidth=%g%s",
5534 vname, fmin, fwid, diststr);
5535 gretl_pop_c_numeric_locale();
5536 } else if (nbins != auto_nbins) {
5537 lib_command_sprintf("freq %s --nbins=%d%s",
5538 vname, nbins, diststr);
5539 } else {
5540 lib_command_sprintf("freq %s%s", vname, diststr);
5541 }
5542 } else {
5543 lib_command_sprintf("freq %s%s", vname, diststr);
5544 }
5545
5546 if (plot) {
5547 lib_command_strcat(" --plot=display");
5548 }
5549
5550 if (parse_lib_command()) {
5551 return;
5552 }
5553
5554 freq = get_freq(v, dataset, fmin, fwid, nbins, 1, opt, &err);
5555
5556 if (!err) {
5557 PRN *prn = NULL;
5558
5559 if (bufopen(&prn) == 0) {
5560 tmp = gretl_window_title(_("frequency distribution"));
5561 print_freq(freq, v, dataset, prn);
5562 view_buffer(prn, 78, 340, tmp, FREQ, NULL);
5563 g_free(tmp);
5564 }
5565
5566 if (plot) {
5567 err = plot_freq(freq, dist, OPT_NONE);
5568 gui_graph_handler(err);
5569 }
5570 }
5571
5572 if (err) {
5573 gui_errmsg(err);
5574 } else {
5575 record_lib_command();
5576 }
5577
5578 free_freq(freq);
5579 }
5580
5581 #if defined(HAVE_TRAMO) || defined (HAVE_X12A)
5582
5583 /* If we got a non-null warning message from X-12-ARIMA,
5584 pull it out of the .err file and display it in a
5585 warning (or error) dialog box.
5586 */
5587
display_x12a_warning(const char * fname,int err)5588 static void display_x12a_warning (const char *fname,
5589 int err)
5590 {
5591 char *errfile = gretl_strdup(fname);
5592
5593 if (errfile != NULL) {
5594 const char *buf = NULL;
5595 char *s, line[128];
5596 PRN *prn = NULL;
5597 FILE *fp;
5598 int n = 0;
5599
5600 if (!err) {
5601 switch_ext(errfile, fname, "err");
5602 }
5603 fp = gretl_fopen(errfile, "r");
5604 if (fp != NULL) {
5605 if (bufopen(&prn)) {
5606 free(errfile);
5607 fclose(fp);
5608 return;
5609 }
5610 while (fgets(line, sizeof line, fp)) {
5611 if (++n > 4 && !string_is_blank(line)) {
5612 tailstrip(line);
5613 s = line + strspn(line, " \t");
5614 pputs(prn, s);
5615 pputc(prn, ' ');
5616 }
5617 }
5618 fclose(fp);
5619 buf = gretl_print_get_buffer(prn);
5620 if (!string_is_blank(buf)) {
5621 if (err) {
5622 errbox(buf);
5623 } else {
5624 warnbox(buf);
5625 }
5626 }
5627 gretl_print_destroy(prn);
5628 }
5629 free(errfile);
5630 }
5631 }
5632
retrieve_tx_output(const char * fname,int * err)5633 static gchar *retrieve_tx_output (const char *fname, int *err)
5634 {
5635 gchar *buf = NULL;
5636 gchar *ret = NULL;
5637
5638 *err = gretl_file_get_contents(fname, &buf, NULL);
5639
5640 if (*err) {
5641 remove(fname);
5642 } else if (!g_utf8_validate(buf, -1, NULL)) {
5643 /* here we assume that the text encoding in both x12a
5644 and tramo output will be ISO-8859 (if not ASCII)
5645 */
5646 GError *gerr = NULL;
5647 gsize bytes;
5648
5649 ret = g_convert(buf, -1, "UTF-8", "ISO-8859-1",
5650 NULL, &bytes, &gerr);
5651 if (gerr != NULL) {
5652 errbox(gerr->message);
5653 g_error_free(gerr);
5654 *err = 1;
5655 }
5656 g_free(buf);
5657 } else {
5658 ret = buf;
5659 }
5660
5661 return ret;
5662 }
5663
display_tx_output(const char * fname,int graph_ok,int tramo,int oldv,gretlopt opt)5664 static void display_tx_output (const char *fname, int graph_ok,
5665 int tramo, int oldv, gretlopt opt)
5666 {
5667 if (opt & OPT_Q) {
5668 /* text output suppressed */
5669 remove(fname);
5670 } else {
5671 gchar *buf;
5672 PRN *prn;
5673 int err = 0;
5674
5675 buf = retrieve_tx_output(fname, &err);
5676 if (err) {
5677 return;
5678 }
5679
5680 prn = gretl_print_new_with_buffer(buf);
5681 view_buffer(prn, (tramo)? 106 : 84, 500,
5682 (tramo)? _("gretl: TRAMO analysis") :
5683 _("gretl: X-12-ARIMA analysis"),
5684 (tramo)? TRAMO : X12A, NULL);
5685 }
5686
5687 if (graph_ok && (opt & OPT_G)) {
5688 register_graph();
5689 }
5690
5691 if (oldv > 0 && dataset->v > oldv) {
5692 populate_varlist();
5693 mark_dataset_as_modified();
5694 }
5695 }
5696
x12a_help(void)5697 static void x12a_help (void)
5698 {
5699 show_gui_help(X12AHELP);
5700 }
5701
real_do_tramo_x12a(int v,int tramo)5702 static void real_do_tramo_x12a (int v, int tramo)
5703 {
5704 /* save options between invocations */
5705 static gretlopt opt = OPT_G;
5706 int oldv = dataset->v;
5707 int save_t1 = dataset->t1;
5708 int save_t2 = dataset->t2;
5709 int (*write_tx_data) (char *, int, DATASET *, gretlopt *,
5710 int, int *, GtkWindow *, void *);
5711 char outfile[MAXLEN] = {0};
5712 int warning = 0;
5713 int graph_ok = 1;
5714 int err = 0;
5715
5716 if (!tramo) {
5717 /* we'll let tramo handle annual data, but not x12a */
5718 if (dataset->pd == 1 || !dataset_is_time_series(dataset)) {
5719 errbox(_("Input must be a monthly or quarterly time series"));
5720 return;
5721 }
5722 }
5723
5724 write_tx_data = gui_get_plugin_function("write_tx_data");
5725 if (write_tx_data == NULL) {
5726 return;
5727 }
5728
5729 series_adjust_sample(dataset->Z[v], &dataset->t1, &dataset->t2);
5730
5731 set_plugin_dialog_open(1);
5732 err = write_tx_data(outfile, v, dataset, &opt, tramo,
5733 &warning, GTK_WINDOW(mdata->main),
5734 x12a_help);
5735 set_plugin_dialog_open(0);
5736
5737 dataset->t1 = save_t1;
5738 dataset->t2 = save_t2;
5739
5740 if (err) {
5741 if (has_suffix(outfile, ".err")) {
5742 display_x12a_warning(outfile, 1);
5743 return;
5744 } else {
5745 gui_errmsg(err);
5746 }
5747 graph_ok = 0;
5748 } else if (warning) {
5749 /* got a warning from x12a */
5750 display_x12a_warning(outfile, 0);
5751 } else if (opt & OPT_S) {
5752 /* created x12a spec file for editing */
5753 view_file(outfile, 1, 0, 78, 370, EDIT_X12A);
5754 opt ^= OPT_S;
5755 return;
5756 } else if (opt & OPT_T) {
5757 /* selected TRAMO only: no graph */
5758 graph_ok = 0;
5759 opt ^= OPT_T;
5760 }
5761
5762 if (*outfile != '\0') {
5763 display_tx_output(outfile, graph_ok, tramo, oldv, opt);
5764 }
5765 }
5766
do_tramo_x12a(GtkAction * action,gpointer p)5767 void do_tramo_x12a (GtkAction *action, gpointer p)
5768 {
5769 const gchar *code = gtk_action_get_name(action);
5770 int v = mdata_active_var();
5771 int tramo = 0;
5772
5773 if (!strcmp(code, "Tramo")) {
5774 tramo = 1;
5775 }
5776
5777 real_do_tramo_x12a(v, tramo);
5778 }
5779
run_x12a_script(const gchar * buf)5780 static void run_x12a_script (const gchar *buf)
5781 {
5782 int (*func) (char *, const gchar *);
5783 char outfile[MAXLEN] = {0};
5784 int err = 0;
5785
5786 func = gui_get_plugin_function("exec_tx_script");
5787 if (func == NULL) {
5788 return;
5789 }
5790
5791 err = func(outfile, buf);
5792
5793 if (err) {
5794 gui_errmsg(err);
5795 }
5796
5797 if (*outfile != '\0') {
5798 display_tx_output(outfile, 0, 0, 0, OPT_NONE);
5799 }
5800 }
5801
5802 #endif /* HAVE_TRAMO || HAVE_X12A */
5803
do_range_mean(void)5804 void do_range_mean (void)
5805 {
5806 int v = mdata_active_var();
5807 int (*range_mean_graph) (int, const DATASET *,
5808 gretlopt opt, PRN *);
5809 const char *opts[] = {
5810 N_("Trim maximum and minimum in sub-samples"),
5811 NULL
5812 };
5813 int active = 0;
5814 gretlopt opt;
5815 PRN *prn;
5816 int resp, err = 0;
5817
5818 resp = checks_only_dialog(_("gretl: range-mean graph"), NULL,
5819 opts, 1, &active, 0, NULL);
5820
5821 if (canceled(resp)) {
5822 return;
5823 }
5824
5825 range_mean_graph = gui_get_plugin_function("range_mean_graph");
5826 if (range_mean_graph == NULL) {
5827 return;
5828 }
5829
5830 if (bufopen(&prn)) {
5831 return;
5832 }
5833
5834 opt = active ? OPT_T : OPT_NONE;
5835 err = range_mean_graph(v, dataset, opt, prn);
5836
5837 if (err) {
5838 gui_errmsg(err);
5839 } else {
5840 /* plot generation handled in plugin */
5841 register_graph();
5842 lib_command_sprintf("rmplot %s", dataset->varname[v]);
5843 if (opt & OPT_T) {
5844 lib_command_strcat(" --trim");
5845 }
5846 record_command_verbatim();
5847 view_buffer(prn, 60, 350, _("gretl: range-mean statistics"),
5848 RMPLOT, NULL);
5849 }
5850 }
5851
do_hurst(void)5852 void do_hurst (void)
5853 {
5854 gint err;
5855 int v = mdata_active_var();
5856 int (*hurst_exponent) (int, const DATASET *, gretlopt, PRN *);
5857 PRN *prn;
5858
5859 hurst_exponent = gui_get_plugin_function("hurst_exponent");
5860 if (hurst_exponent == NULL) {
5861 return;
5862 }
5863
5864 if (bufopen(&prn)) {
5865 return;
5866 }
5867
5868 err = hurst_exponent(v, dataset, OPT_NONE, prn);
5869
5870 if (!err) {
5871 /* plot generation handled in plugin */
5872 register_graph();
5873 lib_command_sprintf("hurst %s", dataset->varname[v]);
5874 record_command_verbatim();
5875 }
5876
5877 view_buffer(prn, 60, 350, _("gretl: Hurst exponent"),
5878 HURST, NULL);
5879 }
5880
5881 enum {
5882 SELECTED_VAR,
5883 MODEL_VAR
5884 };
5885
real_do_corrgm(DATASET * dset,int code,int npq,GtkWidget * parent)5886 static void real_do_corrgm (DATASET *dset, int code,
5887 int npq, GtkWidget *parent)
5888 {
5889 gchar *title;
5890 int T = sample_size(dset);
5891 int order = auto_acf_order(T);
5892 gretlopt opt = OPT_NONE;
5893 const char *opts[1] = {NULL};
5894 int bartlett = 0;
5895 PRN *prn;
5896 int err;
5897
5898 title = gretl_window_title(_("correlogram"));
5899 opts[0] = N_("Use Bartlett standard errors");
5900
5901 err = checks_dialog(title, NULL, opts,
5902 1, &bartlett,
5903 0, 0,
5904 0, NULL,
5905 &order, _("Maximum lag:"),
5906 1, T - 1,
5907 CORRGM, parent);
5908 #if 0
5909 err = spin_dialog(title, NULL, &order, _("Maximum lag:"),
5910 1, T - 1, CORRGM, parent);
5911 #endif
5912
5913 if (err < 0 || bufopen(&prn)) {
5914 g_free(title);
5915 return;
5916 }
5917
5918 if (bartlett) {
5919 opt |= OPT_B;
5920 }
5921
5922 if (code == SELECTED_VAR) {
5923 lib_command_sprintf("corrgm %s %d", selected_varname(), order);
5924 if (parse_lib_command()) {
5925 gretl_print_destroy(prn);
5926 g_free(title);
5927 return;
5928 }
5929 err = corrgram(libcmd.list[1], order, 0,
5930 dset, opt, prn);
5931 if (!err) {
5932 record_lib_command();
5933 }
5934 } else {
5935 /* model residual */
5936 err = corrgram(dset->v - 1, order, npq,
5937 dset, opt | OPT_R, prn);
5938 }
5939
5940 if (err) {
5941 gui_errmsg(err);
5942 gretl_print_destroy(prn);
5943 } else {
5944 register_graph();
5945 view_buffer(prn, 78, 360, title, CORRGM, NULL);
5946 }
5947
5948 g_free(title);
5949 }
5950
do_corrgm(void)5951 void do_corrgm (void)
5952 {
5953 real_do_corrgm(dataset, SELECTED_VAR, 0, NULL);
5954 }
5955
tmp_add_fit_resid(MODEL * pmod,DATASET * dset,int code)5956 static int tmp_add_fit_resid (MODEL *pmod, DATASET *dset, int code)
5957 {
5958 int err = genr_fit_resid(pmod, dset, code);
5959
5960 if (err) {
5961 gui_errmsg(err);
5962 }
5963
5964 return err;
5965 }
5966
residual_correlogram_callback(GtkAction * action,gpointer p)5967 void residual_correlogram_callback (GtkAction *action, gpointer p)
5968 {
5969 windata_t *vwin = (windata_t *) p;
5970 MODEL *pmod = (MODEL *) vwin->data;
5971 int origv = dataset->v;
5972 DATASET *dset;
5973 int npq = 0;
5974 int err = 0;
5975
5976 dset = maybe_get_model_data(pmod, OPT_G, &err);
5977 if (err) {
5978 return;
5979 }
5980
5981 /* add residuals to data set temporarily */
5982 if (tmp_add_fit_resid(pmod, dset, M_UHAT)) {
5983 return;
5984 }
5985
5986 if (pmod->ci == ARMA) {
5987 npq = arma_model_get_n_arma_coeffs(pmod);
5988 }
5989
5990 real_do_corrgm(dset, MODEL_VAR, npq, vwin_toplevel(vwin));
5991
5992 trim_dataset(pmod, origv);
5993 }
5994
5995 /* If code == SELECTED_VAR we're doing the periodiogram for a
5996 selected variable from the dataset; otherwise we're doing it
5997 for a regression residual, added to the dataset on the fly
5998 as the last series.
5999 */
6000
real_do_pergm(DATASET * dset,int code,GtkWidget * parent)6001 static void real_do_pergm (DATASET *dset, int code,
6002 GtkWidget *parent)
6003 {
6004 PRN *prn;
6005 int T = sample_size(dset);
6006 gretlopt opt = OPT_NONE;
6007 int width, resp;
6008 int err = 0;
6009
6010 width = auto_spectrum_order(T, OPT_O);
6011
6012 resp = pergm_dialog(&opt, &width, 2, T / 2, parent);
6013
6014 if (canceled(resp) || bufopen(&prn)) {
6015 return;
6016 }
6017
6018 if (code == SELECTED_VAR) {
6019 lib_command_sprintf("pergm %s %d%s", selected_varname(),
6020 width, print_flags(opt, PERGM));
6021 if (parse_lib_command()) {
6022 gretl_print_destroy(prn);
6023 return;
6024 }
6025 err = periodogram(libcmd.list[1], width,
6026 dset, libcmd.opt, prn);
6027 if (!err) {
6028 record_lib_command();
6029 }
6030 } else {
6031 const double *x = dset->Z[dset->v-1];
6032
6033 err = residual_periodogram(x, width, dset, opt, prn);
6034 }
6035
6036 if (err) {
6037 gui_errmsg(err);
6038 gretl_print_destroy(prn);
6039 } else {
6040 gchar *title = gretl_window_title(_("periodogram"));
6041
6042 register_graph();
6043 view_buffer(prn, 60, 400, _(title), PERGM, NULL);
6044 g_free(title);
6045 }
6046 }
6047
do_pergm(GtkAction * action)6048 void do_pergm (GtkAction *action)
6049 {
6050 real_do_pergm(dataset, SELECTED_VAR, NULL);
6051 }
6052
residual_periodogram_callback(GtkAction * action,gpointer p)6053 void residual_periodogram_callback (GtkAction *action, gpointer p)
6054 {
6055 windata_t *vwin = (windata_t *) p;
6056 MODEL *pmod = (MODEL *) vwin->data;
6057 int origv = dataset->v;
6058 DATASET *dset;
6059 int err = 0;
6060
6061 dset = maybe_get_model_data(pmod, OPT_G, &err);
6062
6063 if (!err) {
6064 err = tmp_add_fit_resid(pmod, dset, M_UHAT);
6065 }
6066
6067 if (!err) {
6068 real_do_pergm(dset, MODEL_VAR, vwin_toplevel(vwin));
6069 trim_dataset(pmod, origv);
6070 }
6071 }
6072
do_fractint(GtkAction * action)6073 void do_fractint (GtkAction *action)
6074 {
6075 const gchar *title = N_("gretl: fractional integration");
6076 int T = sample_size(dataset);
6077 gretlopt opt = OPT_A;
6078 int width, err;
6079 PRN *prn;
6080
6081 width = auto_spectrum_order(T, OPT_NONE);
6082
6083 err = spin_dialog(_(title), NULL, &width, _("Lag order:"),
6084 2, T / 2, FRACTINT, NULL);
6085
6086 if (err < 0 || bufopen(&prn)) {
6087 return;
6088 }
6089
6090 lib_command_sprintf("fractint %s %d%s", selected_varname(),
6091 width, print_flags(opt, FRACTINT));
6092 err = parse_lib_command();
6093
6094 if (!err) {
6095 err = fractint(libcmd.list[1], width, dataset,
6096 libcmd.opt, prn);
6097 if (err) {
6098 gui_errmsg(err);
6099 }
6100 }
6101
6102 if (err) {
6103 gretl_print_destroy(prn);
6104 } else {
6105 record_lib_command();
6106 view_buffer(prn, 60, 400, _(title), FRACTINT, NULL);
6107 }
6108 }
6109
residual_qq_plot(GtkAction * action,gpointer p)6110 void residual_qq_plot (GtkAction *action, gpointer p)
6111 {
6112 windata_t *vwin = (windata_t *) p;
6113 MODEL *pmod = (MODEL *) vwin->data;
6114 int origv = dataset->v;
6115 DATASET *dset;
6116 int err = 0;
6117
6118 dset = maybe_get_model_data(pmod, OPT_G, &err);
6119
6120 if (!err) {
6121 /* add residuals to data set temporarily */
6122 err = tmp_add_fit_resid(pmod, dset, M_UHAT);
6123 }
6124
6125 if (!err) {
6126 /* uhat will be the last variable in dset */
6127 int list[2] = {1, dset->v - 1};
6128
6129 err = qq_plot(list, dset, OPT_NONE);
6130 gui_graph_handler(err);
6131 }
6132
6133 trim_dataset(pmod, origv);
6134 }
6135
do_coeff_intervals(GtkAction * action,gpointer p)6136 void do_coeff_intervals (GtkAction *action, gpointer p)
6137 {
6138 windata_t *vwin = (windata_t *) p;
6139 MODEL *pmod = (MODEL *) vwin->data;
6140 CoeffIntervals *cf;
6141 PRN *prn;
6142
6143 if (bufopen(&prn)) return;
6144
6145 cf = gretl_model_get_coeff_intervals(pmod, dataset);
6146
6147 if (cf != NULL) {
6148 text_print_model_confints(cf, prn);
6149 view_buffer_with_parent(vwin, prn, 78, 300,
6150 _("gretl: coefficient confidence intervals"),
6151 COEFFINT, cf);
6152 }
6153 }
6154
do_outcovmx(GtkAction * action,gpointer p)6155 void do_outcovmx (GtkAction *action, gpointer p)
6156 {
6157 windata_t *vwin = (windata_t *) p;
6158 MODEL *pmod = (MODEL *) vwin->data;
6159 VMatrix *vcv = NULL;
6160 PRN *prn;
6161
6162 if (dataset == NULL || dataset->Z == NULL) {
6163 errbox(_("Data set is gone"));
6164 return;
6165 }
6166
6167 if (bufopen(&prn)) return;
6168
6169 vcv = gretl_model_get_vcv(pmod, dataset);
6170
6171 if (vcv == NULL) {
6172 errbox(_("Error generating covariance matrix"));
6173 } else {
6174 text_print_vmatrix(vcv, prn);
6175 view_buffer_with_parent(vwin, prn, 80, 300,
6176 _("gretl: coefficient covariances"),
6177 COVAR, vcv);
6178 }
6179 }
6180
do_anova(GtkAction * action,gpointer p)6181 void do_anova (GtkAction *action, gpointer p)
6182 {
6183 windata_t *vwin = (windata_t *) p;
6184 MODEL *pmod = (MODEL *) vwin->data;
6185 PRN *prn;
6186 int err;
6187
6188 if (bufopen(&prn)) return;
6189
6190 err = ols_print_anova(pmod, prn);
6191
6192 if (err) {
6193 gui_errmsg(err);
6194 } else {
6195 gchar *title = gretl_window_title(_("ANOVA"));
6196
6197 view_buffer_with_parent(vwin, prn, 80, 300,
6198 title, PRINT, NULL);
6199 g_free(title);
6200 }
6201 }
6202
get_dummifiable_list(void)6203 static int *get_dummifiable_list (void)
6204 {
6205 int *dlist = NULL;
6206 int i;
6207
6208 for (i=1; i<dataset->v; i++) {
6209 if (series_is_dummifiable(i)) {
6210 dlist = gretl_list_append_term(&dlist, i);
6211 }
6212 }
6213
6214 return dlist;
6215 }
6216
6217 /* for use when we have more than one candidate series
6218 to select from */
6219
dummify_target_dialog(const int * dlist,gretlopt * opt)6220 static int dummify_target_dialog (const int *dlist,
6221 gretlopt *opt)
6222 {
6223 dialog_opts *opts;
6224 const char *strs[] = {
6225 N_("Encode all values"),
6226 N_("Skip the lowest value"),
6227 N_("Skip the highest value")
6228 };
6229 gretlopt vals[] = {
6230 OPT_NONE,
6231 OPT_F,
6232 OPT_L
6233 };
6234 int v = 0;
6235
6236 opts = dialog_opts_new(3, OPT_TYPE_RADIO,
6237 opt, vals, strs);
6238
6239 if (opts != NULL) {
6240 v = select_var_from_list_with_opt(dlist,
6241 _("Variable to dummify"),
6242 opts, DUMMIFY, NULL);
6243 dialog_opts_free(opts);
6244 }
6245
6246 return v;
6247 }
6248
dummify_option_dialog(int selvar,gretlopt * opt)6249 static int dummify_option_dialog (int selvar, gretlopt *opt)
6250 {
6251 const char *opts[] = {
6252 N_("Encode all values"),
6253 N_("Skip the lowest value"),
6254 N_("Skip the highest value")
6255 };
6256 gchar *label;
6257 int ret;
6258
6259 if (selvar > 0) {
6260 label = g_strdup_printf(_("Encoding %s as dummies"),
6261 dataset->varname[selvar]);
6262 } else {
6263 label = g_strdup(_("Encoding variables as dummies"));
6264 }
6265
6266 ret = radio_dialog(_("gretl: create dummy variables"),
6267 label, opts, 3, 0, DUMMIFY, NULL);
6268
6269 g_free(label);
6270
6271 *opt = (ret == 1)? OPT_F : (ret == 2)? OPT_L : OPT_NONE;
6272
6273 return ret;
6274 }
6275
add_discrete_dummies(int target)6276 void add_discrete_dummies (int target)
6277 {
6278 gretlopt opt = OPT_NONE;
6279 int resp;
6280
6281 if (target < 0) {
6282 /* coming from main window menu, with a single
6283 series selected but not verified as a valid
6284 candidate for dummification
6285 */
6286 if (series_is_dummifiable(-target)) {
6287 target = -target;
6288 } else {
6289 target = 0;
6290 }
6291 }
6292
6293 if (target > 0) {
6294 /* pre-selected and verified target series */
6295 resp = dummify_option_dialog(target, &opt);
6296 if (canceled(resp)) {
6297 target = 0;
6298 }
6299 } else {
6300 int *dlist = get_dummifiable_list();
6301
6302 if (dlist == NULL) {
6303 infobox(_("No discrete series are available"));
6304 } else {
6305 target = dummify_target_dialog(dlist, &opt);
6306 free(dlist);
6307 }
6308 }
6309
6310 if (target > 0) {
6311 int *list = gretl_list_new(1);
6312 int err;
6313
6314 list[1] = target;
6315 err = list_dumgenr(&list, dataset, opt);
6316 free(list);
6317
6318 if (err) {
6319 errbox(_("Error adding variables"));
6320 } else {
6321 const char *flags = print_flags(opt, DUMMIFY);
6322 const char *vname = dataset->varname[target];
6323
6324 lib_command_sprintf("dummify %s%s", vname, flags);
6325 record_command_verbatim();
6326 populate_varlist();
6327 mark_dataset_as_modified();
6328 }
6329 }
6330 }
6331
dummies_code(GtkAction * action)6332 static int dummies_code (GtkAction *action)
6333 {
6334 const gchar *s = gtk_action_get_name(action);
6335
6336 if (!strcmp(s, "PeriodDums"))
6337 return TS_DUMMIES;
6338 else if (!strcmp(s, "UnitDums"))
6339 return PANEL_UNIT_DUMMIES;
6340 else if (!strcmp(s, "TimeDums"))
6341 return PANEL_TIME_DUMMIES;
6342 else if (!strcmp(s, "dummify"))
6343 return DISCRETE_DUMMIES;
6344 else
6345 return 0;
6346 }
6347
add_dummies(GtkAction * action)6348 void add_dummies (GtkAction *action)
6349 {
6350 gretlopt opt = OPT_NONE;
6351 int u = dummies_code(action);
6352 gint err;
6353
6354 if (u == DISCRETE_DUMMIES) {
6355 int selvar = 0;
6356 int selcount = vwin_selection_count(mdata, &selvar);
6357
6358 if (selcount == 1) {
6359 add_discrete_dummies(-selvar);
6360 } else {
6361 add_discrete_dummies(0);
6362 }
6363 return;
6364 } else if (u == TS_DUMMIES) {
6365 lib_command_strcpy("genr dummy");
6366 err = gen_seasonal_dummies(dataset, 0);
6367 } else if (dataset_is_panel(dataset)) {
6368 if (u == PANEL_UNIT_DUMMIES) {
6369 lib_command_strcpy("genr unitdum");
6370 } else {
6371 lib_command_strcpy("genr timedum");
6372 opt = OPT_T;
6373 }
6374 err = gen_panel_dummies(dataset, opt, NULL);
6375 } else {
6376 /* "can't happen" */
6377 err = E_DATA;
6378 return;
6379 }
6380
6381 if (err) {
6382 gui_errmsg(err);
6383 } else {
6384 record_command_verbatim();
6385 populate_varlist();
6386 mark_dataset_as_modified();
6387 }
6388 }
6389
add_index(GtkAction * action)6390 void add_index (GtkAction *action)
6391 {
6392 const gchar *s = gtk_action_get_name(action);
6393 int pu = !strcmp(s, "AddUnit");
6394 int err, tm = 0;
6395
6396 if (pu) {
6397 err = gen_unit(dataset, NULL);
6398 } else {
6399 tm = !strcmp(s, "AddTime");
6400 err = gen_time(dataset, tm, NULL);
6401 }
6402
6403 if (err) {
6404 gui_errmsg(err);
6405 } else {
6406 if (pu) {
6407 lib_command_strcpy("genr unit");
6408 } else if (tm) {
6409 lib_command_strcpy("genr time");
6410 } else {
6411 lib_command_strcpy("genr index");
6412 }
6413 record_command_verbatim();
6414 populate_varlist();
6415 mark_dataset_as_modified();
6416 }
6417 }
6418
do_add_obs(void)6419 void do_add_obs (void)
6420 {
6421 gretlopt opt = OPT_A;
6422 int n, err = 0;
6423
6424 if (dataset_is_panel(dataset)) {
6425 const char *opts[] = {
6426 _("in the cross-sectional dimension"),
6427 _("in the time dimension")
6428 };
6429 int resp;
6430
6431 resp = radio_dialog(NULL, _("Add observations"),
6432 opts, 2, 0, 0, NULL);
6433 if (resp == GRETL_CANCEL) {
6434 return;
6435 }
6436 if (resp == 1) {
6437 opt |= OPT_T;
6438 }
6439 }
6440
6441 n = add_obs_dialog(NULL, 1, opt, NULL);
6442
6443 if (n > 0) {
6444 err = dataset_add_observations(dataset, n, opt);
6445 if (err) {
6446 gui_errmsg(err);
6447 } else {
6448 mark_dataset_as_modified();
6449 }
6450 }
6451 }
6452
do_remove_obs(void)6453 void do_remove_obs (void)
6454 {
6455 int drop = 0;
6456
6457 if (complex_subsampled()) {
6458 errbox(_("The data set is currently sub-sampled.\n"));
6459 drop_obs_state(FALSE);
6460 } else {
6461 drop = dataset->n - get_original_n();
6462 }
6463
6464 if (drop > 0) {
6465 gchar *msg;
6466 int resp;
6467
6468 msg = g_strdup_printf(_("Really delete the last %d observations?"),
6469 drop);
6470 resp = yes_no_dialog(_("gretl: drop observations"), msg, NULL);
6471 g_free(msg);
6472
6473 if (resp == GRETL_YES) {
6474 int err = dataset_drop_observations(dataset, drop);
6475
6476 if (err) {
6477 gui_errmsg(err);
6478 } else {
6479 mark_dataset_as_modified();
6480 }
6481 drop_obs_state(FALSE);
6482 }
6483 } else {
6484 errbox(_("There are no extra observations to drop"));
6485 drop_obs_state(FALSE);
6486 }
6487 }
6488
stdize_option_dialog(int selvar,gretlopt * opt)6489 static int stdize_option_dialog (int selvar, gretlopt *opt)
6490 {
6491 const char *opts[] = {
6492 N_("Divide by sample standard deviation"),
6493 N_("Divide by standard deviation without df correction"),
6494 N_("Center only")
6495 };
6496 gchar *label;
6497 int ret;
6498
6499 if (selvar > 0) {
6500 label = g_strdup_printf(_("Standardizing %s"),
6501 dataset->varname[selvar]);
6502 } else {
6503 label = g_strdup(_("Standardizing variables"));
6504 }
6505
6506 ret = radio_dialog(_("gretl: create standardized variables"),
6507 label, opts, 3, 0, STDIZE, NULL);
6508 g_free(label);
6509
6510 *opt = (ret == 1)? OPT_N : (ret == 2)? OPT_C : OPT_NONE;
6511
6512 return ret;
6513 }
6514
add_logs_etc(int ci,int varnum,int midas)6515 void add_logs_etc (int ci, int varnum, int midas)
6516 {
6517 char *liststr;
6518 int *tmplist = NULL;
6519 gretlopt opt = OPT_NONE;
6520 int order = 0;
6521 int err = 0;
6522
6523 if ((ci == LAGS || ci == DIFF || ci == LDIFF || ci == SDIFF) && midas) {
6524 /* FIXME! */
6525 warnbox("Please use console or script when transforming MIDAS series");
6526 return;
6527 }
6528
6529 if (varnum > 0 && varnum < dataset->v) {
6530 liststr = gretl_strdup_printf(" %s", dataset->varname[varnum]);
6531 } else {
6532 liststr = main_window_selection_as_string();
6533 }
6534
6535 if (liststr == NULL) {
6536 return;
6537 }
6538
6539 if (ci == LAGS) {
6540 int resp;
6541
6542 order = default_lag_order(dataset);
6543 resp = spin_dialog(_("gretl: generate lags"), NULL,
6544 &order, _("Number of lags to create:"),
6545 1, dataset->n - 1, 0, NULL);
6546 if (canceled(resp)) {
6547 free(liststr);
6548 return;
6549 }
6550 if (order > 0) {
6551 lib_command_sprintf("lags %d ;%s", order, liststr);
6552 } else {
6553 lib_command_sprintf("lags%s", liststr);
6554 }
6555 } else if (ci == STDIZE) {
6556 int resp = stdize_option_dialog(varnum, &opt);
6557
6558 if (canceled(resp)) {
6559 free(liststr);
6560 return;
6561 }
6562 if (opt != OPT_NONE) {
6563 lib_command_sprintf("stdize%s%s", liststr, print_flags(opt, ci));
6564 } else {
6565 lib_command_sprintf("stdize%s", liststr);
6566 }
6567 } else {
6568 lib_command_sprintf("%s%s", gretl_command_word(ci), liststr);
6569 }
6570
6571 free(liststr);
6572
6573 if (parse_lib_command()) {
6574 return;
6575 }
6576
6577 tmplist = gretl_list_copy(libcmd.list);
6578 if (tmplist == NULL) {
6579 nomem();
6580 return;
6581 }
6582
6583 if (ci == LAGS) {
6584 err = list_laggenr(&tmplist, 1, order, NULL, dataset, 0, opt);
6585 } else if (ci == LOGS) {
6586 err = list_loggenr(tmplist, dataset);
6587 } else if (ci == SQUARE) {
6588 err = list_xpxgenr(&tmplist, dataset, opt);
6589 } else if (ci == STDIZE) {
6590 err = list_stdgenr(tmplist, dataset, opt);
6591 } else if (ci == DIFF || ci == LDIFF || ci == SDIFF) {
6592 err = list_diffgenr(tmplist, ci, dataset);
6593 }
6594
6595 if (!err && midas && (ci == LOGS || ci == SQUARE)) {
6596 gretl_list_set_midas(tmplist, dataset);
6597 }
6598
6599 free(tmplist);
6600
6601 if (err) {
6602 errbox(_("Error adding variables"));
6603 } else {
6604 record_lib_command();
6605 populate_varlist();
6606 mark_dataset_as_modified();
6607 maybe_warn();
6608 }
6609 }
6610
logs_etc_code(GtkAction * action)6611 static int logs_etc_code (GtkAction *action)
6612 {
6613 const gchar *s = gtk_action_get_name(action);
6614
6615 if (!strcmp(s, "logs"))
6616 return LOGS;
6617 else if (!strcmp(s, "square"))
6618 return SQUARE;
6619 else if (!strcmp(s, "lags"))
6620 return LAGS;
6621 else if (!strcmp(s, "diff"))
6622 return DIFF;
6623 else if (!strcmp(s, "ldiff"))
6624 return LDIFF;
6625 else if (!strcmp(s, "sdiff"))
6626 return SDIFF;
6627 else if (!strcmp(s, "stdize"))
6628 return STDIZE;
6629 else
6630 return LOGS;
6631 }
6632
logs_etc_callback(GtkAction * action)6633 void logs_etc_callback (GtkAction *action)
6634 {
6635 int ci = logs_etc_code(action);
6636 int v = mdata_active_var();
6637
6638 /* FIXME MIDAS */
6639 add_logs_etc(ci, v, 0);
6640 }
6641
save_fit_resid(windata_t * vwin,int code)6642 int save_fit_resid (windata_t *vwin, int code)
6643 {
6644 MODEL *pmod = vwin->data;
6645 char vname[VNAMELEN];
6646 gchar *descrip = NULL;
6647 double *x = NULL;
6648 int cancel = 0;
6649 int err = 0;
6650
6651 if (pmod->dataset != NULL) {
6652 fprintf(stderr, "FIXME saving fit/resid from subsampled model\n");
6653 err = E_DATA;
6654 } else {
6655 x = get_fit_or_resid(pmod, dataset, code, vname, &descrip, &err);
6656 }
6657
6658 if (err) {
6659 gui_errmsg(err);
6660 return err;
6661 }
6662
6663 name_new_series_dialog(vname, &descrip, vwin, &cancel);
6664
6665 if (cancel) {
6666 free(x);
6667 g_free(descrip);
6668 return 0;
6669 }
6670
6671 err = add_or_replace_series(x, vname, descrip, DS_GRAB_VALUES);
6672 g_free(descrip);
6673
6674 if (err) {
6675 free(x);
6676 } else {
6677 if (code == M_UHAT) {
6678 lib_command_sprintf("series %s = $uhat", vname);
6679 } else if (code == M_YHAT) {
6680 lib_command_sprintf("series %s = $yhat", vname);
6681 } else if (code == M_UHAT2) {
6682 lib_command_sprintf("series %s = $uhat*$uhat", vname);
6683 } else if (code == M_H) {
6684 lib_command_sprintf("series %s = $h", vname);
6685 } else if (code == M_AHAT) {
6686 lib_command_sprintf("series %s = $ahat", vname);
6687 }
6688 record_model_command_verbatim(pmod->ID);
6689 populate_varlist();
6690 mark_dataset_as_modified();
6691 }
6692
6693 return err;
6694 }
6695
save_bundled_series(const double * x,int t1,int t2,const char * key,const char * note,windata_t * vwin)6696 int save_bundled_series (const double *x,
6697 int t1, int t2,
6698 const char *key,
6699 const char *note,
6700 windata_t *vwin)
6701 {
6702 char vname[VNAMELEN];
6703 gchar *descrip = NULL;
6704 int cancel = 0;
6705 int err = 0;
6706
6707 strcpy(vname, key);
6708 descrip = (note != NULL) ? g_strdup(note) : g_strdup("");
6709 name_new_series_dialog(vname, &descrip, vwin, &cancel);
6710
6711 if (cancel) {
6712 g_free(descrip);
6713 return 0;
6714 }
6715
6716 if (t1 == 0 && t2 == dataset->n - 1) {
6717 err = add_or_replace_series((double *) x, vname,
6718 descrip, DS_COPY_VALUES);
6719 } else {
6720 err = add_or_replace_series_data(x, t1, t2, vname,
6721 descrip);
6722 }
6723 g_free(descrip);
6724
6725 if (!err) {
6726 populate_varlist();
6727 mark_dataset_as_modified();
6728 }
6729
6730 return err;
6731 }
6732
add_system_resid(GtkAction * action,gpointer p)6733 void add_system_resid (GtkAction *action, gpointer p)
6734 {
6735 windata_t *vwin = (windata_t *) p;
6736 double *uhat;
6737 char vname[VNAMELEN];
6738 gchar *descrip = NULL;
6739 int j, ci = vwin->role;
6740 int cancel = 0;
6741 int err = 0;
6742
6743 sscanf(gtk_action_get_name(action), "resid %d", &j);
6744
6745 if (ci == VAR || ci == VECM) {
6746 GRETL_VAR *var = (GRETL_VAR *) vwin->data;
6747
6748 uhat = gretl_VAR_get_resid_series(var, j, &err);
6749 } else {
6750 equation_system *sys = vwin->data;
6751
6752 uhat = system_get_resid_series(sys, j, dataset, &err);
6753 }
6754
6755 if (err) {
6756 gui_errmsg(err);
6757 return;
6758 }
6759
6760 j++;
6761
6762 if (ci == VAR || ci == VECM) {
6763 sprintf(vname, "uhat%d", j);
6764 descrip = g_strdup_printf(_("residual from VAR system, equation %d"), j);
6765 } else if (ci == VECM) {
6766 sprintf(vname, "uhat%d", j);
6767 descrip = g_strdup_printf(_("residual from VECM system, equation %d"), j);
6768 } else {
6769 sprintf(vname, "uhat_s%02d", j);
6770 descrip = g_strdup_printf(_("system residual, equation %d"), j);
6771 }
6772
6773 name_new_series_dialog(vname, &descrip, vwin, &cancel);
6774
6775 if (cancel) {
6776 g_free(descrip);
6777 free(uhat);
6778 return;
6779 }
6780
6781 err = add_or_replace_series(uhat, vname, descrip, DS_GRAB_VALUES);
6782 g_free(descrip);
6783
6784 if (err) {
6785 free(uhat);
6786 } else {
6787 populate_varlist();
6788 mark_dataset_as_modified();
6789 }
6790 }
6791
set_scalar_name(GtkWidget * widget,dialog_t * dlg)6792 static void set_scalar_name (GtkWidget *widget, dialog_t *dlg)
6793 {
6794 char *vname = (char *) edit_dialog_get_data(dlg);
6795 GtkWidget *parent = edit_dialog_get_window(dlg);
6796 const gchar *s = edit_dialog_get_text(dlg);
6797
6798 if (s == NULL || gui_validate_varname(s,
6799 GRETL_TYPE_DOUBLE,
6800 parent)) {
6801 edit_dialog_reset(dlg);
6802 } else {
6803 strcpy(vname, s);
6804 edit_dialog_close(dlg);
6805 }
6806 }
6807
set_bundle_name(GtkWidget * widget,dialog_t * dlg)6808 static void set_bundle_name (GtkWidget *widget, dialog_t *dlg)
6809 {
6810 char *vname = (char *) edit_dialog_get_data(dlg);
6811 GtkWidget *parent = edit_dialog_get_window(dlg);
6812 const gchar *s = edit_dialog_get_text(dlg);
6813
6814 if (s == NULL || gui_validate_varname(s,
6815 GRETL_TYPE_BUNDLE,
6816 parent)) {
6817 edit_dialog_reset(dlg);
6818 } else {
6819 strcpy(vname, s);
6820 edit_dialog_close(dlg);
6821 }
6822 }
6823
add_model_stat(MODEL * pmod,int which,windata_t * vwin)6824 void add_model_stat (MODEL *pmod, int which, windata_t *vwin)
6825 {
6826 char vname[VNAMELEN];
6827 double val = NADBL;
6828 const char *descrip = NULL;
6829 const char *statname = NULL;
6830 gchar *blurb;
6831 int err = 0, cancel = 0;
6832
6833 switch (which) {
6834 case M_ESS:
6835 descrip = N_("Sum of squared residuals");
6836 val = pmod->ess;
6837 statname = "$ess";
6838 break;
6839 case M_RSQ:
6840 descrip = N_("Unadjusted R-squared");
6841 val = pmod->rsq;
6842 statname = "$rsq";
6843 break;
6844 case M_TRSQ:
6845 descrip = N_("T*R-squared");
6846 val = pmod->nobs * pmod->rsq;
6847 statname = "$trsq";
6848 break;
6849 case M_DF:
6850 descrip = N_("degrees of freedom");
6851 val = (double) pmod->dfd;
6852 statname = "$df";
6853 break;
6854 case M_SIGMA:
6855 descrip = N_("Standard error of the regression");
6856 val = pmod->sigma;
6857 statname = "$sigma";
6858 break;
6859 case M_LNL:
6860 descrip = N_("Log-likelihood");
6861 val = pmod->lnL;
6862 statname = "$lnl";
6863 break;
6864 case M_AIC:
6865 descrip = N_("Akaike Information Criterion");
6866 val = pmod->criterion[C_AIC];
6867 statname = "$aic";
6868 break;
6869 case M_BIC:
6870 descrip = N_("Schwarz Bayesian criterion");
6871 val = pmod->criterion[C_BIC];
6872 statname = "$bic";
6873 break;
6874 case M_HQC:
6875 descrip = N_("Hannan-Quinn Information Criterion");
6876 val = pmod->criterion[C_HQC];
6877 statname = "$hqc";
6878 break;
6879 case B_MODEL:
6880 statname = "$model";
6881 break;
6882 default:
6883 dummy_call();
6884 return;
6885 }
6886
6887 sprintf(vname, "%s_%d", statname + 1, pmod->ID);
6888
6889 if (which == B_MODEL) {
6890 blurb = g_strdup_printf(_("Bundle from model %d\n"
6891 "Name (max. %d characters):"),
6892 pmod->ID, VNAMELEN -1);
6893 blocking_edit_dialog(0, _("add bundle"), blurb, vname,
6894 set_bundle_name, vname, VARCLICK_NONE,
6895 vwin_toplevel(vwin), &cancel);
6896 } else {
6897 blurb = g_strdup_printf(_("Statistic from model %d\n"
6898 "%s (value = %g)\n"
6899 "Name (max. %d characters):"),
6900 pmod->ID, _(descrip), val,
6901 VNAMELEN -1);
6902 blocking_edit_dialog(0, _("add scalar"), blurb, vname,
6903 set_scalar_name, vname, VARCLICK_NONE,
6904 vwin_toplevel(vwin), &cancel);
6905 }
6906
6907 g_free(blurb);
6908
6909 if (!cancel) {
6910 const char *tstr;
6911
6912 if (which == B_MODEL) {
6913 gretl_bundle *b = bundle_from_model(pmod, dataset, &err);
6914
6915 if (!err) {
6916 err = user_var_add_or_replace(vname, GRETL_TYPE_BUNDLE, b);
6917 tstr = "bundle";
6918 }
6919 } else {
6920 err = gretl_scalar_add(vname, val);
6921 tstr = "scalar";
6922 }
6923 if (!err) {
6924 lib_command_sprintf("%s %s = %s", tstr, vname, statname);
6925 record_model_command_verbatim(pmod->ID);
6926 if (autoicon_on()) {
6927 view_session();
6928 }
6929 }
6930 }
6931
6932 /* note: since this is a scalar or bundle, which will not be saved
6933 by default on File/Save data, we will not mark the data set
6934 as "modified" here */
6935 }
6936
xvar_from_action(GtkAction * action,int * xvar)6937 static void xvar_from_action (GtkAction *action, int *xvar)
6938 {
6939 const gchar *s = gtk_action_get_name(action);
6940
6941 if (!strcmp(s, "f:theil")) {
6942 *xvar = -1;
6943 } else {
6944 sscanf(s, "%*s %d", xvar);
6945 }
6946 }
6947
resid_plot(GtkAction * action,gpointer p)6948 void resid_plot (GtkAction *action, gpointer p)
6949 {
6950 gretlopt opt = OPT_NONE;
6951 int plotlist[4];
6952 windata_t *vwin = (windata_t *) p;
6953 MODEL *pmod = (MODEL *) vwin->data;
6954 int pdum = vwin->active_var;
6955 int xvar = 0;
6956 int uhatno, yno = 0;
6957 int boxplot = 0;
6958 DATASET *dset;
6959 int origv = dataset->v;
6960 int err = 0;
6961
6962 /* special case: GARCH model (show fitted variance) */
6963 if (pmod->ci == GARCH && !(pmod->opt & OPT_Z) && xvar == 0) {
6964 err = garch_resid_plot(pmod, dataset);
6965 gui_graph_handler(err);
6966 return;
6967 }
6968
6969 if (!strcmp(gtk_action_get_name(action), "r:box")) {
6970 boxplot = 1;
6971 } else {
6972 xvar_from_action(action, &xvar);
6973 }
6974
6975 /* FIXME OPT_F? */
6976 dset = maybe_get_model_data(pmod, OPT_F, &err);
6977 if (err) {
6978 return;
6979 }
6980
6981 /* add residuals to data set temporarily */
6982 if (tmp_add_fit_resid(pmod, dset, M_UHAT)) {
6983 return;
6984 }
6985
6986 uhatno = dset->v - 1; /* residual: last var added */
6987 yno = gretl_model_get_depvar(pmod);
6988
6989 plotlist[0] = 1;
6990 plotlist[1] = uhatno;
6991
6992 strcpy(dset->varname[uhatno], _("residual"));
6993 if (yno > 0) {
6994 gchar *label;
6995
6996 label = g_strdup_printf("residual for %s", dset->varname[yno]);
6997 series_set_label(dset, uhatno, label);
6998 g_free(label);
6999 }
7000
7001 opt = OPT_G | OPT_R; /* gui, resids */
7002 if (pdum) {
7003 opt |= OPT_Z; /* dummy */
7004 }
7005
7006 if (pmod->ci == GARCH && (pmod->opt & OPT_Z)) {
7007 series_set_display_name(dset, uhatno, _("standardized residual"));
7008 opt ^= OPT_R;
7009 } else if (boxplot) {
7010 if (multi_unit_panel_sample(dset)) {
7011 opt = OPT_P;
7012 }
7013 err = boxplots(plotlist, NULL, dset, opt);
7014 gui_graph_handler(err);
7015 trim_dataset(pmod, origv);
7016 return;
7017 }
7018
7019 if (xvar) {
7020 /* plot against specified xvar */
7021 plotlist[0] = 2;
7022 plotlist[2] = xvar;
7023 } else {
7024 /* plot against obs index or time */
7025 opt |= OPT_T;
7026 if (dataset_is_time_series(dset) ||
7027 dataset_is_panel(dset)) {
7028 opt |= OPT_O; /* use lines */
7029 }
7030 }
7031
7032 /* plot separated by dummy variable? */
7033 if (pdum) {
7034 plotlist[0] += 1;
7035 plotlist[plotlist[0]] = pdum;
7036 }
7037
7038 /* generate graph */
7039 err = gnuplot(plotlist, NULL, dset, opt);
7040 gui_graph_handler(err);
7041
7042 trim_dataset(pmod, origv);
7043 }
7044
theil_plot(MODEL * pmod,DATASET * dset)7045 static void theil_plot (MODEL *pmod, DATASET *dset)
7046 {
7047 gchar *dname;
7048 int plotlist[3];
7049 int dv, fv, err;
7050
7051 if (tmp_add_fit_resid(pmod, dset, M_YHAT)) {
7052 return;
7053 }
7054
7055 plotlist[0] = 2;
7056 plotlist[1] = dv = gretl_model_get_depvar(pmod);
7057 plotlist[2] = fv = dset->v - 1; /* fitted values */
7058
7059 dname = g_strdup_printf(_("predicted %s"), dset->varname[dv]);
7060 series_set_display_name(dset, fv, dname);
7061 g_free(dname);
7062
7063 err = theil_forecast_plot(plotlist, dset, OPT_G);
7064 gui_graph_handler(err);
7065 }
7066
fit_actual_plot(GtkAction * action,gpointer p)7067 void fit_actual_plot (GtkAction *action, gpointer p)
7068 {
7069 gretlopt opt = OPT_G | OPT_A;
7070 int plotlist[4];
7071 windata_t *vwin = (windata_t *) p;
7072 MODEL *pmod = (MODEL *) vwin->data;
7073 int xvar = 0;
7074 DATASET *dset;
7075 int origv = dataset->v;
7076 char *formula;
7077 int err = 0;
7078
7079 dset = maybe_get_model_data(pmod, OPT_NONE, &err);
7080 if (err) {
7081 return;
7082 }
7083
7084 xvar_from_action(action, &xvar);
7085
7086 if (xvar < 0) {
7087 theil_plot(pmod, dset);
7088 trim_dataset(pmod, origv);
7089 return;
7090 }
7091
7092 formula = gretl_model_get_fitted_formula(pmod, xvar, dset);
7093
7094 if (formula != NULL) {
7095 /* fitted value can be represented as a formula: if feasible,
7096 this produces a better-looking graph */
7097 plotlist[0] = 3;
7098 plotlist[1] = 0; /* placeholder entry */
7099 plotlist[2] = gretl_model_get_depvar(pmod);
7100 plotlist[3] = xvar;
7101 err = gnuplot(plotlist, formula, dset, opt);
7102 gui_graph_handler(err);
7103 free(formula);
7104 return;
7105 }
7106
7107 /* add fitted values to data set temporarily */
7108 if (tmp_add_fit_resid(pmod, dset, M_YHAT)) {
7109 return;
7110 }
7111
7112 plotlist[0] = 3;
7113
7114 /* last var added (fitted vals) */
7115 plotlist[1] = dset->v - 1;
7116 /* depvar from regression */
7117 plotlist[2] = gretl_model_get_depvar(pmod);
7118
7119 if (xvar) {
7120 /* plot against specified xvar */
7121 plotlist[3] = xvar;
7122 } else {
7123 /* plot against obs */
7124 plotlist[0] -= 1;
7125 opt |= OPT_T;
7126 if (dataset_is_time_series(dset)) {
7127 opt |= OPT_O; /* use lines */
7128 }
7129 }
7130
7131 err = gnuplot(plotlist, NULL, dset, opt);
7132 gui_graph_handler(err);
7133
7134 trim_dataset(pmod, origv);
7135 }
7136
fit_actual_splot(GtkAction * action,gpointer p)7137 void fit_actual_splot (GtkAction *action, gpointer p)
7138 {
7139 windata_t *vwin = (windata_t *) p;
7140 MODEL *pmod = (MODEL *) vwin->data;
7141 gretlopt plotopt = OPT_A;
7142 DATASET *dset;
7143 int origv = dataset->v;
7144 int *xlist = NULL;
7145 int list[4];
7146 int err = 0;
7147
7148 dset = maybe_get_model_data(pmod, OPT_NONE, &err);
7149 if (err) {
7150 return;
7151 }
7152
7153 xlist = gretl_model_get_x_list(pmod);
7154 if (xlist == NULL) {
7155 return;
7156 }
7157
7158 list[0] = 3;
7159 list[3] = gretl_model_get_depvar(pmod);
7160
7161 if (pmod->ifc) {
7162 list[1] = xlist[3];
7163 list[2] = xlist[2];
7164 } else {
7165 list[1] = xlist[2];
7166 list[2] = xlist[1];
7167 }
7168
7169 free(xlist);
7170
7171 #ifdef GNUPLOT3D
7172 /* We have a fully interactive gnuplot terminal
7173 (note: you can't rotate plots with aquaterm)
7174 */
7175 plotopt |= OPT_I;
7176 #endif
7177
7178 err = gnuplot_3d(list, NULL, dset, &plotopt);
7179
7180 if (err) {
7181 gui_errmsg(err);
7182 } else if (plotopt & OPT_I) {
7183 gnuplot_view_3d(gretl_plotfile());
7184 } else {
7185 register_graph();
7186 }
7187
7188 trim_dataset(pmod, origv);
7189 }
7190
7191 #define MAXDISPLAY 1000000
7192
display_selected(void)7193 void display_selected (void)
7194 {
7195 int n = sample_size(dataset);
7196 PRN *prn = NULL;
7197 int *list = NULL;
7198 int nvals;
7199 int err = 0;
7200
7201 list = main_window_selection_as_list();
7202 if (list == NULL) {
7203 return;
7204 }
7205
7206 nvals = list[0] * n;
7207 if (nvals > MAXDISPLAY) {
7208 warnbox_printf(_("Too many data values (%d) for display.\n"
7209 "You might try limiting the sample range."),
7210 nvals);
7211 free(list);
7212 return;
7213 }
7214
7215 /* special case: showing only one series */
7216 if (list[0] == 1) {
7217 display_var();
7218 free(list);
7219 return;
7220 }
7221
7222 err = bufopen(&prn);
7223 if (!err) {
7224 err = printdata(list, NULL, dataset, OPT_O, prn);
7225 if (err) {
7226 gui_errmsg(err);
7227 gretl_print_destroy(prn);
7228 }
7229 }
7230
7231 if (!err) {
7232 series_view *sview = multi_series_view_new(list);
7233
7234 preset_viewer_flag(VWIN_MULTI_SERIES);
7235 view_buffer(prn, 78, 400, _("gretl: display data"),
7236 PRINT, sview);
7237 }
7238
7239 free(list);
7240 }
7241
display_fit_resid(GtkAction * action,gpointer p)7242 void display_fit_resid (GtkAction *action, gpointer p)
7243 {
7244 windata_t *vwin = (windata_t *) p;
7245 MODEL *pmod = (MODEL *) vwin->data;
7246 DATASET *dset = NULL;
7247 FITRESID *fr;
7248 PRN *prn;
7249 int err = 0;
7250
7251 dset = maybe_get_model_data(pmod, OPT_NONE, &err);
7252 if (err) {
7253 return;
7254 }
7255
7256 if (bufopen(&prn)) return;
7257
7258 fr = get_fit_resid(pmod, dset, &err);
7259
7260 if (fr == NULL) {
7261 gui_errmsg(err);
7262 gretl_print_destroy(prn);
7263 } else {
7264 text_print_fit_resid(fr, dset, prn);
7265 if (pmod->dataset == NULL) {
7266 view_buffer_with_parent(vwin, prn, 78, 350,
7267 _("gretl: display data"),
7268 AFR, fr);
7269 } else {
7270 view_buffer_with_parent(vwin, prn, 78, 350,
7271 _("gretl: display data"),
7272 PRINT, NULL);
7273 trim_dataset(pmod, 0);
7274 }
7275 }
7276 }
7277
7278 /* determine the series ID number such that it is OK
7279 to delete or redefine series with higher IDs
7280 */
7281
max_untouchable_series_ID(void)7282 int max_untouchable_series_ID (void)
7283 {
7284 int vmax, vsave = 0;
7285
7286 /* check open model windows */
7287 vmax = highest_numbered_variable_in_winstack();
7288 if (vmax > vsave) {
7289 vsave = vmax;
7290 }
7291
7292 /* check models saved as icons */
7293 vmax = highest_numbered_variable_in_session();
7294 if (vmax > vsave) {
7295 vsave = vmax;
7296 }
7297
7298 /* and models saved via command line */
7299 vmax = highest_numbered_var_in_saved_object(dataset);
7300 if (vmax > vsave) {
7301 vsave = vmax;
7302 }
7303
7304 return vsave;
7305 }
7306
7307 /* Before deleting specified variables, check that they are not
7308 required by any saved models; also, don't delete variables
7309 whose deletion would result in the renumbering of variables
7310 used in saved models.
7311 */
7312
maybe_prune_delete_list(int * list)7313 static int maybe_prune_delete_list (int *list)
7314 {
7315 int i, vsave, pruned = 0;
7316
7317 vsave = max_untouchable_series_ID();
7318
7319 for (i=1; i<=list[0]; i++) {
7320 if (list[i] <= vsave) {
7321 gretl_list_delete_at_pos(list, i--);
7322 pruned++;
7323 }
7324 }
7325
7326 return pruned;
7327 }
7328
real_delete_vars(int selvar)7329 static void real_delete_vars (int selvar)
7330 {
7331 const char *vname = NULL;
7332 int *dellist = NULL;
7333 char *liststr = NULL;
7334 gchar *cmdstr = NULL;
7335 gchar *msg = NULL;
7336 int renumber = 0;
7337 int err = 0;
7338
7339 if (dataset_locked()) {
7340 return;
7341 }
7342
7343 if (selvar > 0) {
7344 /* deleting a single specified series */
7345 int testlist[2] = {1, selvar};
7346
7347 vname = dataset->varname[selvar];
7348
7349 if (maybe_prune_delete_list(testlist)) {
7350 errbox_printf(_("Cannot delete %s; variable is in use"), vname);
7351 return;
7352 } else {
7353 msg = g_strdup_printf(_("Really delete %s?"), vname);
7354 }
7355 } else {
7356 /* deleting multiple series selected in main window */
7357 dellist = main_window_selection_as_list();
7358 if (dellist == NULL) {
7359 return;
7360 } else {
7361 msg = g_strdup(_("Really delete the selected variables?"));
7362 }
7363 }
7364
7365 if (msg != NULL) {
7366 /* ask for confirmation */
7367 int resp;
7368
7369 resp = yes_no_dialog(_("gretl: delete"), msg, NULL);
7370 g_free(msg);
7371 if (resp != GRETL_YES) {
7372 free(dellist);
7373 return;
7374 }
7375 }
7376
7377 if (dellist != NULL) {
7378 int pruned = maybe_prune_delete_list(dellist);
7379
7380 if (dellist == 0) {
7381 errbox(_("Cannot delete the specified variables"));
7382 return;
7383 } else if (pruned) {
7384 errbox(_("Cannot delete all of the specified variables"));
7385 }
7386 liststr = gretl_list_to_string(dellist, dataset, &err);
7387 } else if (selvar > 0) {
7388 dellist = gretl_list_new(1);
7389 if (dellist == NULL) {
7390 err = E_ALLOC;
7391 } else {
7392 dellist[1] = selvar;
7393 }
7394 }
7395
7396 if (!err) {
7397 /* set-up for command log */
7398 if (vname != NULL) {
7399 cmdstr = g_strdup_printf("delete %s", vname);
7400 } else {
7401 cmdstr = g_strdup_printf("delete%s", liststr);
7402 }
7403 err = dataset_drop_listed_variables(dellist, dataset,
7404 &renumber, NULL);
7405 }
7406
7407 if (err) {
7408 gui_errmsg(err);
7409 } else {
7410 lib_command_strcpy(cmdstr);
7411 record_command_verbatim();
7412 refresh_data();
7413 if (renumber) {
7414 infobox(_("Take note: variables have been renumbered"));
7415 }
7416 maybe_clear_selector(dellist);
7417 mark_dataset_as_modified();
7418 }
7419
7420 free(dellist);
7421 free(liststr);
7422 g_free(cmdstr);
7423 }
7424
delete_single_var(int id)7425 void delete_single_var (int id)
7426 {
7427 real_delete_vars(id);
7428 }
7429
delete_selected_vars(void)7430 void delete_selected_vars (void)
7431 {
7432 real_delete_vars(0);
7433 }
7434
regular_ts_plot(int v)7435 static int regular_ts_plot (int v)
7436 {
7437 int list[2] = {1, v};
7438 int err;
7439
7440 err = gnuplot(list, NULL, dataset, OPT_G | OPT_O | OPT_T);
7441
7442 if (!err) {
7443 lib_command_sprintf("gnuplot %s --time-series --with-lines",
7444 dataset->varname[v]);
7445 record_command_verbatim();
7446 }
7447
7448 return err;
7449 }
7450
do_panel_plot(int vnum)7451 static void do_panel_plot (int vnum)
7452 {
7453 int t1 = dataset->t1 / dataset->pd;
7454 int t2 = dataset->t2 / dataset->pd;
7455 int save_t1 = dataset->t1;
7456 int save_t2 = dataset->t2;
7457 int handled = 0;
7458 gretlopt ppopt = 0;
7459 int sel, err = 0;
7460
7461 sel = panel_graph_dialog(&t1, &t2);
7462
7463 if (sel < 0) {
7464 /* canceled */
7465 return;
7466 } else {
7467 int n = t2 - t1 + 1;
7468
7469 dataset->t1 = dataset->pd * t1;
7470 dataset->t2 = dataset->t1 + n * dataset->pd - 1;
7471 }
7472
7473 /* note: @ppopt is the option that must be passed to
7474 "panplot" to get the specified effect */
7475
7476 if (sel == 0) {
7477 /* group means time series */
7478 err = gretl_panel_ts_plot(vnum, dataset, OPT_G | OPT_M);
7479 ppopt = OPT_M;
7480 } else if (sel == 1) {
7481 /* time-series overlay */
7482 err = gretl_panel_ts_plot(vnum, dataset, OPT_G);
7483 ppopt = OPT_V;
7484 } else if (sel == 2) {
7485 /* sequential by unit */
7486 err = regular_ts_plot(vnum);
7487 ppopt = OPT_S;
7488 } else if (sel == 3) {
7489 /* small multiples in grid */
7490 err = gretl_panel_ts_plot(vnum, dataset, OPT_S);
7491 ppopt = OPT_D;
7492 } else if (sel == 4) {
7493 /* small multiples stacked vertically */
7494 err = gretl_panel_ts_plot(vnum, dataset, OPT_S | OPT_V);
7495 ppopt = OPT_A;
7496 } else if (sel == 5) {
7497 /* boxplots by group */
7498 do_boxplot_var(vnum, OPT_P);
7499 handled = 1;
7500 } else {
7501 /* single boxplot */
7502 do_boxplot_var(vnum, OPT_S);
7503 handled = 1;
7504 }
7505
7506 dataset->t1 = save_t1;
7507 dataset->t2 = save_t2;
7508
7509 if (!handled) {
7510 if (!err) {
7511 lib_command_sprintf("panplot %s%s", dataset->varname[vnum],
7512 print_flags(ppopt, PANPLOT));
7513 record_command_verbatim();
7514 }
7515 gui_graph_handler(err);
7516 }
7517 }
7518
7519 /* time-series plot or panel plot if appropriate, else
7520 frequency plot */
7521
do_graph_var(int varnum)7522 void do_graph_var (int varnum)
7523 {
7524 if (varnum <= 0) return;
7525
7526 if (dataset_is_cross_section(dataset)) {
7527 do_freq_dist();
7528 } else if (multi_unit_panel_sample(dataset)) {
7529 do_panel_plot(varnum);
7530 } else {
7531 int err = regular_ts_plot(varnum);
7532
7533 gui_graph_handler(err);
7534 }
7535 }
7536
ts_plot_callback(void)7537 void ts_plot_callback (void)
7538 {
7539 do_graph_var(mdata_active_var());
7540 }
7541
do_per_unit_plots(int v)7542 static int do_per_unit_plots (int v)
7543 {
7544 int T = dataset->pd;
7545 int N = (dataset->t2 - dataset->t1 + 1) / T;
7546 int ret = 0;
7547
7548 if (N >= 2) {
7549 const double *x = dataset->Z[v];
7550 int s0 = dataset->t1 / T;
7551 int tvary;
7552 int i, t, s;
7553
7554 ret = 1;
7555 for (i=0; i<N; i++) {
7556 s = s0 + i * T;
7557 tvary = 0;
7558 for (t=1; t<T; t++) {
7559 if (x[s+t] != x[s]) {
7560 tvary = 1;
7561 break;
7562 }
7563 }
7564 if (!tvary) {
7565 ret = 0;
7566 break;
7567 }
7568 }
7569 }
7570
7571 return ret;
7572 }
7573
do_boxplot_var(int varnum,gretlopt opt)7574 void do_boxplot_var (int varnum, gretlopt opt)
7575 {
7576 gretlopt plotopt = OPT_NONE;
7577 int err = 0;
7578
7579 if (varnum < 0) {
7580 return;
7581 }
7582
7583 if (opt & OPT_P) {
7584 /* the --panel option */
7585 plotopt = OPT_P;
7586 } else if (!(opt & OPT_S) && dataset_is_panel(dataset)) {
7587 /* note: OPT_S enforces a single plot */
7588 if (do_per_unit_plots(varnum)) {
7589 plotopt = OPT_P;
7590 }
7591 }
7592
7593 if (opt & OPT_O) {
7594 plotopt |= OPT_O;
7595 }
7596
7597 lib_command_sprintf("boxplot %s%s", dataset->varname[varnum],
7598 print_flags(plotopt, BXPLOT));
7599
7600 if (parse_lib_command()) {
7601 return;
7602 }
7603
7604 err = boxplots(libcmd.list, NULL, dataset, plotopt);
7605 gui_graph_handler(err);
7606
7607 if (!err) {
7608 record_lib_command();
7609 }
7610 }
7611
do_scatters(selector * sr)7612 int do_scatters (selector *sr)
7613 {
7614 const char *buf = selector_list(sr);
7615 gretlopt opt = selector_get_opts(sr);
7616 int err = 0;
7617
7618 if (buf == NULL) return 1;
7619
7620 if (opt & OPT_O) {
7621 lib_command_sprintf("scatters %s --with-lines", buf);
7622 } else {
7623 lib_command_sprintf("scatters %s", buf);
7624 }
7625
7626 err = parse_lib_command();
7627
7628 if (!err) {
7629 err = multi_scatters(libcmd.list, dataset, opt);
7630 gui_graph_handler(err);
7631 if (!err) {
7632 record_lib_command();
7633 }
7634 }
7635
7636 return err;
7637 }
7638
do_regular_boxplot(selector * sr)7639 int do_regular_boxplot (selector *sr)
7640 {
7641 const char *buf = selector_list(sr);
7642 gretlopt opt = selector_get_opts(sr);
7643 int err;
7644
7645 if (buf == NULL) {
7646 return 1;
7647 }
7648
7649 lib_command_sprintf("boxplot %s%s", buf,
7650 (opt & OPT_O)? " --notches " : "");
7651
7652 if (parse_lib_command()) {
7653 return 1;
7654 }
7655
7656 err = boxplots(libcmd.list, NULL, dataset, opt);
7657 gui_graph_handler(err);
7658
7659 if (!err) {
7660 record_lib_command();
7661 }
7662
7663 return 0;
7664 }
7665
do_factorized_boxplot(selector * sr)7666 int do_factorized_boxplot (selector *sr)
7667 {
7668 const char *buf = selector_list(sr);
7669 int err = 0;
7670
7671 if (buf == NULL) {
7672 return 1;
7673 }
7674
7675 lib_command_sprintf("boxplot %s --factorized", buf);
7676
7677 if (parse_lib_command()) {
7678 return 1;
7679 }
7680
7681 if (libcmd.list[0] != 2) {
7682 err = 1;
7683 } else if (!accept_as_discrete(dataset, libcmd.list[2], 0)) {
7684 err = 1;
7685 }
7686 if (err) {
7687 errbox(_("You must supply two variables, the second of "
7688 "which is discrete"));
7689 return err;
7690 }
7691
7692 err = boxplots(libcmd.list, NULL, dataset, OPT_Z);
7693 gui_graph_handler(err);
7694
7695 if (!err) {
7696 record_lib_command();
7697 }
7698
7699 return 0;
7700 }
7701
7702 /* X, Y scatter with separation by dummy (factor) */
7703
do_dummy_graph(selector * sr)7704 int do_dummy_graph (selector *sr)
7705 {
7706 const char *buf = selector_list(sr);
7707 int err = 0;
7708
7709 if (buf == NULL) return 1;
7710
7711 lib_command_sprintf("gnuplot %s --dummy", buf);
7712 if (parse_lib_command()) {
7713 return 1;
7714 }
7715
7716 if (libcmd.list[0] != 3) {
7717 err = 1;
7718 } else if (!accept_as_discrete(dataset,libcmd.list[3], 0)) {
7719 err = 1;
7720 }
7721 if (err) {
7722 errbox(_("You must supply three variables, the last of "
7723 "which is discrete"));
7724 return err;
7725 }
7726
7727 err = gnuplot(libcmd.list, NULL, dataset, OPT_G | OPT_Z);
7728 gui_graph_handler(err);
7729 if (!err) {
7730 record_lib_command();
7731 }
7732
7733 return 0;
7734 }
7735
7736 /* X-Y scatter, controlling for Z */
7737
do_xyz_graph(selector * sr)7738 int do_xyz_graph (selector *sr)
7739 {
7740 const char *buf = selector_list(sr);
7741 int err;
7742
7743 if (buf == NULL) return 1;
7744
7745 lib_command_sprintf("gnuplot %s --control", buf);
7746 if (parse_lib_command()) {
7747 return 1;
7748 }
7749
7750 if (libcmd.list[0] != 3) {
7751 errbox(_("You must supply three variables"));
7752 return 1;
7753 }
7754
7755 err = xy_plot_with_control(libcmd.list, NULL,
7756 dataset, OPT_NONE);
7757 gui_graph_handler(err);
7758 if (!err) {
7759 record_lib_command();
7760 }
7761
7762 return 0;
7763 }
7764
do_qq_from_selector(selector * sr)7765 int do_qq_from_selector (selector *sr)
7766 {
7767 const char *buf = selector_list(sr);
7768 int err;
7769
7770 lib_command_sprintf("qqplot%s", buf);
7771 if (parse_lib_command()) {
7772 return 1;
7773 }
7774
7775 err = qq_plot(libcmd.list, dataset, OPT_NONE);
7776 gui_graph_handler(err);
7777
7778 if (!err) {
7779 record_lib_command();
7780 }
7781
7782 return 0;
7783 }
7784
do_graph_from_selector(selector * sr)7785 int do_graph_from_selector (selector *sr)
7786 {
7787 gretlopt opt = OPT_G;
7788 const char *buf = selector_list(sr);
7789 int code = selector_code(sr);
7790 int err;
7791
7792 if (buf == NULL) return 1;
7793
7794 lib_command_sprintf("gnuplot %s", buf);
7795
7796 if (code == GR_IMP) {
7797 lib_command_strcat(" --with-impulses");
7798 opt |= OPT_M;
7799 } else if (code == GR_PLOT) {
7800 lib_command_strcat(" --time-series --with-lines");
7801 opt |= (OPT_T | OPT_O);
7802 }
7803
7804 if (parse_lib_command()) {
7805 return 1;
7806 }
7807
7808 err = gnuplot(libcmd.list, NULL, dataset, opt);
7809 gui_graph_handler(err);
7810 if (!err) {
7811 record_lib_command();
7812 }
7813
7814 return 0;
7815 }
7816
do_splot_from_selector(selector * sr)7817 int do_splot_from_selector (selector *sr)
7818 {
7819 const char *buf = selector_list(sr);
7820 gretlopt opt = selector_get_opts(sr);
7821 int *list = NULL;
7822 int err = 0;
7823
7824 list = command_list_from_string(buf, &err);
7825 if (err) {
7826 return err;
7827 }
7828
7829 err = gnuplot_3d(list, NULL, dataset, &opt);
7830
7831 if (err) {
7832 gui_errmsg(err);
7833 } else if (opt & OPT_I) {
7834 gnuplot_view_3d(gretl_plotfile());
7835 } else {
7836 register_graph();
7837 }
7838
7839 free(list);
7840
7841 return err;
7842 }
7843
list_position(int v,const int * list)7844 static int list_position (int v, const int *list)
7845 {
7846 int i;
7847
7848 for (i=list[0]; i>=1; i--) {
7849 if (v == list[i]) {
7850 return i;
7851 }
7852 }
7853
7854 return 0;
7855 }
7856
maybe_reorder_list(char * liststr,dialog_opts * opts)7857 static int maybe_reorder_list (char *liststr, dialog_opts *opts)
7858 {
7859 const char *query = _("X-axis variable");
7860 int *list;
7861 int err = 0;
7862
7863 /* note: @liststr comes from main window selection */
7864 list = gretl_list_from_varnames(liststr, dataset, &err);
7865
7866 if (err) {
7867 return err;
7868 } else {
7869 int xvar =
7870 select_var_from_list_with_opt(list, query, opts,
7871 0, NULL);
7872
7873 if (xvar < 0) {
7874 /* the user cancelled */
7875 return 1;
7876 }
7877
7878 if (xvar != list[list[0]]) {
7879 /* re-order if xvar is not in last place */
7880 int tmp = list[list[0]];
7881 int pos = list_position(xvar, list);
7882 int i;
7883
7884 list[list[0]] = xvar;
7885 list[pos] = tmp;
7886 *liststr = '\0';
7887
7888 for (i=1; i<=list[0]; i++) {
7889 strcat(liststr, " ");
7890 strcat(liststr, dataset->varname[list[i]]);
7891 }
7892 }
7893
7894 free(list);
7895 }
7896
7897 return 0;
7898 }
7899
plot_from_selection(int code)7900 void plot_from_selection (int code)
7901 {
7902 gretlopt opt = OPT_G;
7903 int pan_between = 0;
7904 int multiplot = 0;
7905 int *list = NULL;
7906 char *liststr = NULL;
7907 int n_selected = 0;
7908 int cancel = 0;
7909
7910 list = main_window_selection_as_list();
7911
7912 if (list != NULL) {
7913 int err = 0;
7914
7915 n_selected = list[0];
7916 liststr = gretl_list_to_string(list, dataset, &err);
7917 free(list);
7918 }
7919
7920 if (liststr == NULL || *liststr == '\0') {
7921 return;
7922 }
7923
7924 if (code == GR_XY) {
7925 if (multi_unit_panel_sample(dataset)) {
7926 dialog_opts *opts;
7927 const char *strs[] = {
7928 N_("Plot all data"),
7929 N_("Plot group means")
7930 };
7931 gretlopt vals[] = {
7932 OPT_NONE,
7933 OPT_B,
7934 };
7935 gretlopt popt = OPT_NONE;
7936
7937 opts = dialog_opts_new(2, OPT_TYPE_RADIO,
7938 &popt, vals, strs);
7939 cancel = maybe_reorder_list(liststr, opts);
7940 if (popt & OPT_B) {
7941 pan_between = 1;
7942 }
7943 dialog_opts_free(opts);
7944 } else if (n_selected == 2) {
7945 dialog_opts *opts;
7946 const char *strs[] = {N_("suppress fitted line")};
7947 gretlopt vals[] = {OPT_F};
7948 gretlopt popt = OPT_NONE;
7949
7950 opts = dialog_opts_new(1, OPT_TYPE_CHECK,
7951 &popt, vals, strs);
7952 cancel = maybe_reorder_list(liststr, opts);
7953 if (popt & OPT_F) {
7954 opt |= OPT_F;
7955 }
7956 dialog_opts_free(opts);
7957 } else {
7958 cancel = maybe_reorder_list(liststr, NULL);
7959 }
7960 } else if (code == GR_PLOT) {
7961 int k = mdata_selection_count();
7962
7963 if (k > 1) {
7964 const char *opts[] = {
7965 N_("on a single graph"),
7966 N_("in separate small graphs")
7967 };
7968 int ret;
7969
7970 ret = radio_dialog(_("gretl: define graph"),
7971 _("Plot the series"),
7972 opts, 2, 0, 0, NULL);
7973 if (ret < 0) {
7974 cancel = 1;
7975 } else if (ret == 0) {
7976 opt |= (OPT_T | OPT_O);
7977 } else if (ret == 1) {
7978 multiplot = 1;
7979 opt |= OPT_O;
7980 }
7981 } else {
7982 opt |= (OPT_T | OPT_O);
7983 }
7984 }
7985
7986 if (!cancel) {
7987 int err;
7988
7989 if (multiplot) {
7990 lib_command_sprintf("scatters %s --with-lines", liststr);
7991 } else {
7992 /* FIXME pan_between and CLI? */
7993 lib_command_sprintf("gnuplot%s%s", liststr,
7994 (code == GR_PLOT)? " --time-series --with-lines" : "");
7995 if (opt & OPT_F) {
7996 lib_command_strcat(" --fit=none");
7997 }
7998
7999 }
8000
8001 err = parse_lib_command();
8002
8003 if (!err) {
8004 if (multiplot) {
8005 err = multi_scatters(libcmd.list, dataset, opt);
8006 } else if (pan_between) {
8007 err = panel_means_XY_scatter(libcmd.list, dataset, opt);
8008 } else {
8009 if (opt & OPT_F) {
8010 set_optval_string(GNUPLOT, OPT_F, "none");
8011 }
8012 err = gnuplot(libcmd.list, NULL, dataset, opt);
8013 }
8014 gui_graph_handler(err);
8015 if (!err && !pan_between) {
8016 record_lib_command();
8017 }
8018 }
8019 }
8020
8021 free(liststr);
8022 }
8023
all_missing(int v)8024 static int all_missing (int v)
8025 {
8026 int t, os = 0;
8027
8028 for (t=0; t<dataset->n; t++) {
8029 if (!na(dataset->Z[v][t])) {
8030 if (t >= dataset->t1 && t <= dataset->t2) {
8031 return 0;
8032 } else {
8033 os++;
8034 }
8035 }
8036 }
8037
8038 if (os > 0) {
8039 warnbox_printf(_("%s: no valid values in current sample"),
8040 dataset->varname[v]);
8041 } else {
8042 warnbox_printf(_("%s: no valid values"), dataset->varname[v]);
8043 }
8044
8045 return 1;
8046 }
8047
display_var(void)8048 void display_var (void)
8049 {
8050 int list[2];
8051 PRN *prn;
8052 int n, v = mdata_active_var();
8053 int err = 0;
8054
8055 if (all_missing(v)) {
8056 return;
8057 }
8058
8059 list[0] = 1;
8060 list[1] = v;
8061 n = sample_size(dataset);
8062
8063 if (n > MAXDISPLAY) {
8064 warnbox_printf(_("Too many data values (%d) for display.\n"
8065 "You might try limiting the sample range."),
8066 n);
8067 return;
8068 }
8069
8070 err = bufopen(&prn);
8071 if (!err) {
8072 err = printdata(list, NULL, dataset, OPT_O, prn);
8073 if (err) {
8074 gui_errmsg(err);
8075 gretl_print_destroy(prn);
8076 }
8077 }
8078
8079 if (!err) {
8080 windata_t *vwin;
8081
8082 vwin = view_buffer(prn, 36, 400, dataset->varname[v],
8083 VIEW_SERIES, NULL);
8084 series_view_connect(vwin, v);
8085 }
8086 }
8087
midas_list_callback(const int * list,const char * listname,int ci)8088 void midas_list_callback (const int *list,
8089 const char *listname,
8090 int ci)
8091 {
8092 int err = 0;
8093
8094 if (list == NULL) {
8095 list = get_list_by_name(listname);
8096 if (list == NULL) {
8097 /* "can't happen" */
8098 errbox("Couldn't find the specified MIDAS list");
8099 return;
8100 }
8101 }
8102
8103 if (ci == PRINT) {
8104 char *p, title[VNAMELEN];
8105 PRN *prn;
8106
8107 if (bufopen(&prn)) {
8108 return;
8109 }
8110 err = printdata(list, NULL, dataset, OPT_M, prn);
8111 if (err) {
8112 gui_errmsg(err);
8113 gretl_print_destroy(prn);
8114 } else {
8115 if (listname != NULL) {
8116 strcpy(title, listname);
8117 } else {
8118 strcpy(title, dataset->varname[list[1]]);
8119 p = strrchr(title, '_');
8120 if (p != NULL) *p = '\0';
8121 }
8122 view_buffer(prn, 36, 400, title, PRINT, NULL);
8123 }
8124 } else if (ci == PLOT) {
8125 err = hf_plot(list, NULL, dataset, OPT_G | OPT_O);
8126 gui_graph_handler(err);
8127 } else {
8128 dummy_call();
8129 }
8130 }
8131
8132 static int suppress_logo;
8133
send_output_to_kid(windata_t * kid,PRN * prn)8134 static void send_output_to_kid (windata_t *kid, PRN *prn)
8135 {
8136 const char *txt = gretl_print_get_buffer(prn);
8137
8138 textview_append_text_colorized(kid->text, txt, 0);
8139 gretl_print_destroy(prn);
8140 }
8141
8142 static int script_wait;
8143
waiting_for_output(void)8144 int waiting_for_output (void)
8145 {
8146 return script_wait;
8147 }
8148
8149 /* struct to handle "flush" in the course of script execution: this
8150 may occur when we're executing a (time consuming) script in the
8151 "normal" way, or when the user calls a function from a function
8152 package via the GUI
8153 */
8154
8155 struct output_handler {
8156 PRN *prn; /* printer to which output is going */
8157 windata_t *vwin; /* output window */
8158 gulong handler_id; /* signal ID for @vwin */
8159 int flushing; /* is the writer using "flush"? 1/0 */
8160 int stopped; /* flag for premature termination */
8161 int reusable; /* is @vwin a reusable viewer? 1/0 */
8162 };
8163
8164 static struct output_handler oh;
8165
8166 /* done with busy spinner */
8167
stop_wait_for_output(GtkWidget * w,gpointer p)8168 static void stop_wait_for_output (GtkWidget *w, gpointer p)
8169 {
8170 gdk_flush();
8171 script_wait = 0;
8172 maybe_sensitize_iconview();
8173 }
8174
8175 /* Start a spinner as visual indication that there's
8176 something going on: the argument @w should be of
8177 type GTK_BOX, into which a spinner may be packed.
8178 */
8179
start_wait_for_output(windata_t * vwin,GtkWidget * w)8180 void start_wait_for_output (windata_t *vwin, GtkWidget *w)
8181 {
8182 GtkWidget *spinner;
8183
8184 g_return_if_fail(GTK_IS_BOX(w));
8185
8186 spinner = gtk_spinner_new();
8187 gtk_widget_set_size_request(spinner, 24, 24);
8188 gtk_box_pack_end(GTK_BOX(w), spinner, FALSE, FALSE, 5);
8189 gtk_widget_show(spinner);
8190 gtk_spinner_start(GTK_SPINNER(spinner));
8191 script_wait = 1;
8192
8193 if (GTK_IS_TEXT_VIEW(vwin->text)) {
8194 /* @vwin is a reusable output window */
8195 if (get_script_output_policy() == OUTPUT_POLICY_REPLACE) {
8196 textview_set_text(vwin->text, NULL);
8197 }
8198 gretl_viewer_present(vwin);
8199 }
8200
8201 g_signal_connect(G_OBJECT(spinner), "destroy",
8202 G_CALLBACK(stop_wait_for_output),
8203 NULL);
8204
8205 while (gtk_events_pending()) {
8206 gtk_main_iteration();
8207 }
8208 }
8209
clear_output_handler(void)8210 static void clear_output_handler (void)
8211 {
8212 if (oh.vwin != NULL) {
8213 maybe_view_session();
8214 g_signal_handler_disconnect(G_OBJECT(oh.vwin->main),
8215 oh.handler_id);
8216 }
8217
8218 oh.prn = NULL;
8219 oh.vwin = NULL;
8220 oh.handler_id = 0;
8221 oh.flushing = 0;
8222 oh.stopped = 0;
8223 oh.reusable = 0;
8224 }
8225
output_handler_is_free(void)8226 static int output_handler_is_free (void)
8227 {
8228 return oh.prn == NULL;
8229 }
8230
block_deletion(GtkWidget * w,GdkEvent * event,gpointer p)8231 static gint block_deletion (GtkWidget *w, GdkEvent *event, gpointer p)
8232 {
8233 return TRUE;
8234 }
8235
8236 /* When we're in the process of "flushing" (a time-
8237 consuming script is sending output to a window
8238 incrementally) we must ensure that the output window
8239 doesn't get closed prematurely (?)
8240 */
8241
output_handler_block_deletion(void)8242 static void output_handler_block_deletion (void)
8243 {
8244 oh.handler_id =
8245 g_signal_connect(G_OBJECT(oh.vwin->main),
8246 "delete-event",
8247 G_CALLBACK(block_deletion),
8248 NULL);
8249 }
8250
handle_flush_callback(gretlopt opt)8251 static void handle_flush_callback (gretlopt opt)
8252 {
8253 if (oh.vwin != NULL) {
8254 /* we have a "flushable" window in place */
8255 char *buf = gretl_print_get_chunk(oh.prn);
8256
8257 textview_delete_processing_message(oh.vwin->text);
8258 textview_append_text_colorized(oh.vwin->text, buf, 0);
8259 free(buf);
8260 if (opt & OPT_F) {
8261 /* finalize */
8262 if (oh.flushing) {
8263 scroll_to_foot(oh.vwin);
8264 }
8265 gretl_print_destroy(oh.prn);
8266 } else {
8267 /* prepare for another chunk of output */
8268 if (!(opt & OPT_Q)) {
8269 textview_add_processing_message(oh.vwin->text);
8270 }
8271 gretl_print_set_save_position(oh.prn);
8272 oh.flushing = 1;
8273 }
8274 /* ensure that the GUI gets updated */
8275 while (gtk_events_pending()) {
8276 gtk_main_iteration();
8277 }
8278 }
8279 }
8280
vwin_is_busy(windata_t * vwin)8281 int vwin_is_busy (windata_t *vwin)
8282 {
8283 return vwin != NULL && vwin == oh.vwin;
8284 }
8285
start_script_output_handler(PRN * prn,int role,const char * title,windata_t ** outwin)8286 static int start_script_output_handler (PRN *prn, int role,
8287 const char *title,
8288 windata_t **outwin)
8289 {
8290 int err = 0;
8291
8292 if (!output_handler_is_free()) {
8293 /* we're messed up! */
8294 errbox("Script already running?!");
8295 err = 1;
8296 } else {
8297 windata_t *vwin;
8298
8299 if (outwin != NULL && *outwin != NULL) {
8300 /* using an existing viewer */
8301 oh.reusable = 1;
8302 vwin = *outwin;
8303 vwin_add_tmpbar(vwin);
8304 } else {
8305 /* new viewer needed */
8306 vwin = hansl_output_viewer_new(prn, role, title);
8307 if (vwin == NULL) {
8308 err = E_ALLOC;
8309 }
8310 }
8311
8312 if (!err) {
8313 oh.prn = prn;
8314 oh.vwin = vwin;
8315 gretl_print_set_save_position(oh.prn);
8316 if (outwin != NULL && *outwin == NULL) {
8317 *outwin = vwin;
8318 }
8319 output_handler_block_deletion();
8320 }
8321 }
8322
8323 return err;
8324 }
8325
finalize_script_output_window(int role,gpointer data)8326 void finalize_script_output_window (int role, gpointer data)
8327 {
8328 if (oh.vwin != NULL) {
8329 handle_flush_callback(OPT_F);
8330 if (oh.stopped) {
8331 gtk_widget_destroy(oh.vwin->main);
8332 oh.vwin = NULL;
8333 } else {
8334 if (role > 0) {
8335 oh.vwin->role = role;
8336 }
8337 if (data != NULL) {
8338 oh.vwin->data = data;
8339 }
8340 vwin_add_viewbar(oh.vwin, VIEWBAR_HAS_TEXT);
8341 }
8342 }
8343
8344 clear_output_handler();
8345 }
8346
finalize_reusable_output_window(windata_t * vwin)8347 void finalize_reusable_output_window (windata_t *vwin)
8348 {
8349 handle_flush_callback(OPT_F);
8350 vwin_reinstate_toolbar(vwin);
8351 clear_output_handler();
8352 }
8353
maybe_stop_script(GtkWidget * parent)8354 static int maybe_stop_script (GtkWidget *parent)
8355 {
8356 int resp, stop = 0;
8357
8358 if (oh.vwin != NULL) {
8359 gtk_widget_hide(oh.vwin->main);
8360 }
8361
8362 resp = yes_no_dialog(_("gretl: open data"),
8363 _("Opening a new data file will automatically\n"
8364 "close the current one. Any unsaved work\n"
8365 "will be lost. Proceed to open data file?"),
8366 parent);
8367
8368 if (resp == GRETL_YES) {
8369 if (oh.vwin != NULL) {
8370 gretl_viewer_present(oh.vwin);
8371 }
8372 } else {
8373 stop = 1;
8374 oh.stopped = 1;
8375 }
8376
8377 return stop;
8378 }
8379
already_running_script(void)8380 static int already_running_script (void)
8381 {
8382 if (gui_main_exec) {
8383 warnbox(_("There's a script already running"));
8384 return 1;
8385 } else {
8386 return 0;
8387 }
8388 }
8389
8390 /* Execute a script from the buffer in viewer window @vwin */
8391
run_native_script(windata_t * vwin,gchar * buf,int silent)8392 static void run_native_script (windata_t *vwin, gchar *buf,
8393 int silent)
8394 {
8395 int policy = get_script_output_policy();
8396 GtkWidget *parent;
8397 windata_t *targ = NULL;
8398 PRN *prn = NULL;
8399 int save_batch;
8400 int untmp = 0;
8401 int err;
8402
8403 if (already_running_script()) {
8404 return;
8405 }
8406
8407 if (silent) {
8408 goto do_exec;
8409 }
8410
8411 if (policy != OUTPUT_POLICY_NEW_WINDOW) {
8412 /* check for an existing output window */
8413 targ = get_unique_output_viewer();
8414 }
8415
8416 if (targ != NULL && policy == OUTPUT_POLICY_UNSET) {
8417 /* ask the user to choose a policy */
8418 policy = output_policy_dialog(vwin, targ, 0);
8419 if (policy == OUTPUT_POLICY_NEW_WINDOW) {
8420 targ = NULL;
8421 }
8422 }
8423
8424 if (bufopen(&prn)) {
8425 return;
8426 }
8427
8428 #if 0
8429 fprintf(stderr, "run_native_script: policy=%d, targ=%p\n",
8430 policy, (void *) targ);
8431 #endif
8432
8433 if (targ == NULL) {
8434 /* there's no pre-existing output window */
8435 err = start_script_output_handler(prn, SCRIPT_OUT,
8436 NULL, NULL);
8437 if (err) {
8438 gretl_print_destroy(prn);
8439 return;
8440 }
8441 } else {
8442 set_reuseable_output_window(policy, targ);
8443 start_script_output_handler(prn, SCRIPT_OUT,
8444 NULL, &targ);
8445 untmp = 1;
8446 }
8447
8448 do_exec:
8449
8450 parent = vwin_toplevel(vwin);
8451 save_batch = gretl_in_batch_mode();
8452 gui_main_exec = 1;
8453 err = execute_script(NULL, buf, prn, SCRIPT_EXEC, parent);
8454 gui_main_exec = 0;
8455 gretl_set_batch_mode(save_batch);
8456
8457 refresh_data();
8458
8459 if (silent) {
8460 set_gretl_echo(1);
8461 gtk_widget_destroy(vwin_toplevel(vwin));
8462 return;
8463 }
8464
8465 if (oh.vwin != NULL) {
8466 if (untmp) {
8467 finalize_reusable_output_window(targ);
8468 } else {
8469 finalize_script_output_window(0, NULL);
8470 }
8471 } else {
8472 view_buffer(prn, SCRIPT_WIDTH, 450, NULL, SCRIPT_OUT, NULL);
8473 if (untmp) {
8474 /* not reachable any more? */
8475 finalize_reusable_output_window(targ);
8476 }
8477 }
8478
8479 if (!err && vwin->role != EDIT_PKG_SAMPLE &&
8480 vwin->role != VIEW_PKG_SAMPLE &&
8481 *vwin->fname != '\0' && !strstr(vwin->fname, "script_tmp")) {
8482 mkfilelist(FILE_LIST_SCRIPT, vwin->fname, 0);
8483 lib_command_sprintf("run %s", vwin->fname);
8484 record_command_verbatim();
8485 }
8486
8487 /* re-establish command echo (?) */
8488 set_gretl_echo(1);
8489 }
8490
run_script_fragment(windata_t * vwin,gchar * buf)8491 void run_script_fragment (windata_t *vwin, gchar *buf)
8492 {
8493 windata_t *kid = vwin_first_child(vwin);
8494 GtkWidget *parent;
8495 PRN *prn;
8496 int save_batch;
8497
8498 if (already_running_script()) {
8499 return;
8500 }
8501
8502 if (bufopen(&prn)) {
8503 return;
8504 }
8505
8506 if (kid != NULL) {
8507 suppress_logo = 1;
8508 parent = vwin_toplevel(kid);
8509 } else {
8510 parent = vwin_toplevel(vwin);
8511 }
8512
8513 save_batch = gretl_in_batch_mode();
8514 gui_main_exec = 1;
8515 execute_script(NULL, buf, prn, SCRIPT_EXEC, parent);
8516 gui_main_exec = 0;
8517 gretl_set_batch_mode(save_batch);
8518
8519 refresh_data();
8520 suppress_logo = 0;
8521
8522 if (kid != NULL) {
8523 send_output_to_kid(kid, prn);
8524 } else {
8525 view_buffer(prn, SCRIPT_WIDTH, 450, NULL, SCRIPT_OUT, vwin);
8526 }
8527
8528 /* re-establish command echo (?) */
8529 set_gretl_echo(1);
8530 }
8531
exec_line_with_output_handler(ExecState * s,DATASET * dset,const char * title,windata_t ** outwin)8532 int exec_line_with_output_handler (ExecState *s,
8533 DATASET *dset,
8534 const char *title,
8535 windata_t **outwin)
8536 {
8537 int err;
8538
8539 err = start_script_output_handler(s->prn, FNCALL_OUT,
8540 title, outwin);
8541
8542 if (!err) {
8543 GtkWidget *parent = mdata->main;
8544
8545 if (outwin != NULL && *outwin != NULL) {
8546 parent = vwin_toplevel(*outwin);
8547 }
8548
8549 err = gui_exec_line(s, dataset, parent);
8550 }
8551
8552 return err;
8553 }
8554
run_R_script(gchar * buf,GtkWidget * parent)8555 static void run_R_script (gchar *buf, GtkWidget *parent)
8556 {
8557 const char *opts[] = {
8558 N_("Non-interactive (just get output)"),
8559 N_("Interactive R session")
8560 };
8561 int send_data = data_status;
8562 int resp;
8563
8564 if (send_data) {
8565 resp = radio_dialog_with_check("gretl: R", _("R mode"),
8566 opts, 2, 0, 0,
8567 &send_data, _("pre-load data"),
8568 parent);
8569 } else {
8570 resp = radio_dialog("gretl: R", _("R mode"), opts, 2, 0, 0,
8571 parent);
8572 }
8573
8574 /* resp: 0 -> non-interactive; 1 -> interactive */
8575
8576 if (!canceled(resp)) {
8577 start_R(buf, send_data, resp);
8578 }
8579 }
8580
ensure_newline_termination(gchar ** ps)8581 static void ensure_newline_termination (gchar **ps)
8582 {
8583 gchar *s = *ps;
8584
8585 if (s[strlen(s)-1] != '\n') {
8586 gchar *tmp = g_strdup_printf("%s\n", s);
8587
8588 g_free(s);
8589 *ps = tmp;
8590 }
8591 }
8592
8593 /* Call the lpsolve library to solve the linear program in @buf. If
8594 successful, put the lpsolve output into a window and attach the
8595 output bundle: this will contain various key results that can be
8596 saved in scalar or matrix form.
8597
8598 The @opt argument is currently unused; I'm not yet sure if there's
8599 any valid/interesting use for it.
8600 */
8601
call_lpsolve_function(gchar * buf,const char * fname,gretlopt opt)8602 static void call_lpsolve_function (gchar *buf, const char *fname,
8603 gretlopt opt)
8604 {
8605 gretl_bundle *(*lpf) (gretl_bundle *, PRN *, int *);
8606 gretl_bundle *b_inp, *b_out;
8607 PRN *prn = NULL;
8608 int err = 0;
8609
8610 lpf = gui_get_plugin_function("gretl_lpsolve");
8611 if (lpf == NULL) {
8612 return;
8613 }
8614
8615 b_inp = gretl_bundle_new();
8616 if (b_inp == NULL) {
8617 gui_errmsg(E_ALLOC);
8618 return;
8619 }
8620
8621 if (bufopen(&prn)) {
8622 gretl_bundle_destroy(b_inp);
8623 return;
8624 }
8625
8626 gretl_bundle_set_string(b_inp, "lp_buffer", buf);
8627 gretl_bundle_set_int(b_inp, "verbose", 1);
8628 if (*fname != '\0' && strstr(fname, "script_tmp") == NULL) {
8629 char *tmp = gretl_basename(NULL, fname, 0);
8630 char *s = strstr(tmp, ".lp");
8631
8632 if (s != NULL) {
8633 *s = '\0';
8634 }
8635 gretl_bundle_set_string(b_inp, "model_name", tmp);
8636 free(tmp);
8637 } else {
8638 gretl_bundle_set_string(b_inp, "model_name", "untitled");
8639 }
8640 b_out = lpf(b_inp, prn, &err);
8641
8642 if (err) {
8643 gretl_bundle_destroy(b_out);
8644 gui_errmsg(err);
8645 } else {
8646 view_buffer(prn, 84, 480, "lpsolve output", VIEW_BUNDLE, b_out);
8647 }
8648
8649 gretl_bundle_destroy(b_inp);
8650 }
8651
real_run_script(GtkWidget * w,windata_t * vwin,int silent)8652 static void real_run_script (GtkWidget *w, windata_t *vwin,
8653 int silent)
8654 {
8655 gretlopt opt = OPT_NONE;
8656 gboolean selection = FALSE;
8657 gchar *prev_workdir = NULL;
8658 gchar *currdir = NULL;
8659 gchar *buf = NULL;
8660
8661 if (vwin->role == EDIT_GP ||
8662 vwin->role == EDIT_R ||
8663 vwin->role == EDIT_OX ||
8664 vwin->role == EDIT_OCTAVE ||
8665 vwin->role == EDIT_PYTHON ||
8666 vwin->role == EDIT_JULIA ||
8667 vwin->role == EDIT_DYNARE ||
8668 vwin->role == EDIT_LPSOLVE ||
8669 vwin->role == EDIT_STATA ||
8670 vwin->role == EDIT_X12A) {
8671 buf = textview_get_text(vwin->text);
8672 } else if (vwin->role == EDIT_PKG_SAMPLE) {
8673 buf = package_sample_get_script(vwin);
8674 } else {
8675 buf = textview_get_selection_or_all(vwin->text, &selection);
8676 }
8677
8678 if (buf == NULL || *buf == '\0') {
8679 warnbox("No commands to execute");
8680 if (buf != NULL) {
8681 g_free(buf);
8682 }
8683 return;
8684 }
8685
8686 if (vwin->fname[0] != '\0' &&
8687 strstr(vwin->fname, "script_tmp") == NULL &&
8688 g_path_is_absolute(vwin->fname)) {
8689 /* There's a "real" full filename in place */
8690 if (editing_alt_script(vwin->role)) {
8691 /* For an "alt" script we'll temporarily reset
8692 workdir to its location so we're able to pick up
8693 any data files it may reference. We'll also arrange
8694 to revert the working directory once we're done.
8695 */
8696 gchar *dname = g_path_get_dirname(vwin->fname);
8697
8698 currdir = g_get_current_dir();
8699 prev_workdir = g_strdup(gretl_workdir());
8700 gretl_set_path_by_name("workdir", dname);
8701 gretl_chdir(dname);
8702 g_free(dname);
8703 } else if (vwin->role != EDIT_GP && vwin->role != EDIT_PKG_SAMPLE) {
8704 /* native script */
8705 gretl_set_script_dir(vwin->fname);
8706 }
8707 }
8708
8709 if (vwin->role != EDIT_PKG_SAMPLE) {
8710 ensure_newline_termination(&buf);
8711 }
8712
8713 if (vwin->role == EDIT_DYNARE) {
8714 opt = OPT_Y;
8715 }
8716
8717 if (vwin->role == EDIT_GP) {
8718 run_gnuplot_script(buf, vwin);
8719 } else if (vwin->role == EDIT_R) {
8720 run_R_script(buf, vwin_toplevel(vwin));
8721 } else if (vwin->role == EDIT_OX) {
8722 run_foreign_script(buf, LANG_OX, opt);
8723 } else if (vwin->role == EDIT_OCTAVE) {
8724 run_foreign_script(buf, LANG_OCTAVE, opt);
8725 } else if (vwin->role == EDIT_PYTHON) {
8726 run_foreign_script(buf, LANG_PYTHON, opt);
8727 } else if (vwin->role == EDIT_JULIA) {
8728 run_foreign_script(buf, LANG_JULIA, opt);
8729 } else if (vwin->role == EDIT_DYNARE) {
8730 run_foreign_script(buf, LANG_OCTAVE, opt);
8731 } else if (vwin->role == EDIT_LPSOLVE) {
8732 call_lpsolve_function(buf, vwin->fname, opt);
8733 } else if (vwin->role == EDIT_STATA) {
8734 run_foreign_script(buf, LANG_STATA, opt);
8735 } else if (vwin->role == EDIT_X12A) {
8736 run_x12a_script(buf);
8737 } else if (selection) {
8738 run_script_fragment(vwin, buf);
8739 } else {
8740 run_native_script(vwin, buf, silent);
8741 }
8742
8743 g_free(buf);
8744
8745 if (prev_workdir != NULL) {
8746 gretl_set_path_by_name("workdir", prev_workdir);
8747 g_free(prev_workdir);
8748 }
8749 if (currdir != NULL) {
8750 gretl_chdir(currdir);
8751 g_free(currdir);
8752 }
8753 }
8754
do_run_script(GtkWidget * w,windata_t * vwin)8755 void do_run_script (GtkWidget *w, windata_t *vwin)
8756 {
8757 real_run_script(w, vwin, 0);
8758 }
8759
run_script_silent(GtkWidget * w,windata_t * vwin)8760 void run_script_silent (GtkWidget *w, windata_t *vwin)
8761 {
8762 real_run_script(w, vwin, 1);
8763 }
8764
do_open_script(int action)8765 gboolean do_open_script (int action)
8766 {
8767 char *fname = get_tryfile();
8768 int err = gretl_test_fopen(fname, "r");
8769
8770 if (err) {
8771 file_read_errbox(fname);
8772 if (action == EDIT_HANSL) {
8773 delete_from_filelist(FILE_LIST_SESSION, fname);
8774 delete_from_filelist(FILE_LIST_SCRIPT, fname);
8775 }
8776 return FALSE;
8777 }
8778
8779 if (action == EDIT_HANSL) {
8780 strcpy(scriptfile, fname);
8781 mkfilelist(FILE_LIST_SCRIPT, scriptfile, 1);
8782 gretl_set_script_dir(scriptfile);
8783 if (has_system_prefix(scriptfile, SCRIPT_SEARCH)) {
8784 view_script(scriptfile, 0, VIEW_SCRIPT);
8785 } else {
8786 view_script(scriptfile, 1, EDIT_HANSL);
8787 }
8788 } else {
8789 view_script(fname, 1, action);
8790 }
8791
8792 return TRUE;
8793 }
8794
do_new_script(int code,const char * buf)8795 void do_new_script (int code, const char *buf)
8796 {
8797 int action = (code == FUNC)? EDIT_HANSL : code;
8798 windata_t *vwin;
8799 char temp[MAXLEN];
8800 FILE *fp;
8801
8802 sprintf(temp, "%sscript_tmp", gretl_dotdir());
8803 fp = gretl_tempfile_open(temp);
8804 if (fp == NULL) {
8805 return;
8806 }
8807
8808 if (buf != NULL) {
8809 fputs(buf, fp);
8810 } else if (code == FUNC) {
8811 fputs("function \n\nend function\n", fp);
8812 } else if (code == EDIT_OX) {
8813 fputs("#include <oxstd.h>\n\n", fp);
8814 fputs("main()\n{\n\n}\n", fp);
8815 }
8816
8817 fclose(fp);
8818
8819 if (action == EDIT_HANSL) {
8820 strcpy(scriptfile, temp);
8821 }
8822
8823 vwin = view_file(temp, 1, 1, SCRIPT_WIDTH, SCRIPT_HEIGHT, action);
8824
8825 if (buf != NULL && *buf != '\0') {
8826 mark_vwin_content_changed(vwin);
8827 }
8828 }
8829
new_script_callback(GtkAction * action)8830 void new_script_callback (GtkAction *action)
8831 {
8832 const gchar *s = gtk_action_get_name(action);
8833 int etype = EDIT_HANSL;
8834
8835 if (!strcmp(s, "GnuplotScript")) {
8836 etype = EDIT_GP;
8837 } else if (!strcmp(s, "RScript")) {
8838 etype = EDIT_R;
8839 } else if (!strcmp(s, "OxScript")) {
8840 etype = EDIT_OX;
8841 } else if (!strcmp(s, "OctaveScript")) {
8842 etype = EDIT_OCTAVE;
8843 } else if (!strcmp(s, "PyScript")) {
8844 etype = EDIT_PYTHON;
8845 } else if (!strcmp(s, "StataScript")) {
8846 etype = EDIT_STATA;
8847 } else if (!strcmp(s, "JuliaScript")) {
8848 etype = EDIT_JULIA;
8849 } else if (!strcmp(s, "DynareScript")) {
8850 etype = EDIT_DYNARE; /* FIXME not reached */
8851 } else if (!strcmp(s, "lpsolveScript")) {
8852 etype = EDIT_LPSOLVE;
8853 }
8854
8855 do_new_script(etype, NULL);
8856 }
8857
maybe_display_string_table(void)8858 void maybe_display_string_table (void)
8859 {
8860 static int s_table_waiting;
8861
8862 if (gretl_string_table_written() || s_table_waiting) {
8863 char stname[MAXLEN];
8864
8865 if (mdata == NULL) {
8866 s_table_waiting = 1;
8867 return;
8868 }
8869
8870 s_table_waiting = 0;
8871 gretl_build_path(stname, gretl_workdir(), "string_table.txt", NULL);
8872 view_file(stname, 0, 0, 78, 350, VIEW_FILE);
8873 }
8874 }
8875
maybe_restore_full_data(int action)8876 int maybe_restore_full_data (int action)
8877 {
8878 if (dataset_is_subsampled(dataset)) {
8879 int r = GRETL_CANCEL;
8880
8881 if (action == SAVE_DATA) {
8882 r = yes_no_cancel_dialog(_("gretl: save data"),
8883 _("The data set is currently sub-sampled.\n"
8884 "Would you like to restore the full range?"),
8885 NULL);
8886 } else if (action == COMPACT) {
8887 r = yes_no_cancel_dialog(_("gretl: Compact data"),
8888 _("The data set is currently sub-sampled.\n"
8889 "You must restore the full range before compacting.\n"
8890 "Restore the full range now?"), NULL);
8891 } else if (action == EXPAND) {
8892 r = yes_no_cancel_dialog(_("gretl: Expand data"),
8893 _("The data set is currently sub-sampled.\n"
8894 "You must restore the full range before expanding.\n"
8895 "Restore the full range now?"), NULL);
8896 }
8897
8898 if (r == GRETL_YES) {
8899 gui_restore_sample(dataset);
8900 } else if (r == GRETL_CANCEL || action == COMPACT || action == EXPAND) {
8901 return 1;
8902 }
8903 }
8904
8905 return 0;
8906 }
8907
gui_transpose_data(void)8908 void gui_transpose_data (void)
8909 {
8910 int resp;
8911
8912 resp = yes_no_dialog(_("gretl: transpose data"),
8913 _("Transposing means that each variable becomes interpreted\n"
8914 "as an observation, and each observation as a variable.\n"
8915 "Do you want to proceed?"),
8916 NULL);
8917
8918 if (resp == GRETL_YES) {
8919 int err = transpose_data(dataset);
8920
8921 if (err) {
8922 gui_errmsg(err);
8923 } else {
8924 mark_dataset_as_modified();
8925 populate_varlist();
8926 infobox(_("Data transposed"));
8927 }
8928 }
8929 }
8930
gui_sort_data(void)8931 void gui_sort_data (void)
8932 {
8933 int *list = NULL;
8934 int nv = 0;
8935
8936 list = full_var_list(dataset, &nv);
8937
8938 if (nv == 0) {
8939 errbox("No suitable variables");
8940 } else if (list == NULL) {
8941 nomem();
8942 } else {
8943 dialog_opts *opts;
8944 const char *strs[] = {
8945 N_("Ascending"),
8946 N_("Descending")
8947 };
8948 gretlopt vals[] = {
8949 OPT_NONE,
8950 OPT_D
8951 };
8952 gretlopt opt = vals[0];
8953 int v, err = 0;
8954
8955 opts = dialog_opts_new(2, OPT_TYPE_RADIO,
8956 &opt, vals, strs);
8957 if (opts == NULL) {
8958 free(list);
8959 return;
8960 }
8961
8962 v = select_var_from_list_with_opt(list, _("Select sort key"),
8963 opts, DATASORT, NULL);
8964 if (v > 0) {
8965 int list[] = { 1, v };
8966
8967 err = dataset_sort_by(dataset, list, opt);
8968 if (err) {
8969 gui_errmsg(err);
8970 } else {
8971 mark_dataset_as_modified();
8972 }
8973 }
8974 dialog_opts_free(opts);
8975 free(list);
8976 }
8977 }
8978
gui_resample_data(void)8979 void gui_resample_data (void)
8980 {
8981 gchar *title = gretl_window_title(_("resample dataset"));
8982 int resp, n = dataset->n;
8983
8984 resp = spin_dialog(title, _("Resampling with replacement"),
8985 &n, _("Number of cases"),
8986 1, 1000000, 0, NULL);
8987 g_free(title);
8988
8989 if (!canceled(resp)) {
8990 gchar *nstr = g_strdup_printf("%d", n);
8991 int err;
8992
8993 err = modify_dataset(dataset, DS_RESAMPLE, NULL, nstr,
8994 OPT_NONE, NULL);
8995 if (err) {
8996 gui_errmsg(err);
8997 } else {
8998 mark_dataset_as_modified();
8999 }
9000 g_free(nstr);
9001 }
9002 }
9003
db_write_response(const char * filename,const int * list)9004 static int db_write_response (const char *filename, const int *list)
9005 {
9006 gchar *msg;
9007 int resp, ret = 0;
9008
9009 msg = g_strdup_printf("%s\n%s", gretl_errmsg_get(),
9010 _("OK to overwrite?"));
9011
9012 resp = yes_no_dialog("gretl", msg, NULL);
9013
9014 if (resp == GRETL_NO) {
9015 ret = 1;
9016 } else {
9017 ret = write_db_data(filename, list, OPT_F, dataset);
9018 }
9019
9020 g_free(msg);
9021
9022 return ret;
9023 }
9024
9025 #define WRITING_DB(o) (o & OPT_D)
9026
shrink_dataset_to_sample(void)9027 static int shrink_dataset_to_sample (void)
9028 {
9029 int err;
9030
9031 if (complex_subsampled()) {
9032 maybe_free_full_dataset(dataset);
9033 }
9034
9035 err = dataset_shrink_obs_range(dataset);
9036 if (err) {
9037 gui_errmsg(err);
9038 }
9039
9040 restore_sample_state(FALSE);
9041
9042 return err;
9043 }
9044
maybe_shrink_dataset(const char * newname,int action)9045 static int maybe_shrink_dataset (const char *newname,
9046 int action)
9047 {
9048 int shrink = 0;
9049 int resp;
9050
9051 if (datafile == newname || !strcmp(datafile, newname)) {
9052 shrink = 1;
9053 } else {
9054 resp = yes_no_dialog(_("gretl: revised data set"),
9055 _("You have saved a reduced version of the current data set.\n"
9056 "Do you want to switch to the reduced version now?"),
9057 NULL);
9058 shrink = (resp == GRETL_YES);
9059 }
9060
9061 if (shrink) {
9062 if (dataset_is_subsampled(dataset)) {
9063 shrink_dataset_to_sample();
9064 if (action == SAVE_MAP) {
9065 dataset_set_mapfile(dataset, newname);
9066 }
9067 }
9068 if (datafile != newname) {
9069 strcpy(datafile, newname);
9070 }
9071 }
9072
9073 return shrink;
9074 }
9075
maybe_back_up_datafile(const char * fname)9076 static int maybe_back_up_datafile (const char *fname)
9077 {
9078 FILE *fp = gretl_fopen(fname, "rb");
9079 int err = 0;
9080
9081 if (fp != NULL) {
9082 if (fgetc(fp) != EOF) {
9083 /* the file is not empty */
9084 gchar *backup = g_strdup_printf("%s~", fname);
9085
9086 fclose(fp);
9087 err = copyfile(fname, backup);
9088 g_free(backup);
9089 } else {
9090 fclose(fp);
9091 }
9092 }
9093
9094 return err;
9095 }
9096
give_compat_warning(void)9097 static void give_compat_warning (void)
9098 {
9099 const char *msg =
9100 N_("Data files written in the current gdtb binary format\n"
9101 "cannot be read by gretl versions older than 2020b");
9102
9103 warnbox(_(msg));
9104 }
9105
9106 /* Note that in this context "exporting" means that we're saving
9107 a file that is not necessarily synced with the current dataset
9108 in memory (e.g. it may contain a subset of the currently defined
9109 series). The "export" may or may not be in a foreign data
9110 format.
9111 */
9112
store_action_to_opt(const char * fname,int action,int * exporting,int * cancel)9113 static gretlopt store_action_to_opt (const char *fname, int action,
9114 int *exporting, int *cancel)
9115 {
9116 gretlopt opt = OPT_NONE;
9117 int err = 0;
9118
9119 *exporting = 1;
9120
9121 switch (action) {
9122 case AUTO_SAVE_DATA:
9123 case SAVE_DATA:
9124 case SAVE_DATA_AS:
9125 *exporting = 0;
9126 break;
9127 case EXPORT_OCTAVE:
9128 opt = OPT_M;
9129 break;
9130 case EXPORT_R:
9131 opt = OPT_R;
9132 break;
9133 case EXPORT_DAT:
9134 opt = OPT_G; /* PcGive */
9135 break;
9136 case EXPORT_JM:
9137 opt = OPT_J; /* JMulti */
9138 break;
9139 case EXPORT_DB:
9140 opt = OPT_D; /* gretl database */
9141 break;
9142 case EXPORT_GDT:
9143 opt = OPT_X;
9144 break;
9145 default: break;
9146 }
9147
9148 if (action == AUTO_SAVE_DATA) {
9149 /* saving a previously opened gdt(b) file directly,
9150 not coming via file selector: in the case of a
9151 plain gdt file let the save inherit the compression
9152 status of the original file
9153 */
9154 if (has_suffix(fname, ".gdt") && is_gzipped(fname)) {
9155 opt |= OPT_Z; /* --gzipped */
9156 }
9157 } else if (action == SAVE_DATA || action == SAVE_DATA_AS ||
9158 action == SAVE_BOOT_DATA || action == EXPORT_GDT) {
9159 int level = get_optval_int(STORE, OPT_Z, &err);
9160
9161 /* apply compression unless the user has set the
9162 gzip level to zero via the file save dialog
9163 */
9164 if (level > 0) {
9165 opt |= OPT_Z; /* compression */
9166 }
9167 if (has_suffix(fname, ".gdtb")) {
9168 give_compat_warning();
9169 }
9170 }
9171
9172 if (action == SAVE_DATA_AS) {
9173 if (session_file_is_open()) {
9174 opt |= OPT_X; /* "exporting" to gdt (FIXME?) */
9175 } else if (data_status & IMPORT_DATA) {
9176 /* saving data that were imported */
9177 *exporting = 0;
9178 }
9179 }
9180
9181 return opt;
9182 }
9183
9184 /* suppress inclusion of observations column when exporting
9185 data as CSV? */
9186 static gboolean csv_exclude_obs;
9187
9188 /* apparatus for use by the CSV options dialog */
9189
set_csv_exclude_obs(gboolean s)9190 void set_csv_exclude_obs (gboolean s)
9191 {
9192 csv_exclude_obs = s;
9193 }
9194
get_csv_exclude_obs(void)9195 gboolean get_csv_exclude_obs (void)
9196 {
9197 return csv_exclude_obs;
9198 }
9199
9200 /* This is called from the file selector when doing a
9201 data save, and also from the callback from Ctrl-S
9202 in the main gretl window.
9203 */
9204
do_store(char * filename,int action,gpointer data)9205 int do_store (char *filename, int action, gpointer data)
9206 {
9207 gretlopt opt = OPT_NONE;
9208 int exporting = 0;
9209 int cancel = 0;
9210 int err = 0;
9211
9212 if (action == WRITE_MAP) {
9213 /* quick, simple writing of map to geojson */
9214 err = gui_write_data(filename, NULL, dataset, OPT_NONE);
9215 if (err) {
9216 gui_errmsg(err);
9217 } else {
9218 lib_command_sprintf("store \"%s\"", filename);
9219 record_command_verbatim();
9220 }
9221 return err;
9222 }
9223
9224 /* If the dataset is sub-sampled, give the user a chance to
9225 rebuild the full data range before saving.
9226 */
9227 if (maybe_restore_full_data(SAVE_DATA)) {
9228 return 0; /* canceled */
9229 }
9230
9231 if (action != SAVE_MAP) {
9232 opt = store_action_to_opt(filename, action, &exporting, &cancel);
9233 if (cancel) {
9234 return 0;
9235 }
9236 }
9237
9238 if (action == AUTO_SAVE_DATA) {
9239 /* we've now dealt with the specifics of auto_save */
9240 action = SAVE_DATA;
9241 }
9242
9243 lib_command_sprintf("store \"%s\"", filename);
9244
9245 if (exporting || action == SAVE_MAP) {
9246 /* @mylist will be NULL unless there's a current selection
9247 of series from the apparatus in selector.c. That's OK:
9248 implicitly all series will be saved.
9249 */
9250 gchar *mylist = get_selector_storelist();
9251
9252 if (mylist != NULL) {
9253 lib_command_strcat(" ");
9254 lib_command_strcat(mylist);
9255 g_free(mylist);
9256 }
9257 }
9258
9259 if (opt & OPT_X) {
9260 ; /* inside a session: "exporting" gdt */
9261 } else if (opt != OPT_NONE) {
9262 /* not a bog-standard native save */
9263 if (action == EXPORT_CSV && csv_exclude_obs) {
9264 /* pick up option to exclude obs column */
9265 opt |= OPT_X;
9266 }
9267 lib_command_strcat(print_flags(opt, STORE));
9268 }
9269
9270 err = parse_lib_command();
9271
9272 if (!err && !WRITING_DB(opt) && action != SAVE_MAP) {
9273 /* back up the existing datafile if need be */
9274 err = maybe_back_up_datafile(filename);
9275 if (err) {
9276 /* the error message is already handled */
9277 return err;
9278 }
9279 }
9280
9281 if (!err) {
9282 /* actually write the data to file */
9283 err = gui_write_data(filename, libcmd.list, dataset, opt);
9284 }
9285
9286 if (err) {
9287 if (WRITING_DB(opt) && err == E_DB_DUP) {
9288 err = db_write_response(filename, libcmd.list);
9289 } else {
9290 gui_errmsg(err);
9291 }
9292 }
9293
9294 if (!err && !exporting) {
9295 /* record the fact that data have been saved, etc. */
9296 int modified = data_status & MODIFIED_DATA;
9297 int shrunk = 0;
9298
9299 mkfilelist(FILE_LIST_DATA, filename, 0);
9300 if (dataset_is_subsampled(dataset)) {
9301 shrunk = maybe_shrink_dataset(filename, action);
9302 } else if (datafile != filename) {
9303 strcpy(datafile, filename);
9304 }
9305 data_status = (HAVE_DATA | USER_DATA);
9306 if (action == SAVE_MAP && !shrunk && modified) {
9307 /* reinstate the "modified" flag */
9308 data_status |= MODIFIED_DATA;
9309 }
9310 if (is_gzipped(datafile)) {
9311 data_status |= GZIPPED_DATA;
9312 }
9313 set_sample_label(dataset);
9314 }
9315
9316 if (!err && action != SAVE_MAP) {
9317 if (WRITING_DB(opt)) {
9318 database_description_dialog(filename);
9319 } else {
9320 /* note: paired with parse_lib_command() above */
9321 record_lib_command();
9322 }
9323 }
9324
9325 return err;
9326 }
9327
9328 #ifdef OS_OSX
9329
9330 # ifdef HAVE_CARBON
9331
9332 # include <Carbon/Carbon.h>
9333
9334 /* deprecated in macOS >= 10.10, removed in macOS 11 */
9335
osx_open_file(const char * path)9336 int osx_open_file (const char *path)
9337 {
9338 FSRef ref;
9339 int err;
9340
9341 err = FSPathMakeRef((const UInt8 *) path, &ref, NULL);
9342 if (!err) {
9343 err = LSOpenFSRef(&ref, NULL);
9344 }
9345
9346 return err;
9347 }
9348
osx_open_pdf(const char * path,const char * dest)9349 int osx_open_pdf (const char *path, const char *dest)
9350 {
9351 FSRef ref;
9352 int done = 0;
9353 int err;
9354
9355 err = FSPathMakeRef((const UInt8 *) path, &ref, NULL);
9356
9357 if (!err) {
9358 guint8 exe[PATH_MAX] = {0};
9359 FSRef appref;
9360
9361 err = LSGetApplicationForItem(&ref, kLSRolesViewer | kLSRolesEditor,
9362 &appref, NULL);
9363
9364 if (!err) {
9365 FSRefMakePath(&appref, exe, PATH_MAX);
9366 }
9367
9368 if (!err && strstr((const char *) exe, "Adobe") != NULL) {
9369 /* Adobe Acrobat or Acrobat Reader: try passing an
9370 option to open at the specified chapter.
9371 */
9372 LSLaunchFSRefSpec rspec;
9373 AEDesc desc;
9374 gchar *opt;
9375 int lserr;
9376
9377 opt = g_strdup_printf("nameddest=%s", dest);
9378 AECreateDesc(typeChar, opt, strlen(opt), &desc);
9379
9380 rspec.appRef = &appref;
9381 rspec.numDocs = 1;
9382 rspec.itemRefs = &ref;
9383 rspec.passThruParams = &desc;
9384 rspec.launchFlags = kLSLaunchAsync;
9385 rspec.asyncRefCon = NULL;
9386
9387 lserr = LSOpenFromRefSpec(&rspec, NULL);
9388 if (lserr) {
9389 fprintf(stderr, "LSOpenFromRefSpec, err = %d\n", lserr);
9390 } else {
9391 done = 1;
9392 }
9393
9394 AEDisposeDesc(&desc);
9395 g_free(opt);
9396 } else if (!err && strstr((const char *) exe, "Preview") != NULL) {
9397 /* The default Apple Preview.app: there's no option
9398 as per Adobe, but we can at least try to open the
9399 Table-of-Contents pane (Option-Control-3).
9400 */
9401 err = LSOpenFSRef(&ref, NULL);
9402 if (!err) {
9403 FILE *fp = popen("/usr/bin/osascript", "w");
9404
9405 if (fp != NULL) {
9406 /* try to get the table of contents shown */
9407 fputs("activate application \"Preview\"\n", fp);
9408 fputs("tell application \"System Events\"\n", fp);
9409 fputs(" keystroke \"3\" using {option down, command down}\n", fp);
9410 fputs("end tell\n", fp);
9411 pclose(fp);
9412 }
9413 done = 1;
9414 }
9415 }
9416 }
9417
9418 if (!err && !done) {
9419 err = LSOpenFSRef(&ref, NULL);
9420 }
9421
9422 return err;
9423 }
9424
9425 # else /* macOS >= 10.10, no Carbon */
9426
9427 # include <CoreFoundation/CoreFoundation.h>
9428 # include <CoreServices/CoreServices.h>
9429
osx_open_file(const char * path)9430 int osx_open_file (const char *path)
9431 {
9432 CFURLRef u;
9433 int err = 0;
9434
9435 u = CFURLCreateFromFileSystemRepresentation(NULL,
9436 (const UInt8 *) path,
9437 strlen(path),
9438 false);
9439 if (u != NULL) {
9440 err = LSOpenCFURLRef(u, NULL);
9441 CFRelease(u);
9442 } else {
9443 err = 1;
9444 }
9445
9446 return err;
9447 }
9448
osx_open_pdf(const char * path,const char * dest)9449 int osx_open_pdf (const char *path, const char *dest)
9450 {
9451 CFURLRef ref;
9452 int done = 0;
9453 int err;
9454
9455 ref = CFURLCreateFromFileSystemRepresentation(NULL,
9456 (const UInt8 *) path,
9457 strlen(path),
9458 false);
9459
9460 if (!err) {
9461 CFURLRef appref;
9462 int viewer = 0;
9463
9464 appref = LSCopyDefaultApplicationURLForURL(ref, kLSRolesAll, NULL);
9465
9466 if (appref == NULL) {
9467 err = 1;
9468 } else {
9469 CFStringRef exe = CFURLGetString(appref);
9470 const char *s[] = {"Adobe", "Preview"};
9471 CFStringRef v[2];
9472 CFRange cfr;
9473 int i;
9474
9475 v[0] = CFStringCreateWithCString(NULL, s[0], kCFStringEncodingASCII);
9476 v[1] = CFStringCreateWithCString(NULL, s[1], kCFStringEncodingASCII);
9477
9478 for (i=0; i<2; i++) {
9479 cfr = CFStringFind(exe, v[i], 0);
9480 if (cfr.length > 0) {
9481 viewer = i+1;
9482 }
9483 }
9484
9485 CFRelease(v[0]);
9486 CFRelease(v[1]);
9487 }
9488
9489 if (!err && viewer == 1) {
9490 /* Adobe Acrobat or Acrobat Reader: try passing an
9491 option to open at the specified chapter.
9492 */
9493 const void *vals = {ref};
9494 CFArrayRef refs;
9495 LSLaunchURLSpec uspec;
9496 AEDesc desc;
9497 gchar *opt;
9498 int lserr;
9499
9500 opt = g_strdup_printf("nameddest=%s", dest);
9501 AECreateDesc(typeChar, opt, strlen(opt), &desc);
9502 refs = CFArrayCreate(NULL, &vals, 1, &kCFTypeArrayCallBacks);
9503
9504 uspec.appURL = appref;
9505 uspec.itemURLs = refs;
9506 uspec.passThruParams = &desc;
9507 uspec.launchFlags = kLSLaunchAsync;
9508 uspec.asyncRefCon = NULL;
9509
9510 lserr = LSOpenFromURLSpec(&uspec, NULL);
9511 if (lserr) {
9512 fprintf(stderr, "LSOpenFromURLSpec, err = %d\n", lserr);
9513 } else {
9514 done = 1;
9515 }
9516 AEDisposeDesc(&desc);
9517 g_free(opt);
9518 } else if (!err && viewer == 2) {
9519 /* The default Apple Preview.app: there's no option
9520 as per Adobe, but we can at least try to open the
9521 Table-of-Contents pane (Option-Control-3).
9522 */
9523 err = LSOpenCFURLRef(ref, NULL);
9524 if (!err) {
9525 FILE *fp = popen("/usr/bin/osascript", "w");
9526
9527 if (fp != NULL) {
9528 /* try to get the table of contents shown */
9529 fputs("activate application \"Preview\"\n", fp);
9530 fputs("tell application \"System Events\"\n", fp);
9531 fputs(" keystroke \"3\" using {option down, command down}\n", fp);
9532 fputs("end tell\n", fp);
9533 pclose(fp);
9534 }
9535 done = 1;
9536 }
9537 }
9538 }
9539
9540 if (!err && !done) {
9541 err = LSOpenCFURLRef(ref, NULL);
9542 }
9543
9544 CFRelease(ref);
9545
9546 return err;
9547 }
9548
9549 # endif /* Carbon-free variant */
9550
osx_open_url(const char * url)9551 int osx_open_url (const char *url)
9552 {
9553 CFStringRef s;
9554 CFURLRef u;
9555 int err;
9556
9557 s = CFStringCreateWithBytes(NULL, (const UInt8 *) url, strlen(url),
9558 kCFStringEncodingASCII,
9559 0);
9560 if (s == NULL) {
9561 err = 1;
9562 } else {
9563 u = CFURLCreateWithString(NULL, s, NULL);
9564 if (u == NULL) {
9565 err = 1;
9566 } else {
9567 err = LSOpenCFURLRef(u, NULL);
9568 CFRelease(u);
9569 }
9570 CFRelease(s);
9571 }
9572
9573 return err;
9574 }
9575
9576 #endif /* OS_OSX */
9577
clean_up_varlabels(DATASET * dset)9578 static void clean_up_varlabels (DATASET *dset)
9579 {
9580 const char *vlabel;
9581 gchar *conv;
9582 gsize wrote;
9583 int i;
9584
9585 for (i=1; i<dset->v; i++) {
9586 vlabel = series_get_label(dset, i);
9587 if (vlabel != NULL && !g_utf8_validate(vlabel, -1, NULL)) {
9588 conv = g_convert(vlabel, -1,
9589 "UTF-8",
9590 "ISO-8859-1",
9591 NULL, &wrote, NULL);
9592 if (conv != NULL) {
9593 series_set_label(dset, i, conv);
9594 g_free(conv);
9595 }
9596 }
9597 }
9598 }
9599
ok_run_file(char * runfile,int * is_gfn)9600 static int ok_run_file (char *runfile, int *is_gfn)
9601 {
9602 FILE *fp;
9603 char myline[32];
9604 int content = 0;
9605
9606 fp = gretl_fopen(runfile, "r");
9607
9608 if (fp == NULL && !g_path_is_absolute(runfile) &&
9609 strstr(runfile, ".gfn") != NULL) {
9610 /* try for ad hoc gfn file location */
9611 gchar *path = gfn_browser_get_alt_path();
9612
9613 if (path != NULL) {
9614 gchar *tmp = g_strdup(runfile);
9615
9616 gretl_build_path(runfile, path, tmp, NULL);
9617 fp = gretl_fopen(runfile, "r");
9618 g_free(tmp);
9619 g_free(path);
9620 if (fp != NULL) {
9621 fclose(fp);
9622 *is_gfn = 1;
9623 return 1;
9624 }
9625 }
9626 }
9627
9628 if (fp == NULL) {
9629 file_read_errbox(runfile);
9630 return 0;
9631 }
9632
9633 /* check that the file has something in it */
9634 while (fgets(myline, sizeof myline, fp)) {
9635 const char *p = myline;
9636
9637 while (*p) {
9638 if (!isspace(*p)) {
9639 content = 1;
9640 break;
9641 }
9642 p++;
9643 }
9644 if (content) break;
9645 }
9646
9647 fclose(fp);
9648
9649 if (!content) {
9650 warnbox(_("No commands to execute"));
9651 return 0;
9652 }
9653
9654 return 1;
9655 }
9656
gui_get_include_file(const char * fname,char * fullname)9657 static int gui_get_include_file (const char *fname, char *fullname)
9658 {
9659 if (has_suffix(fname, ".gfn") && !g_path_is_absolute(fname)) {
9660 /* If the user is currently working from an ad hoc
9661 function-package directory via the package browser,
9662 search that directory first.
9663 */
9664 gchar *path = gfn_browser_get_alt_path();
9665
9666 if (path != NULL) {
9667 int err;
9668
9669 gretl_build_path(fullname, path, fname, NULL);
9670 err = gretl_test_fopen(fullname, "r");
9671 if (err) {
9672 *fullname = '\0';
9673 }
9674 g_free(path);
9675 if (!err) {
9676 return 0;
9677 }
9678 }
9679 }
9680
9681 return get_full_filename(fname, fullname, OPT_I);
9682 }
9683
gui_output_line(const char * line,ExecState * s,PRN * prn)9684 static void gui_output_line (const char *line, ExecState *s, PRN *prn)
9685 {
9686 int coding, n;
9687
9688 /* a few things that we don't want to echo at all */
9689 if (!strcmp(line, "set echo off") ||
9690 !strcmp(line, "flush") ||
9691 !strncmp(line, "printf", 6) ||
9692 (!strncmp(line, "print ", 6) && strchr(line, '"'))) {
9693 return;
9694 }
9695
9696 coding = gretl_compiling_function() || gretl_compiling_loop();
9697 n = strlen(line);
9698
9699 if (coding) {
9700 pputs(prn, "> ");
9701 }
9702
9703 if (s->in_comment || (n >= 2 && ((line[0] == '/' && line[1] == '*') ||
9704 (line[n-1] == '/' && line[n-2] == '*')))) {
9705 pprintf(prn, "%s\n", line);
9706 } else if (*line == '#') {
9707 pprintf(prn, "%s\n", line);
9708 } else if (!string_is_blank(line)) {
9709 if (!coding) {
9710 pputs(prn, "? ");
9711 }
9712 n = 2;
9713 safe_print_line(line, &n, prn);
9714 pputc(prn, '\n');
9715 }
9716 }
9717
gui_get_input_line(char * line,FILE * fp,const char * buf,int * err)9718 static char *gui_get_input_line (char *line, FILE *fp,
9719 const char *buf,
9720 int *err)
9721 {
9722 char *got;
9723 int n;
9724
9725 *line = '\0';
9726
9727 if (fp != NULL) {
9728 got = fgets(line, MAXLINE, fp);
9729 } else {
9730 got = bufgets(line, MAXLINE, buf);
9731 }
9732
9733 if (got != NULL) {
9734 n = strlen(line);
9735 if (n > MAXLINE - 2 && line[n-1] != '\n') {
9736 *err = E_TOOLONG;
9737 }
9738 }
9739
9740 return got;
9741 }
9742
print_fatal_error(const char * s,PRN * prn)9743 static void print_fatal_error (const char *s, PRN *prn)
9744 {
9745 const char *tokline = get_parser_errline();
9746
9747 if (tokline != NULL && strcmp(tokline, s)) {
9748 pprintf(prn, "> %s\n", tokline);
9749 }
9750
9751 pprintf(prn, "> %s\n", s);
9752 }
9753
9754 /* run commands from runfile or buf, output to prn */
9755
execute_script(char * runfile,const char * buf,PRN * prn,int exec_code,GtkWidget * parent)9756 int execute_script (char *runfile, const char *buf,
9757 PRN *prn, int exec_code,
9758 GtkWidget *parent)
9759 {
9760 ExecState state;
9761 FILE *fb = NULL;
9762 char line[MAXLINE] = {0};
9763 char tmp[MAXLINE] = {0};
9764 int including = (exec_code & INCLUDE_EXEC);
9765 int indent0, bufread = 0;
9766 int loopcomp0 = 0;
9767 int exec_err = 0;
9768
9769 gretl_set_batch_mode(1);
9770
9771 #if 0
9772 debug_print_model_info(model, "Start of execute_script, model");
9773 #endif
9774
9775 if (runfile != NULL) {
9776 /* we'll get commands from file */
9777 int file_is_gfn = 0;
9778
9779 if (!ok_run_file(runfile, &file_is_gfn)) {
9780 return -1;
9781 } else if (file_is_gfn) {
9782 return include_gfn(runfile, OPT_NONE, prn);
9783 } else {
9784 fb = gretl_fopen(runfile, "r");
9785 }
9786 } else {
9787 /* no runfile, commands from buffer */
9788 if (buf == NULL || *buf == '\0') {
9789 errbox(_("No commands to execute"));
9790 return -1;
9791 }
9792 bufgets_init(buf);
9793 bufread = 1;
9794 }
9795
9796 if (!including && !suppress_logo) {
9797 gui_script_logo(prn);
9798 }
9799
9800 gretl_exec_state_init(&state, 0, line, &libcmd, model, prn);
9801 indent0 = gretl_if_state_record();
9802 loopcomp0 = gretl_compiling_loop();
9803
9804 while (libcmd.ci != QUIT) {
9805 if (gretl_execute_loop()) {
9806 exec_err = gretl_loop_exec(&state, dataset, NULL);
9807 if (exec_err) {
9808 goto endwhile;
9809 }
9810 } else {
9811 char *gotline = NULL;
9812 int contd;
9813
9814 gotline = gui_get_input_line(line, fb, buf, &exec_err);
9815 if (gotline == NULL) {
9816 /* done reading */
9817 goto endwhile;
9818 }
9819
9820 if (!exec_err) {
9821 if (state.in_comment ||
9822 libcmd.context == FOREIGN ||
9823 libcmd.context == MPI ||
9824 gretl_compiling_python(line)) {
9825 tailstrip(line);
9826 } else {
9827 contd = top_n_tail(line, sizeof line, &exec_err);
9828 while (contd && !state.in_comment && !exec_err) {
9829 /* handle continued lines */
9830 gotline = gui_get_input_line(tmp, fb, buf, &exec_err);
9831 if (gotline == NULL) {
9832 break;
9833 }
9834 if (!exec_err && *tmp != '\0') {
9835 if (strlen(line) + strlen(tmp) > MAXLINE - 1) {
9836 exec_err = E_TOOLONG;
9837 break;
9838 } else {
9839 strcat(line, tmp);
9840 compress_spaces(line);
9841 }
9842 }
9843 contd = top_n_tail(line, sizeof line, &exec_err);
9844 }
9845 }
9846 }
9847
9848 if (!exec_err) {
9849 if (!including) {
9850 if (gretl_echo_on()) {
9851 gui_output_line(line, &state, prn);
9852 } else if (*line == '#' && gretl_comments_on()) {
9853 gui_output_line(line, &state, prn);
9854 }
9855 }
9856 strcpy(tmp, line);
9857 if (runfile != NULL) {
9858 strcpy(state.runfile, runfile);
9859 }
9860 state.flags = exec_code;
9861 exec_err = gui_exec_line(&state, dataset, parent);
9862 }
9863
9864 if (exec_err) {
9865 if (exec_err == E_STOP) {
9866 /* not really an error */
9867 goto endwhile;
9868 } else if (!gretl_error_is_fatal()) {
9869 exec_err = 0;
9870 } else {
9871 pprintf(prn, _("\nError executing script: halting\n"));
9872 if (exec_err == E_TOOLONG) {
9873 errmsg(exec_err, prn);
9874 } else {
9875 print_fatal_error(tmp, prn);
9876 }
9877 goto endwhile;
9878 }
9879 }
9880 } /* end non-loop command processor */
9881 } /* end while command != quit */
9882
9883 endwhile:
9884
9885 if (bufread) {
9886 bufgets_finalize(buf);
9887 }
9888
9889 if (fb != NULL) {
9890 fclose(fb);
9891 }
9892
9893 refresh_data();
9894 sync_scalars_window();
9895
9896 if (gretl_compiling_loop() != loopcomp0) {
9897 errbox(_("Unbalanced \"loop\"/\"endloop\" in script"));
9898 gretl_abort_compiling_loop();
9899 if (!exec_err) {
9900 exec_err = E_PARSE;
9901 }
9902 }
9903
9904 if (exec_err) {
9905 gretl_if_state_clear();
9906 } else {
9907 exec_err = gretl_if_state_check(indent0);
9908 if (exec_err) {
9909 warnbox(_("Unmatched \"if\" in script (fixed)"));
9910 }
9911 }
9912
9913 if (state.in_comment || (state.cmd->flags & CMD_IGNORE)) {
9914 warnbox(_("Unterminated comment in script"));
9915 gretl_exec_state_uncomment(&state);
9916 }
9917
9918 return exec_err;
9919 }
9920
9921 static GtkWidget *pkgview_parent;
9922
set_pkgview_parent(GtkWidget * w)9923 static void set_pkgview_parent (GtkWidget *w)
9924 {
9925 pkgview_parent = w;
9926 }
9927
9928 /* Below: assemble data to pass to:
9929
9930 void maybe_update_pkgview (const char *filename,
9931 const char *pkgname,
9932 int zipfile,
9933 GtkWidget *parent)
9934 in database.c.
9935 */
9936
handle_gui_pkg_install(gretl_bundle * b)9937 static void handle_gui_pkg_install (gretl_bundle *b)
9938 {
9939 int err = 0;
9940
9941 if (gretl_bundle_get_int(b, "binpkg", NULL) > 0) {
9942 const char *id = gretl_bundle_get_string(b, "path_id", &err);
9943
9944 if (!err) {
9945 sync_path_from_lib(id);
9946 }
9947 } else {
9948 const char *filename;
9949 const char *pkgname;
9950 int zipfile = 0;
9951
9952 filename = gretl_bundle_get_string(b, "filename", &err);
9953 pkgname = gretl_bundle_get_string(b, "pkgname", &err);
9954 zipfile = gretl_bundle_get_int(b, "zipfile", &err);
9955 if (!err) {
9956 maybe_update_pkgview(filename, pkgname, zipfile,
9957 pkgview_parent);
9958 }
9959 }
9960
9961 gretl_bundle_destroy(b);
9962 }
9963
9964 /* Callbacks for when lib_open_append() is invoked. In
9965 the first case we're just checking if OPEN is going
9966 to destroy any unsaved data, and if so giving the user
9967 the option of aborting the command. In the second
9968 case we're prompting the GUI program to update its
9969 state in response to opening a new dataset.
9970 */
9971
handle_data_open_callback(CMD * cmd,void * ptr,GretlObjType type)9972 static int handle_data_open_callback (CMD *cmd, void *ptr,
9973 GretlObjType type)
9974 {
9975 if (type == GRETL_OBJ_DSET) {
9976 /* check that "open" is really OK */
9977 gretlopt opt = cmd->opt;
9978
9979 if (data_status & MODIFIED_DATA) {
9980 if (maybe_stop_script(NULL)) {
9981 return 1; /* abort open */
9982 }
9983 }
9984 if (!(opt & OPT_P)) {
9985 if (gretl_looping() || csv_open_needs_matrix(opt)) {
9986 opt |= OPT_P;
9987 }
9988 }
9989 close_session(opt);
9990 } else if (type == GRETL_OBJ_ANY) {
9991 /* do GUI housekeeping on successful "open" */
9992 OpenOp *op = (OpenOp *) ptr;
9993
9994 if (op->http) {
9995 /* arrange to display "Unsaved data" in place of filename */
9996 data_status |= MODIFIED_DATA;
9997 } else if (op->fname[0] != '\0') {
9998 strncpy(datafile, op->fname, MAXLEN - 1);
9999 }
10000 if (op->ftype == GRETL_CSV || SPREADSHEET_IMPORT(op->ftype) ||
10001 OTHER_IMPORT(op->ftype)) {
10002 data_status |= IMPORT_DATA;
10003 if (!(cmd->opt & OPT_Q)) {
10004 maybe_display_string_table();
10005 }
10006 }
10007 if (dataset->v > 0 && !op->dbdata) {
10008 if (cmd->ci == APPEND) {
10009 register_data(DATA_APPENDED);
10010 } else {
10011 register_data(OPENED_VIA_CLI);
10012 }
10013 }
10014 }
10015
10016 return 0;
10017 }
10018
10019 /* Callback from libgretl to update the GUI in light of
10020 execution of commands via script.
10021 */
10022
gui_exec_callback(ExecState * s,void * ptr,GretlObjType type)10023 static int gui_exec_callback (ExecState *s, void *ptr,
10024 GretlObjType type)
10025 {
10026 int ci = s->cmd->ci;
10027 int err = 0;
10028
10029 if (ci == OPEN) {
10030 return handle_data_open_callback(s->cmd, ptr, type);
10031 } else if (ci == FLUSH) {
10032 handle_flush_callback(s->cmd->opt);
10033 } else if (ci == JOIN) {
10034 if (check_dataset_is_changed(dataset)) {
10035 mark_dataset_as_modified();
10036 populate_varlist();
10037 }
10038 } else if (ptr != NULL && type == GRETL_OBJ_EQN) {
10039 add_model_to_session_callback(ptr, type, s->cmd->opt);
10040 } else if (ptr != NULL && type == GRETL_OBJ_VAR) {
10041 add_model_to_session_callback(ptr, type, s->cmd->opt);
10042 } else if (ptr != NULL && type == GRETL_OBJ_SYS) {
10043 add_model_to_session_callback(ptr, type, s->cmd->opt);
10044 } else if (ci == FREQ && ((s->flags & CONSOLE_EXEC) ||
10045 (s->cmd->opt & OPT_G))) {
10046 register_graph();
10047 } else if (ci == SETOBS) {
10048 set_sample_label(dataset);
10049 mark_dataset_as_modified();
10050 } else if (ci == SMPL) {
10051 set_sample_label(dataset);
10052 } else if (ci == DATAMOD || ci == LABELS) {
10053 mark_dataset_as_modified();
10054 populate_varlist();
10055 } else if (ci == MARKERS) {
10056 mark_dataset_as_modified();
10057 } else if (ci == PKG) {
10058 handle_gui_pkg_install(ptr);
10059 } else if (ci == MODELTAB) {
10060 err = modeltab_exec(s->cmd->param, s->cmd->opt, s->prn);
10061 } else if (ci == GRAPHPG) {
10062 err = graph_page_exec(s->cmd->param, s->cmd->parm2, s->cmd->opt);
10063 } else if (is_plotting_command(s->cmd)) {
10064 if (*s->cmd->savename != '\0') {
10065 ci = is_plotting_command(s->cmd);
10066 maybe_save_graph(s->cmd->savename, ci, s->cmd->opt, s->prn);
10067 } else {
10068 register_graph();
10069 }
10070 } else if (ci == FCAST) {
10071 register_graph();
10072 } else if (ci == CLEAR) {
10073 if (s->cmd->opt & OPT_F) {
10074 /* clear functions only */
10075 gretl_functions_cleanup();
10076 } else if (s->cmd->opt & OPT_D) {
10077 /* clear dataset only */
10078 close_session(OPT_P);
10079 } else {
10080 /* clear all except functions */
10081 close_session(OPT_NONE);
10082 }
10083 } else if (ci == GP_ASYNC) {
10084 const char *pf = gretl_plotfile();
10085
10086 gnuplot_view_3d(pf);
10087 } else if (ci == SET) {
10088 /* 2021-05-16: at present this is used only for
10089 setting of plot_collection
10090 */
10091 adjust_plot_collection(s->cmd->parm2);
10092 }
10093
10094 if (err) {
10095 gui_errmsg(err);
10096 }
10097
10098 return 0;
10099 }
10100
gui_exec_callback_init(void)10101 void gui_exec_callback_init (void)
10102 {
10103 set_gui_callback(gui_exec_callback);
10104 }
10105
10106 /* add to @l1 any elements of @l2 and @l3 that are not
10107 already present */
10108
model_list_union(GList * l1,GList * l2,GList * l3)10109 static GList *model_list_union (GList *l1,
10110 GList *l2,
10111 GList *l3)
10112 {
10113 if (l2 != NULL) {
10114 while (1) {
10115 if (g_list_find(l1, l2->data) == NULL) {
10116 l1 = g_list_append(l1, l2->data);
10117 }
10118 if (l2->next != NULL) {
10119 l2 = l2->next;
10120 } else {
10121 break;
10122 }
10123 }
10124 g_list_free(l2);
10125 }
10126
10127 if (l3 != NULL) {
10128 while (1) {
10129 if (g_list_find(l1, l3->data) == NULL) {
10130 l1 = g_list_append(l1, l3->data);
10131 }
10132 if (l3->next != NULL) {
10133 l3 = l3->next;
10134 } else {
10135 break;
10136 }
10137 }
10138 g_list_free(l3);
10139 }
10140
10141 return l1;
10142 }
10143
10144 /* Apparatus for handling a permanent sub-sampling via the
10145 GUI program. This function, registered as a libgretl
10146 callback, runs both ways: it can be used (see objstack.c
10147 in the library) to get a GList of models represented in
10148 the GUI, for checking, and to send back a GList of models
10149 that will have to be deleted because their dataset has
10150 been cut out from under them.
10151 */
10152
get_or_send_gui_models(GList * list)10153 GList *get_or_send_gui_models (GList *list)
10154 {
10155 if (list == NULL) {
10156 /* signal to send list to objstack */
10157 GList *lw = windowed_model_list();
10158 GList *ls = session_model_list();
10159 GList *lt = table_model_list();
10160
10161 return model_list_union(lw, ls, lt);
10162 } else {
10163 /* handle list returned by objstack */
10164 windata_t *vwin;
10165 void *ptr;
10166
10167 while (1) {
10168 ptr = list->data;
10169 fprintf(stderr, "*** deleting gui model %p\n", ptr);
10170 /* is the model in the model table? */
10171 if (in_model_table(ptr)) {
10172 fprintf(stderr, " removing from model table\n");
10173 remove_from_model_table(ptr);
10174 }
10175 /* is the model in a viewer window? */
10176 vwin = get_viewer_for_data(ptr);
10177 if (vwin != NULL) {
10178 fprintf(stderr, " destroy viewer\n");
10179 gretl_viewer_destroy(vwin);
10180 }
10181 fprintf(stderr, " removing from session\n");
10182 session_model_callback(ptr, OBJ_ACTION_FREE);
10183 if (list->next != NULL) {
10184 list = list->next;
10185 } else {
10186 break;
10187 }
10188 }
10189
10190 g_list_free(list);
10191 return NULL;
10192 }
10193 }
10194
script_delete_function_package(const char * action,const char * param,PRN * prn)10195 static int script_delete_function_package (const char *action,
10196 const char *param,
10197 PRN *prn)
10198 {
10199 gchar *gfnname = NULL;
10200 gchar *pkgname = NULL;
10201 char *p, fname[MAXLEN];
10202 int delfile = 0;
10203 int err;
10204
10205 if (!strcmp(action, "remove")) {
10206 delfile = 1;
10207 }
10208
10209 if (has_suffix(param, ".gfn")) {
10210 gfnname = g_strdup(param);
10211 pkgname = g_strdup(param);
10212 p = strrchr(pkgname, '.');
10213 *p = '\0';
10214 } else {
10215 gfnname = g_strdup_printf("%s.gfn", param);
10216 pkgname = g_strdup(param);
10217 }
10218
10219 *fname = '\0';
10220 err = get_full_filename(gfnname, fname, OPT_I);
10221
10222 if (!err && !gretl_file_exists(fname)) {
10223 pprintf(prn, "Couldn't find %s\n", gfnname);
10224 err = E_FOPEN;
10225 }
10226
10227 if (!err) {
10228 /* unload the package from memory */
10229 function_package_unload_full_by_filename(fname);
10230 /* remove entry from registry, if present */
10231 gui_function_pkg_unregister(pkgname);
10232 if (delfile) {
10233 /* delete package file(s) */
10234 err = delete_function_package(fname);
10235 if (!err) {
10236 p = strrslash(fname);
10237 if (p != NULL) {
10238 *p = '\0';
10239 }
10240 maybe_update_gfn_browser(pkgname, NULL, NULL, NULL,
10241 NULL, fname, 0, 0);
10242 }
10243 }
10244 }
10245
10246 if (err) {
10247 errmsg(err, prn);
10248 } else if (delfile) {
10249 pprintf(prn, "Removed %s\n", pkgname);
10250 } else {
10251 pprintf(prn, "Unloaded %s\n", pkgname);
10252 }
10253
10254 g_free(gfnname);
10255 g_free(pkgname);
10256
10257 return err;
10258 }
10259
script_renumber_series(const int * list,const char * parm,DATASET * dset,PRN * prn)10260 static int script_renumber_series (const int *list,
10261 const char *parm,
10262 DATASET *dset,
10263 PRN *prn)
10264 {
10265 int err, fixmax = max_untouchable_series_ID();
10266
10267 err = renumber_series_with_checks(list, parm, fixmax, dset, prn);
10268 if (err) {
10269 errmsg(err, prn);
10270 }
10271
10272 return err;
10273 }
10274
script_open_session_file(CMD * cmd)10275 static int script_open_session_file (CMD *cmd)
10276 {
10277 char myfile[MAXLEN] = {0};
10278 int err;
10279
10280 err = get_full_filename(cmd->param, myfile, OPT_NONE);
10281 if (err) {
10282 gui_errmsg(err);
10283 return err;
10284 }
10285
10286 if (gretl_is_pkzip_file(myfile)) {
10287 if (cmd->ci == APPEND) {
10288 errbox("Can't append a gretl session file");
10289 return E_DATA;
10290 } else {
10291 set_tryfile(myfile);
10292 verify_open_session();
10293 }
10294 } else {
10295 errbox("Expected a gretl session file");
10296 err = E_DATA;
10297 }
10298
10299 return err;
10300 }
10301
try_run_include(ExecState * s,char * runfile,PRN * prn,GtkWidget * parent)10302 static int try_run_include (ExecState *s, char *runfile,
10303 PRN *prn, GtkWidget *parent)
10304 {
10305 int save_batch, orig_flags, err;
10306
10307 if (gretl_test_fopen(runfile, "r") != 0) {
10308 pprintf(prn, _("Error reading %s\n"), runfile);
10309 return process_command_error(s, E_FOPEN);
10310 }
10311
10312 save_batch = gretl_in_batch_mode();
10313 orig_flags = s->flags;
10314 s->flags = SCRIPT_EXEC;
10315 if (s->cmd->ci == INCLUDE) {
10316 s->flags |= INCLUDE_EXEC;
10317 }
10318 /* 2019-11-22: next line was conditional on ci != INCLUDE */
10319 gretl_set_script_dir(runfile);
10320 err = execute_script(runfile, NULL, prn, s->flags,
10321 parent);
10322 gretl_set_batch_mode(save_batch);
10323 s->flags = orig_flags;
10324
10325 return err;
10326 }
10327
run_include_error(ExecState * s,const char * param,int err,PRN * prn)10328 static int run_include_error (ExecState *s, const char *param,
10329 int err, PRN *prn)
10330 {
10331 const char *msg = gretl_errmsg_get();
10332
10333 pprintf(prn, _("Error reading %s\n"), param);
10334 if (*msg != '\0') {
10335 pprintf(prn, "%s\n", msg);
10336 }
10337
10338 return process_command_error(s, err);
10339 }
10340
10341 #define try_gui_help(c) (c->param != NULL && *c->param != '\0' && \
10342 c->parm2 == NULL && !c->opt)
10343
gui_exec_help(ExecState * s,CMD * cmd)10344 static void gui_exec_help (ExecState *s, CMD *cmd)
10345 {
10346
10347 char *buf = NULL;
10348 int err = 0;
10349
10350 if ((s->flags & CONSOLE_EXEC) && try_gui_help(cmd)) {
10351 err = gui_console_help(cmd->param);
10352 if (err) {
10353 /* fallback */
10354 err = 0;
10355 cli_help(cmd->param, cmd->parm2, cmd->opt, &buf, s->prn);
10356 }
10357 } else {
10358 cli_help(cmd->param, cmd->parm2, cmd->opt, &buf, s->prn);
10359 }
10360
10361 if (buf != NULL) {
10362 view_formatted_text_buffer(cmd->param, buf, 80, 400,
10363 VIEW_PKG_INFO);
10364 free(buf);
10365 }
10366 }
10367
smpl_restrict(gretlopt opt)10368 static int smpl_restrict (gretlopt opt)
10369 {
10370 opt &= ~OPT_Q;
10371 opt &= ~OPT_T;
10372 return opt != OPT_NONE;
10373 }
10374
gui_do_smpl(CMD * cmd,DATASET * dset,PRN * prn)10375 static int gui_do_smpl (CMD *cmd, DATASET *dset, PRN *prn)
10376 {
10377 int n_dropped = 0;
10378 int cancel = 0;
10379 int err = 0;
10380
10381 if (cmd->opt == OPT_F) {
10382 gui_restore_sample(dset);
10383 } else if (cmd->opt == OPT_T && cmd->param == NULL) {
10384 /* --permanent, by itself */
10385 err = perma_sample(dset, cmd->opt, prn, &n_dropped);
10386 } else if (cmd->opt & OPT_U) {
10387 /* the panel --unit option */
10388 err = set_panel_sample(cmd->param, cmd->parm2, cmd->opt, dset);
10389 } else if (smpl_restrict(cmd->opt)) {
10390 /* --restrict, --dummy, etc. */
10391 err = restrict_sample(cmd->param, cmd->list, dset,
10392 NULL, cmd->opt, prn, &n_dropped);
10393 } else if (cmd->param == NULL && cmd->parm2 == NULL) {
10394 /* no args given: give a report */
10395 print_smpl(dset, get_full_length_n(), OPT_F, prn);
10396 return 0; /* done */
10397 } else {
10398 /* simple setting of t1, t2 business */
10399 err = set_sample(cmd->param, cmd->parm2, dset, cmd->opt);
10400 }
10401 if (err == E_CANCEL && (cmd->opt & OPT_T)) {
10402 err = perma_sample_options(cmd->param, cmd->list,
10403 dset, cmd->opt, prn,
10404 &n_dropped, &cancel);
10405 if (cancel) {
10406 return 0;
10407 }
10408 }
10409 if (err) {
10410 errmsg(err, prn);
10411 } else {
10412 print_smpl(dset, get_full_length_n(), OPT_NONE, prn);
10413 if (cmd->opt & OPT_T) {
10414 mark_dataset_as_modified();
10415 } else {
10416 set_sample_label(dset);
10417 }
10418 }
10419 if (err && err != E_ALLOC && (cmd->flags & CMD_CATCH)) {
10420 set_gretl_errno(err);
10421 err = 0;
10422 }
10423
10424 return err;
10425 }
10426
10427 /* gui_exec_line: this is called from the gretl console, from the
10428 command "minibuffer", from execute_script(), and when initiating a
10429 call to a function package (fncall.c). Note that most commands get
10430 passed on to the libgretl function gretl_cmd_exec(), but some GUI
10431 specials are dealt with here, as are some commands that require
10432 special action when called in a GUI context. All estimation
10433 commands are passed on to libgretl.
10434 */
10435
gui_exec_line(ExecState * s,DATASET * dset,GtkWidget * parent)10436 int gui_exec_line (ExecState *s, DATASET *dset, GtkWidget *parent)
10437 {
10438 char *line = s->line;
10439 CMD *cmd = s->cmd;
10440 PRN *prn = s->prn;
10441 char runfile[MAXLEN];
10442 int ppos = -1;
10443 int err = 0;
10444
10445 #if CMD_DEBUG
10446 fprintf(stderr, "gui_exec_line: flags = %d\n", s->flags);
10447 #endif
10448
10449 next_line:
10450
10451 if (gretl_compiling_function()) {
10452 err = gretl_function_append_line(s);
10453 if (err) {
10454 errmsg(err, prn);
10455 } else if (s->flags & CONSOLE_EXEC) {
10456 add_command_to_stack(line, 0);
10457 }
10458 goto more_check; /* was return err; */
10459 }
10460
10461 if (string_is_blank(line)) {
10462 return 0;
10463 }
10464
10465 gretl_exec_state_set_callback(s, gui_exec_callback, OPT_G);
10466
10467 if (!gretl_compiling_loop() && !s->in_comment &&
10468 !cmd->context && !gretl_if_state_false()) {
10469 /* catch requests relating to saved objects, which are not
10470 really "commands" as such */
10471 int action = gui_saved_object_action(line, prn);
10472
10473 if (action == OBJ_ACTION_INVALID) {
10474 return 1; /* action was faulty */
10475 } else if (action != OBJ_ACTION_NONE) {
10476 return 0; /* action was OK (and handled), or ignored */
10477 }
10478 }
10479
10480 if (gretl_compiling_loop()) {
10481 /* when stacking commands for a loop, parse "lightly" */
10482 err = get_command_index(s, LOOP);
10483 } else {
10484 err = parse_command_line(s, dset, NULL);
10485 }
10486
10487 #if CMD_DEBUG
10488 fprintf(stderr, "gui_exec_line: '%s'\n cmd = %p, cmd->ci = %d, param = '%s'\n",
10489 line, (void *) cmd, cmd->ci, cmd->param);
10490 #endif
10491
10492 if (err) {
10493 int catch = 0;
10494
10495 gretl_exec_state_uncomment(s);
10496 if (err != E_ALLOC && (cmd->flags & CMD_CATCH)) {
10497 set_gretl_errno(err);
10498 catch = 1;
10499 }
10500 errmsg(err, prn);
10501 return (catch)? 0 : err;
10502 }
10503
10504 gretl_exec_state_transcribe_flags(s, cmd);
10505
10506 if (cmd->ci < 0) {
10507 /* nothing there, a comment, or masked by "if" */
10508 return 0;
10509 }
10510
10511 if (s->sys != NULL && cmd->ci != END && cmd->ci != EQUATION &&
10512 cmd->ci != SYSTEM) {
10513 pprintf(prn, _("Command '%s' ignored; not valid within "
10514 "equation system\n"), line);
10515 equation_system_destroy(s->sys);
10516 s->sys = NULL;
10517 return 1;
10518 }
10519
10520 if (cmd->ci == LOOP && (s->flags & CONSOLE_EXEC)) {
10521 pputs(prn, _("Enter commands for loop. "
10522 "Type 'endloop' to get out\n"));
10523 }
10524
10525 if (cmd->ci == LOOP || gretl_compiling_loop()) {
10526 /* accumulating loop commands */
10527 err = gretl_loop_append_line(s, dset);
10528 if (err) {
10529 errmsg(err, prn);
10530 } else if (s->flags & CONSOLE_EXEC) {
10531 lib_command_strcpy(line);
10532 record_command_verbatim();
10533 }
10534 goto more_check; /* was return err; */
10535 }
10536
10537 /* Set up to save output to a specific buffer, if wanted */
10538 if (*cmd->savename != '\0' && TEXTSAVE_OK(cmd->ci)) {
10539 ppos = gretl_print_tell(prn);
10540 }
10541
10542 check_for_loop_only_options(cmd->ci, cmd->opt, prn);
10543
10544 switch (cmd->ci) {
10545
10546 case DATA:
10547 err = db_get_series(cmd->param, dset, cmd->opt, prn);
10548 if (err) {
10549 errmsg(err, prn);
10550 } else {
10551 clean_up_varlabels(dset);
10552 register_data(DATA_APPENDED);
10553 if (gretl_messages_on()) {
10554 list_series(dset, OPT_NONE, prn);
10555 }
10556 }
10557 break;
10558
10559 case DELEET:
10560 if (cmd->list != NULL) {
10561 if (dataset_locked()) {
10562 err = E_DATA; /* error message handled */
10563 break;
10564 } else {
10565 if (maybe_prune_delete_list(cmd->list)) {
10566 if (cmd->list[0] == 0) {
10567 pputs(prn, _("No series were deleted"));
10568 pputc(prn, '\n');
10569 if (cmd->param == NULL) {
10570 break;
10571 }
10572 }
10573 }
10574 }
10575 }
10576 if (!err) {
10577 int renumber = 0;
10578
10579 err = gretl_delete_variables(cmd->list, cmd->param,
10580 cmd->opt, dset, &renumber,
10581 prn);
10582 if (err) {
10583 errmsg(err, prn);
10584 } else {
10585 if (renumber) {
10586 pputs(prn, _("Take note: variables have been renumbered"));
10587 pputc(prn, '\n');
10588 maybe_list_series(dset, prn);
10589 } else if (cmd->opt & OPT_D) {
10590 sync_db_windows();
10591 }
10592 }
10593 }
10594 if (err && cmd->flags & CMD_CATCH) {
10595 set_gretl_errno(err);
10596 cmd->flags ^= CMD_CATCH;
10597 err = 0;
10598 }
10599 break;
10600
10601 case HELP:
10602 gui_exec_help(s, cmd);
10603 break;
10604
10605 case OPEN:
10606 case APPEND:
10607 if (dataset_locked()) {
10608 return 0;
10609 } else if (has_suffix(cmd->param, ".gretl")) {
10610 err = script_open_session_file(cmd);
10611 } else {
10612 err = gretl_cmd_exec(s, dset);
10613 }
10614 break;
10615
10616 case NULLDATA:
10617 if (dataset_locked()) {
10618 break;
10619 }
10620 if (cmd->order < 1) {
10621 err = 1;
10622 pputs(prn, _("Data series length count missing or invalid\n"));
10623 } else {
10624 close_session(cmd->opt);
10625 err = open_nulldata(dset, data_status, cmd->order,
10626 OPT_NONE, prn);
10627 if (err) {
10628 errmsg(err, prn);
10629 } else {
10630 register_data(NULLDATA_STARTED);
10631 }
10632 }
10633 break;
10634
10635 case QUIT:
10636 pprintf(prn, _("Script done\n"));
10637 gretl_if_state_clear();
10638 break;
10639
10640 case RUN:
10641 case INCLUDE:
10642 if (cmd->ci == INCLUDE) {
10643 err = gui_get_include_file(cmd->param, runfile);
10644 } else {
10645 err = get_full_filename(cmd->param, runfile, OPT_S);
10646 }
10647 if (err) {
10648 err = run_include_error(s, cmd->param, err, prn);
10649 break;
10650 }
10651 if (gretl_messages_on()) {
10652 pprintf(prn, " %s\n", runfile);
10653 }
10654 if (cmd->ci == INCLUDE && gretl_is_xml_file(runfile)) {
10655 err = load_XML_functions_file(runfile, cmd->opt, prn);
10656 if (err) {
10657 err = run_include_error(s, runfile, err, prn);
10658 }
10659 break;
10660 } else if (cmd->ci == INCLUDE && gfn_is_loaded(runfile)) {
10661 break;
10662 }
10663 if (!strcmp(runfile, s->runfile)) {
10664 pprintf(prn, _("Infinite loop detected in script\n"));
10665 err = 1;
10666 } else {
10667 err = try_run_include(s, runfile, prn, parent);
10668 }
10669 break;
10670
10671 case SMPL:
10672 err = gui_do_smpl(cmd, dset, prn);
10673 break;
10674
10675 case CLEAR:
10676 err = incompatible_options(cmd->opt, OPT_D | OPT_F);
10677 if (!err) {
10678 if (cmd->opt & OPT_F) {
10679 /* clear functions only */
10680 gretl_functions_cleanup();
10681 } else if (cmd->opt & OPT_D) {
10682 /* clear dataset only */
10683 close_session(OPT_P);
10684 } else {
10685 /* clear everything but functions */
10686 close_session(OPT_NONE);
10687 }
10688 }
10689 break;
10690
10691 case PKG:
10692 if (!strcmp(cmd->param, "unload") ||
10693 !strcmp(cmd->param, "remove")) {
10694 err = script_delete_function_package(cmd->param, cmd->parm2, prn);
10695 } else {
10696 set_pkgview_parent(parent);
10697 err = gretl_cmd_exec(s, dset);
10698 set_pkgview_parent(NULL);
10699 }
10700 break;
10701
10702 case DATAMOD:
10703 if (cmd->auxint == DS_CLEAR) {
10704 close_session(cmd->opt);
10705 break;
10706 } else if (cmd->auxint == DS_RENUMBER) {
10707 err = script_renumber_series(cmd->list, cmd->parm2, dset, prn);
10708 break;
10709 }
10710 /* Falls through. */
10711
10712 default:
10713 err = gretl_cmd_exec(s, dset);
10714 break;
10715 } /* end of command switch */
10716
10717 if ((s->flags & CONSOLE_EXEC) && !err) {
10718 /* log the specific command */
10719 char *buf = cmd_to_buf(cmd, line);
10720
10721 if (buf != NULL) {
10722 lib_command_strcpy(buf);
10723 record_command_verbatim();
10724 free(buf);
10725 }
10726 /* and check for display of scalars */
10727 sync_scalars_window();
10728 }
10729
10730 /* save specific output buffer? */
10731 if (!err && *cmd->savename != '\0' && TEXTSAVE_OK(cmd->ci)) {
10732 save_text_buffer(cmd->savename, prn, ppos);
10733 }
10734
10735 more_check:
10736
10737 /* check for more input */
10738 if (!err && s->more != NULL) {
10739 memmove(s->line, s->more, strlen(s->more) + 1);
10740 goto next_line;
10741 }
10742
10743 return err;
10744 }
10745