Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
Download

Testing latest pari + WASM + node.js... and it works?! Wow.

28479 views
License: GPL3
ubuntu2004
1
/* Copyright (C) 2000 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; 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
/*********************************************************************/
16
/** **/
17
/** ARITHMETIC FUNCTIONS **/
18
/** (second part) **/
19
/** **/
20
/*********************************************************************/
21
#include "pari.h"
22
#include "paripriv.h"
23
24
#define DEBUGLEVEL DEBUGLEVEL_arith
25
26
GEN
27
boundfact(GEN n, ulong lim)
28
{
29
switch(typ(n))
30
{
31
case t_INT: return Z_factor_limit(n,lim);
32
case t_FRAC: {
33
pari_sp av = avma;
34
GEN a = Z_factor_limit(gel(n,1),lim);
35
GEN b = Z_factor_limit(gel(n,2),lim);
36
gel(b,2) = ZC_neg(gel(b,2));
37
return gerepilecopy(av, merge_factor(a,b,(void*)&cmpii,cmp_nodata));
38
}
39
}
40
pari_err_TYPE("boundfact",n);
41
return NULL; /* LCOV_EXCL_LINE */
42
}
43
44
/* NOT memory clean */
45
GEN
46
Z_lsmoothen(GEN N, GEN L, GEN *pP, GEN *pE)
47
{
48
long i, j, l = lg(L);
49
GEN E = new_chunk(l), P = new_chunk(l);
50
for (i = j = 1; i < l; i++)
51
{
52
ulong p = uel(L,i);
53
long v = Z_lvalrem(N, p, &N);
54
if (v) { P[j] = p; E[j] = v; j++; if (is_pm1(N)) { N = NULL; break; } }
55
}
56
P[0] = evaltyp(t_VECSMALL) | evallg(j); if (pP) *pP = P;
57
E[0] = evaltyp(t_VECSMALL) | evallg(j); if (pE) *pE = E; return N;
58
}
59
GEN
60
Z_smoothen(GEN N, GEN L, GEN *pP, GEN *pE)
61
{
62
long i, j, l = lg(L);
63
GEN E = new_chunk(l), P = new_chunk(l);
64
for (i = j = 1; i < l; i++)
65
{
66
GEN p = gel(L,i);
67
long v = Z_pvalrem(N, p, &N);
68
if (v)
69
{
70
gel(P,j) = p; gel(E,j) = utoipos(v); j++;
71
if (is_pm1(N)) { N = NULL; break; }
72
}
73
}
74
P[0] = evaltyp(t_COL) | evallg(j); if (pP) *pP = P;
75
E[0] = evaltyp(t_COL) | evallg(j); if (pE) *pE = E; return N;
76
}
77
/***********************************************************************/
78
/** **/
79
/** SIMPLE FACTORISATIONS **/
80
/** **/
81
/***********************************************************************/
82
/* Factor n and output [p,e,c] where
83
* p, e and c are vecsmall with n = prod{p[i]^e[i]} and c[i] = p[i]^e[i] */
84
GEN
85
factoru_pow(ulong n)
86
{
87
GEN f = cgetg(4,t_VEC);
88
pari_sp av = avma;
89
GEN F, P, E, p, e, c;
90
long i, l;
91
/* enough room to store <= 15 * [p,e,p^e] (OK if n < 2^64) */
92
(void)new_chunk((15 + 1)*3);
93
F = factoru(n);
94
P = gel(F,1);
95
E = gel(F,2); l = lg(P);
96
set_avma(av);
97
gel(f,1) = p = cgetg(l,t_VECSMALL);
98
gel(f,2) = e = cgetg(l,t_VECSMALL);
99
gel(f,3) = c = cgetg(l,t_VECSMALL);
100
for(i = 1; i < l; i++)
101
{
102
p[i] = P[i];
103
e[i] = E[i];
104
c[i] = upowuu(p[i], e[i]);
105
}
106
return f;
107
}
108
109
static GEN
110
factorlim(GEN n, ulong lim)
111
{ return lim? Z_factor_limit(n, lim): Z_factor(n); }
112
/* factor p^n - 1, assuming p prime. If lim != 0, limit factorization to
113
* primes <= lim */
114
GEN
115
factor_pn_1_limit(GEN p, long n, ulong lim)
116
{
117
pari_sp av = avma;
118
GEN A = factorlim(subiu(p,1), lim), d = divisorsu(n);
119
long i, pp = itos_or_0(p);
120
for(i=2; i<lg(d); i++)
121
{
122
GEN B;
123
if (pp && d[i]%pp==0 && (
124
((pp&3)==1 && (d[i]&1)) ||
125
((pp&3)==3 && (d[i]&3)==2) ||
126
(pp==2 && (d[i]&7)==4)))
127
{
128
GEN f=factor_Aurifeuille_prime(p,d[i]);
129
B = factorlim(f, lim);
130
A = merge_factor(A, B, (void*)&cmpii, cmp_nodata);
131
B = factorlim(diviiexact(polcyclo_eval(d[i],p), f), lim);
132
}
133
else
134
B = factorlim(polcyclo_eval(d[i],p), lim);
135
A = merge_factor(A, B, (void*)&cmpii, cmp_nodata);
136
}
137
return gerepilecopy(av, A);
138
}
139
GEN
140
factor_pn_1(GEN p, ulong n)
141
{ return factor_pn_1_limit(p, n, 0); }
142
143
#if 0
144
static GEN
145
to_mat(GEN p, long e) {
146
GEN B = cgetg(3, t_MAT);
147
gel(B,1) = mkcol(p);
148
gel(B,2) = mkcol(utoipos(e)); return B;
149
}
150
/* factor phi(n) */
151
GEN
152
factor_eulerphi(GEN n)
153
{
154
pari_sp av = avma;
155
GEN B = NULL, A, P, E, AP, AE;
156
long i, l, v = vali(n);
157
158
l = lg(n);
159
/* result requires less than this: at most expi(n) primes */
160
(void)new_chunk(bit_accuracy(l) * (l /*p*/ + 3 /*e*/ + 2 /*vectors*/) + 3+2);
161
if (v) { n = shifti(n, -v); v--; }
162
A = Z_factor(n); P = gel(A,1); E = gel(A,2); l = lg(P);
163
for(i = 1; i < l; i++)
164
{
165
GEN p = gel(P,i), q = subiu(p,1), fa;
166
long e = itos(gel(E,i)), w;
167
168
w = vali(q); v += w; q = shifti(q,-w);
169
if (! is_pm1(q))
170
{
171
fa = Z_factor(q);
172
B = B? merge_factor(B, fa, (void*)&cmpii, cmp_nodata): fa;
173
}
174
if (e > 1) {
175
if (B) {
176
gel(B,1) = vec_append(gel(B,1), p);
177
gel(B,2) = vec_append(gel(B,2), utoipos(e-1));
178
} else
179
B = to_mat(p, e-1);
180
}
181
}
182
set_avma(av);
183
if (!B) return v? to_mat(gen_2, v): trivial_fact();
184
A = cgetg(3, t_MAT);
185
P = gel(B,1); E = gel(B,2); l = lg(P);
186
AP = cgetg(l+1, t_COL); gel(A,1) = AP; AP++;
187
AE = cgetg(l+1, t_COL); gel(A,2) = AE; AE++;
188
/* prepend "2^v" */
189
gel(AP,0) = gen_2;
190
gel(AE,0) = utoipos(v);
191
for (i = 1; i < l; i++)
192
{
193
gel(AP,i) = icopy(gel(P,i));
194
gel(AE,i) = icopy(gel(E,i));
195
}
196
return A;
197
}
198
#endif
199
200
/***********************************************************************/
201
/** **/
202
/** CHECK FACTORIZATION FOR ARITHMETIC FUNCTIONS **/
203
/** **/
204
/***********************************************************************/
205
int
206
RgV_is_ZVpos(GEN v)
207
{
208
long i, l = lg(v);
209
for (i = 1; i < l; i++)
210
{
211
GEN c = gel(v,i);
212
if (typ(c) != t_INT || signe(c) <= 0) return 0;
213
}
214
return 1;
215
}
216
/* check whether v is a ZV with nonzero entries */
217
int
218
RgV_is_ZVnon0(GEN v)
219
{
220
long i, l = lg(v);
221
for (i = 1; i < l; i++)
222
{
223
GEN c = gel(v,i);
224
if (typ(c) != t_INT || !signe(c)) return 0;
225
}
226
return 1;
227
}
228
/* check whether v is a ZV with nonzero entries OR exactly [0] */
229
static int
230
RgV_is_ZV0(GEN v)
231
{
232
long i, l = lg(v);
233
for (i = 1; i < l; i++)
234
{
235
GEN c = gel(v,i);
236
long s;
237
if (typ(c) != t_INT) return 0;
238
s = signe(c);
239
if (!s) return (l == 2);
240
}
241
return 1;
242
}
243
244
static int
245
RgV_is_prV(GEN v)
246
{
247
long l = lg(v), i;
248
for (i = 1; i < l; i++)
249
if (!checkprid_i(gel(v,i))) return 0;
250
return 1;
251
}
252
int
253
is_nf_factor(GEN F)
254
{
255
return typ(F) == t_MAT && lg(F) == 3
256
&& RgV_is_prV(gel(F,1)) && RgV_is_ZVpos(gel(F,2));
257
}
258
int
259
is_nf_extfactor(GEN F)
260
{
261
return typ(F) == t_MAT && lg(F) == 3
262
&& RgV_is_prV(gel(F,1)) && RgV_is_ZV(gel(F,2));
263
}
264
265
static int
266
is_Z_factor_i(GEN f)
267
{ return typ(f) == t_MAT && lg(f) == 3 && RgV_is_ZVpos(gel(f,2)); }
268
int
269
is_Z_factorpos(GEN f)
270
{ return is_Z_factor_i(f) && RgV_is_ZVpos(gel(f,1)); }
271
int
272
is_Z_factor(GEN f)
273
{ return is_Z_factor_i(f) && RgV_is_ZV0(gel(f,1)); }
274
/* as is_Z_factorpos, also allow factor(0) */
275
int
276
is_Z_factornon0(GEN f)
277
{ return is_Z_factor_i(f) && RgV_is_ZVnon0(gel(f,1)); }
278
GEN
279
clean_Z_factor(GEN f)
280
{
281
GEN P = gel(f,1);
282
long n = lg(P)-1;
283
if (n && equalim1(gel(P,1)))
284
return mkmat2(vecslice(P,2,n), vecslice(gel(f,2),2,n));
285
return f;
286
}
287
GEN
288
fuse_Z_factor(GEN f, GEN B)
289
{
290
GEN P = gel(f,1), E = gel(f,2), P2,E2;
291
long i, l = lg(P);
292
if (l == 1) return f;
293
for (i = 1; i < l; i++)
294
if (abscmpii(gel(P,i), B) > 0) break;
295
if (i == l) return f;
296
/* tail / initial segment */
297
P2 = vecslice(P, i, l-1); P = vecslice(P, 1, i-1);
298
E2 = vecslice(E, i, l-1); E = vecslice(E, 1, i-1);
299
P = vec_append(P, factorback2(P2,E2));
300
E = vec_append(E, gen_1);
301
return mkmat2(P, E);
302
}
303
304
/* n attached to a factorization of a positive integer: either N (t_INT)
305
* a factorization matrix faN, or a t_VEC: [N, faN] */
306
GEN
307
check_arith_pos(GEN n, const char *f) {
308
switch(typ(n))
309
{
310
case t_INT:
311
if (signe(n) <= 0) pari_err_DOMAIN(f, "argument", "<=", gen_0, gen_0);
312
return NULL;
313
case t_VEC:
314
if (lg(n) != 3 || typ(gel(n,1)) != t_INT || signe(gel(n,1)) <= 0) break;
315
n = gel(n,2); /* fall through */
316
case t_MAT:
317
if (!is_Z_factorpos(n)) break;
318
return n;
319
}
320
pari_err_TYPE(f,n);
321
return NULL;/*LCOV_EXCL_LINE*/
322
}
323
/* n attached to a factorization of a nonzero integer */
324
GEN
325
check_arith_non0(GEN n, const char *f) {
326
switch(typ(n))
327
{
328
case t_INT:
329
if (!signe(n)) pari_err_DOMAIN(f, "argument", "=", gen_0, gen_0);
330
return NULL;
331
case t_VEC:
332
if (lg(n) != 3 || typ(gel(n,1)) != t_INT || !signe(gel(n,1))) break;
333
n = gel(n,2); /* fall through */
334
case t_MAT:
335
if (!is_Z_factornon0(n)) break;
336
return n;
337
}
338
pari_err_TYPE(f,n);
339
return NULL;/*LCOV_EXCL_LINE*/
340
}
341
/* n attached to a factorization of an integer */
342
GEN
343
check_arith_all(GEN n, const char *f) {
344
switch(typ(n))
345
{
346
case t_INT:
347
return NULL;
348
case t_VEC:
349
if (lg(n) != 3 || typ(gel(n,1)) != t_INT) break;
350
n = gel(n,2); /* fall through */
351
case t_MAT:
352
if (!is_Z_factor(n)) break;
353
return n;
354
}
355
pari_err_TYPE(f,n);
356
return NULL;/*LCOV_EXCL_LINE*/
357
}
358
359
/***********************************************************************/
360
/** **/
361
/** MISCELLANEOUS ARITHMETIC FUNCTIONS **/
362
/** (ultimately depend on Z_factor()) **/
363
/** **/
364
/***********************************************************************/
365
/* set P,E from F. Check whether F is an integer and kill "factor" -1 */
366
static void
367
set_fact_check(GEN F, GEN *pP, GEN *pE, int *isint)
368
{
369
GEN E, P;
370
if (lg(F) != 3) pari_err_TYPE("divisors",F);
371
P = gel(F,1);
372
E = gel(F,2);
373
RgV_check_ZV(E, "divisors");
374
*isint = RgV_is_ZV(P);
375
if (*isint)
376
{
377
long i, l = lg(P);
378
/* skip -1 */
379
if (l>1 && signe(gel(P,1)) < 0) { E++; P = vecslice(P,2,--l); }
380
/* test for 0 */
381
for (i = 1; i < l; i++)
382
if (!signe(gel(P,i)) && signe(gel(E,i)))
383
pari_err_DOMAIN("divisors", "argument", "=", gen_0, F);
384
}
385
*pP = P;
386
*pE = E;
387
}
388
static void
389
set_fact(GEN F, GEN *pP, GEN *pE) { *pP = gel(F,1); *pE = gel(F,2); }
390
391
int
392
divisors_init(GEN n, GEN *pP, GEN *pE)
393
{
394
long i,l;
395
GEN E, P, e;
396
int isint;
397
398
switch(typ(n))
399
{
400
case t_INT:
401
if (!signe(n)) pari_err_DOMAIN("divisors", "argument", "=", gen_0, gen_0);
402
set_fact(absZ_factor(n), &P,&E);
403
isint = 1; break;
404
case t_VEC:
405
if (lg(n) != 3 || typ(gel(n,2)) !=t_MAT) pari_err_TYPE("divisors",n);
406
set_fact_check(gel(n,2), &P,&E, &isint);
407
break;
408
case t_MAT:
409
set_fact_check(n, &P,&E, &isint);
410
break;
411
default:
412
set_fact(factor(n), &P,&E);
413
isint = 0; break;
414
}
415
l = lg(P);
416
e = cgetg(l, t_VECSMALL);
417
for (i=1; i<l; i++)
418
{
419
e[i] = itos(gel(E,i));
420
if (e[i] < 0) pari_err_TYPE("divisors [denominator]",n);
421
}
422
*pP = P; *pE = e; return isint;
423
}
424
425
static long
426
ndiv(GEN E)
427
{
428
long i, l;
429
GEN e = cgetg_copy(E, &l); /* left on stack */
430
ulong n;
431
for (i=1; i<l; i++) e[i] = E[i]+1;
432
n = itou_or_0( zv_prod_Z(e) );
433
if (!n || n & ~LGBITS) pari_err_OVERFLOW("divisors");
434
return n;
435
}
436
static int
437
cmpi1(void *E, GEN a, GEN b) { (void)E; return cmpii(gel(a,1), gel(b,1)); }
438
/* P a t_COL of objects, E a t_VECSMALL of exponents, return cleaned-up
439
* factorization (removing 0 exponents) as a t_MAT with 2 cols. */
440
static GEN
441
fa_clean(GEN P, GEN E)
442
{
443
long i, j, l = lg(E);
444
GEN Q = cgetg(l, t_COL);
445
for (i = j = 1; i < l; i++)
446
if (E[i]) { gel(Q,j) = gel(P,i); E[j] = E[i]; j++; }
447
setlg(Q,j);
448
setlg(E,j); return mkmat2(Q,Flc_to_ZC(E));
449
}
450
GEN
451
divisors_factored(GEN N)
452
{
453
pari_sp av = avma;
454
GEN *d, *t1, *t2, *t3, D, P, E;
455
int isint = divisors_init(N, &P, &E);
456
GEN (*mul)(GEN,GEN) = isint? mulii: gmul;
457
long i, j, l, n = ndiv(E);
458
459
D = cgetg(n+1,t_VEC); d = (GEN*)D;
460
l = lg(E);
461
*++d = mkvec2(gen_1, const_vecsmall(l-1,0));
462
for (i=1; i<l; i++)
463
for (t1=(GEN*)D,j=E[i]; j; j--,t1=t2)
464
for (t2=d, t3=t1; t3<t2; )
465
{
466
GEN a, b;
467
a = mul(gel(*++t3,1), gel(P,i));
468
b = leafcopy(gel(*t3,2)); b[i]++;
469
*++d = mkvec2(a,b);
470
}
471
if (isint) gen_sort_inplace(D,NULL,&cmpi1,NULL);
472
for (i = 1; i <= n; i++) gmael(D,i,2) = fa_clean(P, gmael(D,i,2));
473
return gerepilecopy(av, D);
474
}
475
static int
476
cmpu1(void *E, GEN va, GEN vb)
477
{ long a = va[1], b = vb[1]; (void)E; return a>b? 1: (a<b? -1: 0); }
478
static GEN
479
fa_clean_u(GEN P, GEN E)
480
{
481
long i, j, l = lg(E);
482
GEN Q = cgetg(l, t_VECSMALL);
483
for (i = j = 1; i < l; i++)
484
if (E[i]) { Q[j] = P[i]; E[j] = E[i]; j++; }
485
setlg(Q,j);
486
setlg(E,j); return mkmat2(Q,E);
487
}
488
GEN
489
divisorsu_fact_factored(GEN fa)
490
{
491
pari_sp av = avma;
492
GEN *d, *t1, *t2, *t3, vD, D, P = gel(fa,1), E = gel(fa,2);
493
long i, j, l, n = ndiv(E);
494
495
D = cgetg(n+1,t_VEC); d = (GEN*)D;
496
l = lg(E);
497
*++d = mkvec2((GEN)1, const_vecsmall(l-1,0));
498
for (i=1; i<l; i++)
499
for (t1=(GEN*)D,j=E[i]; j; j--,t1=t2)
500
for (t2=d, t3=t1; t3<t2; )
501
{
502
ulong a;
503
GEN b;
504
a = (*++t3)[1] * P[i];
505
b = leafcopy(gel(*t3,2)); b[i]++;
506
*++d = mkvec2((GEN)a,b);
507
}
508
gen_sort_inplace(D,NULL,&cmpu1,NULL);
509
vD = cgetg(n+1, t_VECSMALL);
510
for (i = 1; i <= n; i++)
511
{
512
vD[i] = umael(D,i,1);
513
gel(D,i) = fa_clean_u(P, gmael(D,i,2));
514
}
515
return gerepilecopy(av, mkvec2(vD,D));
516
}
517
GEN
518
divisors(GEN N)
519
{
520
long i, j, l;
521
GEN *d, *t1, *t2, *t3, D, P, E;
522
int isint = divisors_init(N, &P, &E);
523
GEN (*mul)(GEN,GEN) = isint? mulii: gmul;
524
525
D = cgetg(ndiv(E)+1,t_VEC); d = (GEN*)D;
526
l = lg(E);
527
*++d = gen_1;
528
for (i=1; i<l; i++)
529
for (t1=(GEN*)D,j=E[i]; j; j--,t1=t2)
530
for (t2=d, t3=t1; t3<t2; ) *++d = mul(*++t3, gel(P,i));
531
if (isint) ZV_sort_inplace(D);
532
return D;
533
}
534
GEN
535
divisors0(GEN N, long flag)
536
{
537
if (flag && flag != 1) pari_err_FLAG("divisors");
538
return flag? divisors_factored(N): divisors(N);
539
}
540
541
GEN
542
divisorsu_moebius(GEN P)
543
{
544
GEN d, t, t2, t3;
545
long i, l = lg(P);
546
d = t = cgetg((1 << (l-1)) + 1, t_VECSMALL);
547
*++d = 1;
548
for (i=1; i<l; i++)
549
for (t2=d, t3=t; t3<t2; ) *(++d) = *(++t3) * -P[i];
550
return t;
551
}
552
GEN
553
divisorsu_fact(GEN fa)
554
{
555
GEN d, t, t1, t2, t3, P = gel(fa,1), E = gel(fa,2);
556
long i, j, l = lg(P);
557
d = t = cgetg(numdivu_fact(fa) + 1,t_VECSMALL);
558
*++d = 1;
559
for (i=1; i<l; i++)
560
for (t1=t,j=E[i]; j; j--,t1=t2)
561
for (t2=d, t3=t1; t3<t2; ) *(++d) = *(++t3) * P[i];
562
vecsmall_sort(t); return t;
563
}
564
GEN
565
divisorsu(ulong N)
566
{
567
pari_sp av = avma;
568
return gerepileupto(av, divisorsu_fact(factoru(N)));
569
}
570
571
static GEN
572
corefa(GEN fa)
573
{
574
GEN P = gel(fa,1), E = gel(fa,2), c = gen_1;
575
long i;
576
for (i=1; i<lg(P); i++)
577
if (mod2(gel(E,i))) c = mulii(c,gel(P,i));
578
return c;
579
}
580
static GEN
581
core2fa(GEN fa)
582
{
583
GEN P = gel(fa,1), E = gel(fa,2), c = gen_1, f = gen_1;
584
long i;
585
for (i=1; i<lg(P); i++)
586
{
587
long e = itos(gel(E,i));
588
if (e & 1) c = mulii(c, gel(P,i));
589
if (e != 1) f = mulii(f, powiu(gel(P,i), e >> 1));
590
}
591
return mkvec2(c,f);
592
}
593
GEN
594
corepartial(GEN n, long all)
595
{
596
pari_sp av = avma;
597
if (typ(n) != t_INT) pari_err_TYPE("corepartial",n);
598
return gerepileuptoint(av, corefa(Z_factor_limit(n,all)));
599
}
600
GEN
601
core2partial(GEN n, long all)
602
{
603
pari_sp av = avma;
604
if (typ(n) != t_INT) pari_err_TYPE("core2partial",n);
605
return gerepilecopy(av, core2fa(Z_factor_limit(n,all)));
606
}
607
/* given an arithmetic function argument, return the underlying integer */
608
static GEN
609
arith_n(GEN A)
610
{
611
switch(typ(A))
612
{
613
case t_INT: return A;
614
case t_VEC: return gel(A,1);
615
default: return factorback(A);
616
}
617
}
618
static GEN
619
core2_i(GEN n)
620
{
621
GEN f = core(n);
622
if (!signe(f)) return mkvec2(gen_0, gen_1);
623
return mkvec2(f, sqrtint(diviiexact(arith_n(n), f)));
624
}
625
GEN
626
core2(GEN n) { pari_sp av = avma; return gerepilecopy(av, core2_i(n)); }
627
628
GEN
629
core0(GEN n,long flag) { return flag? core2(n): core(n); }
630
631
static long
632
_mod4(GEN c) {
633
long r, s = signe(c);
634
if (!s) return 0;
635
r = mod4(c); if (s < 0) r = 4-r;
636
return r;
637
}
638
639
long
640
corediscs(long D, ulong *f)
641
{
642
/* D = f^2 dK */
643
long dK = D>=0 ? (long) coreu(D) : -(long) coreu(-(ulong) D);
644
ulong dKmod4 = ((ulong)dK)&3UL;
645
if (dKmod4 == 2 || dKmod4 == 3)
646
dK *= 4;
647
if (f) *f = usqrt((ulong)(D/dK));
648
return D;
649
}
650
651
GEN
652
coredisc(GEN n)
653
{
654
pari_sp av = avma;
655
GEN c = core(n);
656
if (_mod4(c)<=1) return c; /* c = 0 or 1 mod 4 */
657
return gerepileuptoint(av, shifti(c,2));
658
}
659
660
GEN
661
coredisc2(GEN n)
662
{
663
pari_sp av = avma;
664
GEN y = core2_i(n);
665
GEN c = gel(y,1), f = gel(y,2);
666
if (_mod4(c)<=1) return gerepilecopy(av, y);
667
y = cgetg(3,t_VEC);
668
gel(y,1) = shifti(c,2);
669
gel(y,2) = gmul2n(f,-1); return gerepileupto(av, y);
670
}
671
672
GEN
673
coredisc0(GEN n,long flag) { return flag? coredisc2(n): coredisc(n); }
674
675
long
676
omegau(ulong n)
677
{
678
pari_sp av;
679
if (n == 1UL) return 0;
680
av = avma; return gc_long(av, nbrows(factoru(n)));
681
}
682
long
683
omega(GEN n)
684
{
685
pari_sp av;
686
GEN F, P;
687
if ((F = check_arith_non0(n,"omega"))) {
688
long n;
689
P = gel(F,1); n = lg(P)-1;
690
if (n && equalim1(gel(P,1))) n--;
691
return n;
692
}
693
if (lgefint(n) == 3) return omegau(n[2]);
694
av = avma;
695
F = absZ_factor(n);
696
return gc_long(av, nbrows(F));
697
}
698
699
long
700
bigomegau(ulong n)
701
{
702
pari_sp av;
703
if (n == 1) return 0;
704
av = avma; return gc_long(av, zv_sum(gel(factoru(n),2)));
705
}
706
long
707
bigomega(GEN n)
708
{
709
pari_sp av = avma;
710
GEN F, E;
711
if ((F = check_arith_non0(n,"bigomega")))
712
{
713
GEN P = gel(F,1);
714
long n = lg(P)-1;
715
E = gel(F,2);
716
if (n && equalim1(gel(P,1))) E = vecslice(E,2,n);
717
}
718
else if (lgefint(n) == 3)
719
return bigomegau(n[2]);
720
else
721
E = gel(absZ_factor(n), 2);
722
E = ZV_to_zv(E);
723
return gc_long(av, zv_sum(E));
724
}
725
726
/* assume f = factoru(n), possibly with 0 exponents. Return phi(n) */
727
ulong
728
eulerphiu_fact(GEN f)
729
{
730
GEN P = gel(f,1), E = gel(f,2);
731
long i, m = 1, l = lg(P);
732
for (i = 1; i < l; i++)
733
{
734
ulong p = P[i], e = E[i];
735
if (!e) continue;
736
if (p == 2)
737
{ if (e > 1) m <<= e-1; }
738
else
739
{
740
m *= (p-1);
741
if (e > 1) m *= upowuu(p, e-1);
742
}
743
}
744
return m;
745
}
746
ulong
747
eulerphiu(ulong n)
748
{
749
pari_sp av;
750
if (!n) return 2;
751
av = avma; return gc_long(av, eulerphiu_fact(factoru(n)));
752
}
753
GEN
754
eulerphi(GEN n)
755
{
756
pari_sp av = avma;
757
GEN Q, F, P, E;
758
long i, l;
759
760
if ((F = check_arith_all(n,"eulerphi")))
761
{
762
F = clean_Z_factor(F);
763
n = arith_n(n);
764
if (lgefint(n) == 3)
765
{
766
ulong e;
767
F = mkmat2(ZV_to_nv(gel(F,1)), ZV_to_nv(gel(F,2)));
768
e = eulerphiu_fact(F);
769
set_avma(av); return utoipos(e);
770
}
771
}
772
else if (lgefint(n) == 3) return utoipos(eulerphiu(uel(n,2)));
773
else
774
F = absZ_factor(n);
775
if (!signe(n)) return gen_2;
776
P = gel(F,1);
777
E = gel(F,2); l = lg(P);
778
Q = cgetg(l, t_VEC);
779
for (i = 1; i < l; i++)
780
{
781
GEN p = gel(P,i), q;
782
ulong v = itou(gel(E,i));
783
q = subiu(p,1);
784
if (v != 1) q = mulii(q, v == 2? p: powiu(p, v-1));
785
gel(Q,i) = q;
786
}
787
return gerepileuptoint(av, ZV_prod(Q));
788
}
789
790
long
791
numdivu_fact(GEN fa)
792
{
793
GEN E = gel(fa,2);
794
long n = 1, i, l = lg(E);
795
for (i = 1; i < l; i++) n *= E[i]+1;
796
return n;
797
}
798
long
799
numdivu(long N)
800
{
801
pari_sp av;
802
if (N == 1) return 1;
803
av = avma; return gc_long(av, numdivu_fact(factoru(N)));
804
}
805
static GEN
806
numdiv_aux(GEN F)
807
{
808
GEN x, E = gel(F,2);
809
long i, l = lg(E);
810
x = cgetg(l, t_VECSMALL);
811
for (i=1; i<l; i++) x[i] = itou(gel(E,i))+1;
812
return x;
813
}
814
GEN
815
numdiv(GEN n)
816
{
817
pari_sp av = avma;
818
GEN F, E;
819
if ((F = check_arith_non0(n,"numdiv")))
820
{
821
F = clean_Z_factor(F);
822
E = numdiv_aux(F);
823
}
824
else if (lgefint(n) == 3)
825
return utoipos(numdivu(n[2]));
826
else
827
E = numdiv_aux(absZ_factor(n));
828
return gerepileuptoint(av, zv_prod_Z(E));
829
}
830
831
/* 1 + p + ... + p^v, p != 2^BIL - 1 */
832
static GEN
833
u_euler_sumdiv(ulong p, long v)
834
{
835
GEN u = utoipos(1 + p); /* can't overflow */
836
for (; v > 1; v--) u = addui(1, mului(p, u));
837
return u;
838
}
839
/* 1 + q + ... + q^v */
840
static GEN
841
euler_sumdiv(GEN q, long v)
842
{
843
GEN u = addui(1, q);
844
for (; v > 1; v--) u = addui(1, mulii(q, u));
845
return u;
846
}
847
848
static GEN
849
sumdiv_aux(GEN F)
850
{
851
GEN x, P = gel(F,1), E = gel(F,2);
852
long i, l = lg(P);
853
x = cgetg(l, t_VEC);
854
for (i=1; i<l; i++) gel(x,i) = euler_sumdiv(gel(P,i), itou(gel(E,i)));
855
return ZV_prod(x);
856
}
857
GEN
858
sumdiv(GEN n)
859
{
860
pari_sp av = avma;
861
GEN F, v;
862
863
if ((F = check_arith_non0(n,"sumdiv")))
864
{
865
F = clean_Z_factor(F);
866
v = sumdiv_aux(F);
867
}
868
else if (lgefint(n) == 3)
869
{
870
if (n[2] == 1) return gen_1;
871
F = factoru(n[2]);
872
v = usumdiv_fact(F);
873
}
874
else
875
v = sumdiv_aux(absZ_factor(n));
876
return gerepileuptoint(av, v);
877
}
878
879
static GEN
880
sumdivk_aux(GEN F, long k)
881
{
882
GEN x, P = gel(F,1), E = gel(F,2);
883
long i, l = lg(P);
884
x = cgetg(l, t_VEC);
885
for (i=1; i<l; i++) gel(x,i) = euler_sumdiv(powiu(gel(P,i),k), gel(E,i)[2]);
886
return ZV_prod(x);
887
}
888
GEN
889
sumdivk(GEN n, long k)
890
{
891
pari_sp av = avma;
892
GEN F, v;
893
long k1;
894
895
if (!k) return numdiv(n);
896
if (k == 1) return sumdiv(n);
897
if ((F = check_arith_non0(n,"sumdivk"))) F = clean_Z_factor(F);
898
k1 = k; if (k < 0) k = -k;
899
if (k == 1)
900
v = sumdiv(F? F: n);
901
else
902
{
903
if (F)
904
v = sumdivk_aux(F,k);
905
else if (lgefint(n) == 3)
906
{
907
if (n[2] == 1) return gen_1;
908
F = factoru(n[2]);
909
v = usumdivk_fact(F,k);
910
}
911
else
912
v = sumdivk_aux(absZ_factor(n), k);
913
if (k1 > 0) return gerepileuptoint(av, v);
914
}
915
916
if (F) n = arith_n(n);
917
if (k != 1) n = powiu(n,k);
918
return gerepileupto(av, gdiv(v, n));
919
}
920
921
GEN
922
usumdiv_fact(GEN f)
923
{
924
GEN P = gel(f,1), E = gel(f,2);
925
long i, l = lg(P);
926
GEN v = cgetg(l, t_VEC);
927
for (i=1; i<l; i++) gel(v,i) = u_euler_sumdiv(P[i],E[i]);
928
return ZV_prod(v);
929
}
930
GEN
931
usumdivk_fact(GEN f, ulong k)
932
{
933
GEN P = gel(f,1), E = gel(f,2);
934
long i, l = lg(P);
935
GEN v = cgetg(l, t_VEC);
936
for (i=1; i<l; i++) gel(v,i) = euler_sumdiv(powuu(P[i],k),E[i]);
937
return ZV_prod(v);
938
}
939
940
long
941
uissquarefree_fact(GEN f)
942
{
943
GEN E = gel(f,2);
944
long i, l = lg(E);
945
for (i = 1; i < l; i++)
946
if (E[i] > 1) return 0;
947
return 1;
948
}
949
long
950
uissquarefree(ulong n)
951
{
952
if (!n) return 0;
953
return moebiusu(n)? 1: 0;
954
}
955
long
956
Z_issquarefree(GEN n)
957
{
958
switch(lgefint(n))
959
{
960
case 2: return 0;
961
case 3: return uissquarefree(n[2]);
962
}
963
return moebius(n)? 1: 0;
964
}
965
966
static int
967
fa_issquarefree(GEN F)
968
{
969
GEN P = gel(F,1), E = gel(F,2);
970
long i, s, l = lg(P);
971
if (l == 1) return 1;
972
s = signe(gel(P,1)); /* = signe(x) */
973
if (!s) return 0;
974
for(i = 1; i < l; i++)
975
if (!equali1(gel(E,i))) return 0;
976
return 1;
977
}
978
long
979
issquarefree(GEN x)
980
{
981
pari_sp av;
982
GEN d;
983
switch(typ(x))
984
{
985
case t_INT: return Z_issquarefree(x);
986
case t_POL:
987
if (!signe(x)) return 0;
988
av = avma; d = RgX_gcd(x, RgX_deriv(x));
989
return gc_long(av, lg(d)==3);
990
case t_VEC:
991
case t_MAT: return fa_issquarefree(check_arith_all(x,"issquarefree"));
992
default: pari_err_TYPE("issquarefree",x);
993
return 0; /* LCOV_EXCL_LINE */
994
}
995
}
996
997
/*********************************************************************/
998
/** **/
999
/** DIGITS / SUM OF DIGITS **/
1000
/** **/
1001
/*********************************************************************/
1002
1003
/* set v[i] = 1 iff B^i is needed in the digits_dac algorithm */
1004
static void
1005
set_vexp(GEN v, long l)
1006
{
1007
long m;
1008
if (v[l]) return;
1009
v[l] = 1; m = l>>1;
1010
set_vexp(v, m);
1011
set_vexp(v, l-m);
1012
}
1013
1014
/* return all needed B^i for DAC algorithm, for lz digits */
1015
static GEN
1016
get_vB(GEN T, long lz, void *E, struct bb_ring *r)
1017
{
1018
GEN vB, vexp = const_vecsmall(lz, 0);
1019
long i, l = (lz+1) >> 1;
1020
vexp[1] = 1;
1021
vexp[2] = 1;
1022
set_vexp(vexp, lz);
1023
vB = zerovec(lz); /* unneeded entries remain = 0 */
1024
gel(vB, 1) = T;
1025
for (i = 2; i <= l; i++)
1026
if (vexp[i])
1027
{
1028
long j = i >> 1;
1029
GEN B2j = r->sqr(E, gel(vB,j));
1030
gel(vB,i) = odd(i)? r->mul(E, B2j, T): B2j;
1031
}
1032
return vB;
1033
}
1034
1035
static void
1036
gen_digits_dac(GEN x, GEN vB, long l, GEN *z,
1037
void *E, GEN div(void *E, GEN a, GEN b, GEN *r))
1038
{
1039
GEN q, r;
1040
long m = l>>1;
1041
if (l==1) { *z=x; return; }
1042
q = div(E, x, gel(vB,m), &r);
1043
gen_digits_dac(r, vB, m, z, E, div);
1044
gen_digits_dac(q, vB, l-m, z+m, E, div);
1045
}
1046
1047
static GEN
1048
gen_fromdigits_dac(GEN x, GEN vB, long i, long l, void *E,
1049
GEN add(void *E, GEN a, GEN b),
1050
GEN mul(void *E, GEN a, GEN b))
1051
{
1052
GEN a, b;
1053
long m = l>>1;
1054
if (l==1) return gel(x,i);
1055
a = gen_fromdigits_dac(x, vB, i, m, E, add, mul);
1056
b = gen_fromdigits_dac(x, vB, i+m, l-m, E, add, mul);
1057
return add(E, a, mul(E, b, gel(vB, m)));
1058
}
1059
1060
static GEN
1061
gen_digits_i(GEN x, GEN B, long n, void *E, struct bb_ring *r,
1062
GEN (*div)(void *E, GEN x, GEN y, GEN *r))
1063
{
1064
GEN z, vB;
1065
if (n==1) retmkvec(gcopy(x));
1066
vB = get_vB(B, n, E, r);
1067
z = cgetg(n+1, t_VEC);
1068
gen_digits_dac(x, vB, n, (GEN*)(z+1), E, div);
1069
return z;
1070
}
1071
1072
GEN
1073
gen_digits(GEN x, GEN B, long n, void *E, struct bb_ring *r,
1074
GEN (*div)(void *E, GEN x, GEN y, GEN *r))
1075
{
1076
pari_sp av = avma;
1077
return gerepilecopy(av, gen_digits_i(x, B, n, E, r, div));
1078
}
1079
1080
GEN
1081
gen_fromdigits(GEN x, GEN B, void *E, struct bb_ring *r)
1082
{
1083
pari_sp av = avma;
1084
long n = lg(x)-1;
1085
GEN vB = get_vB(B, n, E, r);
1086
GEN z = gen_fromdigits_dac(x, vB, 1, n, E, r->add, r->mul);
1087
return gerepilecopy(av, z);
1088
}
1089
1090
static GEN
1091
_addii(void *data /* ignored */, GEN x, GEN y)
1092
{ (void)data; return addii(x,y); }
1093
static GEN
1094
_sqri(void *data /* ignored */, GEN x) { (void)data; return sqri(x); }
1095
static GEN
1096
_mulii(void *data /* ignored */, GEN x, GEN y)
1097
{ (void)data; return mulii(x,y); }
1098
static GEN
1099
_dvmdii(void *data /* ignored */, GEN x, GEN y, GEN *r)
1100
{ (void)data; return dvmdii(x,y,r); }
1101
1102
static struct bb_ring Z_ring = { _addii, _mulii, _sqri };
1103
1104
static GEN
1105
check_basis(GEN B)
1106
{
1107
if (!B) return utoipos(10);
1108
if (typ(B)!=t_INT) pari_err_TYPE("digits",B);
1109
if (abscmpiu(B,2)<0) pari_err_DOMAIN("digits","B","<",gen_2,B);
1110
return B;
1111
}
1112
1113
/* x has l digits in base B, write them to z[0..l-1], vB[i] = B^i */
1114
static void
1115
digits_dacsmall(GEN x, GEN vB, long l, ulong* z)
1116
{
1117
pari_sp av = avma;
1118
GEN q,r;
1119
long m;
1120
if (l==1) { *z=itou(x); return; }
1121
m=l>>1;
1122
q = dvmdii(x, gel(vB,m), &r);
1123
digits_dacsmall(q,vB,l-m,z);
1124
digits_dacsmall(r,vB,m,z+l-m);
1125
set_avma(av);
1126
}
1127
1128
GEN
1129
digits(GEN x, GEN B)
1130
{
1131
pari_sp av=avma;
1132
long lz;
1133
GEN z, vB;
1134
if (typ(x)!=t_INT) pari_err_TYPE("digits",x);
1135
B = check_basis(B);
1136
if (signe(B)<0) pari_err_DOMAIN("digits","B","<",gen_0,B);
1137
if (!signe(x)) {set_avma(av); return cgetg(1,t_VEC); }
1138
if (abscmpii(x,B)<0) {set_avma(av); retmkvec(absi(x)); }
1139
if (Z_ispow2(B))
1140
{
1141
long k = expi(B);
1142
if (k == 1) return binaire(x);
1143
if (k < BITS_IN_LONG)
1144
{
1145
(void)new_chunk(4*(expi(x) + 2)); /* HACK */
1146
z = binary_2k_nv(x, k);
1147
set_avma(av); return Flv_to_ZV(z);
1148
}
1149
else
1150
{
1151
set_avma(av); return binary_2k(x, k);
1152
}
1153
}
1154
x = absi_shallow(x);
1155
lz = logint(x,B) + 1;
1156
if (lgefint(B)>3)
1157
{
1158
z = gerepileupto(av, gen_digits_i(x, B, lz, NULL, &Z_ring, _dvmdii));
1159
vecreverse_inplace(z); return z;
1160
}
1161
else
1162
{
1163
vB = get_vB(B, lz, NULL, &Z_ring);
1164
(void)new_chunk(3*lz); /* HACK */
1165
z = zero_zv(lz);
1166
digits_dacsmall(x,vB,lz,(ulong*)(z+1));
1167
set_avma(av); return Flv_to_ZV(z);
1168
}
1169
}
1170
1171
static GEN
1172
fromdigitsu_dac(GEN x, GEN vB, long i, long l)
1173
{
1174
GEN a, b;
1175
long m = l>>1;
1176
if (l==1) return utoi(uel(x,i));
1177
if (l==2) return addumului(uel(x,i), uel(x,i+1), gel(vB, m));
1178
a = fromdigitsu_dac(x, vB, i, m);
1179
b = fromdigitsu_dac(x, vB, i+m, l-m);
1180
return addii(a, mulii(b, gel(vB, m)));
1181
}
1182
1183
GEN
1184
fromdigitsu(GEN x, GEN B)
1185
{
1186
pari_sp av = avma;
1187
long n = lg(x)-1;
1188
GEN vB, z;
1189
if (n==0) return gen_0;
1190
vB = get_vB(B, n, NULL, &Z_ring);
1191
z = fromdigitsu_dac(x, vB, 1, n);
1192
return gerepileuptoint(av, z);
1193
}
1194
1195
static int
1196
ZV_in_range(GEN v, GEN B)
1197
{
1198
long i, l = lg(v);
1199
for(i=1; i < l; i++)
1200
{
1201
GEN vi = gel(v, i);
1202
if (signe(vi) < 0 || cmpii(vi, B) >= 0)
1203
return 0;
1204
}
1205
return 1;
1206
}
1207
1208
GEN
1209
fromdigits(GEN x, GEN B)
1210
{
1211
pari_sp av = avma;
1212
if (typ(x)!=t_VEC || !RgV_is_ZV(x)) pari_err_TYPE("fromdigits",x);
1213
if (lg(x)==1) return gen_0;
1214
B = check_basis(B);
1215
if (Z_ispow2(B) && ZV_in_range(x, B))
1216
return fromdigits_2k(x, expi(B));
1217
x = vecreverse(x);
1218
return gerepileuptoint(av, gen_fromdigits(x, B, NULL, &Z_ring));
1219
}
1220
1221
static const ulong digsum[] ={
1222
0,1,2,3,4,5,6,7,8,9,1,2,3,4,5,6,7,8,9,10,2,3,4,5,6,7,8,9,10,11,3,4,5,6,7,8,
1223
9,10,11,12,4,5,6,7,8,9,10,11,12,13,5,6,7,8,9,10,11,12,13,14,6,7,8,9,10,11,
1224
12,13,14,15,7,8,9,10,11,12,13,14,15,16,8,9,10,11,12,13,14,15,16,17,9,10,11,
1225
12,13,14,15,16,17,18,1,2,3,4,5,6,7,8,9,10,2,3,4,5,6,7,8,9,10,11,3,4,5,6,7,8,
1226
9,10,11,12,4,5,6,7,8,9,10,11,12,13,5,6,7,8,9,10,11,12,13,14,6,7,8,9,10,11,
1227
12,13,14,15,7,8,9,10,11,12,13,14,15,16,8,9,10,11,12,13,14,15,16,17,9,10,11,
1228
12,13,14,15,16,17,18,10,11,12,13,14,15,16,17,18,19,2,3,4,5,6,7,8,9,10,11,3,
1229
4,5,6,7,8,9,10,11,12,4,5,6,7,8,9,10,11,12,13,5,6,7,8,9,10,11,12,13,14,6,7,8,
1230
9,10,11,12,13,14,15,7,8,9,10,11,12,13,14,15,16,8,9,10,11,12,13,14,15,16,17,
1231
9,10,11,12,13,14,15,16,17,18,10,11,12,13,14,15,16,17,18,19,11,12,13,14,15,
1232
16,17,18,19,20,3,4,5,6,7,8,9,10,11,12,4,5,6,7,8,9,10,11,12,13,5,6,7,8,9,10,
1233
11,12,13,14,6,7,8,9,10,11,12,13,14,15,7,8,9,10,11,12,13,14,15,16,8,9,10,11,
1234
12,13,14,15,16,17,9,10,11,12,13,14,15,16,17,18,10,11,12,13,14,15,16,17,18,
1235
19,11,12,13,14,15,16,17,18,19,20,12,13,14,15,16,17,18,19,20,21,4,5,6,7,8,9,
1236
10,11,12,13,5,6,7,8,9,10,11,12,13,14,6,7,8,9,10,11,12,13,14,15,7,8,9,10,11,
1237
12,13,14,15,16,8,9,10,11,12,13,14,15,16,17,9,10,11,12,13,14,15,16,17,18,10,
1238
11,12,13,14,15,16,17,18,19,11,12,13,14,15,16,17,18,19,20,12,13,14,15,16,17,
1239
18,19,20,21,13,14,15,16,17,18,19,20,21,22,5,6,7,8,9,10,11,12,13,14,6,7,8,9,
1240
10,11,12,13,14,15,7,8,9,10,11,12,13,14,15,16,8,9,10,11,12,13,14,15,16,17,9,
1241
10,11,12,13,14,15,16,17,18,10,11,12,13,14,15,16,17,18,19,11,12,13,14,15,16,
1242
17,18,19,20,12,13,14,15,16,17,18,19,20,21,13,14,15,16,17,18,19,20,21,22,14,
1243
15,16,17,18,19,20,21,22,23,6,7,8,9,10,11,12,13,14,15,7,8,9,10,11,12,13,14,
1244
15,16,8,9,10,11,12,13,14,15,16,17,9,10,11,12,13,14,15,16,17,18,10,11,12,13,
1245
14,15,16,17,18,19,11,12,13,14,15,16,17,18,19,20,12,13,14,15,16,17,18,19,20,
1246
21,13,14,15,16,17,18,19,20,21,22,14,15,16,17,18,19,20,21,22,23,15,16,17,18,
1247
19,20,21,22,23,24,7,8,9,10,11,12,13,14,15,16,8,9,10,11,12,13,14,15,16,17,9,
1248
10,11,12,13,14,15,16,17,18,10,11,12,13,14,15,16,17,18,19,11,12,13,14,15,16,
1249
17,18,19,20,12,13,14,15,16,17,18,19,20,21,13,14,15,16,17,18,19,20,21,22,14,
1250
15,16,17,18,19,20,21,22,23,15,16,17,18,19,20,21,22,23,24,16,17,18,19,20,21,
1251
22,23,24,25,8,9,10,11,12,13,14,15,16,17,9,10,11,12,13,14,15,16,17,18,10,11,
1252
12,13,14,15,16,17,18,19,11,12,13,14,15,16,17,18,19,20,12,13,14,15,16,17,18,
1253
19,20,21,13,14,15,16,17,18,19,20,21,22,14,15,16,17,18,19,20,21,22,23,15,16,
1254
17,18,19,20,21,22,23,24,16,17,18,19,20,21,22,23,24,25,17,18,19,20,21,22,23,
1255
24,25,26,9,10,11,12,13,14,15,16,17,18,10,11,12,13,14,15,16,17,18,19,11,12,
1256
13,14,15,16,17,18,19,20,12,13,14,15,16,17,18,19,20,21,13,14,15,16,17,18,19,
1257
20,21,22,14,15,16,17,18,19,20,21,22,23,15,16,17,18,19,20,21,22,23,24,16,17,
1258
18,19,20,21,22,23,24,25,17,18,19,20,21,22,23,24,25,26,18,19,20,21,22,23,24,
1259
25,26,27
1260
};
1261
1262
ulong
1263
sumdigitsu(ulong n)
1264
{
1265
ulong s = 0;
1266
while (n) { s += digsum[n % 1000]; n /= 1000; }
1267
return s;
1268
}
1269
1270
/* res=array of 9-digits integers, return sum_{0 <= i < l} sumdigits(res[i]) */
1271
static ulong
1272
sumdigits_block(ulong *res, long l)
1273
{
1274
ulong s = sumdigitsu(*--res);
1275
while (--l > 0) s += sumdigitsu(*--res);
1276
return s;
1277
}
1278
1279
GEN
1280
sumdigits(GEN n)
1281
{
1282
const long L = (long)(ULONG_MAX / 81);
1283
pari_sp av = avma;
1284
ulong *res;
1285
long l;
1286
1287
if (typ(n) != t_INT) pari_err_TYPE("sumdigits", n);
1288
switch(lgefint(n))
1289
{
1290
case 2: return gen_0;
1291
case 3: return utoipos(sumdigitsu(n[2]));
1292
}
1293
res = convi(n, &l);
1294
if (l < L)
1295
{
1296
ulong s = sumdigits_block(res, l);
1297
set_avma(av); return utoipos(s);
1298
}
1299
else /* Huge. Overflows ulong */
1300
{
1301
GEN S = gen_0;
1302
while (l > L)
1303
{
1304
S = addiu(S, sumdigits_block(res, L));
1305
res += L; l -= L;
1306
}
1307
if (l)
1308
S = addiu(S, sumdigits_block(res, l));
1309
return gerepileuptoint(av, S);
1310
}
1311
}
1312
1313
GEN
1314
sumdigits0(GEN x, GEN B)
1315
{
1316
pari_sp av = avma;
1317
GEN z;
1318
long lz;
1319
1320
if (!B) return sumdigits(x);
1321
if (typ(x) != t_INT) pari_err_TYPE("sumdigits", x);
1322
B = check_basis(B);
1323
if (Z_ispow2(B))
1324
{
1325
long k = expi(B);
1326
if (k == 1) { set_avma(av); return utoi(hammingweight(x)); }
1327
if (k < BITS_IN_LONG)
1328
{
1329
GEN z = binary_2k_nv(x, k);
1330
if (lg(z)-1 > 1L<<(BITS_IN_LONG-k)) /* may overflow */
1331
return gerepileuptoint(av, ZV_sum(Flv_to_ZV(z)));
1332
set_avma(av); return utoi(zv_sum(z));
1333
}
1334
return gerepileuptoint(av, ZV_sum(binary_2k(x, k)));
1335
}
1336
if (!signe(x)) { set_avma(av); return gen_0; }
1337
if (abscmpii(x,B)<0) { set_avma(av); return absi(x); }
1338
if (absequaliu(B,10)) { set_avma(av); return sumdigits(x); }
1339
x = absi_shallow(x); lz = logint(x,B) + 1;
1340
z = gen_digits_i(x, B, lz, NULL, &Z_ring, _dvmdii);
1341
return gerepileuptoint(av, ZV_sum(z));
1342
}
1343
1344