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 2541 : treesearch(GEN T, GEN x)
25 : {
26 2541 : long i = 1;
27 2541 : GEN t = list_data(T);
28 2541 : if (!t || lg(t)==1) return NULL;
29 22925 : while (i)
30 : {
31 21098 : long c = cmp_universal(x, gel(tvalue(i),1));
32 21098 : if (!c) return tvalue(i);
33 20398 : i = c < 0 ? tleft(i): tright(i);
34 : }
35 1827 : 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 12712 : treemat(GEN t, long i, GEN V, long *n)
72 : {
73 12712 : if (i==0) return;
74 6034 : treemat(t, tleft(i), V, n);
75 6034 : ++*n;
76 6034 : gmael(V, 1, *n) = gel(tvalue(i), 1);
77 6034 : gmael(V, 2, *n) = gel(tvalue(i), 2);
78 6034 : treemat(t, tright(i), V, n);
79 : }
80 :
81 : GEN
82 651 : maptomat_shallow(GEN T)
83 : {
84 651 : GEN V, t = list_data(T);
85 651 : long n = 0;
86 651 : if (!t || lg(t)==1) return cgetg(1, t_MAT);
87 644 : V = cgetg(3, t_MAT);
88 644 : gel(V,1) = cgetg(lg(t), t_COL);
89 644 : gel(V,2) = cgetg(lg(t), t_COL);
90 644 : treemat(t, 1, V, &n); return V;
91 : }
92 :
93 : static void
94 504 : treemap_i_r(GEN t, long i, long a, long c, GEN p, GEN M)
95 : {
96 504 : long b = (a+c)>>1;
97 504 : GEN x = mkvec2(gcopy(gmael(M, 1, p[b])), gcopy(gmael(M, 2, p[b])));
98 504 : if (a == c)
99 217 : gel(t, i) = mkvec2(x, mkvecsmall3(0, 0, 1));
100 287 : else if (a+1 == c)
101 : {
102 147 : treemap_i_r(t, i+1, a+1, c, p, M);
103 147 : gel(t, i) = mkvec2(x, mkvecsmall3(0, i+1, theight(i+1) + 1));
104 : }
105 : else
106 : {
107 140 : long l = i+1, r = l + b - a, h;
108 140 : treemap_i_r(t, l, a, b-1, p, M);
109 140 : treemap_i_r(t, r, b+1, c, p, M);
110 140 : h = maxss(theight(l), theight(r))+1;
111 140 : gel(t, i) = mkvec2(x, mkvecsmall3(l, r, h));
112 : }
113 504 : }
114 :
115 : static void
116 77 : treemap_i(GEN t, GEN p, GEN M) { treemap_i_r(t, 1, 1, lg(p)-1, p, M); }
117 :
118 : #define value(i) gmael(list_data(T),(i),1)
119 : #define left(i) mael3(list_data(T),(i),2,1)
120 : #define right(i) mael3(list_data(T),(i),2,2)
121 : #define height(i) mael3(list_data(T),(i),2,3)
122 :
123 : static long
124 3059938 : treeheight(GEN T, long i) { return i? height(i): 0; }
125 :
126 : static void
127 154 : change_leaf(GEN T, GEN x, long p)
128 : {
129 154 : pari_sp av = avma;
130 154 : listput(T, mkvec2(x, gmael(list_data(T), p, 2)), p);
131 154 : set_avma(av);
132 154 : }
133 :
134 : static long
135 51023 : new_leaf(GEN T, GEN x)
136 : {
137 51023 : pari_sp av = avma;
138 51023 : listput(T, mkvec2(x, mkvecsmall3(0,0,1)), 0);
139 51023 : return gc_long(av, lg(list_data(T))-1);
140 : }
141 :
142 : static void
143 803866 : fix_height(GEN T, long x)
144 803866 : { height(x) = maxss(treeheight(T,left(x)), treeheight(T,right(x)))+1; }
145 : static long
146 726103 : treebalance(GEN T, long i)
147 726103 : { return i ? treeheight(T,left(i)) - treeheight(T,right(i)): 0; }
148 :
149 : static long
150 21497 : rotright(GEN T, long y)
151 : {
152 21497 : long x = left(y), t = right(x);
153 21497 : right(x) = y;
154 21497 : left(y) = t;
155 21497 : fix_height(T, y);
156 21497 : fix_height(T, x);
157 21497 : return x;
158 : }
159 :
160 : static long
161 21672 : rotleft(GEN T, long x)
162 : {
163 21672 : long y = right(x), t = left(y);
164 21672 : left(y) = x;
165 21672 : right(x) = t;
166 21672 : fix_height(T, x);
167 21672 : fix_height(T, y);
168 21672 : return y;
169 : }
170 :
171 : static long
172 567161 : treeinsert_r(GEN T, GEN x, long i, long *d)
173 : {
174 : long b, c;
175 567161 : if (i==0 || !list_data(T) || lg(list_data(T))==1) return new_leaf(T, x);
176 516138 : c = cmp_universal(gel(x,1), gel(value(i),1));
177 516138 : if (c < 0)
178 : {
179 256508 : long s = treeinsert_r(T, x, left(i), d);
180 256508 : if (s < 0) return s;
181 256445 : left(i) = s;
182 : }
183 259630 : else if (c > 0)
184 : {
185 259476 : long s = treeinsert_r(T, x, right(i), d);
186 259476 : if (s < 0) return s;
187 259371 : right(i) = s;
188 : }
189 154 : else return -i;
190 515816 : fix_height(T, i);
191 515816 : b = treebalance(T, i);
192 515816 : if (b > 1)
193 : {
194 11473 : if (*d > 0) left(i) = rotleft(T, left(i));
195 11473 : return rotright(T, i);
196 : }
197 504343 : if (b < -1)
198 : {
199 11746 : if (*d < 0) right(i) = rotright(T, right(i));
200 11746 : return rotleft(T, i);
201 : }
202 492597 : *d = c; return i;
203 : }
204 :
205 : static long
206 51177 : treeinsert(GEN T, GEN x)
207 : {
208 51177 : long c = 0, r = treeinsert_r(T, x, 1, &c);
209 : GEN d;
210 51177 : if (r < 0) return -r;
211 51023 : if (r == 1) return 0;
212 119 : d = list_data(T);
213 : /* By convention we want the root to be 1 */
214 119 : swap(gel(d,1), gel(d,r));
215 119 : if (left(1) == 1) left(1) = r;
216 28 : else if (right(1) == 1) right(1) = r;
217 0 : else pari_err_BUG("treeadd");
218 119 : return 0;
219 : }
220 :
221 : static long
222 223608 : treedelete_r(GEN T, GEN x, long i, long *dead)
223 : {
224 : long b, c;
225 223608 : if (i==0 || !list_data(T) || lg(list_data(T))==1) return -1;
226 223601 : c = cmp_universal(x, gel(value(i),1));
227 223601 : if (c < 0)
228 : {
229 101038 : long s = treedelete_r(T, x, left(i), dead);
230 101038 : if (s < 0) return s;
231 101038 : left(i) = s;
232 : }
233 122563 : else if (c > 0)
234 : {
235 89194 : long s = treedelete_r(T, x, right(i), dead);
236 89194 : if (s < 0) return s;
237 89180 : right(i) = s;
238 : }
239 : else
240 : {
241 33369 : *dead = i;
242 33369 : if (left(i)==0 && right(i)==0) return 0;
243 17115 : else if (left(i)==0) return right(i);
244 12803 : else if (right(i)==0) return left(i);
245 : else
246 : {
247 11494 : GEN v, d = list_data(T);
248 11494 : long j = right(i);
249 28028 : while (left(j)) j = left(j);
250 11494 : v = gel(value(j), 1);
251 11494 : right(i) = treedelete_r(T, v, right(i), dead);
252 11494 : swap(gel(d,i), gel(d,j));
253 11494 : lswap(left(i),left(j));
254 11494 : lswap(right(i),right(j));
255 11494 : lswap(height(i),height(j));
256 : }
257 : }
258 201712 : fix_height(T, i);
259 201712 : b = treebalance(T, i);
260 201712 : if (b > 1 && treebalance(T, left(i)) >= 0) return rotright(T, i);
261 200109 : if (b > 1 && treebalance(T, left(i)) < 0)
262 1295 : { left(i) = rotleft(T, left(i)); return rotright(T, i); }
263 198814 : if (b < -1 && treebalance(T, right(i)) <= 0) return rotleft(T,i);
264 196938 : if (b < -1 && treebalance(T, right(i)) > 0)
265 1253 : { right(i) = rotright(T, right(i)); return rotleft(T, i); }
266 195685 : return i;
267 : }
268 :
269 : static long
270 21882 : treedelete(GEN T, GEN x)
271 : {
272 21882 : long dead, l, r = treedelete_r(T, x, 1, &dead);
273 : GEN d;
274 21882 : if (r < 0) return 0;
275 21875 : d = list_data(T); /* != NULL and nonempty */
276 21875 : if (r > 1)
277 : { /* By convention we want the root to be 1 */
278 14 : swap(gel(d,1), gel(d,r));
279 14 : if (left(1) == 1) left(1) = r;
280 14 : else if (right(1) == 1) right(1) = r;
281 7 : else dead = r;
282 : }
283 : /* We want the dead to be last */
284 21875 : l = lg(d)-1;
285 21875 : if (dead != l)
286 : {
287 20433 : long p = treeparent_r(d, gel(value(l),1), 1, 0);
288 20433 : if (left(p) == l) left(p) = dead;
289 10311 : else if (right(p) == l) right(p) = dead;
290 0 : else pari_err_BUG("treedelete2");
291 20433 : swap(gel(d, dead),gel(d, l));
292 : }
293 21875 : listpop(T,0); return 1;
294 : }
295 :
296 : static int
297 75663 : ismap(GEN T) { return typ(T) == t_LIST && list_typ(T) == t_LIST_MAP; }
298 :
299 : void
300 51177 : mapput(GEN T, GEN a, GEN b)
301 : {
302 51177 : pari_sp av = avma;
303 51177 : GEN p = mkvec2(a, b);
304 : long i;
305 51177 : if (!ismap(T)) pari_err_TYPE("mapput",T);
306 51177 : i = treeinsert(T, p); if (i) change_leaf(T, p, i);
307 51177 : set_avma(av);
308 51177 : }
309 :
310 : void
311 21889 : mapdelete(GEN T, GEN a)
312 : {
313 21889 : pari_sp av = avma;
314 : long s;
315 21889 : if (!ismap(T)) pari_err_TYPE("mapdelete",T);
316 21882 : s = treedelete(T, a); set_avma(av);
317 21882 : if (!s) pari_err_COMPONENT("mapdelete", "not in", strtoGENstr("map"), a);
318 21875 : }
319 :
320 : GEN
321 581 : mapget(GEN T, GEN a)
322 : {
323 : GEN x;
324 581 : if (!ismap(T)) pari_err_TYPE("mapget",T);
325 567 : x = treesearch(T, a);
326 567 : if (!x) pari_err_COMPONENT("mapget", "not in", strtoGENstr("map"), a);
327 560 : return gcopy(gel(x, 2));
328 : }
329 :
330 : int
331 1988 : mapisdefined(GEN T, GEN a, GEN *pt_z)
332 : {
333 : GEN x;
334 1988 : if (!ismap(T)) pari_err_TYPE("mapisdefined",T);
335 1974 : x = treesearch(T, a); if (!x) return 0;
336 140 : if (pt_z) *pt_z = gcopy(gel(x, 2));
337 140 : return 1;
338 : }
339 :
340 : GEN
341 14 : mapdomain(GEN T)
342 : {
343 : long i, l;
344 : GEN V;
345 14 : if (!ismap(T)) pari_err_TYPE("mapdomain",T);
346 14 : V = mapdomain_shallow(T); l = lg(V);
347 56 : for (i = 1; i < l; i++) gel(V,i) = gcopy(gel(V,i));
348 14 : return V;
349 : }
350 :
351 : GEN
352 14 : maptomat(GEN T)
353 : {
354 : long i, l;
355 : GEN V;
356 14 : if (!ismap(T)) pari_err_TYPE("maptomat",T);
357 14 : V = maptomat_shallow(T); if (lg(V) == 1) return V;
358 14 : l = lgcols(V);
359 77 : for (i = 1; i < l; i++)
360 : {
361 63 : gcoeff(V,i,1) = gcopy(gcoeff(V,i,1));
362 63 : gcoeff(V,i,2) = gcopy(gcoeff(V,i,2));
363 : }
364 14 : return V;
365 : }
366 :
367 : GEN
368 140 : gtomap(GEN x)
369 : {
370 140 : if (!x) return mkmap();
371 91 : switch(typ(x))
372 : {
373 84 : case t_MAT:
374 : {
375 84 : long l = lg(x);
376 : GEN M, p;
377 84 : if (l == 1 || lgcols(x)==1) return mkmap();
378 84 : if (l != 3) pari_err_TYPE("Map",x);
379 84 : p = gen_indexsort_uniq(gel(x,1),(void*)&cmp_universal, cmp_nodata);
380 84 : l = lgcols(x);
381 84 : if (lg(p) != l)
382 7 : pari_err_DOMAIN("Map","x","is not",strtoGENstr("one-to-one"),x);
383 77 : M = cgetg(3, t_LIST);
384 77 : M[1] = evaltyp(t_LIST_MAP); /* do not set list_nmax! */
385 77 : list_data(M) = cgetg(l, t_VEC);
386 77 : treemap_i(list_data(M), p, x);
387 77 : return M;
388 : }
389 7 : default:
390 7 : pari_err_TYPE("Map",x);
391 : }
392 : return NULL; /* LCOV_EXCL_LINE */
393 : }
|
