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 2214 : treesearch(GEN T, GEN x)
25 : {
26 2214 : long i = 1;
27 2214 : GEN t = list_data(T);
28 2214 : if (!t || lg(t)==1) return NULL;
29 19716 : while (i)
30 : {
31 18138 : long c = cmp_universal(x, gel(tvalue(i),1));
32 18138 : if (!c) return tvalue(i);
33 17514 : i = c < 0 ? tleft(i): tright(i);
34 : }
35 1578 : return NULL;
36 : }
37 :
38 : static long
39 174924 : treeparent_r(GEN t, GEN x, long i, long parent)
40 : {
41 : long c;
42 174924 : if (i==0) return parent;
43 174924 : c = cmp_universal(x, gel(tvalue(i),1));
44 174924 : if (c < 0)
45 77100 : return treeparent_r(t,x,tleft(i),i);
46 97824 : else if (c > 0)
47 80310 : return treeparent_r(t,x,tright(i),i);
48 : else
49 17514 : return parent;
50 : }
51 :
52 : static void
53 114 : treekeys(GEN t, long i, GEN V, long *n)
54 : {
55 114 : if (i==0) return;
56 48 : treekeys(t, tleft(i), V, n);
57 48 : gel(V, ++*n) = gel(tvalue(i),1);
58 48 : treekeys(t, tright(i), V, n);
59 : }
60 :
61 : GEN
62 18 : mapdomain_shallow(GEN T)
63 : {
64 18 : GEN V, t = list_data(T);
65 18 : long n = 0;
66 18 : if (!t || lg(t)==1) return cgetg(1, t_VEC);
67 18 : V = cgetg(lg(t), t_VEC); treekeys(t, 1, V, &n); return V;
68 : }
69 :
70 : static void
71 42 : treeselect(void *E, long (*f)(void* E, GEN x), GEN t, long i, GEN V, long *n)
72 : {
73 42 : if (i==0) return;
74 18 : treeselect(E, f, t, tleft(i), V, n);
75 18 : if (f(E, gel(tvalue(i),2))) gel(V, ++*n) = gel(tvalue(i),1);
76 18 : treeselect(E, f, t, tright(i), V, n);
77 : }
78 :
79 : GEN
80 6 : mapselect_shallow(void *E, long (*f)(void* E, GEN x), GEN T)
81 : {
82 6 : GEN V, t = list_data(T);
83 6 : long n = 0;
84 6 : if (!t || lg(t)==1) return cgetg(1, t_VEC);
85 6 : clone_lock(T);
86 6 : V = cgetg(lg(t), t_COL); treeselect(E, f, t, 1, V, &n);
87 6 : clone_unlock_deep(T); fixlg(V, n+1); return V;
88 : }
89 :
90 : static void
91 11244 : treemat(GEN t, long i, GEN V, long *n)
92 : {
93 11244 : if (i==0) return;
94 5316 : treemat(t, tleft(i), V, n);
95 5316 : ++*n;
96 5316 : gmael(V, 1, *n) = gel(tvalue(i), 1);
97 5316 : gmael(V, 2, *n) = gel(tvalue(i), 2);
98 5316 : treemat(t, tright(i), V, n);
99 : }
100 :
101 : GEN
102 618 : maptomat_shallow(GEN T)
103 : {
104 618 : GEN V, t = list_data(T);
105 618 : long n = 0;
106 618 : if (!t || lg(t)==1) return cgetg(1, t_MAT);
107 612 : V = cgetg(3, t_MAT);
108 612 : gel(V,1) = cgetg(lg(t), t_COL);
109 612 : gel(V,2) = cgetg(lg(t), t_COL);
110 612 : treemat(t, 1, V, &n); return V;
111 : }
112 :
113 : static void
114 516 : treemap_i_r(GEN t, long i, long a, long c, GEN p, GEN M)
115 : {
116 516 : long b = (a+c)>>1;
117 516 : GEN x = mkvec2(gcopy(gmael(M, 1, p[b])), gcopy(gmael(M, 2, p[b])));
118 516 : if (a == c)
119 240 : gel(t, i) = mkvec2(x, mkvecsmall3(0, 0, 1));
120 276 : else if (a+1 == c)
121 : {
122 138 : treemap_i_r(t, i+1, a+1, c, p, M);
123 138 : gel(t, i) = mkvec2(x, mkvecsmall3(0, i+1, theight(i+1) + 1));
124 : }
125 : else
126 : {
127 138 : long l = i+1, r = l + b - a, h;
128 138 : treemap_i_r(t, l, a, b-1, p, M);
129 138 : treemap_i_r(t, r, b+1, c, p, M);
130 138 : h = maxss(theight(l), theight(r))+1;
131 138 : gel(t, i) = mkvec2(x, mkvecsmall3(l, r, h));
132 : }
133 516 : }
134 :
135 : static void
136 102 : 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 2622876 : treeheight(GEN T, long i) { return i? height(i): 0; }
145 :
146 : static void
147 132 : change_leaf(GEN T, GEN x, long p)
148 : {
149 132 : pari_sp av = avma;
150 132 : listput(T, mkvec2(x, gmael(list_data(T), p, 2)), p);
151 132 : set_avma(av);
152 132 : }
153 :
154 : static long
155 43740 : new_leaf(GEN T, GEN x)
156 : {
157 43740 : pari_sp av = avma;
158 43740 : listput(T, mkvec2(x, mkvecsmall3(0,0,1)), 0);
159 43740 : return gc_long(av, lg(list_data(T))-1);
160 : }
161 :
162 : static void
163 689052 : fix_height(GEN T, long x)
164 689052 : { height(x) = maxss(treeheight(T,left(x)), treeheight(T,right(x)))+1; }
165 : static long
166 622386 : treebalance(GEN T, long i)
167 622386 : { return i ? treeheight(T,left(i)) - treeheight(T,right(i)): 0; }
168 :
169 : static long
170 18426 : rotright(GEN T, long y)
171 : {
172 18426 : long x = left(y), t = right(x);
173 18426 : right(x) = y;
174 18426 : left(y) = t;
175 18426 : fix_height(T, y);
176 18426 : fix_height(T, x);
177 18426 : return x;
178 : }
179 :
180 : static long
181 18582 : rotleft(GEN T, long x)
182 : {
183 18582 : long y = right(x), t = left(y);
184 18582 : left(y) = x;
185 18582 : right(x) = t;
186 18582 : fix_height(T, x);
187 18582 : fix_height(T, y);
188 18582 : return y;
189 : }
190 :
191 : static long
192 486156 : treeinsert_r(GEN T, GEN x, long i, long *d)
193 : {
194 : long b, c;
195 486156 : if (i==0 || !list_data(T) || lg(list_data(T))==1) return new_leaf(T, x);
196 442416 : c = cmp_universal(gel(x,1), gel(value(i),1));
197 442416 : if (c < 0)
198 : {
199 219864 : long s = treeinsert_r(T, x, left(i), d);
200 219864 : if (s < 0) return s;
201 219810 : left(i) = s;
202 : }
203 222552 : else if (c > 0)
204 : {
205 222420 : long s = treeinsert_r(T, x, right(i), d);
206 222420 : if (s < 0) return s;
207 222330 : right(i) = s;
208 : }
209 132 : else return -i;
210 442140 : fix_height(T, i);
211 442140 : b = treebalance(T, i);
212 442140 : if (b > 1)
213 : {
214 9834 : if (*d > 0) left(i) = rotleft(T, left(i));
215 9834 : return rotright(T, i);
216 : }
217 432306 : if (b < -1)
218 : {
219 10074 : if (*d < 0) right(i) = rotright(T, right(i));
220 10074 : return rotleft(T, i);
221 : }
222 422232 : *d = c; return i;
223 : }
224 :
225 : static long
226 43872 : treeinsert(GEN T, GEN x)
227 : {
228 43872 : long c = 0, r = treeinsert_r(T, x, 1, &c);
229 : GEN d;
230 43872 : if (r < 0) return -r;
231 43740 : if (r == 1) return 0;
232 108 : d = list_data(T);
233 : /* By convention we want the root to be 1 */
234 108 : swap(gel(d,1), gel(d,r));
235 108 : if (left(1) == 1) left(1) = r;
236 24 : else if (right(1) == 1) right(1) = r;
237 0 : else pari_err_BUG("treeadd");
238 108 : return 0;
239 : }
240 :
241 : static long
242 191664 : treedelete_r(GEN T, GEN x, long i, long *dead)
243 : {
244 : long b, c;
245 191664 : if (i==0 || !list_data(T) || lg(list_data(T))==1) return -1;
246 191658 : c = cmp_universal(x, gel(value(i),1));
247 191658 : if (c < 0)
248 : {
249 86604 : long s = treedelete_r(T, x, left(i), dead);
250 86604 : if (s < 0) return s;
251 86604 : left(i) = s;
252 : }
253 105054 : else if (c > 0)
254 : {
255 76452 : long s = treedelete_r(T, x, right(i), dead);
256 76452 : if (s < 0) return s;
257 76440 : right(i) = s;
258 : }
259 : else
260 : {
261 28602 : *dead = i;
262 28602 : if (left(i)==0 && right(i)==0) return 0;
263 14670 : else if (left(i)==0) return right(i);
264 10974 : else if (right(i)==0) return left(i);
265 : else
266 : {
267 9852 : GEN v, d = list_data(T);
268 9852 : long j = right(i);
269 24024 : while (left(j)) j = left(j);
270 9852 : v = gel(value(j), 1);
271 9852 : right(i) = treedelete_r(T, v, right(i), dead);
272 9852 : swap(gel(d,i), gel(d,j));
273 9852 : lswap(left(i),left(j));
274 9852 : lswap(right(i),right(j));
275 9852 : lswap(height(i),height(j));
276 : }
277 : }
278 172896 : fix_height(T, i);
279 172896 : b = treebalance(T, i);
280 172896 : if (b > 1 && treebalance(T, left(i)) >= 0) return rotright(T, i);
281 171522 : if (b > 1 && treebalance(T, left(i)) < 0)
282 1110 : { left(i) = rotleft(T, left(i)); return rotright(T, i); }
283 170412 : if (b < -1 && treebalance(T, right(i)) <= 0) return rotleft(T,i);
284 168804 : if (b < -1 && treebalance(T, right(i)) > 0)
285 1074 : { right(i) = rotright(T, right(i)); return rotleft(T, i); }
286 167730 : return i;
287 : }
288 :
289 : static long
290 18756 : treedelete(GEN T, GEN x)
291 : {
292 18756 : long dead, l, r = treedelete_r(T, x, 1, &dead);
293 : GEN d;
294 18756 : if (r < 0) return 0;
295 18750 : d = list_data(T); /* != NULL and nonempty */
296 18750 : if (r > 1)
297 : { /* By convention we want the root to be 1 */
298 12 : swap(gel(d,1), gel(d,r));
299 12 : if (left(1) == 1) left(1) = r;
300 12 : else if (right(1) == 1) right(1) = r;
301 6 : else dead = r;
302 : }
303 : /* We want the dead to be last */
304 18750 : l = lg(d)-1;
305 18750 : if (dead != l)
306 : {
307 17514 : long p = treeparent_r(d, gel(value(l),1), 1, 0);
308 17514 : if (left(p) == l) left(p) = dead;
309 8838 : else if (right(p) == l) right(p) = dead;
310 0 : else pari_err_BUG("treedelete2");
311 17514 : swap(gel(d, dead),gel(d, l));
312 : }
313 18750 : listpop(T,0); return 1;
314 : }
315 :
316 : static int
317 64896 : ismap(GEN T) { return typ(T) == t_LIST && list_typ(T) == t_LIST_MAP; }
318 :
319 : void
320 43872 : mapput(GEN T, GEN a, GEN b)
321 : {
322 43872 : pari_sp av = avma;
323 43872 : GEN p = mkvec2(a, b);
324 : long i;
325 43872 : if (!ismap(T)) pari_err_TYPE("mapput",T);
326 43872 : i = treeinsert(T, p); if (i) change_leaf(T, p, i);
327 43872 : set_avma(av);
328 43872 : }
329 :
330 : void
331 18762 : mapdelete(GEN T, GEN a)
332 : {
333 18762 : pari_sp av = avma;
334 : long s;
335 18762 : if (!ismap(T)) pari_err_TYPE("mapdelete",T);
336 18756 : s = treedelete(T, a); set_avma(av);
337 18756 : if (!s) pari_err_COMPONENT("mapdelete", "not in", strtoGENstr("map"), a);
338 18750 : }
339 :
340 : GEN
341 498 : mapget(GEN T, GEN a)
342 : {
343 : GEN x;
344 498 : if (!ismap(T)) pari_err_TYPE("mapget",T);
345 486 : x = treesearch(T, a);
346 486 : if (!x) pari_err_COMPONENT("mapget", "not in", strtoGENstr("map"), a);
347 480 : return gcopy(gel(x, 2));
348 : }
349 :
350 : GEN
351 36 : mapapply(GEN T, GEN a, GEN f, GEN u)
352 : {
353 : GEN x;
354 36 : if (!ismap(T)) pari_err_TYPE("mapapply",T);
355 36 : x = treesearch(T, a);
356 36 : if (!x)
357 : {
358 12 : if (!u) pari_err_COMPONENT("mapapply", "not in", strtoGENstr("map"), a);
359 6 : x = closure_callgen0(u);
360 6 : mapput(T, a, x);
361 6 : return x;
362 : }
363 24 : return closure_callgen1(f, gel(x,2));
364 : }
365 :
366 : int
367 1704 : mapisdefined(GEN T, GEN a, GEN *pt_z)
368 : {
369 : GEN x;
370 1704 : if (!ismap(T)) pari_err_TYPE("mapisdefined",T);
371 1692 : x = treesearch(T, a); if (!x) return 0;
372 120 : if (pt_z) *pt_z = gcopy(gel(x, 2));
373 120 : return 1;
374 : }
375 :
376 : GEN
377 12 : mapdomain(GEN T)
378 : {
379 : long i, l;
380 : GEN V;
381 12 : if (!ismap(T)) pari_err_TYPE("mapdomain",T);
382 12 : V = mapdomain_shallow(T); l = lg(V);
383 48 : for (i = 1; i < l; i++) gel(V,i) = gcopy(gel(V,i));
384 12 : return V;
385 : }
386 :
387 : GEN
388 12 : maptomat(GEN T)
389 : {
390 : long i, l;
391 : GEN V;
392 12 : if (!ismap(T)) pari_err_TYPE("maptomat",T);
393 12 : V = maptomat_shallow(T); if (lg(V) == 1) return V;
394 12 : l = lgcols(V);
395 66 : for (i = 1; i < l; i++)
396 : {
397 54 : gcoeff(V,i,1) = gcopy(gcoeff(V,i,1));
398 54 : gcoeff(V,i,2) = gcopy(gcoeff(V,i,2));
399 : }
400 12 : return V;
401 : }
402 :
403 : GEN
404 156 : gtomap(GEN x)
405 : {
406 156 : if (!x) return mkmap();
407 114 : switch(typ(x))
408 : {
409 108 : case t_MAT:
410 : {
411 108 : long l = lg(x);
412 : GEN M, p;
413 108 : if (l == 1 || lgcols(x)==1) return mkmap();
414 108 : if (l != 3) pari_err_TYPE("Map",x);
415 108 : p = gen_indexsort_uniq(gel(x,1),(void*)&cmp_universal, cmp_nodata);
416 108 : l = lgcols(x);
417 108 : if (lg(p) != l)
418 6 : pari_err_DOMAIN("Map","x","is not",strtoGENstr("one-to-one"),x);
419 102 : M = cgetg(3, t_LIST);
420 102 : M[1] = evaltyp(t_LIST_MAP); /* do not set list_nmax! */
421 102 : list_data(M) = cgetg(l, t_VEC);
422 102 : treemap_i(list_data(M), p, x);
423 102 : return M;
424 : }
425 6 : default:
426 6 : pari_err_TYPE("Map",x);
427 : }
428 : return NULL; /* LCOV_EXCL_LINE */
429 : }
|
