Line data Source code
1 : /* Copyright (C) 2014 The PARI group.
2 :
3 : This file is part of the PARI/GP 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. It is distributed in the hope that it will be useful, but WITHOUT
8 : ANY WARRANTY WHATSOEVER.
9 :
10 : Check the License for details. You should have received a copy of it, along
11 : with the package; see the file 'COPYING'. If not, write to the Free Software
12 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
13 :
14 : #include "pari.h"
15 : #include "paripriv.h"
16 :
17 : /* FIXME: Implement {ascend,descend}_volcano() in terms of the "new"
18 : * volcano traversal functions at the bottom of the file. */
19 :
20 : /* Is j = 0 or 1728 (mod p)? */
21 : INLINE int
22 317210 : is_j_exceptional(ulong j, ulong p) { return j == 0 || j == 1728 % p; }
23 :
24 : INLINE long
25 70856 : node_degree(GEN phi, long L, ulong j, ulong p, ulong pi)
26 : {
27 70856 : pari_sp av = avma;
28 70856 : long n = Flx_nbroots(Flm_Fl_polmodular_evalx(phi, L, j, p, pi), p);
29 70856 : return gc_long(av, n);
30 : }
31 :
32 : /* Given an array path = [j0, j1] of length 2, return the polynomial
33 : *
34 : * \Phi_L(X, j1) / (X - j0)
35 : *
36 : * where \Phi_L(X, Y) is the modular polynomial of level L. An error
37 : * is raised if X - j0 does not divide \Phi_L(X, j1) */
38 : INLINE GEN
39 124819 : nhbr_polynomial(ulong path[], GEN phi, ulong p, ulong pi, long L)
40 : {
41 124819 : pari_sp ltop = avma;
42 124819 : GEN modpol = Flm_Fl_polmodular_evalx(phi, L, path[0], p, pi);
43 : ulong rem;
44 124819 : GEN nhbr_pol = Flx_div_by_X_x(modpol, path[-1], p, &rem);
45 : /* If disc End(path[0]) <= L^2, it's possible for path[0] to appear among the
46 : * roots of nhbr_pol. This should have been obviated by earlier choices */
47 124819 : if (rem) pari_err_BUG("nhbr_polynomial: invalid preceding j");
48 124819 : return gerepileupto(ltop, nhbr_pol);
49 : }
50 :
51 : /* Path is an array with space for at least max_len+1 * elements, whose first
52 : * and second elements are the beginning of the path. I.e., the path starts
53 : * (path[0], path[1])
54 : * If the result is less than max_len, then the last element of path is on the
55 : * floor. If the result equals max_len, then it is unknown whether the last
56 : * element of path is on the floor or not */
57 : static long
58 245610 : extend_path(ulong path[], GEN phi, ulong p, ulong pi, long L, long max_len)
59 : {
60 245610 : pari_sp av = avma;
61 245610 : long d = 1;
62 316239 : for ( ; d < max_len; d++)
63 : {
64 91546 : GEN nhbr_pol = nhbr_polynomial(path + d, phi, p, pi, L);
65 91546 : ulong nhbr = Flx_oneroot(nhbr_pol, p);
66 91546 : set_avma(av);
67 91546 : if (nhbr == p) break; /* no root: we are on the floor. */
68 70629 : path[d+1] = nhbr;
69 : }
70 245610 : return d;
71 : }
72 :
73 : /* This is Sutherland 2009 Algorithm Ascend (p12) */
74 : ulong
75 111221 : ascend_volcano(GEN phi, ulong j, ulong p, ulong pi, long level, long L,
76 : long depth, long steps)
77 : {
78 111221 : pari_sp ltop = avma, av;
79 : /* path will never hold more than max_len < depth elements */
80 111221 : GEN path_g = cgetg(depth + 2, t_VECSMALL);
81 111221 : ulong *path = zv_to_ulongptr(path_g);
82 111221 : long max_len = depth - level;
83 111221 : int first_iter = 1;
84 :
85 111221 : if (steps <= 0 || max_len < 0) pari_err_BUG("ascend_volcano: bad params");
86 111221 : av = avma;
87 255715 : while (steps--)
88 : {
89 111221 : GEN nhbr_pol = first_iter? Flm_Fl_polmodular_evalx(phi, L, j, p, pi)
90 144494 : : nhbr_polynomial(path+1, phi, p, pi, L);
91 144494 : GEN nhbrs = Flx_roots(nhbr_pol, p);
92 144494 : long nhbrs_len = lg(nhbrs)-1, i;
93 144494 : pari_sp btop = avma;
94 144494 : path[0] = j;
95 144494 : first_iter = 0;
96 :
97 144494 : j = nhbrs[nhbrs_len];
98 182752 : for (i = 1; i < nhbrs_len; i++)
99 : {
100 68901 : ulong next_j = nhbrs[i], last_j;
101 : long len;
102 68901 : if (is_j_exceptional(next_j, p))
103 : {
104 : /* Fouquet & Morain, Section 4.3, if j = 0 or 1728, then it is on the
105 : * surface. So we just return it. */
106 0 : if (steps)
107 0 : pari_err_BUG("ascend_volcano: Got to the top with more steps to go!");
108 0 : j = next_j; break;
109 : }
110 68901 : path[1] = next_j;
111 68901 : len = extend_path(path, phi, p, pi, L, max_len);
112 68901 : last_j = path[len];
113 68901 : if (len == max_len
114 : /* Ended up on the surface */
115 68901 : && (is_j_exceptional(last_j, p)
116 68901 : || node_degree(phi, L, last_j, p, pi) > 1)) { j = next_j; break; }
117 38258 : set_avma(btop);
118 : }
119 144494 : path[1] = j; /* For nhbr_polynomial() at the top. */
120 :
121 144494 : max_len++; set_avma(av);
122 : }
123 111221 : return gc_long(ltop, j);
124 : }
125 :
126 : static void
127 179408 : random_distinct_neighbours_of(ulong *nhbr1, ulong *nhbr2,
128 : GEN phi, ulong j, ulong p, ulong pi, long L, long must_have_two_neighbours)
129 : {
130 179408 : pari_sp av = avma;
131 179408 : GEN modpol = Flm_Fl_polmodular_evalx(phi, L, j, p, pi);
132 : ulong rem;
133 179408 : *nhbr1 = Flx_oneroot(modpol, p);
134 179408 : if (*nhbr1 == p) pari_err_BUG("random_distinct_neighbours_of [no neighbour]");
135 179408 : modpol = Flx_div_by_X_x(modpol, *nhbr1, p, &rem);
136 179408 : *nhbr2 = Flx_oneroot(modpol, p);
137 179408 : if (must_have_two_neighbours && *nhbr2 == p)
138 0 : pari_err_BUG("random_distinct_neighbours_of [single neighbour]");
139 179408 : set_avma(av);
140 179408 : }
141 :
142 : /*
143 : * This is Sutherland 2009 Algorithm Descend (p12).
144 : */
145 : ulong
146 1836 : descend_volcano(GEN phi, ulong j, ulong p, ulong pi,
147 : long level, long L, long depth, long steps)
148 : {
149 1836 : pari_sp ltop = avma;
150 : GEN path_g;
151 : ulong *path;
152 : long max_len;
153 :
154 1836 : if (steps <= 0 || level + steps > depth) pari_err_BUG("descend_volcano");
155 1836 : max_len = depth - level;
156 1836 : path_g = cgetg(max_len + 1 + 1, t_VECSMALL);
157 1836 : path = zv_to_ulongptr(path_g);
158 1836 : path[0] = j;
159 : /* level = 0 means we're on the volcano surface... */
160 1836 : if (!level)
161 : {
162 : /* Look for any path to the floor. One of j's first three neighbours leads
163 : * to the floor, since at most two neighbours are on the surface. */
164 1589 : GEN nhbrs = Flx_roots(Flm_Fl_polmodular_evalx(phi, L, j, p, pi), p);
165 : long i;
166 1734 : for (i = 1; i <= 3; i++)
167 : {
168 : long len;
169 1734 : path[1] = nhbrs[i];
170 1734 : len = extend_path(path, phi, p, pi, L, max_len);
171 : /* If nhbrs[i] took us to the floor: */
172 1734 : if (len < max_len || node_degree(phi, L, path[len], p, pi) == 1) break;
173 : }
174 1589 : if (i > 3) pari_err_BUG("descend_volcano [2]");
175 : }
176 : else
177 : {
178 : ulong nhbr1, nhbr2;
179 : long len;
180 247 : random_distinct_neighbours_of(&nhbr1, &nhbr2, phi, j, p, pi, L, 1);
181 247 : path[1] = nhbr1;
182 247 : len = extend_path(path, phi, p, pi, L, max_len);
183 : /* If last j isn't on the floor */
184 247 : if (len == max_len /* Ended up on the surface. */
185 247 : && (is_j_exceptional(path[len], p)
186 221 : || node_degree(phi, L, path[len], p, pi) != 1)) {
187 : /* The other neighbour leads to the floor */
188 96 : path[1] = nhbr2;
189 96 : (void) extend_path(path, phi, p, pi, L, steps);
190 : }
191 : }
192 1836 : return gc_ulong(ltop, path[steps]);
193 : }
194 :
195 : long
196 179161 : j_level_in_volcano(
197 : GEN phi, ulong j, ulong p, ulong pi, long L, long depth)
198 : {
199 179161 : pari_sp av = avma;
200 : GEN chunk;
201 : ulong *path1, *path2;
202 : long lvl;
203 :
204 : /* Fouquet & Morain, Section 4.3, if j = 0 or 1728 then it is on the
205 : * surface. Also, if the volcano depth is zero then j has level 0 */
206 179161 : if (depth == 0 || is_j_exceptional(j, p)) return 0;
207 :
208 179161 : chunk = new_chunk(2 * (depth + 1));
209 179161 : path1 = (ulong *) &chunk[0];
210 179161 : path2 = (ulong *) &chunk[depth + 1];
211 179161 : path1[0] = path2[0] = j;
212 179161 : random_distinct_neighbours_of(&path1[1], &path2[1], phi, j, p, pi, L, 0);
213 179161 : if (path2[1] == p)
214 91845 : lvl = depth; /* Only one neighbour => j is on the floor => level = depth */
215 : else
216 : {
217 87316 : long path1_len = extend_path(path1, phi, p, pi, L, depth);
218 87316 : long path2_len = extend_path(path2, phi, p, pi, L, path1_len);
219 87316 : lvl = depth - path2_len;
220 : }
221 179161 : return gc_long(av, lvl);
222 : }
223 :
224 : #define vecsmall_len(v) (lg(v) - 1)
225 :
226 : INLINE GEN
227 28285787 : Flx_remove_root(GEN f, ulong a, ulong p)
228 : {
229 : ulong r;
230 28285787 : GEN g = Flx_div_by_X_x(f, a, p, &r);
231 28200436 : if (r) pari_err_BUG("Flx_remove_root");
232 28208452 : return g;
233 : }
234 :
235 : INLINE GEN
236 21767455 : get_nbrs(GEN phi, long L, ulong J, const ulong *xJ, ulong p, ulong pi)
237 : {
238 21767455 : pari_sp av = avma;
239 21767455 : GEN f = Flm_Fl_polmodular_evalx(phi, L, J, p, pi);
240 21747559 : if (xJ) f = Flx_remove_root(f, *xJ, p);
241 21708134 : return gerepileupto(av, Flx_roots(f, p));
242 : }
243 :
244 : /* Return a path of length n along the surface of an L-volcano of height h
245 : * starting from surface node j0. Assumes (D|L) = 1 where D = disc End(j0).
246 : *
247 : * Actually, if j0's endomorphism ring is a suborder, we return the
248 : * corresponding shorter path. W must hold space for n + h nodes.
249 : *
250 : * TODO: have two versions of this function: one that assumes J has the correct
251 : * endomorphism ring (hence avoiding several branches in the inner loop) and a
252 : * second that does not and accordingly checks for repetitions */
253 : static long
254 183052 : surface_path(
255 : ulong W[],
256 : long n, GEN phi, long L, long h, ulong J, const ulong *nJ, ulong p, ulong pi)
257 : {
258 183052 : pari_sp av = avma, bv;
259 : GEN T, v;
260 : long j, k, w, x;
261 : ulong W0;
262 :
263 183052 : W[0] = W0 = J;
264 183052 : if (n == 1) return 1;
265 :
266 183052 : T = cgetg(h+2, t_VEC); bv = avma;
267 183055 : v = get_nbrs(phi, L, J, nJ, p, pi);
268 : /* Insert known neighbour first */
269 183047 : if (nJ) v = gerepileupto(bv, vecsmall_prepend(v, *nJ));
270 183047 : gel(T,1) = v;
271 183047 : k = vecsmall_len(v);
272 :
273 183047 : switch (k) {
274 0 : case 0: pari_err_BUG("surface_path"); /* We must always have neighbours */
275 5609 : case 1:
276 : /* If volcano is not flat, then we must have more than one neighbour */
277 5609 : if (h) pari_err_BUG("surface_path");
278 5609 : W[1] = uel(v, 1);
279 5609 : set_avma(av);
280 : /* Check for bad endo ring */
281 5609 : if (W[1] == W[0]) return 1;
282 5530 : return 2;
283 20795 : case 2:
284 : /* If L=2 the only way we can have 2 neighbours is if we have a double root
285 : * which can only happen for |D| <= 16 (Thm 2.2 of Fouquet-Morain)
286 : * and if it does we must have a 2-cycle. Happens for D=-15. */
287 20795 : if (L == 2)
288 : { /* The double root is the neighbour on the surface, with exactly one
289 : * neighbour other than J; the other neighbour of J has either 0 or 2
290 : * neighbours that are not J */
291 0 : GEN u = get_nbrs(phi, L, uel(v, 1), &J, p, pi);
292 0 : long n = vecsmall_len(u) - !!vecsmall_isin(u, J);
293 0 : W[1] = n == 1 ? uel(v,1) : uel(v,2);
294 0 : return gc_long(av, 2);
295 : }
296 : /* Volcano is not flat but found only 2 neighbours for the surface node J */
297 20795 : if (h) pari_err_BUG("surface_path");
298 :
299 20795 : W[1] = uel(v,1); /* TODO: Can we use the other root uel(v,2) somehow? */
300 4354993 : for (w = 2; w < n; w++)
301 : {
302 4334413 : v = get_nbrs(phi, L, W[w-1], &W[w-2], p, pi);
303 : /* A flat volcano must have exactly one non-previous neighbour */
304 4334487 : if (vecsmall_len(v) != 1) pari_err_BUG("surface_path");
305 4334487 : W[w] = uel(v, 1);
306 : /* Detect cycle in case J doesn't have the right endo ring. */
307 4334487 : set_avma(av); if (W[w] == W0) return w;
308 : }
309 20580 : return gc_long(av, n);
310 : }
311 156643 : if (!h) pari_err_BUG("surface_path"); /* Can't have a flat volcano if k > 2 */
312 :
313 : /* At this point, each surface node has L+1 distinct neighbours, 2 of which
314 : * are on the surface */
315 156643 : w = 1;
316 156643 : for (x = 0;; x++)
317 : {
318 : /* Get next neighbour of last known surface node to attempt to
319 : * extend the path. */
320 5456670 : W[w] = umael(T, ((w-1) % h) + 1, x + 1);
321 :
322 : /* Detect cycle in case the given J didn't have the right endo ring */
323 5613313 : if (W[w] == W0) return gc_long(av,w);
324 :
325 : /* If we have to test the last neighbour, we know it's on the
326 : * surface, and if we're done there's no need to extend. */
327 5613185 : if (x == k-1 && w == n-1) return gc_long(av,n);
328 :
329 : /* Walk forward until we hit the floor or finish. */
330 : /* NB: We don't keep the stack clean here; usage is in the order of Lh,
331 : * i.e. L roots for each level of the volcano of height h. */
332 5510625 : for (j = w;;)
333 11593213 : {
334 : long m;
335 : /* We must get 0 or L neighbours here. */
336 17103838 : v = get_nbrs(phi, L, W[j], &W[j-1], p, pi);
337 17065258 : m = vecsmall_len(v);
338 17065258 : if (!m) {
339 : /* We hit the floor: save the neighbours of W[w-1] and dump the rest */
340 5454472 : GEN nbrs = gel(T, ((w-1) % h) + 1);
341 5454472 : gel(T, ((w-1) % h) + 1) = gerepileupto(bv, nbrs);
342 5456670 : break;
343 : }
344 11610786 : if (m != L) pari_err_BUG("surface_path");
345 :
346 11647176 : gel(T, (j % h) + 1) = v;
347 :
348 11647176 : W[++j] = uel(v, 1);
349 : /* If we have our path by h nodes, we know W[w] is on the surface */
350 11647176 : if (j == w + h) {
351 10690825 : ++w;
352 : /* Detect cycle in case the given J didn't have the right endo ring */
353 10690825 : if (W[w] == W0) return gc_long(av,w);
354 10666280 : x = 0; k = L;
355 : }
356 11622631 : if (w == n) return gc_long(av,w);
357 : }
358 : }
359 : }
360 :
361 : long
362 115850 : next_surface_nbr(
363 : ulong *nJ,
364 : GEN phi, long L, long h, ulong J, const ulong *pJ, ulong p, ulong pi)
365 : {
366 115850 : pari_sp av = avma, bv;
367 : GEN S;
368 : ulong *P;
369 : long i, k;
370 :
371 115850 : S = get_nbrs(phi, L, J, pJ, p, pi);
372 115848 : k = vecsmall_len(S);
373 : /* If there is a double root and pJ is set, then k will be zero. */
374 115848 : if (!k) return gc_long(av,0);
375 115848 : if (k == 1 || ( ! pJ && k == 2)) { *nJ = uel(S, 1); return gc_long(av,1); }
376 18260 : if (!h) pari_err_BUG("next_surface_nbr");
377 :
378 18260 : P = (ulong *) new_chunk(h + 1); bv = avma;
379 18260 : P[0] = J;
380 35751 : for (i = 0; i < k; i++)
381 : {
382 : long j;
383 35751 : P[1] = uel(S, i + 1);
384 58689 : for (j = 1; j <= h; j++)
385 : {
386 40429 : GEN T = get_nbrs(phi, L, P[j], &P[j - 1], p, pi);
387 40429 : if (!vecsmall_len(T)) break;
388 22938 : P[j + 1] = uel(T, 1);
389 : }
390 35751 : if (j < h) pari_err_BUG("next_surface_nbr");
391 35751 : set_avma(bv); if (j > h) break;
392 : }
393 : /* TODO: We could save one get_nbrs call by iterating from i up to k-1 and
394 : * assume that the last (kth) nbr is the one we want. For now we're careful
395 : * and check that this last nbr really is on the surface */
396 18260 : if (i == k) pari_err_BUG("next_surf_nbr");
397 18260 : *nJ = uel(S, i+1); return gc_long(av,1);
398 : }
399 :
400 : /* Return the number of distinct neighbours (1 or 2) */
401 : INLINE long
402 176821 : common_nbr(ulong *nbr,
403 : ulong J1, GEN Phi1, long L1,
404 : ulong J2, GEN Phi2, long L2, ulong p, ulong pi)
405 : {
406 176821 : pari_sp av = avma;
407 : GEN d, f, g, r;
408 : long rlen;
409 :
410 176821 : g = Flm_Fl_polmodular_evalx(Phi1, L1, J1, p, pi);
411 176818 : f = Flm_Fl_polmodular_evalx(Phi2, L2, J2, p, pi);
412 176819 : d = Flx_gcd(f, g, p);
413 176817 : if (degpol(d) == 1) { *nbr = Flx_deg1_root(d, p); return gc_long(av,1); }
414 1113 : if (degpol(d) != 2) pari_err_BUG("common_neighbour");
415 1113 : r = Flx_roots(d, p);
416 1113 : rlen = vecsmall_len(r);
417 1113 : if (!rlen) pari_err_BUG("common_neighbour");
418 : /* rlen is 1 or 2 depending on whether the root is unique or not. */
419 1113 : nbr[0] = uel(r, 1);
420 1113 : nbr[1] = uel(r, rlen); return gc_long(av,rlen);
421 : }
422 :
423 : /* Return gcd(Phi1(X,J1)/(X - J0), Phi2(X,J2)). Not stack clean. */
424 : INLINE GEN
425 42216 : common_nbr_pred_poly(
426 : ulong J1, GEN Phi1, long L1,
427 : ulong J2, GEN Phi2, long L2, ulong J0, ulong p, ulong pi)
428 : {
429 : GEN f, g;
430 :
431 42216 : g = Flm_Fl_polmodular_evalx(Phi1, L1, J1, p, pi);
432 42216 : g = Flx_remove_root(g, J0, p);
433 42216 : f = Flm_Fl_polmodular_evalx(Phi2, L2, J2, p, pi);
434 42216 : return Flx_gcd(f, g, p);
435 : }
436 :
437 : /* Find common neighbour of J1 and J2, where J0 is an L1 predecessor of J1.
438 : * Return 1 if successful, 0 if not. */
439 : INLINE int
440 41181 : common_nbr_pred(ulong *nbr,
441 : ulong J1, GEN Phi1, long L1,
442 : ulong J2, GEN Phi2, long L2, ulong J0, ulong p, ulong pi)
443 : {
444 41181 : pari_sp av = avma;
445 41181 : GEN d = common_nbr_pred_poly(J1, Phi1, L1, J2, Phi2, L2, J0, p, pi);
446 41181 : int res = (degpol(d) == 1);
447 41181 : if (res) *nbr = Flx_deg1_root(d, p);
448 41181 : return gc_bool(av,res);
449 : }
450 :
451 : INLINE long
452 1035 : common_nbr_verify(ulong *nbr,
453 : ulong J1, GEN Phi1, long L1,
454 : ulong J2, GEN Phi2, long L2, ulong J0, ulong p, ulong pi)
455 : {
456 1035 : pari_sp av = avma;
457 1035 : GEN d = common_nbr_pred_poly(J1, Phi1, L1, J2, Phi2, L2, J0, p, pi);
458 :
459 1035 : if (!degpol(d)) return gc_long(av,0);
460 375 : if (degpol(d) > 1) pari_err_BUG("common_neighbour_verify");
461 375 : *nbr = Flx_deg1_root(d, p);
462 375 : return gc_long(av,1);
463 : }
464 :
465 : INLINE ulong
466 500 : Flm_Fl_polmodular_evalxy(GEN Phi, long L, ulong x, ulong y, ulong p, ulong pi)
467 : {
468 500 : pari_sp av = avma;
469 500 : GEN f = Flm_Fl_polmodular_evalx(Phi, L, x, p, pi);
470 500 : return gc_ulong(av, Flx_eval_pre(f, y, p, pi));
471 : }
472 :
473 : /* Find a common L1-neighbor of J1 and L2-neighbor of J2, given J0 an
474 : * L2-neighbor of J1 and an L1-neighbor of J2. Return 1 if successful, 0
475 : * otherwise. Will only fail if initial J-invariant had the wrong endo ring */
476 : INLINE int
477 22080 : common_nbr_corner(ulong *nbr,
478 : ulong J1, GEN Phi1, long L1, long h1,
479 : ulong J2, GEN Phi2, long L2, ulong J0, ulong p, ulong pi)
480 : {
481 : ulong nbrs[2];
482 22080 : if (common_nbr(nbrs, J1,Phi1,L1, J2,Phi2,L2, p, pi) == 2)
483 : {
484 : ulong nJ1, nJ2;
485 606 : if (!next_surface_nbr(&nJ2, Phi1, L1, h1, J2, &J0, p, pi) ||
486 386 : !next_surface_nbr(&nJ1, Phi1, L1, h1, nbrs[0], &J1, p, pi)) return 0;
487 :
488 303 : if (Flm_Fl_polmodular_evalxy(Phi2, L2, nJ1, nJ2, p, pi))
489 106 : nbrs[0] = nbrs[1];
490 394 : else if (!next_surface_nbr(&nJ1, Phi1, L1, h1, nbrs[1], &J1, p, pi) ||
491 280 : !Flm_Fl_polmodular_evalxy(Phi2, L2, nJ1, nJ2, p, pi)) return 0;
492 : }
493 21997 : *nbr = nbrs[0]; return 1;
494 : }
495 :
496 : /* Enumerate a surface L1-cycle using gcds with Phi_L2, where c_L2=c_L1^e and
497 : * |c_L1|=n, where c_a is the class of the pos def reduced primeform <a,b,c>.
498 : * Assumes n > e > 1 and roots[0],...,roots[e-1] are already present in W */
499 : static long
500 58516 : surface_gcd_cycle(
501 : ulong W[], ulong V[], long n,
502 : GEN Phi1, long L1, GEN Phi2, long L2, long e, ulong p, ulong pi)
503 : {
504 58516 : pari_sp av = avma;
505 : long i1, i2, j1, j2;
506 :
507 58516 : i1 = j2 = 0;
508 58516 : i2 = j1 = e - 1;
509 : /* If W != V we assume V actually points to an L2-isogenous parallel L1-path.
510 : * e should be 2 in this case */
511 58516 : if (W != V) { i1 = j1+1; i2 = n-1; }
512 : do {
513 : ulong t0, t1, t2, h10, h11, h20, h21;
514 : long k;
515 : GEN f, g, h1, h2;
516 :
517 3403078 : f = Flm_Fl_polmodular_evalx(Phi2, L2, V[i1], p, pi);
518 3394869 : g = Flm_Fl_polmodular_evalx(Phi1, L1, W[j1], p, pi);
519 3396464 : g = Flx_remove_root(g, W[j1 - 1], p);
520 3389476 : h1 = Flx_gcd(f, g, p);
521 3378756 : if (degpol(h1) != 1) break; /* Error */
522 3378963 : h11 = Flx_coeff(h1, 1);
523 3382678 : h10 = Flx_coeff(h1, 0); set_avma(av);
524 :
525 3382186 : f = Flm_Fl_polmodular_evalx(Phi2, L2, V[i2], p, pi);
526 3395572 : g = Flm_Fl_polmodular_evalx(Phi1, L1, W[j2], p, pi);
527 3397639 : k = j2 + 1;
528 3397639 : if (k == n) k = 0;
529 3397639 : g = Flx_remove_root(g, W[k], p);
530 3391087 : h2 = Flx_gcd(f, g, p);
531 3381067 : if (degpol(h2) != 1) break; /* Error */
532 3381446 : h21 = Flx_coeff(h2, 1);
533 3385258 : h20 = Flx_coeff(h2, 0); set_avma(av);
534 :
535 3385462 : i1++; i2--; if (i2 < 0) i2 = n-1;
536 3385462 : j1++; j2--; if (j2 < 0) j2 = n-1;
537 :
538 3385462 : t0 = Fl_mul_pre(h11, h21, p, pi);
539 3401706 : t1 = Fl_inv(t0, p);
540 3398576 : t0 = Fl_mul_pre(t1, h21, p, pi);
541 3402270 : t2 = Fl_mul_pre(t0, h10, p, pi);
542 3402682 : W[j1] = Fl_neg(t2, p);
543 3401983 : t0 = Fl_mul_pre(t1, h11, p, pi);
544 3403670 : t2 = Fl_mul_pre(t0, h20, p, pi);
545 3403803 : W[j2] = Fl_neg(t2, p);
546 3402968 : } while (j2 > j1 + 1);
547 : /* Usually the loop exits when j2 = j1 + 1, in which case we return n.
548 : * If we break early because of an error, then (j2 - (j1+1)) > 0 is the
549 : * number of elements we haven't calculated yet, and we return n minus that
550 : * quantity */
551 58406 : return gc_long(av, n - j2 + j1 + 1);
552 : }
553 :
554 : static long
555 1176 : surface_gcd_path(
556 : ulong W[], ulong V[], long n,
557 : GEN Phi1, long L1, GEN Phi2, long L2, long e, ulong p, ulong pi)
558 : {
559 1176 : pari_sp av = avma;
560 : long i, j;
561 :
562 1176 : i = 0; j = e;
563 : /* If W != V then assume V actually points to a L2-isogenous
564 : * parallel L1-path. e should be 2 in this case */
565 1176 : if (W != V) i = j;
566 4872 : while (j < n)
567 : {
568 : GEN f, g, d;
569 :
570 3696 : f = Flm_Fl_polmodular_evalx(Phi2, L2, V[i], p, pi);
571 3696 : g = Flm_Fl_polmodular_evalx(Phi1, L1, W[j - 1], p, pi);
572 3696 : g = Flx_remove_root(g, W[j - 2], p);
573 3696 : d = Flx_gcd(f, g, p);
574 3696 : if (degpol(d) != 1) break; /* Error */
575 3696 : W[j] = Flx_deg1_root(d, p);
576 3696 : i++; j++; set_avma(av);
577 : }
578 1176 : return gc_long(av, j);
579 : }
580 :
581 : /* Given a path V of length n on an L1-volcano, and W[0] L2-isogenous to V[0],
582 : * extends the path W to length n on an L1-volcano, with W[i] L2-isogenous
583 : * to V[i]. Uses gcds unless L2 is too large to make it helpful. Always uses
584 : * GCD to get W[1] to ensure consistent orientation.
585 : *
586 : * Returns the new length of W. This will almost always be n, but could be
587 : * lower if V was started with a J-invariant with bad endomorphism ring */
588 : INLINE long
589 154741 : surface_parallel_path(
590 : ulong W[], ulong V[], long n,
591 : GEN Phi1, long L1, GEN Phi2, long L2, ulong p, ulong pi, long cycle)
592 : {
593 : ulong W2, nbrs[2];
594 154741 : if (common_nbr(nbrs, W[0], Phi1, L1, V[1], Phi2, L2, p, pi) == 2)
595 : {
596 712 : if (n <= 2) return 1; /* Error: Two choices with n = 2; ambiguous */
597 712 : if (!common_nbr_verify(&W2,nbrs[0], Phi1,L1,V[2], Phi2,L2,W[0], p,pi))
598 389 : nbrs[0] = nbrs[1]; /* nbrs[1] must be the correct choice */
599 323 : else if (common_nbr_verify(&W2,nbrs[1], Phi1,L1,V[2], Phi2,L2,W[0], p,pi))
600 52 : return 1; /* Error: Both paths extend successfully */
601 : }
602 154689 : W[1] = nbrs[0];
603 154689 : if (n <= 2) return n;
604 58516 : return cycle? surface_gcd_cycle(W, V, n, Phi1, L1, Phi2, L2, 2, p, pi)
605 118208 : : surface_gcd_path (W, V, n, Phi1, L1, Phi2, L2, 2, p, pi);
606 : }
607 :
608 : GEN
609 183864 : enum_roots(ulong J0, norm_eqn_t ne, GEN fdb, classgp_pcp_t G)
610 : {
611 : /* MAX_HEIGHT >= max_{p,n} val_p(n) where p and n are ulongs */
612 : enum { MAX_HEIGHT = BITS_IN_LONG };
613 183864 : pari_sp av, ltop = avma;
614 183864 : long s = !!G->L0;
615 183864 : long *n = G->n + s, *L = G->L + s, *o = G->o + s, k = G->k - s;
616 183864 : long i, t, vlen, *e, *h, *off, *poff, *M, N = G->enum_cnt;
617 183864 : ulong p = ne->p, pi = ne->pi, *roots;
618 : GEN Phi, vshape, vp, ve, roots_;
619 :
620 183864 : if (!k) return mkvecsmall(J0);
621 :
622 183055 : roots_ = cgetg(N + MAX_HEIGHT, t_VECSMALL);
623 183057 : roots = zv_to_ulongptr(roots_);
624 183057 : av = avma;
625 :
626 : /* TODO: Shouldn't be factoring this every time. Store in *ne? */
627 183057 : vshape = factoru(ne->v);
628 183053 : vp = gel(vshape, 1);
629 183053 : ve = gel(vshape, 2);
630 :
631 183053 : vlen = vecsmall_len(vp);
632 183053 : Phi = new_chunk(k);
633 183054 : e = new_chunk(k);
634 183055 : off = new_chunk(k);
635 183055 : poff = new_chunk(k);
636 : /* TODO: Surely we can work these out ahead of time? */
637 : /* h[i] is the valuation of p[i] in v */
638 183054 : h = new_chunk(k);
639 415964 : for (i = 0; i < k; ++i) {
640 232913 : h[i] = 0;
641 341654 : for (t = 1; t <= vlen; ++t)
642 271062 : if (vp[t] == L[i]) { h[i] = uel(ve, t); break; }
643 232913 : e[i] = 0;
644 232913 : off[i] = 0;
645 232913 : gel(Phi, i) = polmodular_db_getp(fdb, L[i], p);
646 : }
647 :
648 183051 : M = new_chunk(k);
649 232911 : for (M[0] = 1, i = 1; i < k; ++i) M[i] = M[i-1] * n[i-1];
650 :
651 183051 : t = surface_path(roots, n[0], gel(Phi, 0), L[0], h[0], J0, NULL, p, pi);
652 : /* Error: J0 has bad endo ring */
653 183048 : if (t < n[0]) return gc_NULL(ltop);
654 182696 : if (k == 1) { set_avma(av); setlg(roots_, t + 1); return roots_; }
655 :
656 43177 : i = 1;
657 197866 : while (i < k) {
658 : long j, t0;
659 175571 : for (j = i + 1; j < k && ! e[j]; ++j);
660 154872 : if (j < k) {
661 63261 : if (e[i]) {
662 41181 : if (! common_nbr_pred(
663 164724 : &roots[t], roots[off[i]], gel(Phi,i), L[i],
664 41181 : roots[t - M[j]], gel(Phi, j), L[j], roots[poff[i]], p, pi)) {
665 0 : break; /* Error: J0 has bad endo ring */
666 : }
667 22080 : } else if ( ! common_nbr_corner(
668 110400 : &roots[t], roots[off[i]], gel(Phi,i), L[i], h[i],
669 22080 : roots[t - M[j]], gel(Phi, j), L[j], roots[poff[j]], p, pi)) {
670 83 : break; /* Error: J0 has bad endo ring */
671 : }
672 140805 : } else if ( ! next_surface_nbr(
673 366444 : &roots[t], gel(Phi,i), L[i], h[i],
674 140807 : roots[off[i]], e[i] ? &roots[poff[i]] : NULL, p, pi))
675 0 : break; /* Error: J0 has bad endo ring */
676 154787 : if (roots[t] == roots[0]) break; /* Error: J0 has bad endo ring */
677 :
678 154740 : poff[i] = off[i];
679 154740 : off[i] = t;
680 154740 : e[i]++;
681 176820 : for (j = i-1; j; --j) { e[j] = 0; off[j] = off[j+1]; }
682 :
683 464220 : t0 = surface_parallel_path(&roots[t], &roots[poff[i]], n[0],
684 154740 : gel(Phi, 0), L[0], gel(Phi, i), L[i], p, pi, n[0] == o[0]);
685 154741 : if (t0 < n[0]) break; /* Error: J0 has bad endo ring */
686 :
687 : /* TODO: Do I need to check if any of the new roots is a repeat in
688 : * the case where J0 has bad endo ring? */
689 154689 : t += n[0];
690 225691 : for (i = 1; i < k && e[i] == n[i]-1; i++);
691 : }
692 : /* Check if J0 had wrong endo ring */
693 43176 : if (t != N) return gc_NULL(ltop);
694 42994 : set_avma(av); setlg(roots_, t + 1); return roots_;
695 : }
|
