1 /*
2 * gretl -- Gnu Regression, Econometrics and Time-series Library
3 * Copyright (C) 2001 Allin Cottrell and Riccardo "Jack" Lucchetti
4 *
5 * This program is free software: you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation, either version 3 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program. If not, see <http://www.gnu.org/licenses/>.
17 *
18 */
19
20 #include "libgretl.h"
21 #include "gretl_list.h"
22 #include "gretl_func.h"
23 #include "gretl_midas.h"
24 #include "libset.h"
25 #include "uservar.h"
26
27 #include <errno.h>
28 #include <glib.h>
29
30 #define LDEBUG 0
31
32 /**
33 * SECTION:gretl_list
34 * @short_description: handling of lists of integers
35 * @title: Lists
36 * @include: libgretl.h
37 *
38 * Lists of integers are used in many contexts in libgretl, e.g.
39 * for holding the ID numbers of variables in a regression
40 * specification. A gretl "list" is simply an array of ints
41 * following a definite convention: the value at position 0
42 * gives the number of elements that follow. The total number
43 * of ints in the list foo is therefore foo[0] + 1, and reading
44 * the substantive members of foo involves looping from
45 * position 1 to position foo[0].
46 */
47
48 /**
49 * LISTSEP:
50 *
51 * Symbolic name for the separator used in gretl lists; this
52 * corresponds to a semicolon in the string representation of
53 * a list.
54 */
55
56 /**
57 * gretl_is_midas_list:
58 * @list: the list array.
59 * @dset: pointer to dataset.
60 *
61 * Returns: 1 if @list has been set as a MIDAS list in an
62 * approved manner, 0 otherwise.
63 */
64
gretl_is_midas_list(const int * list,const DATASET * dset)65 int gretl_is_midas_list (const int *list, const DATASET *dset)
66 {
67 int ret = 0;
68
69 if (list != NULL && list[0] > 2) {
70 int i, m, p;
71
72 if (!series_is_midas_anchor(dset, list[1])) {
73 return 0;
74 }
75
76 m = series_get_midas_period(dset, list[1]);
77 if (!is_valid_midas_frequency_ratio(dset, m) || list[0] != m) {
78 return 0;
79 }
80
81 ret = 1;
82 for (i=2; i<=list[0] && ret; i++) {
83 p = series_get_midas_period(dset, list[i]);
84 if (p != m - 1) {
85 ret = 0;
86 }
87 m = p;
88 }
89 }
90
91 return ret;
92 }
93
94 /**
95 * gretl_list_set_midas:
96 * @list: the list array.
97 * @dset: pointer to dataset.
98 *
99 * Attempts to set the MIDAS flag on the members of @list.
100 *
101 * 0 on success, non-zero code on failure.
102 */
103
gretl_list_set_midas(const int * list,DATASET * dset)104 int gretl_list_set_midas (const int *list, DATASET *dset)
105 {
106 int err = 0;
107
108 if (list != NULL) {
109 int i, m = list[0];
110
111 if (!is_valid_midas_frequency_ratio(dset, m)) {
112 err = E_INVARG;
113 }
114
115 for (i=1; i<=list[0] && !err; i++) {
116 if (list[i] < 1 || list[i] >= dset->v) {
117 err = E_INVARG;
118 }
119 }
120
121 if (!err) {
122 int freq = get_midas_frequency(dset, m);
123
124 series_set_midas_anchor(dset, list[1]);
125 series_set_midas_period(dset, list[1], m);
126 series_set_midas_freq(dset, list[1], freq);
127
128 for (i=2; i<=list[0]; i++) {
129 series_set_midas_period(dset, list[i], m - i + 1);
130 series_set_midas_freq(dset, list[i], freq);
131 }
132 }
133 }
134
135 return err;
136 }
137
138 /**
139 * gretl_list_new:
140 * @nterms: the maximum number of elements to be stored in the list.
141 *
142 * Creates a newly allocated list with space for @nterms elements,
143 * besides the leading element, which in a gretl list always
144 * holds a count of the number of elements that follow. This
145 * leading element is initialized appropriately. For example, if
146 * @nterms = 4, space for 5 integers is allocated and the first
147 * element of the array is set to 4. The other elements of
148 * the list are initialized to 0.
149 *
150 * Returns: the newly allocated list, or NULL on failure.
151 */
152
gretl_list_new(int nterms)153 int *gretl_list_new (int nterms)
154 {
155 int *list = NULL;
156 int i;
157
158 if (nterms < 0) {
159 return NULL;
160 }
161
162 list = malloc((nterms + 1) * sizeof *list);
163
164 if (list != NULL) {
165 list[0] = nterms;
166 for (i=1; i<=nterms; i++) {
167 list[i] = 0;
168 }
169 }
170
171 return list;
172 }
173
174 /**
175 * gretl_list_array_new:
176 * @nlists: the number of lists to create.
177 * @nterms: the maximum number of elements to be stored in each list.
178 *
179 * Creates an array of newly allocated lists, each of which as described
180 * in connection with gretl_list_new().
181 *
182 * Returns: the newly allocated lists, or NULL on failure.
183 */
184
gretl_list_array_new(int nlists,int nterms)185 int **gretl_list_array_new (int nlists, int nterms)
186 {
187 int **lists = NULL;
188 int i;
189
190 if (nlists < 0) {
191 return NULL;
192 }
193
194 lists = malloc(nlists * sizeof *lists);
195
196 if (lists != NULL) {
197 for (i=0; i<nlists; i++) {
198 lists[i] = gretl_list_new(nterms);
199 }
200 }
201
202 return lists;
203 }
204
205 /**
206 * gretl_list_array_free:
207 * @lists: array of gretl lists.
208 * @nlists: the number of lists in @lists.
209 *
210 * Frees all the lists in @lists and also the top-level pointer.
211 */
212
gretl_list_array_free(int ** lists,int nlists)213 void gretl_list_array_free (int **lists, int nlists)
214 {
215 if (lists != NULL) {
216 int i;
217
218 for (i=0; i<nlists; i++) {
219 free(lists[i]);
220 }
221 free(lists);
222 }
223 }
224
225 /**
226 * gretl_consecutive_list_new:
227 * @lmin: starting value for consecutive list elements.
228 * @lmax: ending value.
229 *
230 * Creates a newly allocated list whose elements run from
231 * @lmin to @lmax consecutively.
232 *
233 * Returns: the newly allocated list, or NULL on failure.
234 */
235
gretl_consecutive_list_new(int lmin,int lmax)236 int *gretl_consecutive_list_new (int lmin, int lmax)
237 {
238 int *list = NULL;
239 int i, n;
240
241 n = lmax - lmin + 1;
242 if (n <= 0) {
243 return NULL;
244 }
245
246 list = gretl_list_new(n);
247
248 if (list != NULL) {
249 for (i=0; i<n; i++) {
250 list[i+1] = lmin + i;
251 }
252 }
253
254 return list;
255 }
256
257 /**
258 * gretl_list_resize:
259 * @oldlist: pointer to list to be resized.
260 * @nterms: the new maximum number of elements for the list.
261 *
262 * Resizes the content of @oldlist to hold @nterms, and adjusts
263 * the first element to reflect the new size. If the new
264 * list is longer than the old, the extra elements are initialized
265 * to zero.
266 *
267 * Returns: the resized list, or NULL on failure.
268 */
269
gretl_list_resize(int ** oldlist,int nterms)270 int *gretl_list_resize (int **oldlist, int nterms)
271 {
272 int *list = NULL;
273 int i, oldn = 0;
274
275 if (nterms < 0 || oldlist == NULL) {
276 return NULL;
277 }
278
279 if (*oldlist != NULL) {
280 oldn = (*oldlist)[0];
281 if (nterms == oldn) {
282 /* no-op */
283 return *oldlist;
284 }
285 }
286
287 list = realloc(*oldlist, (nterms + 1) * sizeof *list);
288
289 if (list != NULL) {
290 list[0] = nterms;
291 *oldlist = list;
292 for (i=oldn+1; i<=list[0]; i++) {
293 list[i] = 0;
294 }
295 } else {
296 free(*oldlist);
297 *oldlist = NULL;
298 }
299
300 return list;
301 }
302
303 /**
304 * gretl_list_append_term:
305 * @plist: pointer to list to be augmented.
306 * @v: the term to be added.
307 *
308 * Resizes (or allocates from scratch) the content of @plist,
309 * so that it can hold one extra element, and sets the last
310 * element to @v.
311 *
312 * Returns: the augmented list, or NULL on failure.
313 */
314
gretl_list_append_term(int ** plist,int v)315 int *gretl_list_append_term (int **plist, int v)
316 {
317 int *list = NULL;
318
319 if (*plist == NULL) {
320 list = gretl_list_new(1);
321 if (list != NULL) {
322 list[1] = v;
323 }
324 } else {
325 int oldn = (*plist)[0];
326
327 list = realloc(*plist, (oldn + 2) * sizeof *list);
328 if (list != NULL) {
329 list[0] += 1;
330 list[list[0]] = v;
331 } else {
332 free(*plist);
333 }
334 }
335
336 *plist = list;
337
338 return list;
339 }
340
341 /**
342 * gretl_list_sort:
343 * @list: list to be sorted.
344 *
345 * Sorts the elements from position 1 to the end of @list
346 * in ascending order.
347 *
348 * Returns: the sorted list.
349 */
350
gretl_list_sort(int * list)351 int *gretl_list_sort (int *list)
352 {
353 int i, sorted = 1;
354
355 for (i=1; i<list[0]; i++) {
356 if (list[i] > list[i+1]) {
357 sorted = 0;
358 break;
359 }
360 }
361
362 if (!sorted) {
363 qsort(list + 1, list[0], sizeof *list, gretl_compare_ints);
364 }
365
366 return list;
367 }
368
369 /**
370 * gretl_list_cmp:
371 * @list1: gretl list.
372 * @list2: gretl list.
373 *
374 * Returns: 0 if @list1 and @list2 have identical content,
375 * otherwise 1.
376 */
377
gretl_list_cmp(const int * list1,const int * list2)378 int gretl_list_cmp (const int *list1, const int *list2)
379 {
380 int i;
381
382 if (list1 == NULL && list2 != NULL) {
383 return 1;
384 } else if (list1 != NULL && list2 == NULL) {
385 return 1;
386 } else if (list1 == NULL && list2 == NULL) {
387 return 0;
388 }
389
390 for (i=0; i<=list1[0]; i++) {
391 if (list2[i] != list1[i]) {
392 return 1;
393 }
394 }
395
396 return 0;
397 }
398
399 /**
400 * gretl_null_list:
401 *
402 * Creates a newly allocated "list" with only one member,
403 * which is set to zero.
404 *
405 * Returns: the newly allocated list, or NULL on failure.
406 */
407
gretl_null_list(void)408 int *gretl_null_list (void)
409 {
410 int *list = malloc(sizeof *list);
411
412 if (list != NULL) {
413 list[0] = 0;
414 }
415
416 return list;
417 }
418
419 /**
420 * gretl_list_copy:
421 * @src: an array of integers, the first element of which holds
422 * a count of the number of elements following.
423 *
424 * Returns: an allocated copy @src (or NULL if @src is NULL).
425 */
426
gretl_list_copy(const int * src)427 int *gretl_list_copy (const int *src)
428 {
429 int *targ = NULL;
430
431 if (src != NULL) {
432 int n = src[0] + 1;
433
434 targ = malloc(n * sizeof *targ);
435 if (targ != NULL) {
436 memcpy(targ, src, n * sizeof *targ);
437 }
438 }
439
440 return targ;
441 }
442
443 /**
444 * gretl_list_copy_from_pos:
445 * @src: an array of integers, the first element of which holds
446 * a count of the number of elements following.
447 *
448 * Returns: an allocated copy @src from position @pos onward
449 * (or NULL on failure).
450 */
451
gretl_list_copy_from_pos(const int * src,int pos)452 int *gretl_list_copy_from_pos (const int *src, int pos)
453 {
454 int *targ = NULL;
455 int i, n;
456
457 if (src != NULL && ((n = src[0] - pos + 1) > 0)) {
458 targ = gretl_list_new(n);
459 if (targ != NULL) {
460 for (i=1; i<=n; i++) {
461 targ[i] = src[i+pos-1];
462 }
463 }
464 }
465
466 return targ;
467 }
468
469 /**
470 * gretl_list_from_string:
471 * @str: string representation of list of integers.
472 * @err: location to receive error code.
473 *
474 * Reads a string containing a list of integers, separated by
475 * spaces and/or commas and possibly wrapped in parentheses,
476 * and constructs an array of these integers. The first
477 * element is the number of integers that follow.
478 * This function supports an abbreviation for consecutive
479 * (increasing) integers in the list, using the notation, e.g.,
480 * "1-4" as shorthand for "1 2 3 4".
481 *
482 * Returns: the allocated array, or NULL on failure.
483 */
484
gretl_list_from_string(const char * str,int * err)485 int *gretl_list_from_string (const char *str, int *err)
486 {
487 char *p, *q, *s, *next;
488 int i, r1, r2, rg;
489 int *list;
490 int n = 0;
491
492 if (str == NULL) {
493 *err = E_DATA;
494 return NULL;
495 }
496
497 /* 'p' marks the memory to be freed */
498 p = s = gretl_strdup(str);
499 if (s == NULL) {
500 *err = E_ALLOC;
501 return NULL;
502 }
503
504 *err = 0;
505
506 /* strip white space at both ends */
507 while (isspace(*s)) s++;
508 tailstrip(s);
509
510 /* strip parentheses or braces, if present */
511 if (*s == '(' || *s == '{') {
512 char close = (*s == '(')? ')' : '}';
513
514 n = strlen(s);
515 if (s[n-1] != close) {
516 /* got opening grouping character but no close */
517 *err = E_PARSE;
518 return NULL;
519 }
520 s[n-1] = '\0';
521 s++;
522 while (isspace(*s)) s++;
523 tailstrip(s);
524 }
525
526 q = s; /* copy relevant starting point */
527
528 gretl_charsub(s, ',', ' ');
529
530 errno = 0;
531
532 /* first pass: figure out the number of values
533 in the list, checking for errors as we go
534 */
535
536 n = 0; /* value counter */
537
538 while (*s && !*err) {
539 s += strspn(s, " ");
540 if (n > 0 && *s == ';') {
541 /* list separator */
542 n++;
543 s++;
544 continue;
545 }
546 r1 = strtol(s, &next, 10);
547 if (errno || next == s) {
548 fprintf(stderr, "gretl_list_from_string: '%s'\n", s);
549 *err = E_PARSE;
550 } else {
551 s = next;
552 if (*s == '-') {
553 /* hyphen indicating range? */
554 s++;
555 r2 = strtol(s, &next, 10);
556 if (errno || next == s) {
557 *err = E_PARSE;
558 } else if (r2 < r1) {
559 *err = E_PARSE;
560 } else {
561 n += r2 - r1 + 1;
562 }
563 s = next;
564 } else {
565 /* single numerical value */
566 n++;
567 }
568 }
569 }
570
571 if (*err || n == 0) {
572 free(p);
573 return NULL;
574 }
575
576 list = gretl_list_new(n);
577 if (list == NULL) {
578 *err = E_ALLOC;
579 free(p);
580 return NULL;
581 }
582
583 /* second pass: fill out the list (no error
584 checking should be needed at this stage)
585 */
586
587 s = q; /* back to start of string */
588 n = 1; /* list position indicator */
589
590 while (*s) {
591 s += strspn(s, " ");
592 if (*s == ';') {
593 list[n++] = LISTSEP;
594 s++;
595 continue;
596 }
597 r1 = strtol(s, &s, 10);
598 if (*s == '-') {
599 s++;
600 r2 = strtol(s, &s, 10);
601 rg = r2 - r1 + 1;
602 for (i=0; i<rg; i++) {
603 list[n++] = r1 + i;
604 }
605 } else {
606 list[n++] = r1;
607 }
608 }
609
610 free(p);
611
612 return list;
613 }
614
615 /**
616 * gretl_list_from_varnames:
617 * @str: string holding space-separated series names.
618 * @dset: pointer to dataset.
619 * @err: location to receive error code.
620 *
621 * Returns: an allocated gretl list holding the ID numbers of
622 * the series named in @str, or NULL on failure.
623 */
624
gretl_list_from_varnames(const char * str,const DATASET * dset,int * err)625 int *gretl_list_from_varnames (const char *str,
626 const DATASET *dset,
627 int *err)
628 {
629 int *list = NULL;
630 char **S;
631 int n = 0;
632
633 if (str == NULL || count_fields(str, NULL) < 1) {
634 *err = E_DATA;
635 return NULL;
636 }
637
638 S = gretl_string_split(str, &n, NULL);
639 if (S == NULL) {
640 *err = E_ALLOC;
641 return NULL;
642 }
643
644 list = gretl_list_new(n);
645
646 if (list == NULL) {
647 *err = E_ALLOC;
648 } else {
649 int i, vi;
650
651 for (i=0; i<n; i++) {
652 if (!strcmp(S[i], "0")) {
653 vi = 0;
654 } else {
655 vi = current_series_index(dset, S[i]);
656 }
657 if (vi < 0) {
658 *err = E_UNKVAR;
659 break;
660 } else {
661 list[i+1] = vi;
662 }
663 }
664 }
665
666 strings_array_free(S, n);
667
668 return list;
669 }
670
671 #define LN_10 2.30258509299404590
672
integer_length(int k)673 static int integer_length (int k)
674 {
675 double x = k;
676 int len = 0;
677
678 if (x < 0) {
679 x = fabs(x);
680 len = 1;
681 }
682
683 if (x < 10) {
684 len += 1;
685 } else {
686 len += (int) ceil(log(x)/LN_10);
687 len += (k % 10 == 0);
688 }
689
690 return len;
691 }
692
693 /**
694 * gretl_list_to_numeric_string:
695 * @list: array of integers.
696 *
697 * Prints the given @list of integers into a newly
698 * allocated string, separated by single spaces and with
699 * one leading space.
700 *
701 * Returns: The string representation of the list on success,
702 * or NULL on failure.
703 */
704
gretl_list_to_numeric_string(const int * list)705 char *gretl_list_to_numeric_string (const int *list)
706 {
707 char *buf;
708 int i, len = 1;
709
710 for (i=1; i<=list[0]; i++) {
711 if (list[i] == LISTSEP) {
712 len += 2;
713 } else {
714 len += integer_length(list[i]) + 1;
715 }
716 }
717
718 if (len > MAXLINE - 32) {
719 /* string would be too long for command line */
720 return NULL;
721 }
722
723 buf = malloc(len);
724
725 if (buf != NULL) {
726 char numstr[16];
727
728 *buf = '\0';
729 for (i=1; i<=list[0]; i++) {
730 if (list[i] == LISTSEP) {
731 strcat(buf, " ;");
732 } else {
733 sprintf(numstr, " %d", list[i]);
734 strcat(buf, numstr);
735 }
736 }
737 }
738
739 return buf;
740 }
741
742 /**
743 * gretl_list_to_string:
744 * @list: array of integers.
745 * @dset: pointer to dataset.
746 * @err: location to receive error code.
747 *
748 * Returns: allocated string representation of @list, with ID
749 * numbers cashed out as series names (and with one leading
750 * space), or NULL on failure. The list separator #LISTSEP,
751 * is accepted in the incoming @list, otherwise all terms
752 * must be integers in the range 0 to the greatest current
753 * series ID within @dset.
754 */
755
gretl_list_to_string(const int * list,const DATASET * dset,int * err)756 char *gretl_list_to_string (const int *list,
757 const DATASET *dset,
758 int *err)
759 {
760 char *buf = NULL;
761 int len = 1;
762 int i, vi;
763
764 if (list == NULL) {
765 *err = E_DATA;
766 return NULL;
767 }
768
769 if (list[0] == 0) {
770 return gretl_strdup("");
771 }
772
773 for (i=1; i<=list[0]; i++) {
774 vi = list[i];
775 if (vi == LISTSEP) {
776 len += 2;
777 } else if (vi >= 0 && vi < dset->v) {
778 len += strlen(dset->varname[vi]) + 1;
779 } else {
780 *err = E_DATA;
781 return NULL;
782 }
783 }
784
785 buf = calloc(len, 1);
786
787 if (buf == NULL) {
788 *err = E_ALLOC;
789 } else {
790 for (i=1; i<=list[0]; i++) {
791 vi = list[i];
792 if (vi == LISTSEP) {
793 strcat(buf, " ;");
794 } else {
795 strcat(buf, " ");
796 strcat(buf, dset->varname[vi]);
797 }
798 }
799 }
800
801 return buf;
802 }
803
804 /**
805 * gretl_list_to_vector:
806 * @list: array of integers.
807 * @err: location to receive error code.
808 *
809 * Returns: allocated representation of @list as a row vector
810 * or NULL on failure.
811 */
812
gretl_list_to_vector(const int * list,int * err)813 gretl_matrix *gretl_list_to_vector (const int *list, int *err)
814 {
815 gretl_vector *v = NULL;
816
817 if (list == NULL) {
818 *err = E_DATA;
819 } else {
820 int i, n = list[0];
821
822 if (n == 0) {
823 v = gretl_null_matrix_new();
824 if (v == NULL) {
825 *err = E_ALLOC;
826 }
827 } else if (n > 0) {
828 v = gretl_vector_alloc(n);
829 if (v == NULL) {
830 *err = E_ALLOC;
831 } else {
832 for (i=0; i<n; i++) {
833 v->val[i] = list[i+1];
834 }
835 }
836 } else {
837 *err = E_DATA;
838 }
839 }
840
841 return v;
842 }
843
844 /**
845 * gretl_list_get_names:
846 * @list: array of integers.
847 * @dset: dataset information.
848 * @err: location to receive error code.
849 *
850 * Prints the names of the members of @list of integers into
851 * a newly allocated string, separated by commas.
852 *
853 * Returns: allocated string on success or NULL on failure.
854 */
855
gretl_list_get_names(const int * list,const DATASET * dset,int * err)856 char *gretl_list_get_names (const int *list, const DATASET *dset,
857 int *err)
858 {
859 char *buf = NULL;
860 int len = 0;
861 int i, vi;
862
863 if (list == NULL) {
864 *err = E_DATA;
865 return NULL;
866 }
867
868 if (list[0] == 0) {
869 return gretl_strdup("");
870 }
871
872 for (i=1; i<=list[0]; i++) {
873 vi = list[i];
874 if (vi < 0 || vi >= dset->v) {
875 len += strlen("unknown") + 1;
876 } else {
877 len += strlen(dset->varname[vi]) + 1;
878 }
879 }
880
881 buf = malloc(len);
882 if (buf == NULL) {
883 *err = E_ALLOC;
884 return NULL;
885 }
886
887 *buf = '\0';
888
889 for (i=1; i<=list[0]; i++) {
890 vi = list[i];
891 if (vi < 0 || vi >= dset->v) {
892 strcat(buf, "unknown");
893 } else {
894 strcat(buf, dset->varname[vi]);
895 }
896 if (i < list[0]) {
897 strcat(buf, ",");
898 }
899 }
900
901 return buf;
902 }
903
904 /**
905 * gretl_list_get_names_array:
906 * @list: array of integers.
907 * @dset: dataset information.
908 * @err: location to receive error code.
909 *
910 * Returns: An array of strings holding the names of the
911 * members of @list, or NULL on failure.
912 */
913
gretl_list_get_names_array(const int * list,const DATASET * dset,int * err)914 char **gretl_list_get_names_array (const int *list,
915 const DATASET *dset,
916 int *err)
917 {
918 char **S = NULL;
919 int i, vi, n;
920
921 if (list == NULL) {
922 *err = E_DATA;
923 return NULL;
924 }
925
926 if (list[0] == 0) {
927 return NULL;
928 }
929
930 n = list[0];
931
932 S = strings_array_new(n);
933 if (S == NULL) {
934 *err = E_ALLOC;
935 return NULL;
936 }
937
938 for (i=0; i<n; i++) {
939 vi = list[i+1];
940 if (vi < 0 || vi >= dset->v) {
941 S[i] = gretl_strdup("unknown");
942 } else {
943 S[i] = gretl_strdup(dset->varname[vi]);
944 }
945 if (S[i] == NULL) {
946 *err = E_ALLOC;
947 strings_array_free(S, n);
948 S = NULL;
949 break;
950 }
951 }
952
953 return S;
954 }
955
956 /**
957 * gretl_list_to_lags_string:
958 * @list: array of integers.
959 * @err: location to receive error code.
960 *
961 * Prints the given @list of integers into a newly
962 * allocated string, enclosed by braces and separated by commas.
963 * Will fail if @list contains any numbers greater than 998.
964 *
965 * Returns: The string representation of the list on success,
966 * or NULL on failure.
967 */
968
gretl_list_to_lags_string(const int * list,int * err)969 char *gretl_list_to_lags_string (const int *list, int *err)
970 {
971 char *buf;
972 char numstr[16];
973 int len, i;
974
975 len = 4 * (list[0] + 1) + 2;
976
977 if (len > MAXLINE - 32) {
978 *err = E_DATA;
979 return NULL;
980 }
981
982 buf = calloc(len, 1);
983 if (buf == NULL) {
984 *err = E_ALLOC;
985 return NULL;
986 }
987
988 for (i=1; i<=list[0]; i++) {
989 if (abs(list[i] >= 999)) {
990 *err = E_DATA;
991 break;
992 } else {
993 if (i == 1) {
994 sprintf(numstr, "{%d", list[i]);
995 } else {
996 sprintf(numstr, ",%d", list[i]);
997 }
998 strcat(buf, numstr);
999 }
1000 }
1001 strcat(buf, "}");
1002
1003 if (*err) {
1004 free(buf);
1005 buf = NULL;
1006 }
1007
1008 return buf;
1009 }
1010
1011 /**
1012 * in_gretl_list:
1013 * @list: an array of integers, the first element of which holds
1014 * a count of the number of elements following.
1015 * @k: integer to test.
1016 *
1017 * Checks whether @k is present among the members of @list,
1018 * in position 1 or higher.
1019 *
1020 * Returns: the position of @k in @list, or 0 if @k is not
1021 * present.
1022 */
1023
in_gretl_list(const int * list,int k)1024 int in_gretl_list (const int *list, int k)
1025 {
1026 int i;
1027
1028 if (list != NULL) {
1029 for (i=1; i<=list[0]; i++) {
1030 if (list[i] == k) {
1031 return i;
1032 }
1033 }
1034 }
1035
1036 return 0;
1037 }
1038
reglist_move_const(int * list,int k)1039 static void reglist_move_const (int *list, int k)
1040 {
1041 int i, cnum = list[k];
1042
1043 for (i=k; i>2; i--) {
1044 list[i] = list[i-1];
1045 }
1046
1047 list[2] = cnum;
1048 }
1049
1050 /**
1051 * reglist_check_for_const:
1052 * @list: regression list suitable for use with a gretl
1053 * model (should not contain #LISTSEP).
1054 * @dset: dataset struct.
1055 *
1056 * Checks @list for an intercept term (a variable all of
1057 * whose valid values in sample are 1). If such a variable
1058 * is present, it is moved to position 2 in the list.
1059 *
1060 * Returns: 1 if the list contains an intercept, else 0.
1061 */
1062
reglist_check_for_const(int * list,const DATASET * dset)1063 int reglist_check_for_const (int *list, const DATASET *dset)
1064 {
1065 int cpos = gretl_list_const_pos(list, 2, dset);
1066 int ret = 0;
1067
1068 if (cpos > 1) {
1069 ret = 1;
1070 }
1071
1072 if (cpos > 2) {
1073 reglist_move_const(list, cpos);
1074 }
1075
1076 return ret;
1077 }
1078
1079 /**
1080 * gretl_list_delete_at_pos:
1081 * @list: an array of integers, the first element of which holds
1082 * a count of the number of elements following.
1083 * @pos: position at which to delete list element.
1084 *
1085 * Deletes the element at position @pos from @list and moves any
1086 * remaining elements forward. Decrements the value of the first,
1087 * counter, element of @list.
1088 *
1089 * Returns: 0 on success, 1 on error.
1090 */
1091
gretl_list_delete_at_pos(int * list,int pos)1092 int gretl_list_delete_at_pos (int *list, int pos)
1093 {
1094 int i, err = 0;
1095
1096 if (pos < 1 || pos > list[0]) {
1097 err = 1;
1098 } else {
1099 for (i=pos; i<list[0]; i++) {
1100 list[i] = list[i + 1];
1101 }
1102
1103 list[list[0]] = 0;
1104 list[0] -= 1;
1105 }
1106
1107 return err;
1108 }
1109
1110 /**
1111 * gretl_list_purge_const:
1112 * @list: list of variable ID numbers.
1113 * @dset: dataset struct.
1114 *
1115 * Checks @list from position 1 onward for the presence of a
1116 * variable whose valid values in sample all equal 1.0. If
1117 * such a variable is found, it is deleted from @list (that is,
1118 * any following elements are moved forward by one and list[0]
1119 * is decremented by 1).
1120 *
1121 * Returns: 1 if a constant was found and deleted, else 0.
1122 */
1123
gretl_list_purge_const(int * list,const DATASET * dset)1124 int gretl_list_purge_const (int *list, const DATASET *dset)
1125 {
1126 int i, gotc = 0;
1127 int l0 = list[0];
1128
1129 /* handle the case where the constant comes last; if it's
1130 the only element behind the list separator, remove both
1131 the constant and the separator */
1132
1133 if (list[l0] == 0 || true_const(list[l0], dset)) {
1134 gotc = 1;
1135 list[0] -= 1;
1136 if (list[l0 - 1] == LISTSEP) {
1137 list[l0 - 1] = 0;
1138 list[0] -= 1;
1139 }
1140 } else {
1141 for (i=1; i<l0; i++) {
1142 if (list[i] == 0 || true_const(list[i], dset)) {
1143 for ( ; i<l0; i++) {
1144 list[i] = list[i+1];
1145 }
1146 list[l0] = 0;
1147 list[0] -= 1;
1148 gotc = 1;
1149 break;
1150 }
1151 }
1152 }
1153
1154 return gotc;
1155 }
1156
1157 /**
1158 * gretl_list_min_max:
1159 * @list: gretl list.
1160 * @lmin: location to receive minimum value.
1161 * @lmax: location to receive maximum value.
1162 *
1163 * Reads @list from position 1 onward and writes to @lmin
1164 * and @lmax the minimum and maximum values among the elements
1165 * of the list. Reading stops at the end of the list or when
1166 * a list separator is encountered.
1167 *
1168 * Returns: 0 on successful completion, error code if the
1169 * list is NULL or empty.
1170 */
1171
gretl_list_min_max(const int * list,int * lmin,int * lmax)1172 int gretl_list_min_max (const int *list, int *lmin, int *lmax)
1173 {
1174 if (list == NULL || list[0] == 0) {
1175 return E_DATA;
1176 } else {
1177 int i;
1178
1179 *lmin = *lmax = list[1];
1180
1181 for (i=2; i<=list[0]; i++) {
1182 if (list[i] < *lmin) {
1183 *lmin = list[i];
1184 }
1185 if (list[i] > *lmax) {
1186 *lmax = list[i];
1187 }
1188 }
1189
1190 return 0;
1191 }
1192 }
1193
1194 /**
1195 * gretl_list_add:
1196 * @orig: an array of integers, the first element of which holds
1197 * a count of the number of elements following.
1198 * @add: list of variables to be added.
1199 * @err: location to receive error code.
1200 *
1201 * Creates a list containing the union of elements of @orig
1202 * and the elements of @add. If one or more elements of
1203 * @add were already present in @orig, the error code is
1204 * %E_ADDDUP.
1205 *
1206 * Returns: new list on success, NULL on error.
1207 */
1208
gretl_list_add(const int * orig,const int * add,int * err)1209 int *gretl_list_add (const int *orig, const int *add, int *err)
1210 {
1211 int n_orig = orig[0];
1212 int n_add = add[0];
1213 int i, j, k;
1214 int *big;
1215
1216 *err = 0;
1217
1218 big = gretl_list_new(n_orig + n_add);
1219 if (big == NULL) {
1220 *err = E_ALLOC;
1221 return NULL;
1222 }
1223
1224 for (i=0; i<=n_orig; i++) {
1225 big[i] = orig[i];
1226 }
1227
1228 k = orig[0];
1229
1230 for (i=1; i<=n_add; i++) {
1231 for (j=1; j<=n_orig; j++) {
1232 if (add[i] == orig[j]) {
1233 /* a "new" var was already present */
1234 free(big);
1235 *err = E_ADDDUP;
1236 return NULL;
1237 }
1238 }
1239 big[0] += 1;
1240 big[++k] = add[i];
1241 }
1242
1243 if (big[0] == n_orig) {
1244 free(big);
1245 big = NULL;
1246 *err = E_NOADD;
1247 }
1248
1249 return big;
1250 }
1251
1252 /**
1253 * gretl_list_plus:
1254 * @l1: an array of integers, the first element of which holds
1255 * a count of the number of elements following.
1256 * @l2: list of variables to be added.
1257 * @err: location to receive error code.
1258 *
1259 * Creates a list containing all elements of @l1 followed
1260 * by all elements of @l2. This differs from gretl_list_union()
1261 * in that some elements may end up being repeated in the
1262 * returned list.
1263 *
1264 * Returns: new list on success, NULL on error.
1265 */
1266
gretl_list_plus(const int * l1,const int * l2,int * err)1267 int *gretl_list_plus (const int *l1, const int *l2, int *err)
1268 {
1269 int n1 = l1[0];
1270 int n2 = l2[0];
1271 int i, j;
1272 int *ret;
1273
1274 ret = gretl_list_new(n1 + n2);
1275 if (ret == NULL) {
1276 *err = E_ALLOC;
1277 return NULL;
1278 }
1279
1280 j = 1;
1281
1282 for (i=1; i<=n1; i++) {
1283 ret[j++] = l1[i];
1284 }
1285
1286 for (i=1; i<=n2; i++) {
1287 ret[j++] = l2[i];
1288 }
1289
1290 return ret;
1291 }
1292
1293 /**
1294 * gretl_list_union:
1295 * @l1: list of integers.
1296 * @l2: list of integers.
1297 * @err: location to receive error code.
1298 *
1299 * Creates a list holding the union of @l1 and @l2.
1300 *
1301 * Returns: new list on success, NULL on error.
1302 */
1303
gretl_list_union(const int * l1,const int * l2,int * err)1304 int *gretl_list_union (const int *l1, const int *l2, int *err)
1305 {
1306 int *ret, *lcopy;
1307 int n_orig = l1[0];
1308 int n_add = l2[0];
1309 int i, j, k;
1310
1311 *err = 0;
1312
1313 lcopy = gretl_list_copy(l2);
1314
1315 if (lcopy == NULL) {
1316 *err = E_ALLOC;
1317 return NULL;
1318 } else {
1319 /* see how many terms we're actually adding, if any */
1320 for (i=1; i<=l2[0]; i++) {
1321 if (lcopy[i] == -1) {
1322 continue;
1323 }
1324 k = in_gretl_list(l1, lcopy[i]);
1325 if (k > 0) {
1326 /* element already present in l1 */
1327 n_add--;
1328 lcopy[i] = -1;
1329 } else {
1330 /* not present in l1, but check for duplicates of
1331 this element in l2 */
1332 for (j=1; j<=l2[0]; j++) {
1333 if (j != i && l2[j] == l2[i]) {
1334 n_add--;
1335 lcopy[j] = -1;
1336 }
1337 }
1338 }
1339 }
1340 }
1341
1342 if (n_add == 0) {
1343 ret = gretl_list_copy(l1);
1344 } else {
1345 ret = gretl_list_new(n_orig + n_add);
1346 }
1347
1348 if (ret == NULL) {
1349 *err = E_ALLOC;
1350 } else if (n_add > 0) {
1351 for (i=1; i<=n_orig; i++) {
1352 ret[i] = l1[i];
1353 }
1354
1355 k = l1[0];
1356
1357 for (i=1; i<=lcopy[0]; i++) {
1358 if (lcopy[i] != -1) {
1359 ret[++k] = lcopy[i];
1360 }
1361 }
1362 }
1363
1364 free(lcopy);
1365
1366 return ret;
1367 }
1368
1369 /**
1370 * gretl_list_append_list:
1371 * @pl1: pointer to priginal list.
1372 * @l2: list to append.
1373 * @err: location to receive error code
1374 *
1375 * Creates a list holding the intersection of @l1 and @l2.
1376 *
1377 * Returns: new list on success, NULL on error.
1378 */
1379
gretl_list_append_list(int ** pl1,const int * l2,int * err)1380 int *gretl_list_append_list (int **pl1, const int *l2, int *err)
1381 {
1382 int *tmp, *l1 = NULL;
1383 int n, n1, n2;
1384
1385 if (pl1 == NULL) {
1386 *err = E_INVARG;
1387 return NULL;
1388 }
1389
1390 l1 = *pl1;
1391 n1 = l1 == NULL ? 0 : l1[0];
1392 n2 = l2 == NULL ? 0 : l2[0];
1393 n = n1 + n2;
1394
1395 if (n2 == 0) {
1396 /* nothing to be appended */
1397 return l1;
1398 }
1399
1400 tmp = realloc(l1, (n + 1) * sizeof *tmp);
1401 if (tmp == NULL) {
1402 *err = E_ALLOC;
1403 return NULL;
1404 } else {
1405 int i, j = n1 + 1;
1406
1407 tmp[0] = n;
1408 for (i=1; i<=n2; i++) {
1409 tmp[j++] = l2[i];
1410 }
1411 *pl1 = tmp;
1412 }
1413
1414 return *pl1;
1415 }
1416
1417 /**
1418 * gretl_list_intersection:
1419 * @l1: list of integers.
1420 * @l2: list of integers.
1421 * @err: location to receive error code.
1422 *
1423 * Creates a list holding the intersection of @l1 and @l2.
1424 *
1425 * Returns: new list on success, NULL on error.
1426 */
1427
gretl_list_intersection(const int * l1,const int * l2,int * err)1428 int *gretl_list_intersection (const int *l1, const int *l2, int *err)
1429 {
1430 int *ret = NULL;
1431 int i, j;
1432 int n = 0;
1433
1434 for (i=1; i<=l1[0]; i++) {
1435 for (j=1; j<=l2[0]; j++) {
1436 if (l2[j] == l1[i]) {
1437 n++;
1438 break;
1439 }
1440 }
1441 }
1442
1443 if (n == 0) {
1444 ret = gretl_null_list();
1445 } else {
1446 ret = gretl_list_new(n);
1447 if (ret != NULL) {
1448 n = 1;
1449 for (i=1; i<=l1[0]; i++) {
1450 for (j=1; j<=l2[0]; j++) {
1451 if (l2[j] == l1[i]) {
1452 ret[n++] = l1[i];
1453 break;
1454 }
1455 }
1456 }
1457 }
1458 }
1459
1460 if (ret == NULL) {
1461 *err = E_ALLOC;
1462 }
1463
1464 return ret;
1465 }
1466
name_xprod_term(char * vname,int vi,int vj,int di,const DATASET * dset)1467 static void name_xprod_term (char *vname, int vi, int vj,
1468 int di, const DATASET *dset)
1469 {
1470 const char *si = dset->varname[vi];
1471 const char *sj = dset->varname[vj];
1472 int ilen = strlen(si);
1473 int jlen = strlen(sj);
1474 int totlen = ilen + jlen + 2;
1475 char numstr[16];
1476
1477 sprintf(numstr, "%d", di);
1478 totlen += strlen(numstr);
1479
1480 if (totlen >= VNAMELEN) {
1481 int decr = 1 + totlen - VNAMELEN;
1482
1483 while (decr > 0) {
1484 if (ilen > jlen) {
1485 ilen--;
1486 } else {
1487 jlen--;
1488 }
1489 decr--;
1490 }
1491 }
1492
1493 sprintf(vname, "%.*s_%.*s_%s", ilen, si, jlen, sj, numstr);
1494 }
1495
set_xprod_label(int v,int vi,int vj,double val,DATASET * dset)1496 static void set_xprod_label (int v, int vi, int vj,
1497 double val, DATASET *dset)
1498 {
1499 const char *si = dset->varname[vi];
1500 const char *sj = dset->varname[vj];
1501 char label[MAXLABEL];
1502
1503 sprintf(label, "interaction of %s and (%s == %g)", si, sj, val);
1504 series_record_label(dset, v, label);
1505 }
1506
nonneg_integer_series(const DATASET * dset,int v)1507 static int nonneg_integer_series (const DATASET *dset, int v)
1508 {
1509 double xt;
1510 int t;
1511
1512 for (t=dset->t1; t<=dset->t2; t++) {
1513 xt = dset->Z[v][t];
1514 if (!na(xt) && (xt != floor(xt) || xt < 0)) {
1515 return 0;
1516 }
1517 }
1518
1519 return 1;
1520 }
1521
1522 /**
1523 * gretl_list_product:
1524 * @X: list of integers (representing discrete variables).
1525 * @Y: list of integers.
1526 * @dset: pointer to dataset.
1527 * @err: location to receive error code.
1528 *
1529 * Creates a list holding the Cartesian product of @X and @Y.
1530 *
1531 * Returns: new list on success, NULL on error.
1532 */
1533
gretl_list_product(const int * X,const int * Y,DATASET * dset,int * err)1534 int *gretl_list_product (const int *X, const int *Y,
1535 DATASET *dset, int *err)
1536 {
1537 int *ret = NULL;
1538 gretl_matrix *xvals;
1539 char vname[VNAMELEN];
1540 const double *x, *y;
1541 int *x_is_int = NULL;
1542 int newv, n_old = 0;
1543 int n, vi, vj;
1544 int i, j, k, t;
1545
1546 if (X == NULL || Y == NULL) {
1547 *err = E_DATA;
1548 return NULL;
1549 }
1550
1551 if (X[0] == 0 || Y[0] == 0) {
1552 ret = gretl_null_list();
1553 if (ret == NULL) {
1554 *err = E_ALLOC;
1555 }
1556 return ret;
1557 }
1558
1559 x_is_int = gretl_list_new(X[0]);
1560 if (x_is_int == NULL) {
1561 *err = E_ALLOC;
1562 return NULL;
1563 }
1564
1565 /* check the X list for discreteness */
1566
1567 for (j=1; j<=X[0] && !*err; j++) {
1568 vj = X[j];
1569 if (nonneg_integer_series(dset, vj)) {
1570 x_is_int[j] = 1;
1571 } else if (!series_is_discrete(dset, vj)) {
1572 gretl_errmsg_sprintf(_("The variable '%s' is not discrete"),
1573 dset->varname[vj]);
1574 *err = E_DATA;
1575 }
1576 }
1577
1578 if (*err) {
1579 free(x_is_int);
1580 return NULL;
1581 }
1582
1583 n = sample_size(dset);
1584 newv = dset->v;
1585
1586 for (j=1; j<=X[0] && !*err; j++) {
1587 vj = X[j];
1588 x = dset->Z[vj];
1589 xvals = gretl_matrix_values(x + dset->t1, n, OPT_S, err);
1590 if (!*err) {
1591 *err = dataset_add_series(dset, Y[0] * xvals->rows);
1592 if (!*err) {
1593 for (i=1; i<=Y[0] && !*err; i++) {
1594 vi = Y[i];
1595 y = dset->Z[vi];
1596 for (k=0; k<xvals->rows && !*err; k++) {
1597 int v, oldv, iik;
1598 double xik;
1599
1600 xik = gretl_vector_get(xvals, k);
1601 iik = x_is_int[j] ? (int) xik : (k + 1);
1602 name_xprod_term(vname, vi, vj, iik, dset);
1603 oldv = current_series_index(dset, vname);
1604 if (oldv > 0) {
1605 /* reuse existing series of the same name */
1606 v = oldv;
1607 n_old++;
1608 } else {
1609 /* make a new series */
1610 v = newv++;
1611 }
1612 for (t=dset->t1; t<=dset->t2; t++) {
1613 if (na(x[t]) || na(xik)) {
1614 dset->Z[v][t] = NADBL;
1615 } else {
1616 dset->Z[v][t] = (x[t] == xik)? y[t] : 0;
1617 }
1618 }
1619 gretl_list_append_term(&ret, v);
1620 if (ret == NULL) {
1621 *err = E_ALLOC;
1622 } else {
1623 if (v != oldv) {
1624 strcpy(dset->varname[v], vname);
1625 }
1626 set_xprod_label(v, vi, vj, xik, dset);
1627 }
1628 }
1629 }
1630 }
1631 gretl_matrix_free(xvals);
1632 }
1633 }
1634
1635 free(x_is_int);
1636
1637 if (n_old > 0) {
1638 /* we added more series than were actually needed */
1639 dataset_drop_last_variables(dset, n_old);
1640 }
1641
1642 return ret;
1643 }
1644
1645 /**
1646 * gretl_list_omit_last:
1647 * @orig: an array of integers, the first element of which holds
1648 * a count of the number of elements following.
1649 * @err: location to receive error code.
1650 *
1651 * Creates a list containing all but the last element of @orig,
1652 * which must not contain #LISTSEP and must contain at least
1653 * two members.
1654 *
1655 * Returns: new list on success, NULL on error.
1656 */
1657
gretl_list_omit_last(const int * orig,int * err)1658 int *gretl_list_omit_last (const int *orig, int *err)
1659 {
1660 int *list = NULL;
1661 int i;
1662
1663 *err = 0;
1664
1665 if (orig[0] < 2) {
1666 *err = E_NOVARS;
1667 } else {
1668 for (i=1; i<=orig[0]; i++) {
1669 if (orig[i] == LISTSEP) {
1670 /* can't handle compound lists */
1671 *err = 1;
1672 break;
1673 }
1674 }
1675 }
1676
1677 if (!*err) {
1678 list = gretl_list_new(orig[0] - 1);
1679 if (list == NULL) {
1680 *err = E_ALLOC;
1681 } else {
1682 for (i=1; i<orig[0]; i++) {
1683 list[i] = orig[i];
1684 }
1685 }
1686 }
1687
1688 return list;
1689 }
1690
list_count(const int * list)1691 static int list_count (const int *list)
1692 {
1693 int i, k = 0;
1694
1695 if (list == NULL) {
1696 return 0;
1697 }
1698
1699 for (i=1; i<=list[0]; i++) {
1700 if (list[i] == LISTSEP) {
1701 break;
1702 } else {
1703 k++;
1704 }
1705 }
1706
1707 return k;
1708 }
1709
1710 /**
1711 * gretl_list_omit:
1712 * @orig: an array of integers, the first element of which holds
1713 * a count of the number of elements following.
1714 * @omit: list of variables to drop.
1715 * @minpos: minimum position to check. This should be 2 for a regular
1716 * regression list, to skip the dependent var in position 1; but in
1717 * other contexts it may be 1 to start from the first element of @orig.
1718 * @err: pointer to receive error code.
1719 *
1720 * Creates a list containing the elements of @orig that are not
1721 * present in @omit. It is an error if the @omit list contains
1722 * members that are not present in @orig, and also if the @omit
1723 * list contains duplicated elements.
1724 *
1725 * Returns: new list on success, NULL on error.
1726 */
1727
gretl_list_omit(const int * orig,const int * omit,int minpos,int * err)1728 int *gretl_list_omit (const int *orig, const int *omit,
1729 int minpos, int *err)
1730 {
1731 int n_omit = omit[0];
1732 int n_orig = list_count(orig);
1733 int *ret = NULL;
1734 int i, j, k;
1735
1736 if (n_omit > n_orig) {
1737 *err = E_DATA;
1738 return NULL;
1739 }
1740
1741 *err = 0;
1742
1743 /* check for spurious "omissions" */
1744 for (i=1; i<=omit[0]; i++) {
1745 k = in_gretl_list(orig, omit[i]);
1746 if (k < minpos) {
1747 gretl_errmsg_sprintf(_("Variable %d was not in the original list"),
1748 omit[i]);
1749 *err = 1;
1750 return NULL;
1751 }
1752 }
1753
1754 ret = gretl_list_new(n_orig - n_omit);
1755
1756 if (ret == NULL) {
1757 *err = E_ALLOC;
1758 } else if (n_omit < n_orig) {
1759 int match;
1760
1761 k = 1;
1762 for (i=1; i<=n_orig; i++) {
1763 if (i < minpos) {
1764 ret[k++] = orig[i];
1765 } else {
1766 match = 0;
1767 for (j=1; j<=n_omit; j++) {
1768 if (orig[i] == omit[j]) {
1769 /* matching var: omit it */
1770 match = 1;
1771 break;
1772 }
1773 }
1774 if (!match) {
1775 /* var is not in omit list: keep it */
1776 ret[k++] = orig[i];
1777 }
1778 }
1779 }
1780 }
1781
1782 return ret;
1783 }
1784
1785 /**
1786 * gretl_list_drop:
1787 * @orig: an array of integers, the first element of which holds
1788 * a count of the number of elements following.
1789 * @drop: list of variables to drop.
1790 * @err: pointer to receive error code.
1791 *
1792 * Creates a list containing the elements of @orig that are not
1793 * present in @drop. Unlike gretl_list_omit(), processing always
1794 * starts from position 1 in @orig, and it is not an error if
1795 * some members of @drop are not present in @orig, or if some
1796 * members of @drop are duplicated.
1797 *
1798 * Returns: new list on success, NULL on error.
1799 */
1800
gretl_list_drop(const int * orig,const int * drop,int * err)1801 int *gretl_list_drop (const int *orig, const int *drop, int *err)
1802 {
1803 int *lcopy = NULL;
1804 int *ret = NULL;
1805 int n_omit = 0;
1806 int i, k;
1807
1808 *err = 0;
1809
1810 lcopy = gretl_list_copy(orig);
1811
1812 if (lcopy == NULL) {
1813 *err = E_ALLOC;
1814 return NULL;
1815 } else {
1816 /* see how many terms we're omitting */
1817 for (i=1; i<=drop[0]; i++) {
1818 k = in_gretl_list(lcopy, drop[i]);
1819 if (k > 0) {
1820 n_omit++;
1821 lcopy[k] = -1;
1822 }
1823 }
1824 }
1825
1826 if (n_omit == 0) {
1827 ret = lcopy;
1828 } else {
1829 ret = gretl_list_new(orig[0] - n_omit);
1830 if (ret == NULL) {
1831 *err = E_ALLOC;
1832 } else if (n_omit < orig[0]) {
1833 k = 1;
1834 for (i=1; i<=orig[0]; i++) {
1835 if (lcopy[i] >= 0) {
1836 ret[k++] = orig[i];
1837 }
1838 }
1839 }
1840 free(lcopy);
1841 }
1842
1843 return ret;
1844 }
1845
1846 /**
1847 * gretl_list_diff:
1848 * @targ: target list (must be pre-allocated).
1849 * @biglist: inclusive list.
1850 * @sublist: subset of biglist.
1851 *
1852 * Fills out @targ with the elements of @biglist, from position 2
1853 * onwards, that are not present in @sublist. It is assumed that
1854 * the variable ID number in position 1 (dependent variable) is the
1855 * same in both lists. It is an error if, from position 2 on,
1856 * @sublist is not a proper subset of @biglist. See also
1857 * #gretl_list_diff_new.
1858 *
1859 * Returns: 0 on success, 1 on error.
1860 */
1861
gretl_list_diff(int * targ,const int * biglist,const int * sublist)1862 int gretl_list_diff (int *targ, const int *biglist, const int *sublist)
1863 {
1864 int i, j, k, n;
1865 int match, err = 0;
1866
1867 n = biglist[0] - sublist[0];
1868 targ[0] = n;
1869
1870 if (n <= 0) {
1871 err = 1;
1872 } else {
1873 k = 1;
1874 for (i=2; i<=biglist[0]; i++) {
1875 match = 0;
1876 for (j=2; j<=sublist[0]; j++) {
1877 if (sublist[j] == biglist[i]) {
1878 match = 1;
1879 break;
1880 }
1881 }
1882 if (!match) {
1883 if (k <= n) {
1884 targ[k++] = biglist[i];
1885 } else {
1886 err = 1;
1887 }
1888 }
1889 }
1890 }
1891
1892 return err;
1893 }
1894
1895 /**
1896 * gretl_list_diff_new:
1897 * @biglist: inclusive list.
1898 * @sublist: subset of biglist.
1899 * @minpos: position in lists at which to start.
1900 *
1901 * Returns: a newly allocated list including the elements of @biglist,
1902 * from position @minpos onwards, that are not present in @sublist,
1903 * again from @minpos onwards, or NULL on failure. Note that
1904 * comparison stops whenever a list separator is found; i.e. only
1905 * the pre-separator portions of the lists are compared.
1906 */
1907
gretl_list_diff_new(const int * biglist,const int * sublist,int minpos)1908 int *gretl_list_diff_new (const int *biglist, const int *sublist,
1909 int minpos)
1910 {
1911 int *targ = NULL;
1912 int i, j, bi;
1913 int match;
1914
1915 if (biglist == NULL || sublist == NULL) {
1916 return NULL;
1917 }
1918
1919 targ = gretl_null_list();
1920 if (targ == NULL) {
1921 return NULL;
1922 }
1923
1924 for (i=minpos; i<=biglist[0]; i++) {
1925 bi = biglist[i];
1926 if (bi == LISTSEP) {
1927 break;
1928 }
1929 match = 0;
1930 for (j=minpos; j<=sublist[0]; j++) {
1931 if (sublist[j] == LISTSEP) {
1932 break;
1933 } else if (sublist[j] == bi) {
1934 match = 1;
1935 break;
1936 }
1937 }
1938 if (!match) {
1939 /* but is this var already accounted for? */
1940 for (j=1; j<=targ[0]; j++) {
1941 if (targ[j] == bi) {
1942 match = 1;
1943 break;
1944 }
1945 }
1946 }
1947 if (!match) {
1948 targ = gretl_list_append_term(&targ, biglist[i]);
1949 if (targ == NULL) {
1950 break;
1951 }
1952 }
1953 }
1954
1955 return targ;
1956 }
1957
1958 /**
1959 * gretl_list_add_list:
1960 * @targ: location of list to which @src should be added.
1961 * @src: list to be added to @targ.
1962 *
1963 * Adds @src onto the end of @targ. The length of @targ becomes the
1964 * sum of the lengths of the two original lists.
1965 *
1966 * Returns: 0 on success, non-zero on failure.
1967 */
1968
gretl_list_add_list(int ** targ,const int * src)1969 int gretl_list_add_list (int **targ, const int *src)
1970 {
1971 int *big;
1972 int i, n1, n2;
1973 int err = 0;
1974
1975 if (targ == NULL || *targ == NULL) {
1976 return E_DATA;
1977 }
1978
1979 if (src == NULL || src[0] == 0) {
1980 /* no-op */
1981 return 0;
1982 }
1983
1984 n1 = (*targ)[0];
1985 n2 = src[0];
1986
1987 big = realloc(*targ, (n1 + n2 + 1) * sizeof *big);
1988
1989 if (big == NULL) {
1990 err = E_ALLOC;
1991 } else {
1992 big[0] = n1 + n2;
1993 for (i=1; i<=src[0]; i++) {
1994 big[n1 + i] = src[i];
1995 }
1996 *targ = big;
1997 }
1998
1999 return err;
2000 }
2001
2002 /**
2003 * gretl_list_insert_list:
2004 * @targ: location of list into which @src should be inserted.
2005 * @src: list to be inserted.
2006 * @pos: zero-based position at which @src should be inserted.
2007 *
2008 * Inserts @src into @targ at @pos. The length of @targ becomes the
2009 * sum of the lengths of the two original lists.
2010 *
2011 * Returns: 0 on success, non-zero on failure.
2012 */
2013
gretl_list_insert_list(int ** targ,const int * src,int pos)2014 int gretl_list_insert_list (int **targ, const int *src, int pos)
2015 {
2016 int *big;
2017 int n1 = (*targ)[0];
2018 int n2 = src[0];
2019 int bign = n1 + n2;
2020 int i, err = 0;
2021
2022 if (pos > n1 + 1) {
2023 return 1;
2024 }
2025
2026 big = realloc(*targ, (bign + 1) * sizeof *big);
2027
2028 if (big == NULL) {
2029 err = E_ALLOC;
2030 } else {
2031 big[0] = bign;
2032 for (i=bign; i>=pos+n2; i--) {
2033 big[i] = big[i-n2];
2034 }
2035 for (i=1; i<=src[0]; i++) {
2036 big[pos+i-1] = src[i];
2037 }
2038 *targ = big;
2039 }
2040
2041 return err;
2042 }
2043
2044 /**
2045 * gretl_list_insert_list_minus:
2046 * @targ: location of list into which @src should be inserted.
2047 * @src: list to be inserted.
2048 * @pos: zero-based position at which @src should be inserted.
2049 *
2050 * Inserts @src into @targ at @pos. The length of @targ becomes the
2051 * sum of the lengths of the two original lists minus one. This
2052 * can be useful if we were expecting to insert a single variable
2053 * but found we had to insert a list instead. Insertion of @src
2054 * overwrites any entries in @targ beyond @pos (the expectation is
2055 * that this function will be called in the process of assembling
2056 * @targ, in left-to-right mode).
2057 *
2058 * Returns: 0 on success, non-zero on failure.
2059 */
2060
gretl_list_insert_list_minus(int ** targ,const int * src,int pos)2061 int gretl_list_insert_list_minus (int **targ, const int *src, int pos)
2062 {
2063 int *big;
2064 int n1 = (*targ)[0];
2065 int n2 = src[0];
2066 int bign = n1 - 1 + n2;
2067 int i, err = 0;
2068
2069 if (pos > n1 + 1) {
2070 return 1;
2071 }
2072
2073 big = realloc(*targ, (bign + 1) * sizeof *big);
2074 if (big == NULL) {
2075 err = E_ALLOC;
2076 } else {
2077 big[0] = bign;
2078 for (i=1; i<=src[0]; i++) {
2079 big[pos+i-1] = src[i];
2080 }
2081 *targ = big;
2082 }
2083
2084 return err;
2085 }
2086
2087 /**
2088 * gretl_list_sublist:
2089 * @list: the source list.
2090 * @pos0: the starting position.
2091 * $pos1: the ending position.
2092 *
2093 * Returns: a newly allocated sublist containing elements @pos0
2094 * to @pos1 of the source.
2095 */
2096
gretl_list_sublist(const int * list,int pos0,int pos1)2097 int *gretl_list_sublist (const int *list, int pos0, int pos1)
2098 {
2099 int n = pos1 - pos0 + 1;
2100 int *ret = gretl_list_new(n);
2101
2102 if (n > 0 && ret != NULL) {
2103 int i, j = 1;
2104
2105 for (i=pos0; i<=pos1; i++) {
2106 ret[j++] = list[i];
2107 }
2108 }
2109
2110 return ret;
2111 }
2112
2113 /**
2114 * list_members_replaced:
2115 * @pmod: the model whose list is to be tested.
2116 * @dset: dataset information.
2117 *
2118 * Checks whether any variable used in @pmod has been redefined
2119 * since the model in question was estimated.
2120 *
2121 * Returns: non-zero if any variables have been replaced, 0 otherwise.
2122 */
2123
list_members_replaced(const MODEL * pmod,const DATASET * dset)2124 int list_members_replaced (const MODEL *pmod, const DATASET *dset)
2125 {
2126 const char *errmsg = N_("Can't do this: some vars in original "
2127 "model have been redefined");
2128 int i, vi;
2129
2130 if (pmod->list == NULL) {
2131 return 0;
2132 }
2133
2134 for (i=1; i<=pmod->list[0]; i++) {
2135 vi = pmod->list[i];
2136 if (vi == LISTSEP) {
2137 continue;
2138 }
2139 if (vi >= dset->v) {
2140 gretl_errmsg_set(_(errmsg));
2141 return E_DATA;
2142 }
2143 if (series_get_mtime(dset, vi) > pmod->esttime) {
2144 gretl_errmsg_set(_(errmsg));
2145 return E_DATA;
2146 }
2147 }
2148
2149 return 0;
2150 }
2151
2152 /**
2153 * gretl_list_const_pos:
2154 * @list: an array of integer variable ID numbers, the first element
2155 * of which holds a count of the number of elements following.
2156 * @minpos: position in @list at which to start the search (>= 1).
2157 * @dset: dataset struct.
2158 *
2159 * Checks @list for the presence, in position @minpos or higher, of
2160 * a variable whose valid values in sample all equal 1. This usually
2161 * amounts to checking whether a list of regressors includes
2162 * an intercept term.
2163 *
2164 * Returns: The list position of the const, or 0 if none is
2165 * found.
2166 */
2167
gretl_list_const_pos(const int * list,int minpos,const DATASET * dset)2168 int gretl_list_const_pos (const int *list, int minpos,
2169 const DATASET *dset)
2170 {
2171 int i;
2172
2173 if (minpos < 1) {
2174 return 0;
2175 }
2176
2177 /* we give preference to the "official" const... */
2178 for (i=minpos; i<=list[0]; i++) {
2179 if (list[i] == 0) {
2180 return i;
2181 }
2182 }
2183
2184 /* ... but if it's not found */
2185 for (i=minpos; i<=list[0]; i++) {
2186 if (true_const(list[i], dset)) {
2187 return i;
2188 }
2189 }
2190
2191 return 0;
2192 }
2193
2194 /**
2195 * gretl_list_separator_position:
2196 * @list: an array of integer variable ID numbers, the first element
2197 * of which holds a count of the number of elements following.
2198 *
2199 * Returns: if @list contains the separator for compound
2200 * lists, #LISTSEP, the position in @list at which this is found,
2201 * else 0. The search begins at position 1.
2202 */
2203
gretl_list_separator_position(const int * list)2204 int gretl_list_separator_position (const int *list)
2205 {
2206 int i;
2207
2208 if (list != NULL) {
2209 for (i=1; i<=list[0]; i++) {
2210 if (list[i] == LISTSEP) {
2211 return i;
2212 }
2213 }
2214 }
2215
2216 return 0;
2217 }
2218
2219 /**
2220 * gretl_list_has_separator:
2221 * @list: an array of integer variable ID numbers, the first element
2222 * of which holds a count of the number of elements following.
2223 *
2224 * Returns: 1 if @list contains the separator for compound
2225 * lists, #LISTSEP, else 0. The search begins at position 1.
2226 */
2227
gretl_list_has_separator(const int * list)2228 int gretl_list_has_separator (const int *list)
2229 {
2230 return gretl_list_separator_position(list) > 0;
2231 }
2232
2233 /**
2234 * gretl_list_split_on_separator:
2235 * @list: source list.
2236 * @plist1: pointer to accept first sub-list, or NULL.
2237 * @plist2: pointer to accept second sub-list, or NULL.
2238 *
2239 * If @list contains the list separator, #LISTSEP, creates two
2240 * sub-lists, one containing the elements of @list preceding
2241 * the separator and one containing the elements following
2242 * the separator. The sub-lists are newly allocated, and assigned
2243 * as the content of @plist1 and @plist2 respectively. Note, however,
2244 * that one or other of the sublists can be discarded by passing
2245 * NULL as the second or third argument.
2246 *
2247 * Returns: 0 on success, %E_ALLOC is memory allocation fails,
2248 * or %E_DATA if @list does not contain a separator.
2249 */
2250
gretl_list_split_on_separator(const int * list,int ** plist1,int ** plist2)2251 int gretl_list_split_on_separator (const int *list,
2252 int **plist1,
2253 int **plist2)
2254 {
2255 int *list1 = NULL, *list2 = NULL;
2256 int i, n = 0;
2257
2258 for (i=1; i<=list[0]; i++) {
2259 if (list[i] == LISTSEP) {
2260 n = i;
2261 break;
2262 }
2263 }
2264
2265 if (n == 0) {
2266 return E_PARSE;
2267 }
2268
2269 if (plist1 != NULL) {
2270 if (n > 1) {
2271 list1 = gretl_list_new(n - 1);
2272 if (list1 == NULL) {
2273 return E_ALLOC;
2274 }
2275 for (i=1; i<n; i++) {
2276 list1[i] = list[i];
2277 }
2278 }
2279 *plist1 = list1;
2280 }
2281
2282 if (plist2 != NULL) {
2283 if (n < list[0]) {
2284 list2 = gretl_list_new(list[0] - n);
2285 if (list2 == NULL) {
2286 free(list1);
2287 return E_ALLOC;
2288 }
2289 for (i=1; i<=list2[0]; i++) {
2290 list2[i] = list[i + n];
2291 }
2292 }
2293 *plist2 = list2;
2294 }
2295
2296 return 0;
2297 }
2298
2299 /**
2300 * gretl_lists_join_with_separator:
2301 * @list1: first sub-list.
2302 * @list2: second sub-list.
2303 *
2304 * Concatenates the content of @list2 onto @list1, after first
2305 * appending the list separator. It is acceptable that @list1
2306 * be NULL, in which case the returned list is just @list2
2307 * with the separator prepended. But it is not acceptable that
2308 * @list2 be null; in that this function returns NULL.
2309 *
2310 * Returns: alllcated list on success or NULL on failure.
2311 */
2312
gretl_lists_join_with_separator(const int * list1,const int * list2)2313 int *gretl_lists_join_with_separator (const int *list1, const int *list2)
2314 {
2315 int *biglist;
2316 int i, j, n;
2317
2318 if (list2 == NULL) {
2319 return NULL;
2320 }
2321
2322 n = (list1 != NULL)? list1[0] : 0;
2323
2324
2325 n += list2[0] + 1;
2326 biglist = gretl_list_new(n);
2327
2328 if (biglist == NULL) {
2329 return NULL;
2330 }
2331
2332 j = 1;
2333
2334 if (list1 != NULL) {
2335 for (i=1; i<=list1[0]; i++) {
2336 biglist[j++] = list1[i];
2337 }
2338 }
2339
2340 biglist[j++] = LISTSEP;
2341
2342 for (i=1; i<=list2[0]; i++) {
2343 biglist[j++] = list2[i];
2344 }
2345
2346 return biglist;
2347 }
2348
real_list_dup(const int * list,int start,int stop)2349 static int real_list_dup (const int *list, int start, int stop)
2350 {
2351 int i, j, ret = -1;
2352
2353 for (i=start; i<stop && ret<0; i++) {
2354 for (j=i+1; j<=stop && ret<0; j++) {
2355 if (list[i] == list[j]) {
2356 ret = list[i];
2357 }
2358 }
2359 }
2360
2361 return ret;
2362 }
2363
2364 /**
2365 * gretl_list_duplicates:
2366 * @list: an array of integer variable ID numbers, the first element
2367 * of which holds a count of the number of elements following.
2368 * @ci: index of gretl command (for context).
2369 *
2370 * Checks whether or not a gretl list contains duplicated elements.
2371 * Exactly what counts as duplication depends on the context of the
2372 * command in which @list will be used, which is given by @ci.
2373 *
2374 * Returns: the ID number of the first duplicated variable found,
2375 * or -1 in case of no duplication.
2376 */
2377
gretl_list_duplicates(const int * list,GretlCmdIndex ci)2378 int gretl_list_duplicates (const int *list, GretlCmdIndex ci)
2379 {
2380 int multi = 0;
2381 int start = 2;
2382 int i, ret = -1;
2383
2384 if (ci == COINT || ci == ANOVA || ci == DELEET) {
2385 start = 1;
2386 } else if (ci == ARCH) {
2387 start = 3;
2388 } else if (ci == ARMA) {
2389 for (i=list[0]-1; i>2; i--) {
2390 if (list[i] == LISTSEP) {
2391 start = i+1;
2392 break;
2393 }
2394 }
2395 } else if (ci == LAGS && list[0] > 1 && list[2] == LISTSEP) {
2396 start = 3;
2397 } else if (ci == AR || ci == SCATTERS || ci == MPOLS || ci == GARCH) {
2398 for (i=2; i<list[0]; i++) {
2399 if (list[i] == LISTSEP) {
2400 start = i+1;
2401 break;
2402 }
2403 }
2404 } else if (ci == IVREG || ci == HECKIT || ci == EQUATION) {
2405 multi = 1;
2406 for (i=2; i<list[0]; i++) {
2407 if (list[i] == LISTSEP) {
2408 start = i+1;
2409 break;
2410 }
2411 }
2412 ret = real_list_dup(list, start, list[0]);
2413 if (ret == -1) {
2414 ret = real_list_dup(list, 2, start - 2);
2415 }
2416 } else if (ci == VAR || ci == VECM || ci == COINT2) {
2417 int seppos = 0;
2418
2419 multi = 1;
2420 for (i=1; i<list[0]; i++) {
2421 if (list[i] == LISTSEP) {
2422 seppos = i;
2423 break;
2424 }
2425 }
2426 if (seppos) {
2427 /* check each sublist */
2428 ret = real_list_dup(list, 1, seppos - 1);
2429 if (ret == -1) {
2430 ret = real_list_dup(list, seppos + 1, list[0]);
2431 }
2432 } else {
2433 /* just one list to examine */
2434 ret = real_list_dup(list, 1, list[0]);
2435 }
2436 } else if (ci == DPANEL) {
2437 int stop = 0;
2438
2439 multi = 1;
2440 for (i=2; i<list[0]; i++) {
2441 if (list[i] == LISTSEP) {
2442 start = i;
2443 break;
2444 }
2445 }
2446 for (i=list[0]-1; i>=2; i--) {
2447 if (list[i] == LISTSEP) {
2448 stop = i;
2449 break;
2450 }
2451 }
2452
2453 if (stop == start) {
2454 ret = real_list_dup(list, start + 1, list[0]);
2455 } else {
2456 ret = real_list_dup(list, start + 1, stop - 1);
2457 if (ret == -1) {
2458 ret = real_list_dup(list, stop + 1, list[0]);
2459 }
2460 }
2461 multi = 1;
2462 } else if (ci == BIPROBIT) {
2463 multi = 1;
2464 if (list[1] == list[2]) {
2465 ret = 1;
2466 }
2467 if (ret == -1) {
2468 for (i=3; i<list[0]; i++) {
2469 if (list[i] == LISTSEP) {
2470 start = i+1;
2471 break;
2472 }
2473 }
2474 ret = real_list_dup(list, start, list[0]);
2475 if (ret == -1) {
2476 ret = real_list_dup(list, 3, start - 2);
2477 }
2478 }
2479 }
2480
2481 if (!multi) {
2482 ret = real_list_dup(list, start, list[0]);
2483 }
2484
2485 return ret;
2486 }
2487
2488 /**
2489 * gretl_lists_share_members:
2490 * @list1:
2491 * @list2:
2492 *
2493 * Returns: the number of elements that are in common between
2494 * @list1 and @list2.
2495 */
2496
gretl_lists_share_members(const int * list1,const int * list2)2497 int gretl_lists_share_members (const int *list1, const int *list2)
2498 {
2499 int i, n = 0;
2500
2501 if (list1 != NULL && list2 != NULL) {
2502 for (i=1; i<=list1[0]; i++) {
2503 if (in_gretl_list(list2, list1[i])) {
2504 n++;
2505 }
2506 }
2507 }
2508
2509 return n;
2510 }
2511
2512 /**
2513 * gretl_list_n_distinct_members:
2514 * @list: list to test.
2515 *
2516 * Returns: the count of distinct elements in list from position
2517 * 1 onward, not counting #LISTSEP if present.
2518 */
2519
gretl_list_n_distinct_members(const int * list)2520 int gretl_list_n_distinct_members (const int *list)
2521 {
2522 int i, j, n = list[0];
2523
2524 for (i=1; i<=list[0]; i++) {
2525 if (list[i] == LISTSEP) {
2526 n--;
2527 } else {
2528 for (j=2; j<i; j++) {
2529 if (list[i] == list[j]) {
2530 n--;
2531 break;
2532 }
2533 }
2534 }
2535 }
2536
2537 return n;
2538 }
2539
2540 /**
2541 * full_var_list:
2542 * @dset: dataset information.
2543 * @nvars: location for return of number of elements in full list.
2544 *
2545 * Creates a newly allocated list including all series in the
2546 * dataset that are not hidden variables, and are accessible
2547 * at the current level of function execution.
2548 * The return value is NULL in case either (a) allocation of
2549 * memory failed, or (b) the resulting list would be empty.
2550 * The caller can distinguish between these possibilities by
2551 * examining the value returned in @nvars, which will be zero if
2552 * and only if the resulting list would be empty. If this is
2553 * not of interest to the caller, @nvars may be given as NULL.
2554 *
2555 * Returns: the allocated list, or NULL.
2556 */
2557
full_var_list(const DATASET * dset,int * nvars)2558 int *full_var_list (const DATASET *dset, int *nvars)
2559 {
2560 int fsd = gretl_function_depth();
2561 int i, j, nv = 0;
2562 int *list = NULL;
2563
2564 if (dset == NULL) {
2565 if (nvars != NULL) {
2566 *nvars = 0;
2567 }
2568 return NULL;
2569 }
2570
2571 for (i=1; i<dset->v; i++) {
2572 if (!series_is_hidden(dset, i) &&
2573 series_get_stack_level(dset, i) == fsd) {
2574 nv++;
2575 }
2576 }
2577
2578 if (nvars != NULL) {
2579 *nvars = nv;
2580 }
2581
2582 if (nv > 0) {
2583 list = gretl_list_new(nv);
2584 }
2585
2586 if (list != NULL) {
2587 j = 1;
2588 for (i=1; i<dset->v; i++) {
2589 if (!series_is_hidden(dset, i) &&
2590 series_get_stack_level(dset, i) == fsd) {
2591 list[j++] = i;
2592 }
2593 }
2594 }
2595
2596 return list;
2597 }
2598
2599 /**
2600 * gretl_list_is_consecutive:
2601 * @list: list to check.
2602 *
2603 * Returns: 1 if the elements of @list, from position 1 onward,
2604 * are consecutive integer values, else 0.
2605 */
2606
gretl_list_is_consecutive(const int * list)2607 int gretl_list_is_consecutive (const int *list)
2608 {
2609 int i, ret = 1;
2610
2611 for (i=2; i<=list[0]; i++) {
2612 if (list[i] != list[i-1] + 1) {
2613 ret = 0;
2614 break;
2615 }
2616 }
2617
2618 return ret;
2619 }
2620
2621 /**
2622 * gretl_list_build:
2623 * @s: string list specification.
2624 * @dset: dataset information.
2625 * @err: location to receive error code
2626 *
2627 * Builds a list based on the specification in @s, which may include
2628 * the ID numbers of variables, the names of variables, and/or the
2629 * names of previously defined lists (all separated by spaces).
2630 *
2631 * Returns: the constructed list, or NULL on failure.
2632 */
2633
gretl_list_build(const char * s,const DATASET * dset,int * err)2634 int *gretl_list_build (const char *s, const DATASET *dset, int *err)
2635 {
2636 char test[32];
2637 int *list = NULL;
2638 int *nlist;
2639 int i, v, len, nf;
2640
2641 list = gretl_null_list();
2642 if (list == NULL) {
2643 *err = E_ALLOC;
2644 return NULL;
2645 }
2646
2647 nf = count_fields(s, NULL);
2648
2649 for (i=0; i<nf && !*err; i++) {
2650 s += strspn(s, " ");
2651 len = strcspn(s, " ");
2652 if (len > 31) {
2653 *err = E_PARSE;
2654 } else {
2655 *test = 0;
2656 strncat(test, s, len);
2657
2658 /* valid elements: integers, varnames, named lists */
2659
2660 if (isdigit(*test)) {
2661 v = positive_int_from_string(test);
2662 if (v >= 0) {
2663 list = gretl_list_append_term(&list, v);
2664 } else {
2665 *err = E_PARSE;
2666 }
2667 } else {
2668 v = series_index(dset, test);
2669 if (v < dset->v) {
2670 list = gretl_list_append_term(&list, v);
2671 } else {
2672 nlist = get_list_by_name(test);
2673 if (nlist != NULL) {
2674 *err = gretl_list_add_list(&list, nlist);
2675 } else {
2676 *err = E_UNKVAR;
2677 }
2678 }
2679 }
2680
2681 if (list == NULL) {
2682 *err = E_ALLOC;
2683 }
2684 }
2685 s += len;
2686 }
2687
2688 if (*err) {
2689 free(list);
2690 list = NULL;
2691 }
2692
2693 return list;
2694 }
2695
2696 /**
2697 * gretl_list_print:
2698 * @list: list to print.
2699 * @dset: dataset information.
2700 * @prn: gretl printing struct.
2701 *
2702 * Prints to @prn the given @list of variables, by name
2703 * if @dset is non-NULL otherwise by ID number.
2704 */
2705
gretl_list_print(const int * list,const DATASET * dset,PRN * prn)2706 void gretl_list_print (const int *list, const DATASET *dset,
2707 PRN *prn)
2708 {
2709 int testlen = 62;
2710 int i, li, len = 0;
2711
2712 if (list == NULL) {
2713 pputs(prn, "null\n");
2714 } else if (list[0] == 0) {
2715 pputs(prn, "empty\n");
2716 } else {
2717 for (i=1; i<=list[0]; i++) {
2718 li = list[i];
2719 if (li == LISTSEP) {
2720 len += pputs(prn, "; ");
2721 } else if (dset == NULL) {
2722 len += pprintf(prn, "%d ", li);
2723 } else if (li < 0 || li >= dset->v) {
2724 len += pputs(prn, "?? ");
2725 } else {
2726 len += pprintf(prn, "%s ", dset->varname[li]);
2727 if (len > testlen && i < list[0]) {
2728 pputs(prn, "\\\n ");
2729 len = 1;
2730 }
2731 }
2732 }
2733 pputc(prn, '\n');
2734 }
2735 }
2736
2737 /**
2738 * varname_match_list:
2739 * @dset: pointer to dataset information.
2740 * @pattern: pattern to be matched.
2741 * @err: location to receive error code.
2742 *
2743 * Returns: a list of ID numbers of variables whose names
2744 * match @pattern, or NULL if there are no matches.
2745 */
2746
varname_match_list(const DATASET * dset,const char * pattern,int * err)2747 int *varname_match_list (const DATASET *dset, const char *pattern,
2748 int *err)
2749 {
2750 GPatternSpec *pspec;
2751 int *list = NULL;
2752 int i, fd, n = 0;
2753
2754 if (dset == NULL || dset->v == 0) {
2755 return NULL;
2756 }
2757
2758 fd = gretl_function_depth();
2759
2760 pspec = g_pattern_spec_new(pattern);
2761
2762 for (i=1; i<dset->v; i++) {
2763 if (fd == 0 || fd == series_get_stack_level(dset, i)) {
2764 if (g_pattern_match_string(pspec, dset->varname[i])) {
2765 n++;
2766 }
2767 }
2768 }
2769
2770 if (n > 0) {
2771 list = gretl_list_new(n);
2772 if (list == NULL) {
2773 *err = E_ALLOC;
2774 } else {
2775 int j = 1;
2776
2777 for (i=1; i<dset->v; i++) {
2778 if (fd == 0 || fd == series_get_stack_level(dset, i)) {
2779 if (g_pattern_match_string(pspec, dset->varname[i])) {
2780 list[j++] = i;
2781 }
2782 }
2783 }
2784 }
2785 }
2786
2787 g_pattern_spec_free(pspec);
2788
2789 return list;
2790 }
2791
2792 /**
2793 * ellipsis_list:
2794 * @dset: pointer to dataset information.
2795 * @v1: index of first variable.
2796 * @v2: index of last variable.
2797 * @err: location to receive error code.
2798 *
2799 * Returns: a list of ID numbers of variables running
2800 * from @v1 to @v2.
2801 */
2802
ellipsis_list(const DATASET * dset,int v1,int v2,int * err)2803 int *ellipsis_list (const DATASET *dset, int v1, int v2, int *err)
2804 {
2805 int *list = NULL;
2806 int i, fd, n = 0;
2807
2808 if (dset == NULL || dset->v == 0) {
2809 return NULL;
2810 }
2811
2812 fd = gretl_function_depth();
2813
2814 for (i=v1; i<=v2; i++) {
2815 if (fd == 0 || fd == series_get_stack_level(dset, i)) {
2816 n++;
2817 }
2818 }
2819
2820 if (n > 0) {
2821 list = gretl_list_new(n);
2822 if (list == NULL) {
2823 *err = E_ALLOC;
2824 } else {
2825 int j = 1;
2826
2827 for (i=v1; i<=v2; i++) {
2828 if (fd == 0 || fd == series_get_stack_level(dset, i)) {
2829 list[j++] = i;
2830 }
2831 }
2832 }
2833 }
2834
2835 return list;
2836 }
2837
2838 /**
2839 * gretl_list_from_vector:
2840 * @v: matrix (must be a vector).
2841 * @dset: pointer to dataset.
2842 * @err: location to receive error code.
2843 *
2844 * Tries to interpret the matrix @v as a list of ID
2845 * numbers of series. This can work only if @v is a
2846 * vector, and all its elements have integer values
2847 * k satisfying 0 <= k < v, where v is the number
2848 * of series in @dset. In the special case where @v
2849 * is a null matrix, an empty list is returned.
2850 *
2851 * Returns: a gretl list, or NULL on failure.
2852 */
2853
gretl_list_from_vector(const gretl_matrix * v,const DATASET * dset,int * err)2854 int *gretl_list_from_vector (const gretl_matrix *v,
2855 const DATASET *dset,
2856 int *err)
2857 {
2858 int *list = NULL;
2859
2860 if (gretl_is_null_matrix(v)) {
2861 list = gretl_null_list();
2862 if (list == NULL) {
2863 *err = E_ALLOC;
2864 }
2865 } else {
2866 int i, vi, k = gretl_vector_get_length(v);
2867
2868 if (k == 0) {
2869 *err = E_TYPES;
2870 } else {
2871 for (i=0; i<k && !*err; i++) {
2872 vi = gretl_int_from_double(v->val[i], err);
2873 if (!*err && (vi >= dset->v || (vi < 0 && vi != LISTSEP))) {
2874 gretl_errmsg_sprintf("list from vector: series ID %d "
2875 "is out of bounds", vi);
2876 *err = E_UNKVAR;
2877 }
2878 }
2879 if (!*err) {
2880 list = gretl_list_new(k);
2881 if (list == NULL) {
2882 *err = E_ALLOC;
2883 } else {
2884 for (i=0; i<k; i++) {
2885 list[i+1] = (int) v->val[i];
2886 }
2887 }
2888 }
2889 }
2890 }
2891
2892 return list;
2893 }
2894
colnames_ok_for_series(const char ** S,int n)2895 static int colnames_ok_for_series (const char **S, int n)
2896 {
2897 int i, j, err = 0;
2898
2899 for (i=0; i<n; i++) {
2900 err = check_varname(S[i]);
2901 if (!err && gretl_is_user_var(S[i])) {
2902 gretl_errmsg_sprintf("'%s': name conflicts with different type", S[i]);
2903 err = E_TYPES;
2904 } else {
2905 for (j=0; j<n; j++) {
2906 if (j != i && strcmp(S[j], S[i]) == 0) {
2907 gretl_errmsg_sprintf("'%s': name is not unique", S[i]);
2908 err = 1;
2909 }
2910 }
2911 }
2912 if (err) {
2913 return 0;
2914 }
2915 }
2916
2917 return 1;
2918 }
2919
try_list_vname(char * chkname,const char * pfx,int j,int n)2920 static int try_list_vname (char *chkname,
2921 const char *pfx,
2922 int j, int n)
2923 {
2924 gchar *tmp = g_strdup_printf("%s%0*d", pfx, n, j);
2925 int err = check_varname(tmp);
2926
2927 if (!err && gretl_is_user_var(tmp)) {
2928 gretl_errmsg_sprintf("'%s': name conflicts with different type", tmp);
2929 err = E_TYPES;
2930 }
2931 if (!err) {
2932 strcpy(chkname, tmp);
2933 }
2934 g_free(tmp);
2935
2936 return err;
2937 }
2938
2939 /**
2940 * gretl_list_from_matrix:
2941 * @X: matrix.
2942 * @prefix: prefix for series names, or NULL.
2943 * @dset: pointer to dataset.
2944 * @err: location to receive error code.
2945 *
2946 * Tries to add the columns of @X to @dset as series, and
2947 * if successful constructs a list holding the added series.
2948 * numbers of series. This is possible only if the rows of
2949 * @X can be matched to observations in @dset.
2950 *
2951 * Returns: allocated list, or NULL on failure.
2952 */
2953
2954 /* There's actually no possibility of overflow below */
2955 #if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 6)
2956 #pragma GCC diagnostic push
2957 #pragma GCC diagnostic ignored "-Wformat-overflow"
2958 #endif
2959
gretl_list_from_matrix(const gretl_matrix * X,const char * prefix,DATASET * dset,int * err)2960 int *gretl_list_from_matrix (const gretl_matrix *X,
2961 const char *prefix,
2962 DATASET *dset,
2963 int *err)
2964 {
2965 int *list = NULL;
2966 const char **S = NULL;
2967 int orig_v = dset->v;
2968
2969 if (gretl_is_null_matrix(X)) {
2970 list = gretl_null_list();
2971 if (list == NULL) {
2972 *err = E_ALLOC;
2973 }
2974 return list;
2975 }
2976
2977 S = gretl_matrix_get_colnames(X);
2978 if (S == NULL && prefix == NULL) {
2979 *err = E_INVARG;
2980 } else if (S != NULL) {
2981 /* check the colnames */
2982 if (!colnames_ok_for_series(S, X->cols)) {
2983 *err = E_INVARG;
2984 }
2985 } else {
2986 /* check the prefix */
2987 if (strlen(prefix) > VNAMELEN - 3) {
2988 *err = E_INVARG;
2989 }
2990 }
2991
2992 if (!*err) {
2993 char chkname[VNAMELEN];
2994 int mt1 = gretl_matrix_get_t1(X);
2995 int mt2 = gretl_matrix_get_t2(X);
2996 int s1 = 0, s2 = 0;
2997 int n_add = X->cols;
2998 int j, slen = 0;
2999 int ok = 0;
3000
3001 if (mt2 > 0) {
3002 if (X->rows != mt2 - mt1 + 1) {
3003 ; /* time indices not usable! */
3004 } else if (mt2 < dset->t1 || mt1 > dset->t2) {
3005 ; /* no overlap of ranges */
3006 } else {
3007 s1 = dset->t1 - mt1;
3008 s2 = X->rows - s1;
3009 ok = 1;
3010 }
3011 } else if (X->rows == sample_size(dset)) {
3012 /* length matches current sample */
3013 s1 = 0;
3014 s2 = X->rows - 1;
3015 ok = 1;
3016 } else if (X->rows == dset->n) {
3017 /* length matches full series length */
3018 s1 = dset->t1;
3019 s2 = dset->t2;
3020 ok = 1;
3021 }
3022 if (!ok) {
3023 gretl_errmsg_set("matrix to list: data ranges could not be matched");
3024 *err = E_DATA;
3025 } else {
3026 list = gretl_list_new(X->cols);
3027 if (list == NULL) {
3028 *err = E_ALLOC;
3029 }
3030 }
3031
3032 if (S == NULL) {
3033 slen = (int) floor(log10(X->cols)) + 1;
3034 if (slen > 6) {
3035 *err = E_DATA;
3036 }
3037 }
3038
3039 /* first pass, check the putative series names */
3040 for (j=0; j<X->cols && !*err; j++) {
3041 if (S != NULL) {
3042 strcpy(chkname, S[j]);
3043 } else {
3044 *err = try_list_vname(chkname, prefix, j+1, slen);
3045 }
3046 if (!*err && gretl_is_series(chkname, dset)) {
3047 /* an existing series, decrement the count
3048 of series to be added to @dset
3049 */
3050 n_add--;
3051 }
3052 }
3053
3054 if (!*err && n_add > 0) {
3055 *err = dataset_add_NA_series(dset, n_add);
3056 }
3057 if (!*err) {
3058 int vnew = orig_v;
3059 int vj, t, s;
3060
3061 for (j=0; j<X->cols && !*err; j++) {
3062 if (S != NULL) {
3063 strcpy(chkname, S[j]);
3064 } else if (prefix != NULL) {
3065 sprintf(chkname, "%s%0*d", prefix, slen, j+1);
3066 }
3067 vj = current_series_index(dset, chkname);
3068 if (vj < 0) {
3069 vj = vnew++;
3070 strcpy(dset->varname[vj], chkname);
3071 }
3072 for (t=dset->t1, s=s1; t<=dset->t2 && s<=s2; t++, s++) {
3073 if (s < 0) {
3074 dset->Z[vj][t] = NADBL;
3075 } else {
3076 dset->Z[vj][t] = gretl_matrix_get(X, s, j);
3077 }
3078 }
3079 list[j+1] = vj;
3080 }
3081 }
3082 }
3083
3084 if (*err) {
3085 dataset_drop_last_variables(dset, dset->v > orig_v);
3086 free(list);
3087 list = NULL;
3088 }
3089
3090 return list;
3091 }
3092
3093 #if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 6)
3094 #pragma GCC diagnostic pop
3095 #endif
3096
3097 /**
3098 * gretl_auxlist_from_vector:
3099 * @v: source vector.
3100 * @err: location to receive error code.
3101 *
3102 * Unlike gretl_list_from_vector() this function does not
3103 * require that the elements of @v are valid series IDs. They
3104 * may represent a set of orders.
3105 *
3106 * Returns: a newly allocated gretl list containing the values
3107 * in @v, or NULL on failure. Note that it is an error if
3108 * @v is NULL, or is not a vector.
3109 */
3110
gretl_auxlist_from_vector(const gretl_vector * v,int * err)3111 int *gretl_auxlist_from_vector (const gretl_vector *v, int *err)
3112 {
3113 int i, n = gretl_vector_get_length(v);
3114 int *list = NULL;
3115
3116 if (n == 0) {
3117 *err = E_DATA;
3118 } else {
3119 list = gretl_list_new(n);
3120 if (list == NULL) {
3121 *err = E_ALLOC;
3122 } else {
3123 for (i=0; i<n; i++) {
3124 list[i+1] = (int) v->val[i];
3125 }
3126 }
3127 }
3128
3129 return list;
3130 }
3131
3132 /**
3133 * varname_match_any:
3134 * @dset: pointer to dataset information.
3135 * @pattern: pattern to be matched.
3136 *
3137 * Returns: 1 if at least one variable in the dataset has a
3138 * name that matches @pattern, otherwise 0.
3139 */
3140
varname_match_any(const DATASET * dset,const char * pattern)3141 int varname_match_any (const DATASET *dset, const char *pattern)
3142 {
3143 GPatternSpec *pspec;
3144 int i, fd, ret = 0;
3145
3146 fd = gretl_function_depth();
3147
3148 pspec = g_pattern_spec_new(pattern);
3149
3150 for (i=1; i<dset->v; i++) {
3151 if (fd == 0 || fd == series_get_stack_level(dset, i)) {
3152 if (g_pattern_match_string(pspec, dset->varname[i])) {
3153 ret = 1;
3154 break;
3155 }
3156 }
3157 }
3158
3159 g_pattern_spec_free(pspec);
3160
3161 return ret;
3162 }
3163