Line data Source code
1 : /* Copyright (C) 2015 The PARI group.
2 :
3 : This file is part of the PARI package.
4 :
5 : PARI/GP is free software; you can redistribute it and/or modify it under the
6 : terms of the GNU General Public License as published by the Free Software
7 : Foundation; either version 2 of the License, or (at your option) any later
8 : version. It is distributed in the hope that it will be useful, but WITHOUT
9 : ANY WARRANTY WHATSOEVER.
10 :
11 : Check the License for details. You should have received a copy of it, along
12 : with the package; see the file 'COPYING'. If not, write to the Free Software
13 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14 :
15 : #include "pari.h"
16 : #include "paripriv.h"
17 :
18 : #define tvalue(i) gmael(t,(i),1)
19 : #define tleft(i) mael3(t,(i),2,1)
20 : #define tright(i) mael3(t,(i),2,2)
21 : #define theight(i) mael3(t,(i),2,3)
22 :
23 : static GEN
24 2583 : treesearch(GEN T, GEN x)
25 : {
26 2583 : long i = 1;
27 2583 : GEN t = list_data(T);
28 2583 : if (!t || lg(t)==1) return NULL;
29 23002 : while (i)
30 : {
31 21161 : long c = cmp_universal(x, gel(tvalue(i),1));
32 21161 : if (!c) return tvalue(i);
33 20433 : i = c < 0 ? tleft(i): tright(i);
34 : }
35 1841 : return NULL;
36 : }
37 :
38 : static long
39 204078 : treeparent_r(GEN t, GEN x, long i, long parent)
40 : {
41 : long c;
42 204078 : if (i==0) return parent;
43 204078 : c = cmp_universal(x, gel(tvalue(i),1));
44 204078 : if (c < 0)
45 89950 : return treeparent_r(t,x,tleft(i),i);
46 114128 : else if (c > 0)
47 93695 : return treeparent_r(t,x,tright(i),i);
48 : else
49 20433 : return parent;
50 : }
51 :
52 : static void
53 133 : treekeys(GEN t, long i, GEN V, long *n)
54 : {
55 133 : if (i==0) return;
56 56 : treekeys(t, tleft(i), V, n);
57 56 : gel(V, ++*n) = gel(tvalue(i),1);
58 56 : treekeys(t, tright(i), V, n);
59 : }
60 :
61 : GEN
62 21 : mapdomain_shallow(GEN T)
63 : {
64 21 : GEN V, t = list_data(T);
65 21 : long n = 0;
66 21 : if (!t || lg(t)==1) return cgetg(1, t_VEC);
67 21 : V = cgetg(lg(t), t_VEC); treekeys(t, 1, V, &n); return V;
68 : }
69 :
70 : static void
71 49 : treeselect(void *E, long (*f)(void* E, GEN x), GEN t, long i, GEN V, long *n)
72 : {
73 49 : if (i==0) return;
74 21 : treeselect(E, f, t, tleft(i), V, n);
75 21 : if (f(E, gel(tvalue(i),2))) gel(V, ++*n) = gel(tvalue(i),1);
76 21 : treeselect(E, f, t, tright(i), V, n);
77 : }
78 :
79 : GEN
80 7 : mapselect_shallow(void *E, long (*f)(void* E, GEN x), GEN T)
81 : {
82 7 : GEN V, t = list_data(T);
83 7 : long n = 0;
84 7 : if (!t || lg(t)==1) return cgetg(1, t_VEC);
85 7 : clone_lock(T);
86 7 : V = cgetg(lg(t), t_COL); treeselect(E, f, t, 1, V, &n);
87 7 : clone_unlock_deep(T); fixlg(V, n+1); return V;
88 : }
89 :
90 : static void
91 13118 : treemat(GEN t, long i, GEN V, long *n)
92 : {
93 13118 : if (i==0) return;
94 6202 : treemat(t, tleft(i), V, n);
95 6202 : ++*n;
96 6202 : gmael(V, 1, *n) = gel(tvalue(i), 1);
97 6202 : gmael(V, 2, *n) = gel(tvalue(i), 2);
98 6202 : treemat(t, tright(i), V, n);
99 : }
100 :
101 : GEN
102 721 : maptomat_shallow(GEN T)
103 : {
104 721 : GEN V, t = list_data(T);
105 721 : long n = 0;
106 721 : if (!t || lg(t)==1) return cgetg(1, t_MAT);
107 714 : V = cgetg(3, t_MAT);
108 714 : gel(V,1) = cgetg(lg(t), t_COL);
109 714 : gel(V,2) = cgetg(lg(t), t_COL);
110 714 : treemat(t, 1, V, &n); return V;
111 : }
112 :
113 : static void
114 602 : treemap_i_r(GEN t, long i, long a, long c, GEN p, GEN M)
115 : {
116 602 : long b = (a+c)>>1;
117 602 : GEN x = mkvec2(gcopy(gmael(M, 1, p[b])), gcopy(gmael(M, 2, p[b])));
118 602 : if (a == c)
119 280 : gel(t, i) = mkvec2(x, mkvecsmall3(0, 0, 1));
120 322 : else if (a+1 == c)
121 : {
122 161 : treemap_i_r(t, i+1, a+1, c, p, M);
123 161 : gel(t, i) = mkvec2(x, mkvecsmall3(0, i+1, theight(i+1) + 1));
124 : }
125 : else
126 : {
127 161 : long l = i+1, r = l + b - a, h;
128 161 : treemap_i_r(t, l, a, b-1, p, M);
129 161 : treemap_i_r(t, r, b+1, c, p, M);
130 161 : h = maxss(theight(l), theight(r))+1;
131 161 : gel(t, i) = mkvec2(x, mkvecsmall3(l, r, h));
132 : }
133 602 : }
134 :
135 : static void
136 119 : treemap_i(GEN t, GEN p, GEN M) { treemap_i_r(t, 1, 1, lg(p)-1, p, M); }
137 :
138 : #define value(i) gmael(list_data(T),(i),1)
139 : #define left(i) mael3(list_data(T),(i),2,1)
140 : #define right(i) mael3(list_data(T),(i),2,2)
141 : #define height(i) mael3(list_data(T),(i),2,3)
142 :
143 : static long
144 3060022 : treeheight(GEN T, long i) { return i? height(i): 0; }
145 :
146 : static void
147 154 : change_leaf(GEN T, GEN x, long p)
148 : {
149 154 : pari_sp av = avma;
150 154 : listput(T, mkvec2(x, gmael(list_data(T), p, 2)), p);
151 154 : set_avma(av);
152 154 : }
153 :
154 : static long
155 51030 : new_leaf(GEN T, GEN x)
156 : {
157 51030 : pari_sp av = avma;
158 51030 : listput(T, mkvec2(x, mkvecsmall3(0,0,1)), 0);
159 51030 : return gc_long(av, lg(list_data(T))-1);
160 : }
161 :
162 : static void
163 803894 : fix_height(GEN T, long x)
164 803894 : { height(x) = maxss(treeheight(T,left(x)), treeheight(T,right(x)))+1; }
165 : static long
166 726117 : treebalance(GEN T, long i)
167 726117 : { return i ? treeheight(T,left(i)) - treeheight(T,right(i)): 0; }
168 :
169 : static long
170 21497 : rotright(GEN T, long y)
171 : {
172 21497 : long x = left(y), t = right(x);
173 21497 : right(x) = y;
174 21497 : left(y) = t;
175 21497 : fix_height(T, y);
176 21497 : fix_height(T, x);
177 21497 : return x;
178 : }
179 :
180 : static long
181 21679 : rotleft(GEN T, long x)
182 : {
183 21679 : long y = right(x), t = left(y);
184 21679 : left(y) = x;
185 21679 : right(x) = t;
186 21679 : fix_height(T, x);
187 21679 : fix_height(T, y);
188 21679 : return y;
189 : }
190 :
191 : static long
192 567182 : treeinsert_r(GEN T, GEN x, long i, long *d)
193 : {
194 : long b, c;
195 567182 : if (i==0 || !list_data(T) || lg(list_data(T))==1) return new_leaf(T, x);
196 516152 : c = cmp_universal(gel(x,1), gel(value(i),1));
197 516152 : if (c < 0)
198 : {
199 256508 : long s = treeinsert_r(T, x, left(i), d);
200 256508 : if (s < 0) return s;
201 256445 : left(i) = s;
202 : }
203 259644 : else if (c > 0)
204 : {
205 259490 : long s = treeinsert_r(T, x, right(i), d);
206 259490 : if (s < 0) return s;
207 259385 : right(i) = s;
208 : }
209 154 : else return -i;
210 515830 : fix_height(T, i);
211 515830 : b = treebalance(T, i);
212 515830 : if (b > 1)
213 : {
214 11473 : if (*d > 0) left(i) = rotleft(T, left(i));
215 11473 : return rotright(T, i);
216 : }
217 504357 : if (b < -1)
218 : {
219 11753 : if (*d < 0) right(i) = rotright(T, right(i));
220 11753 : return rotleft(T, i);
221 : }
222 492604 : *d = c; return i;
223 : }
224 :
225 : static long
226 51184 : treeinsert(GEN T, GEN x)
227 : {
228 51184 : long c = 0, r = treeinsert_r(T, x, 1, &c);
229 : GEN d;
230 51184 : if (r < 0) return -r;
231 51030 : if (r == 1) return 0;
232 126 : d = list_data(T);
233 : /* By convention we want the root to be 1 */
234 126 : swap(gel(d,1), gel(d,r));
235 126 : if (left(1) == 1) left(1) = r;
236 28 : else if (right(1) == 1) right(1) = r;
237 0 : else pari_err_BUG("treeadd");
238 126 : return 0;
239 : }
240 :
241 : static long
242 223608 : treedelete_r(GEN T, GEN x, long i, long *dead)
243 : {
244 : long b, c;
245 223608 : if (i==0 || !list_data(T) || lg(list_data(T))==1) return -1;
246 223601 : c = cmp_universal(x, gel(value(i),1));
247 223601 : if (c < 0)
248 : {
249 101038 : long s = treedelete_r(T, x, left(i), dead);
250 101038 : if (s < 0) return s;
251 101038 : left(i) = s;
252 : }
253 122563 : else if (c > 0)
254 : {
255 89194 : long s = treedelete_r(T, x, right(i), dead);
256 89194 : if (s < 0) return s;
257 89180 : right(i) = s;
258 : }
259 : else
260 : {
261 33369 : *dead = i;
262 33369 : if (left(i)==0 && right(i)==0) return 0;
263 17115 : else if (left(i)==0) return right(i);
264 12803 : else if (right(i)==0) return left(i);
265 : else
266 : {
267 11494 : GEN v, d = list_data(T);
268 11494 : long j = right(i);
269 28028 : while (left(j)) j = left(j);
270 11494 : v = gel(value(j), 1);
271 11494 : right(i) = treedelete_r(T, v, right(i), dead);
272 11494 : swap(gel(d,i), gel(d,j));
273 11494 : lswap(left(i),left(j));
274 11494 : lswap(right(i),right(j));
275 11494 : lswap(height(i),height(j));
276 : }
277 : }
278 201712 : fix_height(T, i);
279 201712 : b = treebalance(T, i);
280 201712 : if (b > 1 && treebalance(T, left(i)) >= 0) return rotright(T, i);
281 200109 : if (b > 1 && treebalance(T, left(i)) < 0)
282 1295 : { left(i) = rotleft(T, left(i)); return rotright(T, i); }
283 198814 : if (b < -1 && treebalance(T, right(i)) <= 0) return rotleft(T,i);
284 196938 : if (b < -1 && treebalance(T, right(i)) > 0)
285 1253 : { right(i) = rotright(T, right(i)); return rotleft(T, i); }
286 195685 : return i;
287 : }
288 :
289 : static long
290 21882 : treedelete(GEN T, GEN x)
291 : {
292 21882 : long dead, l, r = treedelete_r(T, x, 1, &dead);
293 : GEN d;
294 21882 : if (r < 0) return 0;
295 21875 : d = list_data(T); /* != NULL and nonempty */
296 21875 : if (r > 1)
297 : { /* By convention we want the root to be 1 */
298 14 : swap(gel(d,1), gel(d,r));
299 14 : if (left(1) == 1) left(1) = r;
300 14 : else if (right(1) == 1) right(1) = r;
301 7 : else dead = r;
302 : }
303 : /* We want the dead to be last */
304 21875 : l = lg(d)-1;
305 21875 : if (dead != l)
306 : {
307 20433 : long p = treeparent_r(d, gel(value(l),1), 1, 0);
308 20433 : if (left(p) == l) left(p) = dead;
309 10311 : else if (right(p) == l) right(p) = dead;
310 0 : else pari_err_BUG("treedelete2");
311 20433 : swap(gel(d, dead),gel(d, l));
312 : }
313 21875 : listpop(T,0); return 1;
314 : }
315 :
316 : static int
317 75712 : ismap(GEN T) { return typ(T) == t_LIST && list_typ(T) == t_LIST_MAP; }
318 :
319 : void
320 51184 : mapput(GEN T, GEN a, GEN b)
321 : {
322 51184 : pari_sp av = avma;
323 51184 : GEN p = mkvec2(a, b);
324 : long i;
325 51184 : if (!ismap(T)) pari_err_TYPE("mapput",T);
326 51184 : i = treeinsert(T, p); if (i) change_leaf(T, p, i);
327 51184 : set_avma(av);
328 51184 : }
329 :
330 : void
331 21889 : mapdelete(GEN T, GEN a)
332 : {
333 21889 : pari_sp av = avma;
334 : long s;
335 21889 : if (!ismap(T)) pari_err_TYPE("mapdelete",T);
336 21882 : s = treedelete(T, a); set_avma(av);
337 21882 : if (!s) pari_err_COMPONENT("mapdelete", "not in", strtoGENstr("map"), a);
338 21875 : }
339 :
340 : GEN
341 581 : mapget(GEN T, GEN a)
342 : {
343 : GEN x;
344 581 : if (!ismap(T)) pari_err_TYPE("mapget",T);
345 567 : x = treesearch(T, a);
346 567 : if (!x) pari_err_COMPONENT("mapget", "not in", strtoGENstr("map"), a);
347 560 : return gcopy(gel(x, 2));
348 : }
349 :
350 : GEN
351 42 : mapapply(GEN T, GEN a, GEN f, GEN u)
352 : {
353 : GEN x;
354 42 : if (!ismap(T)) pari_err_TYPE("mapapply",T);
355 42 : x = treesearch(T, a);
356 42 : if (!x)
357 : {
358 14 : if (!u) pari_err_COMPONENT("mapapply", "not in", strtoGENstr("map"), a);
359 7 : x = closure_callgen0(u);
360 7 : mapput(T, a, x);
361 7 : return x;
362 : }
363 28 : return closure_callgen1(f, gel(x,2));
364 : }
365 :
366 : int
367 1988 : mapisdefined(GEN T, GEN a, GEN *pt_z)
368 : {
369 : GEN x;
370 1988 : if (!ismap(T)) pari_err_TYPE("mapisdefined",T);
371 1974 : x = treesearch(T, a); if (!x) return 0;
372 140 : if (pt_z) *pt_z = gcopy(gel(x, 2));
373 140 : return 1;
374 : }
375 :
376 : GEN
377 14 : mapdomain(GEN T)
378 : {
379 : long i, l;
380 : GEN V;
381 14 : if (!ismap(T)) pari_err_TYPE("mapdomain",T);
382 14 : V = mapdomain_shallow(T); l = lg(V);
383 56 : for (i = 1; i < l; i++) gel(V,i) = gcopy(gel(V,i));
384 14 : return V;
385 : }
386 :
387 : GEN
388 14 : maptomat(GEN T)
389 : {
390 : long i, l;
391 : GEN V;
392 14 : if (!ismap(T)) pari_err_TYPE("maptomat",T);
393 14 : V = maptomat_shallow(T); if (lg(V) == 1) return V;
394 14 : l = lgcols(V);
395 77 : for (i = 1; i < l; i++)
396 : {
397 63 : gcoeff(V,i,1) = gcopy(gcoeff(V,i,1));
398 63 : gcoeff(V,i,2) = gcopy(gcoeff(V,i,2));
399 : }
400 14 : return V;
401 : }
402 :
403 : GEN
404 182 : gtomap(GEN x)
405 : {
406 182 : if (!x) return mkmap();
407 133 : switch(typ(x))
408 : {
409 126 : case t_MAT:
410 : {
411 126 : long l = lg(x);
412 : GEN M, p;
413 126 : if (l == 1 || lgcols(x)==1) return mkmap();
414 126 : if (l != 3) pari_err_TYPE("Map",x);
415 126 : p = gen_indexsort_uniq(gel(x,1),(void*)&cmp_universal, cmp_nodata);
416 126 : l = lgcols(x);
417 126 : if (lg(p) != l)
418 7 : pari_err_DOMAIN("Map","x","is not",strtoGENstr("one-to-one"),x);
419 119 : M = cgetg(3, t_LIST);
420 119 : M[1] = evaltyp(t_LIST_MAP); /* do not set list_nmax! */
421 119 : list_data(M) = cgetg(l, t_VEC);
422 119 : treemap_i(list_data(M), p, x);
423 119 : return M;
424 : }
425 7 : default:
426 7 : pari_err_TYPE("Map",x);
427 : }
428 : return NULL; /* LCOV_EXCL_LINE */
429 : }
|
