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 /* Mechanism for recording and retrieving the preferred set of lags
21 for a given variable. We save the preferences that are set, and
22 destroy the stacked preferences when we switch data sets.
23 */
24
25 #define LDEBUG 0
26
27 #include "gretl.h"
28 #include "selector.h"
29 #include "lagpref.h"
30
31 enum {
32 LAGS_NONE, /* no lags specified for variable */
33 LAGS_MINMAX, /* min and max lags given (consecutive) */
34 LAGS_LIST, /* list of lags specific given */
35 LAGS_TMP /* provisional list when working from model */
36 } SpecType;
37
38 typedef struct lagpref_ lagpref;
39
40 struct lagpref_ {
41 int v;
42 char context;
43 char spectype;
44 union lspec {
45 int lminmax[2];
46 int *laglist;
47 } lspec;
48 };
49
50 static lagpref **lprefs;
51 static int n_prefs;
52
destroy_lag_preferences(void)53 void destroy_lag_preferences (void)
54 {
55 int i;
56
57 for (i=0; i<n_prefs; i++) {
58 if (lprefs[i]->spectype == LAGS_LIST) {
59 free(lprefs[i]->lspec.laglist);
60 }
61 free(lprefs[i]);
62 }
63
64 free(lprefs);
65 lprefs = NULL;
66 n_prefs = 0;
67 }
68
add_lpref_to_stack(lagpref * lpref)69 static int add_lpref_to_stack (lagpref *lpref)
70 {
71 lagpref **tmp;
72 int err = 0;
73
74 tmp = realloc(lprefs, (n_prefs + 1) * sizeof *lprefs);
75 if (tmp == NULL) {
76 err = E_ALLOC;
77 } else {
78 lprefs = tmp;
79 lprefs[n_prefs] = lpref;
80 n_prefs++;
81 }
82
83 return err;
84 }
85
lpref_new(int v,char context,int type)86 static lagpref *lpref_new (int v, char context, int type)
87 {
88 lagpref *lpref = malloc(sizeof *lpref);
89
90 if (lpref == NULL) {
91 return NULL;
92 }
93
94 lpref->v = v;
95 lpref->context = context;
96
97 #if LDEBUG > 1
98 fprintf(stderr, "lpref_new: added lpref for var %d\n", v);
99 #endif
100
101 if (type == LAGS_LIST) {
102 lpref->spectype = type;
103 lpref->lspec.laglist = NULL;
104 } else if (context == LAG_Y_X || context == LAG_Y_W) {
105 /* by default: one lag, but not enabled */
106 lpref->spectype = LAGS_MINMAX;
107 lpref->lspec.lminmax[0] = 1;
108 lpref->lspec.lminmax[1] = 1;
109 } else {
110 lpref->spectype = LAGS_NONE;
111 }
112
113 return lpref;
114 }
115
116 #if LDEBUG > 1
print_lpref(lagpref * lpref)117 static void print_lpref (lagpref *lpref)
118 {
119 if (lpref == NULL) {
120 fprintf(stderr, "No lag reference recorded\n");
121 return;
122 }
123
124 fprintf(stderr, "print_lpref: lagpref at %p: v = %d, context = %d\n",
125 (void *) lpref, lpref->v, lpref->context);
126
127 if (lpref->spectype == LAGS_NONE) {
128 fprintf(stderr, " type == LAGS_NONE (%d)\n", LAGS_NONE);
129 } else if (lpref->spectype == LAGS_MINMAX) {
130 fprintf(stderr, " type == LAGS_MINMAX (%d), min=%d, max=%d\n",
131 LAGS_MINMAX, lpref->lspec.lminmax[0], lpref->lspec.lminmax[1]);
132 } else if (lpref->spectype == LAGS_LIST) {
133 fprintf(stderr, " laglist at %p\n", (void *) lpref->lspec.laglist);
134 printlist(lpref->lspec.laglist, " type == LAGS_LIST");
135 }
136 }
137 #endif
138
139 /* Modify the lag preferences for a given variable, based either on
140 selections made via the lags dialog box or on the specification of
141 a pre-existing model. Return 1 if the preferences in question were
142 in fact changed, otherwise 0.
143 */
144
145 static int
modify_lpref(lagpref * lpref,char spectype,int lmin,int lmax,int * laglist)146 modify_lpref (lagpref *lpref, char spectype, int lmin, int lmax, int *laglist)
147 {
148 int mod = 1;
149
150 if (spectype == LAGS_TMP) {
151 /* special for compiling lag preferences based on a saved
152 model specification */
153 gretl_list_append_term(&lpref->lspec.laglist, lmin);
154 #if LDEBUG > 1
155 fprintf(stderr, "modify_lpref: added lag %d\n", lmin);
156 #endif
157 return 1;
158 }
159
160 /* if we got something presented as a list of specific lags, but
161 actually it's a consecutive list, convert to "minmax" form
162 */
163 if (spectype == LAGS_LIST) {
164 gretl_list_sort(laglist);
165 if (gretl_list_is_consecutive(laglist)) {
166 lmin = laglist[1];
167 lmax = laglist[laglist[0]];
168 free(laglist);
169 spectype = LAGS_MINMAX;
170 }
171 }
172
173 if (spectype == lpref->spectype) {
174 if (spectype == LAGS_LIST) {
175 if (!gretl_list_cmp(laglist, lpref->lspec.laglist)) {
176 free(laglist);
177 mod = 0;
178 }
179 } else if (spectype == LAGS_MINMAX) {
180 if (lmin == lpref->lspec.lminmax[0] &&
181 lmax == lpref->lspec.lminmax[1]) {
182 mod = 0;
183 }
184 } else if (spectype == LAGS_NONE) {
185 mod = 0;
186 }
187 }
188
189 if (mod == 0) {
190 /* no-op: no (effective) change made */
191 return mod;
192 }
193
194 /* beyond this point we're making changes to the saved
195 lag preferences */
196
197 if (lpref->spectype == LAGS_LIST) {
198 free(lpref->lspec.laglist);
199 lpref->lspec.laglist = NULL;
200 }
201
202 if (spectype == LAGS_MINMAX) {
203 lpref->lspec.lminmax[0] = lmin;
204 lpref->lspec.lminmax[1] = lmax;
205 } else if (spectype == LAGS_LIST) {
206 lpref->lspec.laglist = laglist;
207 } else if (spectype == LAGS_NONE) {
208 lpref->lspec.lminmax[0] = 0;
209 lpref->lspec.lminmax[1] = 0;
210 }
211
212 lpref->spectype = spectype;
213
214 #if LDEBUG > 1
215 fprintf(stderr, "did modify_lpref: type=%d, lmin=%d, lmax=%d list=%p\n",
216 spectype, lmin, lmax, (void *) laglist);
217 print_lpref(lpref);
218 #endif
219
220 return mod;
221 }
222
get_saved_lpref(int v,char context)223 static lagpref *get_saved_lpref (int v, char context)
224 {
225 lagpref *lpref = NULL;
226 int i;
227
228 #if LDEBUG > 1
229 fprintf(stderr, "get_saved_lpref: v=%d, context=%d, n_prefs=%d\n",
230 v, context, n_prefs);
231 #endif
232
233 for (i=0; i<n_prefs; i++) {
234 if (lprefs[i]->v == v && lprefs[i]->context == context) {
235 lpref = lprefs[i];
236 break;
237 }
238 }
239
240 #if LDEBUG > 1
241 if (lpref != NULL) {
242 print_lpref(lpref);
243 }
244 #endif
245
246 return lpref;
247 }
248
get_VAR_lags_list(void)249 const int *get_VAR_lags_list (void)
250 {
251 lagpref *lp = get_saved_lpref(VDEFLT, LAG_Y_V);
252
253 if (lp != NULL && lp->spectype == LAGS_LIST) {
254 return lp->lspec.laglist;
255 } else {
256 return NULL;
257 }
258 }
259
set_VAR_max_lag(int lmax)260 void set_VAR_max_lag (int lmax)
261 {
262 lagpref *lp = get_saved_lpref(VDEFLT, LAG_Y_V);
263
264 if (lp != NULL && lp->spectype == LAGS_MINMAX) {
265 lp->lspec.lminmax[1] = lmax;
266 }
267 }
268
269 /* determine if a variable in a listbox is just a "dummy" lag
270 entry or not */
271
is_lag_dummy(int v,int lag,char context)272 int is_lag_dummy (int v, int lag, char context)
273 {
274 lagpref *lpref = get_saved_lpref(v, context);
275 int ynum = selector_get_depvar_number(NULL);
276 int ret = 0;
277
278 if (v > 0 && v == ynum) {
279 ret = 1;
280 } else if (lpref != NULL) {
281 if (lpref->spectype == LAGS_LIST &&
282 lag > lpref->lspec.laglist[1]) {
283 ret = 1;
284 } else if (lpref->spectype == LAGS_MINMAX &&
285 lag > lpref->lspec.lminmax[0]) {
286 ret = 1;
287 }
288 }
289
290 return ret;
291 }
292
maybe_destroy_depvar_lags(lagpref * lpref,char context)293 static void maybe_destroy_depvar_lags (lagpref *lpref, char context)
294 {
295 if (lpref != NULL) {
296 if (lpref->spectype == LAGS_MINMAX &&
297 lpref->lspec.lminmax[0] == 0 &&
298 lpref->lspec.lminmax[1] == 0) {
299 lpref->lspec.lminmax[0] = 1;
300 lpref->lspec.lminmax[1] = 1;
301 enable_lags_for_context(context, FALSE);
302 }
303 } else {
304 enable_lags_for_context(context, FALSE);
305 }
306 }
307
308 /* called when a specific lag, e.g. foo(-3), is removed from
309 a list of selected variables with the mouse */
310
remove_specific_lag(int v,int lag,char context)311 int remove_specific_lag (int v, int lag, char context)
312 {
313 int ynum = selector_get_depvar_number(NULL);
314 lagpref *lpref;
315 int lmin, lmax;
316 int err = 0;
317
318 if (v == ynum) {
319 if (context == LAG_X) {
320 context = LAG_Y_X;
321 } else if (context == LAG_W) {
322 context = LAG_Y_W;
323 }
324 }
325
326 lpref = get_saved_lpref(v, context);
327
328 if (lpref == NULL) {
329 err = 1;
330 } else {
331 if (lpref->spectype == LAGS_LIST) {
332 int pos = in_gretl_list(lpref->lspec.laglist, lag);
333
334 if (pos == 0) {
335 err = 1;
336 } else {
337 gretl_list_delete_at_pos(lpref->lspec.laglist, pos);
338 if (lpref->lspec.laglist[0] == 0) {
339 /* no values left */
340 modify_lpref(lpref, LAGS_NONE, 0, 0, NULL);
341 } else if (gretl_list_is_consecutive(lpref->lspec.laglist)) {
342 /* convert lag spec to minmax form */
343 int l0 = lpref->lspec.laglist[0];
344
345 lmin = lpref->lspec.laglist[1];
346 lmax = lpref->lspec.laglist[l0];
347 modify_lpref(lpref, LAGS_MINMAX, lmin, lmax, NULL);
348 }
349 }
350 } else if (lpref->spectype == LAGS_MINMAX) {
351 lmin = lpref->lspec.lminmax[0];
352 lmax = lpref->lspec.lminmax[1];
353 if (lag < lmin || lag > lmax) {
354 err = 1;
355 } else if (lag == lmin && lmin == lmax) {
356 lpref->lspec.lminmax[0] = 0;
357 lpref->lspec.lminmax[1] = 0;
358 } else if (lag == lmin) {
359 lpref->lspec.lminmax[0] += 1;
360 } else if (lag == lmax) {
361 lpref->lspec.lminmax[1] -= 1;
362 } else {
363 /* convert lag spec to list form */
364 int *llist;
365
366 llist = gretl_list_new(lmax - lmin);
367 if (llist == NULL) {
368 err = 1;
369 } else {
370 int i, j = 1;
371
372 for (i=lmin; i<=lmax; i++) {
373 if (i != lag) {
374 llist[j++] = i;
375 }
376 }
377 modify_lpref(lpref, LAGS_LIST, 0, 0, llist);
378 }
379 }
380 } else {
381 err = 1;
382 }
383 }
384
385 /* special handling of dependent var lags */
386 if (context == LAG_Y_X || context == LAG_Y_W) {
387 maybe_destroy_depvar_lags(lpref, context);
388 }
389
390 return err;
391 }
392
lpref_add(int v,char context,int type)393 static lagpref *lpref_add (int v, char context, int type)
394 {
395 lagpref *lpref = lpref_new(v, context, type);
396
397 if (lpref != NULL) {
398 if (add_lpref_to_stack(lpref)) {
399 free(lpref);
400 lpref = NULL;
401 }
402 }
403
404 return lpref;
405 }
406
set_lag_prefs_from_list(int v,int * llist,char context,int * changed)407 int set_lag_prefs_from_list (int v, int *llist, char context,
408 int *changed)
409 {
410 lagpref *lpref = get_saved_lpref(v, context);
411 int mod, err = 0;
412
413 *changed = 0;
414
415 if (lpref == NULL) {
416 *changed = 1;
417 lpref = lpref_add(v, context, LAGS_NONE);
418 }
419
420 if (lpref == NULL) {
421 err = E_ALLOC;
422 } else {
423 mod = modify_lpref(lpref, LAGS_LIST, 0, 0, llist);
424 if (!*changed && mod) {
425 *changed = 1;
426 }
427 }
428
429 return err;
430 }
431
minmax_defaults(int lmin,int lmax,char context)432 static int minmax_defaults (int lmin, int lmax, char context)
433 {
434 if ((context == LAG_X || context == LAG_W) &&
435 lmin == 0 && lmax == 0) {
436 return 1;
437 }
438
439 if ((context == LAG_Y_X || context == LAG_Y_W) &&
440 lmin == 1 && lmax == 1) {
441 return 1;
442 }
443
444 return 0;
445 }
446
set_lag_prefs_from_minmax(int v,int lmin,int lmax,char context,int * changed)447 int set_lag_prefs_from_minmax (int v, int lmin, int lmax,
448 char context, int *changed)
449 {
450 lagpref *lpref = get_saved_lpref(v, context);
451 int mod, err = 0;
452
453 *changed = 0;
454
455 if (lpref == NULL && minmax_defaults(lmin, lmax, context)) {
456 return 0;
457 }
458
459 if (lpref == NULL) {
460 *changed = 1;
461 lpref = lpref_add(v, context, LAGS_NONE);
462 }
463
464 if (lpref == NULL) {
465 err = E_ALLOC;
466 } else {
467 mod = modify_lpref(lpref, LAGS_MINMAX, lmin, lmax, NULL);
468 if (mod) {
469 *changed = 1;
470 }
471 }
472
473 return err;
474 }
475
476 /* push a specific lag onto the list of lags for a variable */
477
set_lag_pref_from_lag(int v,int lag,char context)478 static int set_lag_pref_from_lag (int v, int lag, char context)
479 {
480 lagpref *lpref = get_saved_lpref(v, context);
481 int err = 0;
482
483 if (lpref == NULL) {
484 lpref = lpref_add(v, context, LAGS_LIST);
485 }
486
487 if (lpref == NULL) {
488 err = E_ALLOC;
489 } else {
490 modify_lpref(lpref, LAGS_TMP, lag, 0, NULL);
491 if (lpref->lspec.laglist == NULL) {
492 err = E_ALLOC;
493 }
494 }
495
496 return err;
497 }
498
parent_in_list(const int * list,int p)499 static int parent_in_list (const int *list, int p)
500 {
501 int i;
502
503 for (i=1; i<=list[0]; i++) {
504 if (list[i] == p || list[i] == -p) {
505 return 1;
506 }
507 }
508
509 return 0;
510 }
511
512 /* get lag preferences out of a list of regressors or instruments
513 from a pre-existing model */
514
set_lag_prefs_from_xlist(int * list,int dv,char cbase,int * pnset)515 static int set_lag_prefs_from_xlist (int *list, int dv, char cbase,
516 int *pnset)
517 {
518 char context;
519 int i, vi, lag, pv;
520 int nset = 0;
521 int err = 0;
522
523 /* Search the list for recognizable lags and if we find any,
524 consolidate the lag information by variable
525 */
526
527 for (i=1; i<=list[0] && !err; i++) {
528 vi = list[i];
529 if (vi == 0 || vi == LISTSEP) {
530 continue;
531 }
532 pv = 0;
533 lag = series_get_lag(dataset, vi);
534 if (lag) {
535 pv = series_get_parent_id(dataset, vi);
536 }
537 if (pv > 0) {
538 context = (pv == dv)? cbase + 1 : cbase;
539 err = set_lag_pref_from_lag(pv, lag, context);
540 if (!err) {
541 if (pv != dv && !parent_in_list(list, pv)) {
542 /* convert to "ghost" list entry for parent variable */
543 list[i] = -pv;
544 } else {
545 /* delete lagged var from list to avoid duplication */
546 gretl_list_delete_at_pos(list, i--);
547 }
548 enable_lags_for_context(context, TRUE);
549 nset++;
550 }
551 }
552 }
553
554 /* Now check whether any lagged vars were also present in
555 contemporaneous form. Note that recognizable lags have been
556 removed by now, and also that we don't need to bother about the
557 dependent variable. Also note that negative variable numbers
558 mark positions in the list where a "ghost" entry has been
559 inserted for a parent variable that is present only in lagged
560 form: at this point we restore the correct variable number.
561 */
562
563 if (!err && nset > 0) {
564 lagpref *lpref;
565
566 for (i=1; i<=list[0]; i++) {
567 vi = list[i];
568 if (vi == LISTSEP) {
569 continue;
570 }
571 if (vi < 0) {
572 /* fix "ghosted" contemporaneous var */
573 list[i] = -vi;
574 } else {
575 /* genuine contemporaneous var */
576 lpref = get_saved_lpref(vi, cbase);
577 if (lpref != NULL) {
578 /* insert lag 0 */
579 set_lag_pref_from_lag(vi, 0, cbase);
580 }
581 }
582 }
583 }
584
585 if (pnset != NULL) {
586 *pnset = nset;
587 }
588
589 return err;
590 }
591
592 /* convert any singleton or consecutive lists of lags (produced
593 piecewise from a model's lists) to min/max form
594 */
595
clean_up_model_prefs(void)596 static void clean_up_model_prefs (void)
597 {
598 int *list;
599 int i, lmin, lmax;
600
601 for (i=0; i<n_prefs; i++) {
602 list = gretl_list_sort(lprefs[i]->lspec.laglist);
603 lmin = list[1];
604 lmax = list[list[0]];
605 if (lmax - lmin == list[0] - 1) {
606 /* singleton or consecutive */
607 modify_lpref(lprefs[i], LAGS_MINMAX, lmin, lmax, NULL);
608 }
609 }
610
611 }
612
613 /* Read the lists of regressors and instruments from a saved model,
614 parse the lags info in these lists and convert to saved
615 "lagpref" form.
616 */
617
set_lag_prefs_from_model(int dv,int * xlist,int * zlist)618 int set_lag_prefs_from_model (int dv, int *xlist, int *zlist)
619 {
620 int n, nset = 0;
621 int err = 0;
622
623 /* start with a clean slate */
624 destroy_lag_preferences();
625 enable_lags_for_context(LAG_Y_X, FALSE);
626 enable_lags_for_context(LAG_Y_W, FALSE);
627
628 if (xlist != NULL) {
629 /* regressors */
630 err = set_lag_prefs_from_xlist(xlist, dv, LAG_X, &n);
631 nset += n;
632 }
633
634 if (!err && zlist != NULL) {
635 /* instruments */
636 err = set_lag_prefs_from_xlist(zlist, dv, LAG_W, &n);
637 nset += n;
638 }
639
640 if (nset > 0) {
641 clean_up_model_prefs();
642 }
643
644 return err;
645 }
646
set_lag_prefs_from_VAR(const int * lags,int * xlist)647 int set_lag_prefs_from_VAR (const int *lags, int *xlist)
648 {
649 int err = 0;
650
651 /* start with a clean slate */
652 destroy_lag_preferences();
653
654 /* lags of endogenous variables */
655 if (lags != NULL) {
656 int *list = gretl_list_copy(lags);
657 int ch;
658
659 if (list == NULL) {
660 err = E_ALLOC;
661 } else {
662 /* set directly from a given lag list */
663 err = set_lag_prefs_from_list(VDEFLT, list, LAG_Y_V, &ch);
664 }
665 }
666
667 /* lags among exogenous vars */
668 if (!err && xlist != NULL) {
669 int nset = 0;
670
671 err = set_lag_prefs_from_xlist(xlist, -1, LAG_X, &nset);
672 if (nset > 0) {
673 clean_up_model_prefs();
674 }
675 }
676
677 return err;
678 }
679
set_null_lagpref(int v,char context,int * changed)680 void set_null_lagpref (int v, char context, int *changed)
681 {
682 lagpref *lpref = get_saved_lpref(v, context);
683
684 if (lpref != NULL) {
685 *changed = modify_lpref(lpref, LAGS_NONE, 0, 0, NULL);
686 } else {
687 *changed = 0;
688 }
689 }
690
691 void
get_lag_preference(int v,int * lmin,int * lmax,const int ** laglist,char context,selector * sr)692 get_lag_preference (int v, int *lmin, int *lmax, const int **laglist,
693 char context, selector *sr)
694 {
695 lagpref *lpref = get_saved_lpref(v, context);
696
697 *lmin = *lmax = 0;
698 *laglist = NULL;
699
700 if (context == LAG_Y_V && lpref == NULL) {
701 *lmin = 1;
702 if (sr != NULL) {
703 *lmax = selector_get_VAR_order(sr);
704 }
705 return;
706 }
707
708 if (!lags_enabled_for_context(context)) {
709 return;
710 }
711
712 if ((context == LAG_Y_X || context == LAG_Y_W) && lpref == NULL) {
713 *lmin = *lmax = 1;
714 return;
715 }
716
717 if (lpref == NULL || v >= dataset->v) {
718 return;
719 }
720
721 if (lpref->spectype == LAGS_LIST) {
722 *laglist = lpref->lspec.laglist;
723 } else if (lpref->spectype == LAGS_MINMAX) {
724 *lmin = lpref->lspec.lminmax[0];
725 *lmax = lpref->lspec.lminmax[1];
726 }
727 }
728
get_lag_pref_as_list(int v,char context)729 int *get_lag_pref_as_list (int v, char context)
730 {
731 lagpref *lpref = get_saved_lpref(v, context);
732 int *list = NULL;
733
734 #if LDEBUG
735 fprintf(stderr, "get_lag_pref_as_list: var = %d, context = %d\n", v, context);
736 #endif
737
738 if (!lags_enabled_for_context(context)) {
739 return NULL;
740 }
741
742 if ((context == LAG_Y_X || context == LAG_Y_W) && lpref == NULL) {
743 /* the default: a single lag */
744 list = gretl_list_new(1);
745 if (list != NULL) {
746 list[1] = 1;
747 }
748 return list;
749 }
750
751 if (lpref != NULL) {
752 if (lpref->spectype == LAGS_LIST) {
753 list = gretl_list_copy(lpref->lspec.laglist);
754 } else if (lpref->spectype == LAGS_MINMAX) {
755 list = gretl_consecutive_list_new(lpref->lspec.lminmax[0],
756 lpref->lspec.lminmax[1]);
757 }
758 }
759
760 #if LDEBUG
761 printlist(list, "returned list");
762 #endif
763
764 return list;
765 }
766