Line data Source code
1 : % Functions that operate on sets in the form of arrays and lists:
2 : % Copyright (C) 2010-2021,2022 John E. Davis
3 : %
4 : % This file is part of the S-Lang Library and may be distributed under the
5 : % terms of the GNU General Public License. See the file COPYING for
6 : % more information.
7 : %
8 : % Functions: unique, union, complement, intersection, ismember
9 : private define pop_set_object ()
10 : {
11 168 : variable a = ();
12 168 : if ((typeof(a) != Array_Type) && (typeof(a) != List_Type))
13 6 : a = [a];
14 168 : return a;
15 : }
16 :
17 : private define list_unique (a)
18 : {
19 3 : variable len = length(a);
20 3 : variable indices = Int_Type[len];
21 : variable i, j, k;
22 :
23 3 : k = 0;
24 3 : _for i (0, len-1, 1)
25 : {
26 20 : variable a_i = a[i];
27 20 : _for j (0, i-1, 1)
28 : {
29 83 : if (_eqs(a_i, a[j]))
30 4 : break;
31 : }
32 : then
33 : {
34 16 : indices[k] = i;
35 16 : k++;
36 : }
37 : }
38 3 : return indices[[0:k-1]];
39 : }
40 :
41 :
42 : define unique ()
43 : {
44 : variable i, j, len;
45 : variable a;
46 :
47 12 : if (_NARGS != 1)
48 : {
49 0 : _pop_n (_NARGS);
50 0 : usage ("i = unique (a); %% i = indices of unique elements of a");
51 : }
52 :
53 12 : a = pop_set_object ();
54 12 : if (typeof(a) == List_Type)
55 : {
56 : try
57 : {
58 6 : a = list_to_array (a);
59 : }
60 2 : catch AnyError: return list_unique (a);
61 : }
62 :
63 10 : len = length(a);
64 10 : if (len <= 1)
65 3 : return [0:len-1];
66 :
67 7 : if (length(array_shape(a)) != 1)
68 0 : a = _reshape (__tmp(a),[len]);
69 :
70 : try
71 : {
72 7 : i = array_sort(a);
73 : }
74 1 : catch AnyError: return list_unique (a);
75 :
76 6 : a = a[i];
77 6 : if (a[0] == a[-1]) % all equal
78 2 : return [0];
79 4 : j = where (shift(a,-1)!=a);
80 : % Now, i contains the sorted indices, and j contains the indices into the
81 : % sorted array. So, the unique elements are given by a[i][j] where a is
82 : % the original input array. It seems amusing that the indices given by
83 : % [i][j] are also given by i[j].
84 4 : return i[__tmp(j)];
85 : }
86 :
87 : define union ()
88 : {
89 4 : !if (_NARGS)
90 0 : usage ("U = union (A, B, ..., C);");
91 :
92 4 : variable args = {}, obj;
93 4 : variable has_list = 0;
94 4 : loop (_NARGS)
95 : {
96 12 : obj = pop_set_object ();
97 12 : has_list += (typeof (obj) == List_Type);
98 12 : list_insert (args, obj);
99 : }
100 :
101 4 : variable a = NULL;
102 4 : if (has_list == 0)
103 : {
104 : try
105 : {
106 2 : a = [__push_list (args)];
107 : }
108 0 : catch AnyError:;
109 : }
110 :
111 4 : if (a == NULL)
112 : {
113 2 : a = {};
114 2 : foreach obj (args)
115 : {
116 6 : if (typeof(obj) == List_Type)
117 : {
118 3 : list_join (a, obj);
119 3 : continue;
120 : }
121 3 : foreach (obj)
122 : {
123 5 : variable x = ();
124 5 : list_append (a, x);
125 : }
126 : }
127 : }
128 4 : return a[unique (a)];
129 : }
130 :
131 : % return indices of a that are not in b
132 : private define list_complement (a, b)
133 : {
134 14 : variable lena = length(a), lenb = length(b);
135 7 : variable indices = Int_Type[lena];
136 : variable i, j, k;
137 :
138 7 : k = 0;
139 7 : _for i (0, lena-1, 1)
140 : {
141 23 : variable a_i = a[i];
142 23 : _for j (0, lenb-1, 1)
143 : {
144 37 : if (_eqs(a_i, b[j]))
145 13 : break;
146 : }
147 : then
148 : {
149 10 : indices[k] = i;
150 10 : k++;
151 : }
152 : }
153 7 : return indices[[0:k-1]];
154 : }
155 :
156 : define complement ()
157 : {
158 : variable a, b;
159 52 : if (_NARGS != 2)
160 0 : usage ("\
161 : i = complement (a, b);\n\
162 : %% Returns the indices of the elements of `a' that are not in `b'");
163 :
164 52 : b = pop_set_object ();
165 52 : a = pop_set_object ();
166 :
167 : variable
168 52 : lena = length(a),
169 52 : lenb = length(b);
170 :
171 52 : if ((lena == 0) || (lenb == 0))
172 8 : return [0:lena-1];
173 :
174 : variable sia, sib;
175 : try
176 : {
177 44 : if (typeof (a) == List_Type)
178 27 : a = list_to_array (a);
179 37 : if (typeof (b) == List_Type)
180 9 : b = list_to_array (b);
181 37 : sia = array_sort (a);
182 37 : sib = array_sort (b);
183 : }
184 : catch AnyError:
185 7 : return list_complement (a, b);
186 :
187 : variable
188 74 : c = Int_Type [lena], j = 0,
189 : ia, ib, xa, xb, k;
190 :
191 74 : ia = 0; ib = 0;
192 37 : xb = b[sib[ib]];
193 182 : while (ia < lena)
194 : {
195 156 : k = sia[ia];
196 156 : xa = a[k];
197 156 : if (xa < xb)
198 : {
199 51 : c[j] = k;
200 51 : j++;
201 51 : ia++;
202 51 : continue;
203 : }
204 105 : if (xb == xa)
205 : {
206 31 : ia++;
207 31 : continue;
208 : }
209 :
210 74 : while (ib++, (ib < lenb) && (xa > b[sib[ib]]))
211 0 : ;
212 74 : if (ib == lenb)
213 : {
214 11 : variable n = lena-ia;
215 11 : c[[j:j+n-1]] = sia[[ia:lena-1]];
216 11 : j += n;
217 11 : break;
218 : }
219 63 : xb = b[sib[ib]];
220 63 : if (xa == xb)
221 62 : ia++;
222 : }
223 37 : return c[[0:j-1]];
224 : }
225 :
226 : % Return the indices into a of the common elements of both a and b
227 : define intersection ()
228 : {
229 20 : if (_NARGS < 2)
230 0 : usage ("\
231 : i = intersection (a, b, .., c);\n\
232 : %% Returns the indices of 'a' of the common elements of b,.., c");
233 :
234 20 : variable b = pop_set_object ();
235 20 : loop (_NARGS-1)
236 : {
237 20 : variable a = pop_set_object ();
238 20 : variable i = complement (a, __tmp(b));
239 20 : i = complement (a, a[i]);
240 20 : b = a[i];
241 : }
242 20 : return i;
243 : }
244 :
245 : % Returns whether or not a is a member of b.
246 : define ismember ()
247 : {
248 4 : if (_NARGS != 2)
249 0 : usage ("I = ismember (a, b);\n\
250 : Returns a boolean array indicated whether the corresponding elements of 'a'\n\
251 : are members of 'b'");
252 :
253 : variable a, b;
254 4 : (a, b) = ();
255 4 : if ((typeof(a) == Array_Type) || (typeof(a) == List_Type))
256 : {
257 2 : variable lena = length (a);
258 2 : variable result = Char_Type[lena];
259 2 : result[intersection(a,b)] = 1;
260 2 : return result;
261 : }
262 2 : return 0 != length (intersection (a, b));
263 : }
|
