[pari-sage] 08/12: Imported Upstream version 2.8-1564-gdeac36e
Tobias Hansen
thansen at moszumanska.debian.org
Sat May 23 14:30:50 UTC 2015
This is an automated email from the git hooks/post-receive script.
thansen pushed a commit to branch master
in repository pari-sage.
commit be91d9c9f081ef5e6365d6ace59ae63964164d6b
Author: Tobias Hansen <tobias.han at gmx.de>
Date: Sat May 23 13:41:20 2015 +0200
Imported Upstream version 2.8-1564-gdeac36e
---
CHANGES | 63 +-
COMPAT | 24 +
Configure | 2 -
config/Makefile.SH | 13 +-
config/get_config_options | 2 +-
config/get_fltk | 27 +-
config/get_gmp | 33 +-
config/get_graphic_lib | 6 +-
config/get_include_path | 17 -
config/get_libpth | 54 -
config/get_readline | 46 +-
config/gmp_mismatch.c | 13 +
config/has_fltk.c | 7 +
config/version | 2 +-
doc/develop.tex | 31 +-
doc/usersch3.tex | 1758 +++++++++++++-------
doc/usersch5.tex | 78 +-
misc/tex2mail.in | 4 +-
src/basemath/Flx.c | 20 +-
src/basemath/FpV.c | 2 +-
src/basemath/FpX.c | 40 +-
src/basemath/FpXX.c | 2 +-
src/basemath/QX_factor.c | 12 +-
src/basemath/Qfb.c | 5 +-
src/basemath/RgV.c | 13 +
src/basemath/RgX.c | 32 +
src/basemath/ZG.c | 13 +-
src/basemath/ZV.c | 225 ++-
src/basemath/alglin3.c | 42 +-
src/basemath/arith1.c | 46 +-
src/basemath/base1.c | 8 +-
src/basemath/base2.c | 25 +-
src/basemath/base5.c | 2 +-
src/basemath/bb_group.c | 24 +
src/basemath/bibli1.c | 33 +-
src/basemath/bibli2.c | 18 +-
src/basemath/buch2.c | 26 +-
src/basemath/concat.c | 7 +-
src/basemath/ellanal.c | 35 +-
src/basemath/elliptic.c | 231 +--
src/basemath/galconj.c | 4 +-
src/basemath/gen1.c | 8 +-
src/basemath/gen2.c | 152 +-
src/basemath/gen3.c | 33 +-
src/basemath/hyperell.c | 50 +-
src/basemath/ifactor1.c | 5 +-
src/basemath/map.c | 461 +++++
src/basemath/mellininv.c | 497 ++++++
src/basemath/modsym.c | 2 +-
src/basemath/nffactor.c | 56 +-
src/basemath/polarit2.c | 45 +-
src/basemath/qfsolve.c | 5 +-
src/basemath/rootpol.c | 28 +-
src/basemath/trans1.c | 73 +
src/basemath/trans2.c | 154 +-
src/basemath/trans3.c | 75 +-
src/basemath/zetamult.c | 202 +++
src/desc/deftune | 5 +-
src/funclist | 71 +-
src/functions/conversions/Colrev | 5 +-
src/functions/conversions/Map | 16 +
src/functions/conversions/Vecrev | 4 +-
src/functions/elliptic_curves/ellL1 | 2 +-
src/functions/elliptic_curves/ellfromeqn | 51 +
src/functions/elliptic_curves/hyperellcharpoly | 6 +-
src/functions/gp2c_internal/_wrap | 7 +
src/functions/number_theoretical/qfbnucomp | 12 +-
src/functions/number_theoretical/qfbnupow | 13 +-
src/functions/operators/sign | 3 +-
.../{linear_algebra => programming}/listcreate | 2 +-
.../{linear_algebra => programming}/listinsert | 2 +-
.../{linear_algebra => programming}/listkill | 2 +-
.../{linear_algebra => programming}/listpop | 4 +-
.../{linear_algebra => programming}/listput | 4 +-
.../{linear_algebra => programming}/listsort | 2 +-
src/functions/programming/mapdelete | 14 +
src/functions/programming/mapget | 19 +
src/functions/programming/mapisdefined | 22 +
src/functions/programming/mapput | 23 +
src/functions/sums/asympnum | 49 +
src/functions/sums/contfraceval | 11 +
src/functions/sums/contfracinit | 15 +
src/functions/sums/derivnum | 2 +-
src/functions/sums/intcirc | 5 +-
src/functions/sums/intfouriercos | 18 -
src/functions/sums/intfourierexp | 19 -
src/functions/sums/intfouriersin | 18 -
src/functions/sums/intfuncinit | 112 +-
src/functions/sums/intlaplaceinv | 56 -
src/functions/sums/intmellininv | 43 -
src/functions/sums/intmellininvshort | 42 -
src/functions/sums/intnum | 210 +--
src/functions/sums/intnumgauss | 37 +
src/functions/sums/intnumgaussinit | 33 +
src/functions/sums/intnuminit | 60 +-
src/functions/sums/intnuminitgen | 18 -
src/functions/sums/intnumstep | 9 -
src/functions/sums/limitnum | 64 +
src/functions/sums/sumnum | 226 +--
src/functions/sums/sumnumalt | 53 -
src/functions/sums/sumnuminit | 38 +-
src/functions/sums/sumnummonien | 21 +
src/functions/sums/sumnummonieninit | 87 +
src/functions/transcendental/cotanh | 6 +
src/functions/transcendental/gammamellininv | 22 +
src/functions/transcendental/gammamellininvasymp | 23 +
src/functions/transcendental/gammamellininvinit | 37 +
src/functions/transcendental/sinc | 9 +
src/functions/transcendental/zetamult | 12 +
src/headers/paridecl.h | 94 +-
src/headers/parierr.h | 2 +-
src/headers/parigen.h | 8 +-
src/headers/pariinl.h | 14 +-
src/headers/paripriv.h | 16 +-
src/headers/paritune.h | 10 +-
src/kernel/gmp/tune.h | 10 +-
src/kernel/none/add.c | 2 +-
src/kernel/none/tune-gen.h | 5 +-
src/kernel/none/tune.h | 10 +-
src/language/anal.h | 1 +
src/language/es.c | 85 +-
src/language/eval.c | 46 +-
src/language/gplib.c | 2 +-
src/language/init.c | 36 +-
src/language/init.h | 51 +-
src/language/intnum.c | 1687 ++++++++++---------
src/language/sumiter.c | 202 ++-
src/modules/ellfromeqn.c | 165 ++
src/modules/kummer.c | 25 +-
src/modules/stark.c | 5 +-
src/modules/thue.c | 2 +-
src/test/32/asymp | 26 +
src/test/32/bessel | 8 +-
src/test/32/compat | 6 +-
src/test/32/contfrac | 16 +
src/test/32/ell | 9 +-
src/test/32/ellanal | 12 +-
src/test/32/extract | 70 +-
src/test/32/fflog | 3 +-
src/test/32/gamma | 3 +
src/test/32/gammamellininv | 8 +
src/test/32/help | 4 +-
src/test/32/hyperell | 4 +-
src/test/32/intnum | 168 +-
src/test/32/log | 1 +
src/test/32/map | 14 +
src/test/32/padic | 2 +
src/test/32/pol | 2 +
src/test/32/printf | 3 +-
src/test/32/qf | 5 +-
src/test/32/qfb | 3 +-
src/test/32/qfbclassno | 3 +-
src/test/32/quad | 16 +
src/test/32/rnf | 6 +-
src/test/32/rnfkummer | 15 +-
src/test/32/round4 | 8 +-
src/test/32/ser | 5 +-
src/test/32/sumnum | 42 +
src/test/32/trans2 | 17 +-
src/test/32/version | 2 +
src/test/32/zetamult | 27 +
src/test/in/asymp | 32 +
src/test/in/contfrac | 13 +
src/test/in/ell | 17 +-
src/test/in/extract | 2 +-
src/test/in/fflog | 5 +-
src/test/in/gamma | 2 +
src/test/in/gammamellininv | 72 +
src/test/in/hyperell | 3 +-
src/test/in/intnum | 117 +-
src/test/in/log | 1 +
src/test/in/map | 54 +
src/test/in/nfields | 2 +-
src/test/in/padic | 2 +-
src/test/in/pol | 5 +
src/test/in/printf | 3 +
src/test/in/qf | 5 +
src/test/in/qfb | 2 +
src/test/in/qfbclassno | 2 +-
src/test/in/quad | 14 +
src/test/in/rnf | 2 +
src/test/in/round4 | 6 +
src/test/in/ser | 2 +-
src/test/in/sumiter | 2 +-
src/test/in/sumnum | 71 +
src/test/in/trans2 | 11 +
src/test/in/version | 1 +
src/test/in/zetamult | 23 +
src/test/tune.c | 10 +-
189 files changed, 7072 insertions(+), 2930 deletions(-)
diff --git a/CHANGES b/CHANGES
index eed5cef..db49f27 100644
--- a/CHANGES
+++ b/CHANGES
@@ -5,8 +5,7 @@ Done for version 2.8.0 (released ??/??/2015):
Fixed
1- make install fails on OS/X: ln -s libpari.dylib libpari.dylib fails
- 2- Q_pvalrem(t_FRAC) => wrong result
- 3- [] == 0 but []~ != 0 (now []~ == 0 as well) [#1560]
+ 2- Q_pvalrem(t_FRAC) => wrong result 3- [] == 0 but []~ != 0 (now []~ == 0 as well) [#1560]
BA 4- test-kernel did not work when using --mt=pthread
BA 5- ellheegner was using too much memory in some case
6- ellap can overflow on 32-bit machine [#1558]
@@ -121,6 +120,28 @@ VBr83- [darwin] remove obsolete linker options that cause crashes [#1623]
92- intnum(x = [-oo,-3/2], [oo,-5/2], f(x)) --> loss of accuracy due to
confusion between endpoint behaviours a/b in intnuminit data
E.g. f(x)=(x<0,1/(1+(-x)^(3/2)), 1/(1+x^(5/2)));
+ 93- intnum(x = [-oo,-3/2], [oo,-5/2], f(x)) --> loss of accuracy due to
+ confusion between endpoint behaviours a/b in intnuminit data
+ E.g. f(x)=(x<0,1/(1+(-x)^(3/2)), 1/(1+x^(5/2)));
+ 94- intnum(x=[0,-1/2],[1,-1/3], x^(-1/2) + (1-x)^(-1/3)) -> error [didn't
+ suport singularities at both endpoints]
+ 95- buffer overflow after default(format,"f.precision") (whenever many
+ initial zeroes)
+ 96- qfminim(A, 0, ...) -> stack overflow [#1682]
+ 97- e=ellinit("11a1"); ellztopoint(e,3*e.omega[1]/5) -> [5, junk]
+ (instead of expected [5,5]) [#1683]
+ 98- bnfinit(quadhilbert(-2180)) -> precision error [#1688]
+ 99- div_scal_rfrac could create an invalid t_POL [#1651]
+ 100- polroots(t_POL with leading coeff = 0) -> fp exception or error [#1690]
+ 101- \r cannot deal with very long filenames [#1616]
+ 102- rnfisabelian(nf, non monic t_POL) -> SEGV [#1693]
+ 103- Vecrev(x,n) / Colrev(x,n) when 'n' is not omitted: it wasn't true
+ that Colrev/Polrev were inverse functions [#1698]
+ 104- possibly incorrect result in nfdisc(T,listP) even though listP included
+ all prime divisors of the field discriminant. Example:
+ p=10^100+267; q=10^120+79;
+ T=polcompositum(x^2-p,x^2-q,2);
+ nfdisc([T,[2,p,q]])
Added
1- add optional argument to sumdigits to specify the base
@@ -246,7 +267,24 @@ AP 81- [GP] central simple algebra package, GP functions
89- Configure --with-runtime-perl option
PB 90- Faster matrix multiplication over finite fields
91- allow content(t_VECSMALL)
- 92 [libpari] ZX_div_by_X_1
+ 92- [libpari] ZX_div_by_X_1
+HC 93- intnumgauss / intnumgaussinit: Gauss-Legendre quadrature
+LGr94- GP function sinc
+HC 95- contfracinit / contfraceval functions
+HC 96- limitnum / asympnum
+BA 97- [libpari] functions FlxV_prod, RgV_prod
+BA 98- GP function ellfromeqn
+HC 99- gammamellininv, gammamellininvasymp, gammamellininvinit
+BA100- [libpari] RgX_Rg_eval_bk, RgX_RgV_eval
+ 101- [libpari] RgX_cxeval
+HC102- GP function zetamult
+PB103- ZM_mul: Add Strassen-Winograd algorithm
+ 104- GP functions sumnummonien/sumnummonieninit
+ 105- [libpari] RgM_gram_schmidt, RgM_Babai
+BA106- GP function cotanh
+ 107- support sign(t_QUAD with positive discriminant)
+ 108- comparison operators (<,>,<=,>=): support t_QUAD with *same* positive
+ discriminant
Changed
1- make log(+/-I) return (+/-)Pi/2*I with gen_0 real part [#1556]
@@ -340,7 +378,26 @@ LGr52- use GRH-guaranteed bounds in bnfinit for residue estimate
55- old functions from gp-1.39.15 no longer loaded into an "entree" table,
no longer complete specially "whatnow" arguments; remove compat.c and
most of gp_init.c
+BA 56- Rename row_Flm -> Flm_row, row_zm -> zm_row
+ 57- rewrote intnum / intnuminit routines
+ 58- nucomp now takes L = floor(|D|^(1/4)) as a 3rd argument. Former
+ nucomp(x,n) is nucomp(x,n,NULL).
+BA 59- divide_conquer_assoc renamed to gen_product
+ 60- sumnum algorithm (replace Abel-Plana by Euler-Mac Laurin). Changed
+ the interface !
Removed
1- deprecated functions nfbasis0, nfdisc0, factorpadic0
2- deprecated function manage_var
+ 3- useless function intnuminitgen (not very useful and impossible to use
+ reliably together with intnum with boundary conditions)
+ 4- useless function intnumstep: instead of intnum(a,b, intnumstep()+m),
+ use intnum(a,b,m).
+ 5- partially implemented functions intfouriercos / intfouriersin /
+ intfourierexp / intlaplaceinv / intmellininv / intmellinvshort: use
+ intnum (possibly intfuncinit). Make sure to indicate oscillating behaviour
+ when function decrease slowly at oo
+ 6- optional flag to intfuncinit
+BA 7- divide_conquer_prod: use gen_product instead
+ 8- useless function sumnumalt
+
diff --git a/COMPAT b/COMPAT
index 30ee16b..021a904 100644
--- a/COMPAT
+++ b/COMPAT
@@ -1,6 +1,14 @@
This file lists the incompatible changes between Version 2.x and older versions
%%%%%%%%%%%%%%%%%%%%%%%%%%%% VERSION 2.8 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ - removed useless function sumnumalt: use sumalt
+ - replace algorithm behind sumnum / sumnuminit : replace Abel-Plana
+ (slow, imprecise, forced to assume holomorphy and evaluate at complex
+ values, yielding determination problems) by Euler MacLaurin (none of
+ these disadvantages). The interface had to change : the (mandatory)
+ abcissa of integration becomes meaningless, and the initialization
+ possibilities are different. Please read the documentation ??sumnum
+ and ??sumnuminit
- t_STR used to compare as larger than any real number via < or >
operators. Such a comparison now raises an exception.
- valuation(0,p), nfeltval(nf,0,pr), idealval(nf,0) now all return +oo
@@ -29,6 +37,17 @@ This file lists the incompatible changes between Version 2.x and older versions
- genus2red: change syntax. Allow either genus2red(P) or genus2red([P,Q])
instead of mandatory Q (was: genus2red(Q,P) with Q almost always 0).
Allow uniformization with hyperellcharpoly
+ - remove useless function intnuminitgen (not very useful and impossible to
+ use reliably together with intnum with boundary conditions)
+ - remove useless function intnumstep: instead of intnum(a,b, intnumstep()+m),
+ use intnum(a,b,m)
+ - remove partially implemented functions intfouriercos / intfouriersin /
+ intfourierexp / intlaplaceinv / intmellininv / intmellinvshort: use
+ intnum (possibly intfuncinit). Make sure to indicate oscillating behaviour
+ when function decrease slowly at oo
+ - remove optional flag to intfuncinit: misleading and only affords
+ a 2 x speedup in an 'init' function (maybe reimplement later in a
+ more general form...)
* Specific to the PARI library:
===============================
@@ -50,6 +69,11 @@ This file lists the incompatible changes between Version 2.x and older versions
See PARI_OLD_NAMES.
- ellsea is replaced by Fp_ellcard_SEA
- rename PI -> M_PI
+ - renamed row_zm -> zm_row, row_Flm -> Flm_row
+ - nucomp now takes L = floor(|D|^(1/4)) as a 3rd argument. Former
+ nucomp(x,n) is nucomp(x,n,NULL).
+ - divide_conquer_assoc renamed to gen_product, divide_conquer_prod removed
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%% VERSION 2.6 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- eval() no longer evaluates its arguments in "permissive" mode: eval("1a")
diff --git a/Configure b/Configure
index 7a66846..673e5a5 100755
--- a/Configure
+++ b/Configure
@@ -87,8 +87,6 @@ exec 5>> $config_log
####################### CONFIGURE - LIBRARIES ###############################
# Looking for libraries: gmp, X11, fltk, Qt, readline
echo Checking for optional libraries and headers...
-. ./get_include_path
-. ./get_libpth
# $_gmp_list
if test "$kernlvl1" = "gmp"; then
. ./get_gmp
diff --git a/config/Makefile.SH b/config/Makefile.SH
index 237d62b..dc6525f 100644
--- a/config/Makefile.SH
+++ b/config/Makefile.SH
@@ -79,7 +79,7 @@ Qt4)
PLOTLIBS="-L\$(QTDIR)/lib $QTLIB"
graph=plotQt4;;
fltk)
- PLOTCFLAGS="-I\$(FLTKDIR)/include $X11_INC"
+ PLOTCFLAGS=
PLOTLIBS="$FLTK_LIBS"
postconfig='fltk-config --post '
graph=plotfltk;;
@@ -272,9 +272,7 @@ QTDIR = "$QTDIR"
MOC = \$(QTDIR)/bin/moc
PLOTCFLAGS = $PLOTCFLAGS
PLOTLIBS = $PLOTLIBS
-CPLUSPLUS = g++
-
-FLTKDIR = "$FLTKDIR"
+CXX = g++
TOPLDDYN = "$TOP/$objdir"
# Description system
@@ -725,17 +723,18 @@ for dir in basemath modules language gp graph systems mt; do
plotQt)
cflags="$cflags \$(PLOTCFLAGS)"
depend="$RECT_H"
- compile="\$(MOC) -o plotQt.moc.cpp $src/graph/plotQt.c && \$(CPLUSPLUS)"
+ compile="\$(MOC) -o plotQt.moc.cpp $src/graph/plotQt.c && \$(CXX)"
;;
plotQt4)
cflags="$cflags \$(PLOTCFLAGS)"
depend="$RECT_H"
- compile="\$(MOC) \$(PLOTCFLAGS) -o plotQt4.moc.cpp $src/graph/plotQt4.c && \$(CPLUSPLUS)"
+ compile="\$(MOC) \$(PLOTCFLAGS) -o plotQt4.moc.cpp $src/graph/plotQt4.c
+&& \$(CXX)"
;;
plotfltk)
cflags="$cflags \$(PLOTCFLAGS)"
depend="$RECT_H"
- compile="\$(CPLUSPLUS)"
+ compile="\$(CXX)"
;;
plot*)
cflags="$cflags \$(PLOTCFLAGS)"
diff --git a/config/get_config_options b/config/get_config_options
index 4b52b43..18949ac 100644
--- a/config/get_config_options
+++ b/config/get_config_options
@@ -165,7 +165,7 @@ Optional libraries:
--with-gmp-lib=DIR specify location of gmp libs
--with-qt[=DIR] use the Qt graphical library [prefix for Qt dir.]
- --with-fltk[=DIR] use the FLTK graphical library [prefix for FLTK dir.]
+ --with-fltk use the FLTK graphical library [need fltk-config]
Miscellaneous
--with-runtime-perl[=path-to-perl-binary] for gphelp / tex2mail
diff --git a/config/get_fltk b/config/get_fltk
index cfe16c3..ee21b6d 100644
--- a/config/get_fltk
+++ b/config/get_fltk
@@ -1,24 +1,17 @@
if test -z "$with_fltk"; then
with_fltk=yes
fi
-FLTKDIR=
-case "$with_fltk" in
-yes)
- pth=$libpth; lib=fltk; . ./locatelib
- if test -n "$fltk"; then
- FLTKDIR=`dirname $fltk | sed -e 's/lib\/$//'`
- fi
- ;;
-*) if test ! -d "$with_fltk"; then
- echo "### FLTK directory '$with_fltk' not found"
- else
- FLTKDIR=$with_fltk
- fi;;
-esac
-if test -n "$FLTKDIR"; then
- echo "Using FLTK library, FLTKDIR = $FLTKDIR"
- FLTK_LIBS="`fltk-config --ldflags` -lstdc++"
+FLTK_LIBS="`fltk-config --ldflags`"
+exe=$osname-$arch-fltk$$
+cxx=$CXX
+if test -z "$cxx"; then cxx=g++; fi;
+cmd="$cxx $CFLAGS $FLTK_LIBS -o $exe has_fltk.c"
+. log_cmd
+if test -r "$exe"; then
+ echo "Using FLTK library"
+ FLTK_LIBS="$FLTK_LIBS -lstdc++"
else
echo "### FLTK not found. Building without FLTK support"
FLTK_LIBS=
fi
+rm -f $exe
diff --git a/config/get_gmp b/config/get_gmp
index 41ebb38..7f780e8 100644
--- a/config/get_gmp
+++ b/config/get_gmp
@@ -1,28 +1,33 @@
_gmp_list="gmp GMPLIBS GMPINCLUDE"
gmp=
-if test -n "$with_gmp"; then
- with_gmp_lib="$with_gmp_lib $with_gmp/lib"
- with_gmp_include="$with_gmp_include $with_gmp/include"
-fi
+case "$with_gmp" in
+ yes|"");;
+ *)
+ if test -z "$with_gmp_lib"; then
+ with_gmp_lib="$with_gmp/lib"
+ fi
+ if test -z "$with_gmp_include"; then
+ with_gmp_include="$with_gmp/include"
+ fi;;
+esac
-pth="$with_gmp_include $basic_include_path"
+pth="$with_gmp_include"
x=`./locate 'gmp.h' '' $pth`
case $x in
?:/*|/*) gmp_include=`dirname $x`
echo ..."Found gmp header in $gmp_include"
GMPINCLUDE="-I$gmp_include"
;;
- *) echo ..."gmp header file not found by Configure, trying to proceed"
- gmp=;;
esac
try() { GMPLIBS=$1; cmd="$cmd0 $1"; . log_cmd; }
-exe=$osname-$arch-gmpv$$
+exe=$osname-$arch-gmp$$
cmd0="$CC $CFLAGS $extraflag $GMPINCLUDE -o $exe gmp_version.c"
if test -n "$with_gmp_lib"; then
- try "-L$with_gmp_lib -lgmp"
+ gmp=$with_gmp_lib
+ try "-L$gmp -lgmp"
fi
if test ! -r $exe; then
try "-lgmp"
@@ -50,6 +55,16 @@ case "$gmp_version" in
fi;;
*) if test -z "$gmp"; then gmp=yes; fi;;
esac
+
+if test -n "$gmp"; then
+ cmd="$CC $CFLAGS $extraflag $GMPINCLUDE -o $exe gmp_mismatch.c $GMPLIBS"
+ . log_cmd
+ if test ! -r $exe; then
+ gmp=
+ echo "### GMP headers mismatch: try both --with-gmp-lib and --with-gmp-include"
+ fi
+fi
+
rm -f $exe $exe$exe_suff
if test -z "$gmp"; then
diff --git a/config/get_graphic_lib b/config/get_graphic_lib
index 8a8aa97..3a96ac1 100644
--- a/config/get_graphic_lib
+++ b/config/get_graphic_lib
@@ -3,7 +3,7 @@ if test "$optimization" = profiling; then
fi
_graphic_list="which_graphic_lib X11 X11_INC X11_LIBS \
-FLTKDIR FLTK_LIBS QTDIR QTLIB"
+FLTK_LIBS QTDIR QTLIB"
if test -n "$with_fltk"; then which_graphic_lib=fltk; fi
if test -n "$with_qt"; then which_graphic_lib=Qt; fi
@@ -37,8 +37,8 @@ case $which_graphic_lib in
auto|fltk)
case $osname in
darwin) ;; # fltk brings in CoreFoundation, incompatible with pari_daemon
- *). ./get_fltk # FLTKDIR, FLTK_LIBS ;;
- if test -z "$FLTKDIR"; then
+ *). ./get_fltk # FLTK_LIBS ;;
+ if test -z "$FLTK_LIBS"; then
case $which_graphic_lib in fltk) which_graphic_lib=none;; esac
else
which_graphic_lib=fltk
diff --git a/config/get_include_path b/config/get_include_path
deleted file mode 100644
index da1d9a8..0000000
--- a/config/get_include_path
+++ /dev/null
@@ -1,17 +0,0 @@
-incpth="`echo $C_INCLUDE_PATH | sed -e \"s%\([^$dir_sep]*\)$dir_sep*%\1 \1/readline %g\"`"
-case "$osname" in
- os2);;
- cygwin*) incpth="$incpth\
- $cygtop/usr/local/include\
- $cygtop/usr/include\
- $cygtop/H-${arch}-cygwin32/${arch}-cygwin32/include\
- ";;
- *) incpth="$incpth\
- /usr/local/include\
- /usr/include\
- /opt/include\
- /opt/local/include\
- /opt/gnu/include\
- ";;
-esac
-basic_include_path=$incpth
diff --git a/config/get_libpth b/config/get_libpth
deleted file mode 100644
index 6e3fb72..0000000
--- a/config/get_libpth
+++ /dev/null
@@ -1,54 +0,0 @@
-case "$sizeof_long" in
- 8) addlib64="/usr/local/lib64 /lib64 /usr/lib64"
-esac
-
-libpth="`echo $LIBRARY_PATH | sed -e \"s%\([^$dir_sep]*\)$dir_sep*%\1 %g\"`"
-case "$osname" in
- cygwin*)
- cygtop=/cygdrive/c
- if test ! -d $cygtop; then
- ver=`uname -r | cut -d. -f1`
- cygtop=/Cygnus/cygwin/B$ver
- if test ! -d $cygtop; then
- cygtop=/Cygnus/cygwin-B$ver
- if test ! -d $cygtop; then
- cygtop=/usr/${arch}-pc-cygwin
- if test ! -d $cygtop; then
- echo ..."I could not find Cygwin top directory" >&2
- fi
- fi
- fi
- fi
- if test "$cygtop" = /cygdrive/c; then
-# cygnus for version 1.*
- libpth="$libpth\
- /usr/local/lib\
- /lib\
- "
- cygtop=
- else
-# cygnus for version 0.*
- libpth="$libpth\
- $cygtop/H-${arch}-cygwin32/lib\
- $cygtop/H-${arch}-cygwin32/${arch}-cygwin32/lib\
- "
- fi;;
- os2) libpth=`echo $libpth | sed 's,\\\\,/,g'`;;
- *) libpth="$libpth $addlib64\
- /usr/local/lib\
- /lib\
- /usr/lib\
- /opt/lib\
- /opt/local/lib\
- /opt/gnu/lib\
- /lib/pa1.1\
- /usr/lib/large\
- /lib/large\
- /usr/lib/small\
- /lib/small\
- /usr/ccs/lib\
- /usc/ucblib\
- /usr/shlib\
- .\
- ";;
-esac
diff --git a/config/get_readline b/config/get_readline
index 47217d7..80b3a94 100644
--- a/config/get_readline
+++ b/config/get_readline
@@ -2,24 +2,28 @@
_readline_list="readline readline_version RLINCLUDE RLLIBS"
readline=
-if test -n "$with_readline"; then
- with_readline_lib="$with_readline_lib $with_readline/lib"
- with_readline_include="$with_readline_include $with_readline/include"
-fi
+case "$with_readline" in
+ yes|"");;
+ *)
+ if test -z "$with_readline_lib"; then
+ with_readline_lib="$with_readline/lib"
+ fi
+ if test -z "$with_readline_include"; then
+ with_readline_include="$with_readline/include"
+ fi;;
+esac
# Readline -- Headers
-pth="$with_readline_include $basic_include_path"
+pth="$with_readline_include"
x=`./locate 'readline/readline.h' '' $pth`
case $x in
- ?:/*|/*) rl_include=`dirname $x`
+ ?:/*|/*) rl_include=`dirname $x`
echo ..."Found readline header in $rl_include"
if (echo $rl_include | grep "readline$" > /dev/null); then
rl_include=`dirname $rl_include`
RLINCLUDE="-I$rl_include"
fi
;;
- *) echo ..."readline header file not found by Configure, trying to proceed"
- readline=;;
esac
exe=$osname-$arch-rlv$$
@@ -47,32 +51,6 @@ for tlib in "" tinfo ncurses termcap; do
if test -r $exe; then break; fi
done
-# failed; retry with -Lxxx using locatelib
-if test ! -r $exe; then
- pth="$with_readline_lib $libpth"
- lib=readline; . ./locatelib
- if test -n "$readline"; then
- rl="-L$readline -lreadline"
- else
- rl="-lreadline" # not found, sequel will almost certainly fail
- fi
- for tlib in "" tinfo ncurses termcap; do
- t=$rl
- if test -n "$tlib"; then # termcap compatible library, using locatelib
- eval pth="\$with_${tlib}_lib $libpth"
- lib=$tlib; . ./locatelib
- eval p="\$$tlib"
- if test -n "$p"; then
- t="$t -L$p -l$tlib"
- else
- t="$t -l$p"
- fi
- fi
- try "$t"
- if test -r $exe; then break; fi
- done
-fi
-
readline_version=
if test -r $exe; then
readline_version=`env LD_LIBRARY_PATH="$LD_LIBRARY_PATH$dir_sep$readline" $RUNTEST $exe`;
diff --git a/config/gmp_mismatch.c b/config/gmp_mismatch.c
new file mode 100644
index 0000000..18bbece
--- /dev/null
+++ b/config/gmp_mismatch.c
@@ -0,0 +1,13 @@
+#include <stdio.h>
+#include <gmp.h>
+int main()
+{
+ mp_limb_t *x = NULL, *y = NULL;
+ long nx = 0;
+#ifdef mpn_sqr
+ mpn_sqr(y, x, nx);
+#else
+ mpn_mul_n(y, x, x, nx);
+#endif
+ return 0;
+}
diff --git a/config/has_fltk.c b/config/has_fltk.c
new file mode 100644
index 0000000..422bc0c
--- /dev/null
+++ b/config/has_fltk.c
@@ -0,0 +1,7 @@
+#include <FL/Fl.H>
+#include <FL/Fl_Window.H>
+#include <FL/fl_draw.H>
+int main() {
+ &fl_color_cube;
+ return 0;
+}
diff --git a/config/version b/config/version
index e6a148a..3f68e8d 100644
--- a/config/version
+++ b/config/version
@@ -11,7 +11,7 @@ patch='0'
version_code=`expr $VersionMajor \\* 65536 + $VersionMinor \\* 256 + $patch`
# Status: alpha, beta, released, development. Rewritten by config/settar !
-stat='development git-0e48e9b'
+stat='development git-deac36e'
# soname of stable libpari.so is libpari.so.$soname_num
status="$stat"
diff --git a/doc/develop.tex b/doc/develop.tex
index 610abb7..b7de915 100644
--- a/doc/develop.tex
+++ b/doc/develop.tex
@@ -195,7 +195,36 @@ A typical low-level construct:
l = L? lg(L): 1;
for (i = 1; i < l; i++) output( gel(L, i) );
for (i = 1; i < l; i++) gel(L, i) = gclone( ... );
- at eprog\noindent
+ at eprog
+
+\subsec{Maps as Lists}
+
+GP's maps are implemented on top of \typ{LIST}s so as to benefit from
+their peculiar memory models. Lists thus come in two subtypes: \typ{LIST\_RAW}
+(actual lists) and \typ{LIST\_MAP} (a map).
+
+\fun{GEN}{listcreate_typ}{long t} create a list of subtype $t$. Plain
+\kbd{listcreate} is an alias for
+\bprog
+ listcreate_typ(t_LIST_RAW);
+ at eprog
+
+\fun{long}{list_typ}{GEN L} return the list subtype, either \typ{LIST\_RAW} or
+\typ{LIST\_MAP}.
+
+\fun{void}{listpop}{GEN L, long index} as \kbd{listpop0},
+assuming that $L$ is a \typ{LIST\_RAW}.
+
+\fun{GEN}{listput}{GEN list, GEN object, long index} as \kbd{listput0},
+assuming that $L$ is a \typ{LIST\_RAW}.
+
+\fun{GEN}{mapdomain}{GEN T} vector of keys of the map $T$.
+
+\fun{GEN}{mapdomain_shallow}{GEN T} shallow version of \kbd{mapdomain}.
+
+\fun{GEN}{maptomat}{GEN T} convert a map to a factorization matrix.
+
+\fun{GEN}{maptomat_shallow}{GEN T} shallow version of \kbd{maptomat}.
\section{Protection of non-interruptible code}
diff --git a/doc/usersch3.tex b/doc/usersch3.tex
index ef8ef2b..de59291 100644
--- a/doc/usersch3.tex
+++ b/doc/usersch3.tex
@@ -444,7 +444,8 @@ The library syntax is \fun{GEN}{gmul2n}{GEN x, long n}.
\subsec{sign$(x)$}\kbdsidx{sign}\label{se:sign}
\idx{sign} ($0$, $1$ or $-1$) of $x$, which must be of
-type integer, real or fraction.
+type integer, real or fraction; \typ{QUAD} with positive discriminants and
+\typ{INFINITY} are also supported.
The library syntax is \fun{GEN}{gsigne}{GEN x}.
@@ -555,7 +556,10 @@ The library syntax is \fun{GEN}{gtocol0}{GEN x, long n}.
\fun{GEN}{gtocol}{GEN x} is also available.
\subsec{Colrev$(x, \{n\})$}\kbdsidx{Colrev}\label{se:Colrev}
-As $\kbd{Col}(x, n)$, then reverse the result. In particular
+As $\kbd{Col}(x, -n)$, then reverse the result. In particular,
+\kbd{Colrev} is the reciprocal function of \kbd{Polrev}: the
+coefficients of the vector start with the constant coefficient of the
+polynomial and the others follow by increasing degree.
The library syntax is \fun{GEN}{gtocolrev0}{GEN x, long n}.
\fun{GEN}{gtocolrev}{GEN x} is also available.
@@ -570,6 +574,21 @@ either initialize all lists to the empty list, or use them sparingly.
The library syntax is \fun{GEN}{gtolist}{GEN x = NULL}.
The variant \fun{GEN}{listcreate}{void} creates an empty list.
+\subsec{Map$(\{x\})$}\kbdsidx{Map}\label{se:Map}
+A ``Map'' is an associative array, or dictionary: a data
+type composed of a collection of (\emph{key}, \emph{value}) pairs, such that
+each key appears just once in the collection. This function
+converts the matrix $[a_1,b_1;a_2,b_2;\dots;a_n,b_n]$ to the map $a_i\mapsto
+b_i$.
+\bprog
+? M = Map(factor(13!));
+? mapget(M,3)
+%2 = 5
+ at eprog\noindent If the argument $x$ is omitted, create an empty map, which
+may be filled later via \tet{mapput}
+
+The library syntax is \fun{GEN}{gtomap}{GEN x = NULL}.
+
\subsec{Mat$(\{x=[\,]\})$}\kbdsidx{Mat}\label{se:Mat}
Transforms the object $x$ into a matrix.
If $x$ is already a matrix, a copy of $x$ is created.
@@ -874,8 +893,8 @@ is $|n|$. Variant: \fun{GEN}{gtovec}{GEN x} is also available.
The library syntax is \fun{GEN}{gtovec0}{GEN x, long n}.
\subsec{Vecrev$(x, \{n\})$}\kbdsidx{Vecrev}\label{se:Vecrev}
-As $\kbd{Vec}(x, n)$, then reverse the result. In particular
-In this case, \kbd{Vecrev} is the reciprocal function of \kbd{Polrev}: the
+As $\kbd{Vec}(x, -n)$, then reverse the result. In particular,
+\kbd{Vecrev} is the reciprocal function of \kbd{Polrev}: the
coefficients of the vector start with the constant coefficient of the
polynomial and the others follow by increasing degree.
@@ -2134,6 +2153,11 @@ Cotangent of $x$.
The library syntax is \fun{GEN}{gcotan}{GEN x, long prec}.
+\subsec{cotanh$(x)$}\kbdsidx{cotanh}\label{se:cotanh}
+Hyperbolic cotangent of $x$.
+
+The library syntax is \fun{GEN}{gcotanh}{GEN x, long prec}.
+
\subsec{dilog$(x)$}\kbdsidx{dilog}\label{se:dilog}
Principal branch of the dilogarithm of $x$,
i.e.~analytic continuation of the power series $\log_2(x)=\sum_{n\ge1}x^n/n^2$.
@@ -2245,6 +2269,73 @@ Gamma function evaluated at the argument $x+1/2$.
The library syntax is \fun{GEN}{ggammah}{GEN x, long prec}.
+\subsec{gammamellininv$(G,t,\{m=0\})$}\kbdsidx{gammamellininv}\label{se:gammamellininv}
+Returns the value at $t$ of the inverse Mellin transform
+$G$ initialized by \tet{gammamellininvinit}.
+\bprog
+? G = gammamellininvinit([0]);
+? gammamellininv(G, 2) - 2*exp(-Pi*2^2)
+%2 = -4.484155085839414627 E-44
+ at eprog
+
+The alternative shortcut
+\bprog
+ gammamellininv(A,t,m)
+ at eprog\noindent for
+\bprog
+ gammamellininv(gammamellininvinit(A,m), t)
+ at eprog\noindent is available.
+
+The library syntax is \fun{GEN}{gammamellininv}{GEN G, GEN t, long m, long prec}.
+
+\subsec{gammamellininvasymp$(A,n,\{m=0\})$}\kbdsidx{gammamellininvasymp}\label{se:gammamellininvasymp}
+Return the first $n$ terms of the asymptotic expansion at infinity
+of the $m$-th derivative $K^{(m)}(t)$ of the inverse Mellin transform of the
+function
+$$f(s) = \Gamma_\R(s+a_1)\*\ldots\*\Gamma_\R(s+a_d)\;,$$
+where \kbd{A} is the vector $[a_1,\ldots,a_d]$ and
+$\Gamma_\R(s)=\pi^{-s/2}\*\Gamma(s/2)$.
+The result is a vector
+$[M[1]...M[n]]$ with M[1]=1, such that
+$$K^{(m)}(t)=\sqrt(2^{d+1}/d)t^{1-d+a+m(2/d-1)}e^{-d\pi t^{2/d}}
+ \sum_{n\ge0} M[n+1]t^{-2n/d}$$
+with $a=(1-d+\sum_{1\le j\le d}a_j)/d$.
+
+The library syntax is \fun{GEN}{gammamellininvasymp}{GEN A, long precdl, long n}.
+
+\subsec{gammamellininvinit$(A,\{m=0\})$}\kbdsidx{gammamellininvinit}\label{se:gammamellininvinit}
+Initialize data for the computation by \tet{gammamellininv} of
+the $m$-th derivative of the inverse Mellin transform of the function
+$$f(s) = \Gamma_\R(s+a_1)\*\ldots\*\Gamma_\R(s+a_d)$$
+where \kbd{A} is the vector $[a_1,\ldots,a_d]$ and
+$\Gamma_\R(s)=\pi^{-s/2}\*\Gamma(s/2)$. This is the special case of Meijer's
+$G$ functions used to compute $L$-values via the approximate functional
+equation.
+
+\misctitle{Caveat} Contrary to the PARI convention, this function
+guarantees an \emph{absolute} (rather than relative) error bound.
+
+For instance, the inverse Mellin transform of $\Gamma_\R(s)$ is
+$2\exp(-\pi z^2)$:
+\bprog
+? G = gammamellininvinit([0]);
+? gammamellininv(G, 2) - 2*exp(-Pi*2^2)
+%2 = -4.484155085839414627 E-44
+ at eprog
+The inverse Mellin transform of $\Gamma_\R(s+1)$ is
+$2 z\exp(-\pi z^2)$, and its second derivative is
+$ 4\pi z \exp(-\pi z^2)(2\pi z^2 - 3)$:
+\bprog
+? G = gammamellininvinit([1], 2);
+? a(z) = 4*Pi*z*exp(-Pi*z^2)*(2*Pi*z^2-3);
+? b(z) = gammamellininv(G,z);
+? t(z) = b(z) - a(z);
+? t(3/2)
+%3 = -1.4693679385278593850 E-39
+ at eprog
+
+The library syntax is \fun{GEN}{gammamellininvinit}{GEN A, long m, long prec}.
+
\subsec{hyperu$(a,b,x)$}\kbdsidx{hyperu}\label{se:hyperu}
$U$-confluent hypergeometric function with
parameters $a$ and $b$. The parameters $a$ and $b$ can be complex but
@@ -2364,6 +2455,14 @@ Sine of $x$.
The library syntax is \fun{GEN}{gsin}{GEN x, long prec}.
+\subsec{sinc$(x)$}\kbdsidx{sinc}\label{se:sinc}
+Cardinal sine of $x$, i.e. $\sin(x)/x$ if $x\neq 0$, $1$ otherwise.
+Note that this function also allows to compute
+$$(1-\cos(x)) / x^2 = \kbd{sinc}(x/2)^2 / 2$$
+accurately near $x = 0$.
+
+The library syntax is \fun{GEN}{gsinc}{GEN x, long prec}.
+
\subsec{sinh$(x)$}\kbdsidx{sinh}\label{se:sinh}
Hyperbolic sine of $x$.
@@ -2518,6 +2617,17 @@ integers $k$ such that $k \equiv 1 \pmod{p-1}$ (resp. $k$ is odd) if
$p$ is odd (resp. $p = 2$).
The library syntax is \fun{GEN}{gzeta}{GEN s, long prec}.
+
+\subsec{zetamult$(s)$}\kbdsidx{zetamult}\label{se:zetamult}
+For $s$ a vector of positive integers such that $s[1] \geq 2$,
+returns the multiple zeta value (MZV)
+$$\zeta(s_1,\dots, s_k) = \sum_{n_1>\dots>n_k>0} n_1^{-s_1}\dots n_k^{-s_k}.$$
+\bprog
+? zetamult([2,1]) - zeta(3) \\ Euler's identity
+%1 = 0.E-38
+ at eprog
+
+The library syntax is \fun{GEN}{zetamult}{GEN s, long prec}.
%SECTION: transcendental
\section{Arithmetic functions}\label{se:arithmetic}
@@ -2801,7 +2911,8 @@ not with $x$, but with its content:
\bprog
? content([ [2], 4*matid(3) ])
%1 = 2
- at eprog
+ at eprog\noindent The content of a \typ{VECSMALL} is computed assuming the
+entries are signed integers in $[-2^{BIL-1}, 2^{BIL-1}[$.
The library syntax is \fun{GEN}{content}{GEN x}.
@@ -4067,23 +4178,27 @@ The library syntax is \fun{GEN}{hclassno}{GEN x}.
\idx{composition} of the primitive positive
definite binary quadratic forms $x$ and $y$ (type \typ{QFI}) using the NUCOMP
and NUDUPL algorithms of \idx{Shanks}, \`a la Atkin. $L$ is any positive
-constant, but for optimal speed, one should take $L=|D|^{1/4}$, where $D$ is
-the common discriminant of $x$ and $y$. When $x$ and $y$ do not have the same
-discriminant, the result is undefined.
+constant, but for optimal speed, one should take $L=|D/4|^{1/4}$, i.e.
+\kbd{sqrtnint(abs(D)>>2,4)}, where $D$ is the common discriminant of $x$ and
+$y$. When $x$ and $y$ do not have the same discriminant, the result is
+undefined.
-The current implementation is straightforward and in general \emph{slower}
-than the generic routine (since the latter takes advantage of asymptotically
-fast operations and careful optimizations).
+The current implementation is slower than the generic routine for small $D$,
+and becomes faster when $D$ has about $45$ bits.
The library syntax is \fun{GEN}{nucomp}{GEN x, GEN y, GEN L}.
Also available is \fun{GEN}{nudupl}{GEN x, GEN L} when $x=y$.
-\subsec{qfbnupow$(x,n)$}\kbdsidx{qfbnupow}\label{se:qfbnupow}
+\subsec{qfbnupow$(x,n,\{L\})$}\kbdsidx{qfbnupow}\label{se:qfbnupow}
$n$-th power of the primitive positive definite
-binary quadratic form $x$ using \idx{Shanks}'s NUCOMP and NUDUPL algorithms
-(see \kbd{qfbnucomp}, in particular the final warning).
+binary quadratic form $x$ using \idx{Shanks}'s NUCOMP and NUDUPL algorithms;
+if set, $L$ should be equal to \kbd{sqrtnint(abs(D)>>2,4)}, where $D < 0$ is
+the discriminant of $x$.
-The library syntax is \fun{GEN}{nupow}{GEN x, GEN n}.
+The current implementation is slower than the generic routine for small
+discriminant $D$, and becomes faster for $D \approx 2^45$.
+
+The library syntax is \fun{GEN}{nupow}{GEN x, GEN n, GEN L = NULL}.
\subsec{qfbpowraw$(x,n)$}\kbdsidx{qfbpowraw}\label{se:qfbpowraw}
$n$-th power of the binary quadratic form
@@ -4212,7 +4327,17 @@ usually more convenient to use
\fun{GEN}{Buchquad}{GEN D, double c1, double c2, long prec}
\subsec{quaddisc$(x)$}\kbdsidx{quaddisc}\label{se:quaddisc}
-Discriminant of the quadratic field $\Q(\sqrt{x})$, where $x\in\Q$.
+Discriminant of the \'etale algebra $\Q(\sqrt{x})$, where $x\in\Q^*$.
+This is the same as \kbd{coredisc}$(d)$ where $d$ is the integer square-free
+part of $x$, so x=$d f^2$ with $f\in \Q^*$ and $d\in\Z$.
+This returns $0$ for $x = 0$, $1$ for $x$ square and the discriminant of the
+quadratic field $\Q(\sqrt{x})$ otherwise.
+\bprog
+? quaddisc(7)
+%1 = 28
+? quaddisc(-7)
+%2 = -7
+ at eprog
The library syntax is \fun{GEN}{quaddisc}{GEN x}.
@@ -4394,14 +4519,15 @@ factors; in that case $B$ must obviously be smaller than the largest
non-trivial divisor of $N$.
\bprog
setrand(1); \\ to make the example reproducible
-p = nextprime(random(10^30));
-q = nextprime(random(10^30)); N = p*q;
+interval = [10^30, 10^31];
+p = randomprime(interval);
+q = randomprime(interval); N = p*q;
p0 = p % 10^20; \\ assume we know 1) p > 10^29, 2) the last 19 digits of p
-p1 = zncoppersmith(10^19*x + p0, N, 10^12, 10^29)
+L = zncoppersmith(10^19*x + p0, N, 10^12, 10^29)
\\ result in 10ms.
-%1 = [35023733690]
-? gcd(p1[1] * 10^19 + p0, N) == p
+%6 = [738281386540]
+? gcd(L[1] * 10^19 + p0, N) == p
%2 = 1
@eprog\noindent and we recovered $p$, faster than by trying all
possibilities $ < 10^{12}$.
@@ -4419,7 +4545,8 @@ C = lift( (Mod(x0,N) + P)^e ); \\ known ciphertext, with padding P
zncoppersmith((P + x)^3 - C, N, X)
\\ result in 244ms.
-%3 = [265174753892462432]
+%14 = [2679982004001230401]
+
? %[1] == x0
%4 = 1
@eprog\noindent
@@ -4972,7 +5099,7 @@ Eisenstein series of weight $k$ at the lattice $w$, as given by
\tet{ellperiods}, namely
$$
(2i \pi/\omega_2)^k
-\Big(1 + 2/\zeta(1-k) \sum_{n\geq 0} n^{k-1}q^n / (1-q^n)\Big),
+\Big(1 + 2/\zeta(1-k) \sum_{n\geq 1} n^{k-1}q^n / (1-q^n)\Big),
$$
where $q = \exp(2i\pi \tau)$ and $\tau:=\omega_1/\omega_2$ belongs to the
complex upper half-plane. It is also possible to directly input $w =
@@ -5091,6 +5218,51 @@ coefficients of $w$ belong to $\Z[a_1,a_2,a_3,a_4,a_6]$.
The library syntax is \fun{GEN}{ellformalw}{GEN E, long precdl, long n = -1}, where \kbd{n } is a variable number.
+\subsec{ellfromeqn$(P)$}\kbdsidx{ellfromeqn}\label{se:ellfromeqn}
+Given a genus $1$ plane curve, defined by the affine equation $f(x,y) = 0$,
+return the coefficients $[a_1,a_2,a_3,a_4,a_6]$ of a Weierstrass equation
+for its Jacobian. This allows to recover a Weierstrass model for an elliptic
+curve given by a general plane cubic or by a binary quartic or biquadratic
+model.
+
+The function implements the $f \mapsto f^*$ formulae of Artin, Tate and
+Villegas (Advances in Math. 198 (2005), pp. 366--382).
+
+In the example below, the function is used to convert between twisted Edward
+coordinates and Weierstrass coordinates.
+
+\bprog
+? e = ellfromeqn(a*x^2+y^2-(1+d*x^2*y^2))
+%1 = [0,-a-d,0,-4*d*a,4*d*a^2+4*d^2*a]
+? E = ellinit(ellfromeqn(y^2-x^2 - 1 +(121665/121666*x^2*y^2)),2^255-19);
+? ellcard(E)
+%2 = 57896044618658097711785492504343953926856930875039260848015607506283634007912
+ at eprog
+
+The elliptic curve associated to the sum of two cubes is given by
+\bprog
+? ellfromeqn(x^3+y^3-a)
+%1 = [0,0,-9*a,0,-27*a^2]
+ at eprog
+
+Congruent number problem: Let $n$ be an integer,
+if $a^2+b^2=c^2$ and $a\*b=2\*n$,
+then by substituting $b$ by $2\*n/a$ in the first equation,
+we get $((a^2+(2\*n/a)^2)-c^2)*a^2 = 0$.
+We set $x=a$, $y=a*c$.
+\bprog
+? ellfromeqn((x^2+(2*n/x)^2-(y/x)^2)*x^2)
+%1 = [0,0,0,-16*n^2,0]
+ at eprog
+For example $23$ is congruent since the curve has a point of infinite order,
+namely:
+\bprog
+? ellheegner(ellinit(subst([0,0,0,-16*n^2,0],n,23)))
+%2 = [168100/289,68053440/4913]
+ at eprog
+
+The library syntax is \fun{GEN}{ellfromeqn}{GEN P}.
+
\subsec{ellfromj$(j)$}\kbdsidx{ellfromj}\label{se:ellfromj}
Returns the coefficients $[a_1,a_2,a_3,a_4,a_6]$ of a fixed elliptic curve
with $j$-invariant $j$.
@@ -5391,7 +5563,7 @@ functions $[f, g, h]$ such that the isogeny $E \to E/G$ is given by $(x,y)
\mapsto (f(x)/h(x)^2, g(x,y)/h(x)^3)$.
\bprog
? E = ellinit([0,1]);
-? elltors(e)
+? elltors(E)
%2 = [6, [6], [[2, 3]]]
? ellisogeny(E, [2,3], 1) \\ Weierstrass model for E/<P>
%3 = [0, 0, 0, -135, -594]
@@ -6185,16 +6357,20 @@ infinity $[0]$.
The library syntax is \fun{GEN}{pointell}{GEN E, GEN z, long prec}.
-\subsec{genus2red$(Q,P,\{p\})$}\kbdsidx{genus2red}\label{se:genus2red}
-Let $Q,P$ be polynomials with integer coefficients.
+\subsec{genus2red$(P,\{p\})$}\kbdsidx{genus2red}\label{se:genus2red}
+Let $P$ be a polynomial with integer coefficients.
Determines the reduction at $p > 2$ of the (proper, smooth) genus~2
-curve $C/\Q$, defined by the hyperelliptic equation $y^2+Qy = P$. (The
+curve $C/\Q$, defined by the hyperelliptic equation $y^2 = P$. (The
special fiber $X_p$ of the minimal regular model $X$ of $C$ over $\Z$.)
+The special syntax \kbd{genus2red}$([P,Q])$ is also allowed, where the
+polynomials $P$ and $Q$ have integer coefficients, to represent the model
+$y^2 + Q(x)y = P(x)$.
+
If $p$ is omitted, determines the reduction type for all (odd) prime
divisors of the discriminant.
-\noindent This function rewritten from an implementation of Liu's algorithm by
-Cohen and Liu (1994), \kbd{genus2reduction-0.3}, see
+\noindent This function was rewritten from an implementation of Liu's
+algorithm by Cohen and Liu (1994), \kbd{genus2reduction-0.3}, see
\url{http://www.math.u-bordeaux1.fr/~liu/G2R/}.
\misctitle{CAVEAT} The function interface may change: for the
@@ -6210,7 +6386,7 @@ conductor at $2$ and $N$ is the global conductor.
\bprog
? default(debuglevel, 1);
-? genus2red(0,x^6 + 3*x^3 + 63, 3)
+? genus2red(x^6 + 3*x^3 + 63, 3)
(potential) stable reduction: [1, []]
reduction at p: [III{9}] page 184, [3, 3], f = 10
%1 = [59049, Mat([3, 10]), x^6 + 3*x^3 + 63, [3, [1, []],
@@ -6295,25 +6471,27 @@ Namikawa-Ueno.
\item The figure \kbd{[2I\_0-m]} in Namikawa-Ueno, page 159, must be denoted
by \kbd{[2I\_0-(m+1)]}.
-The library syntax is \fun{GEN}{genus2red}{GEN Q, GEN P, GEN p = NULL}.
+The library syntax is \fun{GEN}{genus2red}{GEN P, GEN p = NULL}.
-\subsec{hyperellcharpoly$(Q)$}\kbdsidx{hyperellcharpoly}\label{se:hyperellcharpoly}
-Let $X$ be the curve defined by $y^2=Q(x)$, where $Q$ is a polynomial of
-degree $2\*g+1$ over a finite field of characteristic $p\ge 2\*g$,
+\subsec{hyperellcharpoly$(X)$}\kbdsidx{hyperellcharpoly}\label{se:hyperellcharpoly}
+$X$ being a non-singular hyperelliptic curve defined over a finite field,
return the characteristic polynomial of the Frobenius automorphism.
+$X$ can be given either by a squarefree polynomial $P$ such that
+$X: y^2 = P(x)$ or by a vector $[P,Q]$ such that
+$X: y^2 + Q(x)\*y = P(x)$ and $Q^2+4\*P$ is squarefree.
-The library syntax is \fun{GEN}{hyperellcharpoly}{GEN Q}.
+The library syntax is \fun{GEN}{hyperellcharpoly}{GEN X}.
\subsec{hyperellpadicfrobenius$(Q,p,n)$}\kbdsidx{hyperellpadicfrobenius}\label{se:hyperellpadicfrobenius}
Let $X$ be the curve defined by $y^2=Q(x)$, where $Q$ is a polynomial of
-degree $2\*g+1$ over $\Q$ and $p\ge g$ a prime such that $X$ has good reduction
+degree $d$ over $\Q$ and $p\ge d$ a prime such that $X$ has good reduction
at $p$ return the matrix of the Frobenius endomorphism $\varphi$ on the
crystalline module $D_p(E) = \Q_p \otimes H^1_{dR}(E/\Q)$ with respect to the
basis of the given model $(\omega, x\*\omega,\ldots,x^{g-1}\*\omega)$, where
-$\omega = dx/(2\*y)$ is the invariant differential. The characteristic
-polynomial of $\varphi$ is the numerator of the zeta-function of the reduction
-of the curve $X$ modlo $p$. The matrix is computed to absolute $p$-adic
-precision $p^n$.
+$\omega = dx/(2\*y)$ is the invariant differential, where $g$ is the genus of
+$X$ (either $d=2\*g+1$ or $d=2\*g+2$). The characteristic polynomial of
+$\varphi$ is the numerator of the zeta-function of the reduction of the curve
+$X$ modlo $p$. The matrix is computed to absolute $p$-adic precision $p^n$.
The library syntax is \fun{GEN}{hyperellpadicfrobenius}{GEN Q, long p}.
%SECTION: elliptic_curves
@@ -9545,17 +9723,28 @@ minimal degree satisfying certain local conditions:
\kbd{Ld[i]};
\item at the $i$-th real place of \var{nf}, it is complex if $pl[i]=-1$
-(no condition if $pl[i]=1$).
+(no condition if $pl[i]=0$).
The extension has degree the LCM of the local degrees. Currently, the degree
is restricted to be a prime power for the search, and to be prime for the
construction because of the \kbd{rnfkummer} restrictions.
+When \var{nf} is $\Q$, prime integers are accepted instead of \var{prid}
+structures. However, their primality is not checked and the behaviour is
+undefined if you provide a composite number.
+
\misctitle{Warning} If the number field \var{nf} does not contain the $n$-th
roots of unity where $n$ is the degree of the extension to be computed,
triggers the computation of the \var{bnf} of $nf(\zeta_n)$, which may be
costly.
+\bprog
+? nf = nfinit(y^2-5);
+? pr = idealprimedec(nf,13)[1];
+? pol = nfgrunwaldwang(nf, [pr], [2], [0,-1], 'x)
+%3 = x^2 + Mod(3/2*y + 13/2, y^2 - 5)
+ at eprog
+
The library syntax is \fun{GEN}{nfgrunwaldwang}{GEN nf, GEN Lpr, GEN Ld, GEN pl, long v = -1}, where \kbd{v} is a variable number.
\subsec{nfhilbert$(\var{nf},a,b,\{\var{pr}\})$}\kbdsidx{nfhilbert}\label{se:nfhilbert}
@@ -11258,6 +11447,13 @@ on the basis~$(e_i)$.
= \bigoplus_{i=0}^{d-1}Lx^i$! The $i$-th coefficients are related by
conjugating by~$x^i$, which on~$L$ amounts to acting by~$\sigma^i$.
+\misctitle{Warning} For a central simple algebra over $\Q$ defined by a
+multiplication table, we cannot distinguish between the basis and the algebraic
+representations from the size of the vectors. The behaviour is then to always
+interpret the column vector as a basis representation if the coefficients are
+\typ{INT} or \typ{FRAC}, and as an algebraic representation if the coefficients
+are \typ{POL} or \typ{POLMOD}.
+
\subsec{algabsdim$(\var{al})$}\kbdsidx{algabsdim}\label{se:algabsdim}
Given an algebra \var{al} output by \tet{alginit} or by
@@ -11505,14 +11701,15 @@ The library syntax is \fun{GEN}{algdisc}{GEN al}.
\subsec{algdivl$(\var{al},x,y)$}\kbdsidx{algdivl}\label{se:algdivl}
Given two elements $x$ and $y$ in \var{al}, computes their left quotient
-$x\backslash y$ in the algebra \var{al}. Assumes that $y$ is left divisible
-by $x$. Also accepts matrices with coefficients in \var{al}.
+$x\backslash y$ in the algebra \var{al}: an element $z$ such that $xz=y$ (such
+an element is not unique when $x$ is a zerodivisor). If~$x$ is invertible, this
+is the same as $x^{-1}y$. Assumes that $y$ is left divisible by $x$ (i.e. that
+$z$ exists). Also accepts matrices with coefficients in~\var{al}.
The library syntax is \fun{GEN}{algdivl}{GEN al, GEN x, GEN y}.
\subsec{algdivr$(\var{al},x,y)$}\kbdsidx{algdivr}\label{se:algdivr}
-Given two elements $x$ and $y$ in \var{al}, computes their right quotient
-$x/y$ in the algebra \var{al}. Assumes that $y$ is invertible. Also accepts
+Given two elements $x$ and $y$ in \var{al}, return $xy^{-1}$. Also accepts
matrices with coefficients in \var{al}.
The library syntax is \fun{GEN}{algdivr}{GEN al, GEN x, GEN y}.
@@ -11827,6 +12024,24 @@ instead.
The library syntax is \fun{GEN}{algisdivision}{GEN al, GEN pl = NULL}.
+\subsec{algisdivl$(\var{al},x,y,\{\&z\})$}\kbdsidx{algisdivl}\label{se:algisdivl}
+Given two elements $x$ and $y$ in \var{al}, tests whether $y$ is left
+divisible by $x$, that is whether there exists~$z$ in \var{al} such
+that~$xz=y$, and sets $z$ to this element if it exists.
+\bprog
+? A = alginit(nfinit(y), [-1,1]);
+? algisdivl(A,[x+2,-x-2]~,[x,1]~)
+%2 = 0
+? algisdivl(A,[x+2,-x-2]~,[-x,x]~,&z)
+%3 = 1
+? z
+%4 = [Mod(-2/5*x - 1/5, x^2 + 1), 0]~
+ at eprog
+
+Also accepts matrices with coefficients in \var{al}.
+
+The library syntax is \fun{GEN}{algisdivl}{GEN al, GEN x, GEN y, GEN *z = NULL}.
+
\subsec{algisinv$(\var{al},x,\{\&\var{ix}\})$}\kbdsidx{algisinv}\label{se:algisinv}
Given an element $x$ in \var{al}, tests whether $x$ is invertible, and sets
$ix$ to the inverse of $x$.
@@ -11844,6 +12059,30 @@ Also accepts matrices with coefficients in \var{al}.
The library syntax is \fun{GEN}{algisinv}{GEN al, GEN x, GEN *ix = NULL}.
+\subsec{algisramified$(\var{al},\{\var{pl}\})$}\kbdsidx{algisramified}\label{se:algisramified}
+Given a central simple algebra \var{al} output by \tet{alginit}, test
+whether \var{al} is ramified, i.e. not isomorphic to a matrix algebra over its
+center. If \var{pl} is set, it should be a prime ideal of~$K$ or an integer
+between~$1$ and~$r_1+r_2$, and in that case test whether \var{al} is locally
+ramified at the place \var{pl} instead.
+
+\bprog
+? nf = nfinit(y^2-5);
+? A = alginit(nf, [-1,y]);
+? algisramified(A, 1)
+%3 = 1
+? algisramified(A, 2)
+%4 = 0
+? algisramified(A, idealprimedec(nf,2)[1])
+%5 = 1
+? algisramified(A, idealprimedec(nf,5)[1])
+%6 = 0
+? algisramified(A)
+%7 = 1
+ at eprog
+
+The library syntax is \fun{GEN}{algisramified}{GEN al, GEN pl = NULL}.
+
\subsec{algissemisimple$(\var{al})$}\kbdsidx{algissemisimple}\label{se:algissemisimple}
\var{al} being a table algebra output by \tet{algtableinit} or a central
simple algebra output by \tet{alginit}, tests whether the algebra \var{al} is
@@ -11891,6 +12130,30 @@ without testing it.
The library syntax is \fun{GEN}{algissimple}{GEN al, long ss }.
+\subsec{algissplit$(\var{al},\{\var{pl}\})$}\kbdsidx{algissplit}\label{se:algissplit}
+Given a central simple algebra \var{al} output by \tet{alginit}, test
+whether \var{al} is split, i.e. isomorphic to a matrix algebra over its center.
+If \var{pl} is set, it should be a prime ideal of~$K$ or an integer between~$1$
+and~$r_1+r_2$, and in that case test whether \var{al} is locally split at the
+place \var{pl} instead.
+
+\bprog
+? nf = nfinit(y^2-5);
+? A = alginit(nf, [-1,y]);
+? algissplit(A, 1)
+%3 = 0
+? algissplit(A, 2)
+%4 = 1
+? algissplit(A, idealprimedec(nf,2)[1])
+%5 = 0
+? algissplit(A, idealprimedec(nf,5)[1])
+%6 = 1
+? algissplit(A)
+%7 = 0
+ at eprog
+
+The library syntax is \fun{GEN}{algissplit}{GEN al, GEN pl = NULL}.
+
\subsec{algmul$(\var{al},x,y)$}\kbdsidx{algmul}\label{se:algmul}
Given two elements $x$ and $y$ in \var{al}, computes their product $x*y$
in the algebra~\var{al}.
@@ -12081,6 +12344,21 @@ by $I_2$, $a = \kbd{[0,1;0,0]}$ and $b = \kbd{[0,0;0,1]}$, such that $a^2 =
The library syntax is \fun{GEN}{algradical}{GEN al}.
+\subsec{algramifiedplaces$(\var{al})$}\kbdsidx{algramifiedplaces}\label{se:algramifiedplaces}
+Given a central simple algebra \var{al} output by \tet{alginit}, return a
+\typ{VEC} containing the list of places of the center of \var{al} that are
+ramified in \var{al}. Each place is described as an integer between~$1$
+and~$r_1$ or as a prime ideal.
+
+\bprog
+? nf = nfinit(y^2-5);
+? A = alginit(nf, [-1,y]);
+? algramifiedplaces(A)
+%3 = [1, [2, [2, 0]~, 1, 2, 1]]
+ at eprog
+
+The library syntax is \fun{GEN}{algramifiedplaces}{GEN al}.
+
\subsec{algrandom$(\var{al},b)$}\kbdsidx{algrandom}\label{se:algrandom}
Given an algebra \var{al} and an integer \var{b}, returns a random
element in \var{al} with coefficients in~$[-b,b]$.
@@ -13045,9 +13323,16 @@ The library syntax is \fun{GEN}{polchebyshev1}{long n, long v = -1}, where \kbd{
\subsec{polzagier$(n,m)$}\kbdsidx{polzagier}\label{se:polzagier}
Creates Zagier's polynomial $P_n^{(m)}$ used in
-the functions \kbd{sumalt} and \kbd{sumpos} (with $\fl=1$). One must have $m\le
-n$. The exact definition can be found in ``Convergence acceleration of
-alternating series'', Cohen et al., Experiment.~Math., vol.~9, 2000, pp.~3--12.
+the functions \kbd{sumalt} and \kbd{sumpos} (with $\fl=1$), see
+``Convergence acceleration of alternating series'', Cohen et al.,
+\emph{Experiment.~Math.}, vol.~9, 2000, pp.~3--12.
+
+If $m < 0$ or $m \ge n$, $P_n^{(m)} = 0$.
+We have
+$P_n := P_n^{(0)}$ is $T_n(2x-1)$, where $T_n$ is the Legendre polynomial of
+the second kind. For $n > m > 0$, $P_n^{(m)}$ is the $m$-th difference with
+step $2$ of the sequence $n^{m+1}P_n$; in this case, it satisfies
+$$2 P_n^{(m)}(sin^2 t) = \dfrac{d^{m+1}}{dt^{m+1}}(\sin(2t)^m \sin(2(n-m)t)).$$
%@article {MR2001m:11222,
% AUTHOR = {Cohen, Henri and Rodriguez Villegas, Fernando and Zagier, Don},
@@ -13602,69 +13887,6 @@ $\fl=0$), \fun{GEN}{lindep2}{GEN v, long flag} (real/complex entries)
Finally \fun{GEN}{deplin}{GEN v} returns a non-zero kernel vector for a
\typ{MAT} input.
-\subsec{listcreate$()$}\kbdsidx{listcreate}\label{se:listcreate}
-Creates an empty list. This routine used to have a mandatory argument,
-which is now ignored (for backward compatibility). In fact, this function
-has become redundant and obsolete; it will disappear in future versions of
-PARI: just use \kbd{List()}
-% \syn{NO}
-
-\subsec{listinsert$(L,x,n)$}\kbdsidx{listinsert}\label{se:listinsert}
-Inserts the object $x$ at
-position $n$ in $L$ (which must be of type \typ{LIST}). This has
-complexity $O(\#L - n + 1)$: all the
-remaining elements of \var{list} (from position $n+1$ onwards) are shifted
-to the right.
-
-The library syntax is \fun{GEN}{listinsert}{GEN L, GEN x, long n}.
-
-\subsec{listkill$(L)$}\kbdsidx{listkill}\label{se:listkill}
-Obsolete, retained for backward compatibility. Just use \kbd{L = List()}
-instead of \kbd{listkill(L)}. In most cases, you won't even need that, e.g.
-local variables are automatically cleared when a user function returns.
-
-The library syntax is \fun{void}{listkill}{GEN L}.
-
-\subsec{listpop$(\var{list},\{n\})$}\kbdsidx{listpop}\label{se:listpop}
-Removes the $n$-th element of the list
-\var{list} (which must be of type \typ{LIST}). If $n$ is omitted,
-or greater than the list current length, removes the last element.
-If the list is already empty, do nothing. This runs in time $O(\#L - n + 1)$.
-
-The library syntax is \fun{void}{listpop}{GEN list, long n}.
-
-\subsec{listput$(\var{list},x,\{n\})$}\kbdsidx{listput}\label{se:listput}
-Sets the $n$-th element of the list
-\var{list} (which must be of type \typ{LIST}) equal to $x$. If $n$ is omitted,
-or greater than the list length, appends $x$.
-You may put an element into an occupied cell (not changing the
-list length), but it is easier to use the standard \kbd{list[n] = x}
-construct. This runs in time $O(\#L)$ in the worst case (when the list must
-be reallocated), but in time $O(1)$ on average: any number of successive
-\kbd{listput}s run in time $O(\#L)$, where $\#L$ denotes the list
-\emph{final} length.
-
-The library syntax is \fun{GEN}{listput}{GEN list, GEN x, long n}.
-
-\subsec{listsort$(L,\{\fl=0\})$}\kbdsidx{listsort}\label{se:listsort}
-Sorts the \typ{LIST} \var{list} in place, with respect to the (somewhat
-arbitrary) universal comparison function \tet{cmp}. In particular, the
-ordering is the same as for sets and \tet{setsearch} can be used on a sorted
-list.
-\bprog
-? L = List([1,2,4,1,3,-1]); listsort(L); L
-%1 = List([-1, 1, 1, 2, 3, 4])
-? setsearch(L, 4)
-%2 = 6
-? setsearch(L, -2)
-%3 = 0
- at eprog\noindent This is faster than the \kbd{vecsort} command since the list
-is sorted in place: no copy is made. No value returned.
-
-If $\fl$ is non-zero, suppresses all repeated coefficients.
-
-The library syntax is \fun{void}{listsort}{GEN L, long flag}.
-
\subsec{matadjoint$(M,\{\fl=0\})$}\kbdsidx{matadjoint}\label{se:matadjoint}
\idx{adjoint matrix} of $M$, i.e.~a matrix $N$
of cofactors of $M$, satisfying $M*N=\det(M)*\Id$. $M$ must be a
@@ -15285,6 +15507,70 @@ $\text{abs}(x)$.
See also the discrete summation methods below, sharing the prefix \kbd{sum}.
+\subsec{asympnum$(\var{expr},\{k={20}\},\{\var{alpha} = 1\})$}\kbdsidx{asympnum}\label{se:asympnum}
+Asymptotic expansion of \var{expr}, corresponding to a sequence $u(n)$,
+assuming it has the shape
+$$u(n) \approx \sum_{i \geq 0} a_i n^{-i\alpha}$$
+with rational coefficients $a_i$ with reasonable height; the algorithm
+is heuristic and performs repeated calls to limitnum, with
+\kbd{k} and \kbd{alpha} are as in \kbd{limitnum}
+\bprog
+? f(n) = n! / (n^n*exp(-n)*sqrt(n));
+? asympnum(f)
+%2 = [] \\ failure !
+? l = limitnum(f)
+%3 = 2.5066282746310005024157652848110452530
+? asympnum(n->f(n)/l) \\ normalize
+%4 = [1, 1/12, 1/288, -139/51840]
+ at eprog\noindent and we indeed get a few terms of Stirling's expansion. Note
+that it helps to normalize with a limit computed to higher accuracy:
+\bprog
+? \p100
+? L = limitnum(f)
+? \p38
+? asympnum(n->f(n)/L) \\ we get more terms!
+%6 = [1, 1/12, 1/288, -139/51840, -571/2488320, 163879/209018880,\
+ 5246819/75246796800, -534703531/902961561600]
+ at eprog\noindent If \kbd{alpha} is not an integer, loss of accuracy is
+expected, so it should be precomputed to double accuracy, say:
+\bprog
+? \p38
+? asympnum(n->-log(1-1/n^Pi),,Pi)
+%1 = [0, 1, 1/2, 1/3]
+? asympnum(n->-log(1-1/sqrt(n)),,1/2)
+%2 = [0, 1, 1/2, 1/3, 1/4, 1/5, 1/6, 1/7, 1/8, 1/9, 1/10, 1/11, 1/12, \
+ 1/13, 1/14, 1/15, 1/16, 1/17, 1/18, 1/19, 1/20, 1/21, 1/22]
+
+? localprec(100); a = Pi;
+? asympnum(n->-log(1-1/n^a),,a) \\ better !
+%4 = [0, 1, 1/2, 1/3, 1/4, 1/5, 1/6, 1/7, 1/8, 1/9, 1/10, 1/11, 1/12]
+ at eprog
+
+\synt{asympnum}{void *E, GEN (*u)(void *,GEN,long), long muli, GEN alpha, long prec}, where \kbd{u(E, n, prec)} must return $u(n)$ in precision \kbd{prec}.
+Also available is
+\fun{GEN}{asympnum0}{GEN u, long muli, GEN alpha, long prec}, where $u$
+must be a vector of sufficient length as above.
+
+\subsec{contfraceval$(\var{CF},t,\{\var{lim}=-1\})$}\kbdsidx{contfraceval}\label{se:contfraceval}
+Given a continued fraction \kbd{CF} output by \kbd{contfracinit}, evaluate
+the first \kbd{lim} terms of the continued fraction at \kbd{t} (all
+terms if \kbd{lim} is negative or omitted; if positive, \kbd{lim} must be
+less than or equal to the length of \kbd{CF}.
+
+The library syntax is \fun{GEN}{contfraceval}{GEN CF, GEN t, long lim}.
+
+\subsec{contfracinit$(M,\{\var{lim} = -1\})$}\kbdsidx{contfracinit}\label{se:contfracinit}
+Given $M$ representing the power series $S=\sum_{n\ge0} M[n+1]z^n$,
+transform it into a continued fraction; restrict to $n\leq \kbd{lim}$
+if latter is non-negative. $M$ can be a vector, a power
+series, a polynomial, or a rational function.
+The result is a 2-component vector $[A,B]$ such that
+$S = M[1] / (1+A[1]z+B[1]z^2/(1+A[2]z+B[2]z^2/(1+...1/(1+A[lim/2]z))))$.
+Does not work if any coefficient of $M$ vanishes, nor for series for
+which certain partial denominators vanish.
+
+The library syntax is \fun{GEN}{contfracinit}{GEN M, long lim }.
+
\subsec{derivnum$(X=a,\var{expr})$}\kbdsidx{derivnum}\label{se:derivnum}
Numerical derivation of \var{expr} with respect to $X$ at $X=a$.
@@ -15309,190 +15595,129 @@ Numerical
integration of $(2i\pi)^{-1}\var{expr}$ with respect to $X$ on the circle
$|X-a| = R$.
In other words, when \var{expr} is a meromorphic
-function, sum of the residues in the corresponding disk. \var{tab} is as in
+function, sum of the residues in the corresponding disk; \var{tab} is as in
\kbd{intnum}, except that if computed with \kbd{intnuminit} it should be with
the endpoints \kbd{[-1, 1]}.
\bprog
? \p105
? intcirc(s=1, 0.5, zeta(s)) - 1
-%1 = -2.398082982 E-104 - 7.94487211 E-107*I
+time = 496 ms.
+%1 = 1.2883911040127271720 E-101 + 0.E-118*I
@eprog
\synt{intcirc}{void *E, GEN (*eval)(void*,GEN), GEN a,GEN R,GEN tab, long prec}.
-\subsec{intfouriercos$(X=a,b,z,\var{expr},\{\var{tab}\})$}\kbdsidx{intfouriercos}\label{se:intfouriercos}
-Numerical
-integration of $\var{expr}(X)\cos(2\pi zX)$ from $a$ to $b$, in other words
-Fourier cosine transform (from $a$ to $b$) of the function represented by
-\var{expr}. Endpoints $a$ and $b$ are coded as in \kbd{intnum}, and are not
-necessarily at infinity, but if they are, oscillations (i.e. $[[\pm1],\alpha
-I]$) are forbidden.
-
-\synt{intfouriercos}{void *E, GEN (*eval)(void*,GEN), GEN a, GEN b, GEN z, GEN tab, long prec}.
-
-\subsec{intfourierexp$(X=a,b,z,\var{expr},\{\var{tab}\})$}\kbdsidx{intfourierexp}\label{se:intfourierexp}
-Numerical
-integration of $\var{expr}(X)\exp(-2i\pi zX)$ from $a$ to $b$, in other words
-Fourier transform (from $a$ to $b$) of the function represented by
-\var{expr}. Note the minus sign. Endpoints $a$ and $b$ are coded as in
-\kbd{intnum}, and are not necessarily at infinity but if they are,
-oscillations (i.e. $[[\pm1],\alpha I]$) are forbidden.
-
-\synt{intfourierexp}{void *E, GEN (*eval)(void*,GEN), GEN a, GEN b, GEN z, GEN tab, long prec}.
-
-\subsec{intfouriersin$(X=a,b,z,\var{expr},\{\var{tab}\})$}\kbdsidx{intfouriersin}\label{se:intfouriersin}
-Numerical
-integration of $\var{expr}(X)\sin(2\pi zX)$ from $a$ to $b$, in other words
-Fourier sine transform (from $a$ to $b$) of the function represented by
-\var{expr}. Endpoints $a$ and $b$ are coded as in \kbd{intnum}, and are not
-necessarily at infinity but if they are, oscillations (i.e. $[[\pm1],\alpha
-I]$) are forbidden.
-
-\synt{intfouriersin}{void *E, GEN (*eval)(void*,GEN), GEN a, GEN b, GEN z, GEN tab, long prec}.
-
-\subsec{intfuncinit$(X=a,b,\var{expr},\{\fl=0\},\{m=0\})$}\kbdsidx{intfuncinit}\label{se:intfuncinit}
-Initialize tables for use with integral transforms such as \kbd{intmellininv},
-etc., where $a$ and $b$ are coded as in \kbd{intnum}, $\var{expr}$ is the
-function $s(X)$ to which the integral transform is to be applied (which will
-multiply the weights of integration) and $m$ is as in \kbd{intnuminit}. If
-$\fl$ is nonzero, assumes that $s(-X)=\overline{s(X)}$, which makes the
-computation twice as fast. See \kbd{intmellininvshort} for examples of the
-use of this function, which is particularly useful when the function $s(X)$
-is lengthy to compute, such as a gamma product.
-
-\synt{intfuncinit}{void *E, GEN (*eval)(void*,GEN), GEN a,GEN b,long m, long flag, long prec}. Note that the order of $m$ and $\fl$ are reversed compared
-to the \kbd{GP} syntax.
-
-\subsec{intlaplaceinv$(X=\var{sig},z,\var{expr},\{\var{tab}\})$}\kbdsidx{intlaplaceinv}\label{se:intlaplaceinv}
-Numerical integration of $(2i\pi)^{-1}\var{expr}(X)e^{Xz}$ with respect
-to $X$ on the line $\Re(X)=sig$. In other words, inverse Laplace transform
-of the function corresponding to \var{expr} at the value $z$.
-
-$sig$ is coded as follows. Either it is a real number $\sigma$, equal to the
-abscissa of integration, and then the integrand is assumed to
-be slowly decreasing when the imaginary part of the variable tends to
-$\pm\infty$. Or it is a two component vector $[\sigma,\alpha]$, where
-$\sigma$ is as before, and either $\alpha=0$ for slowly decreasing functions,
-or $\alpha>0$ for functions decreasing like $\exp(-\alpha t)$. Note that it
-is not necessary to choose the exact value of $\alpha$. \var{tab} is as in
-\kbd{intnum}.
-
-It is often a good idea to use this function with a value of $m$ one or two
-higher than the one chosen by default (which can be viewed thanks to the
-function \kbd{intnumstep}), or to increase the abscissa of integration
-$\sigma$. For example:
-
-\bprog
-? \p 105
-? intlaplaceinv(x=2, 1, 1/x) - 1
-time = 350 ms.
-%1 = 7.37... E-55 + 1.72... E-54*I \\@com not so good
-? m = intnumstep()
-%2 = 7
-? intlaplaceinv(x=2, 1, 1/x, m+1) - 1
-time = 700 ms.
-%3 = 3.95... E-97 + 4.76... E-98*I \\@com better
-? intlaplaceinv(x=2, 1, 1/x, m+2) - 1
-time = 1400 ms.
-%4 = 0.E-105 + 0.E-106*I \\@com perfect but slow.
-? intlaplaceinv(x=5, 1, 1/x) - 1
-time = 340 ms.
-%5 = -5.98... E-85 + 8.08... E-85*I \\@com better than \%1
-? intlaplaceinv(x=5, 1, 1/x, m+1) - 1
-time = 680 ms.
-%6 = -1.09... E-106 + 0.E-104*I \\@com perfect, fast.
-? intlaplaceinv(x=10, 1, 1/x) - 1
-time = 340 ms.
-%7 = -4.36... E-106 + 0.E-102*I \\@com perfect, fastest, but why $sig=10$?
-? intlaplaceinv(x=100, 1, 1/x) - 1
-time = 330 ms.
-%7 = 1.07... E-72 + 3.2... E-72*I \\@com too far now...
- at eprog
-
-\synt{intlaplaceinv}{void *E, GEN (*eval)(void*,GEN), GEN sig,GEN z, GEN tab, long prec}.
-
-\subsec{intmellininv$(X=\var{sig},z,\var{expr},\{\var{tab}\})$}\kbdsidx{intmellininv}\label{se:intmellininv}
-Numerical
-integration of $(2i\pi)^{-1}\var{expr}(X)z^{-X}$ with respect to $X$ on the
-line $\Re(X)=sig$, in other words, inverse Mellin transform of
-the function corresponding to \var{expr} at the value $z$.
-
-$sig$ is coded as follows. Either it is a real number $\sigma$, equal to the
-abscissa of integration, and then the integrated is assumed to decrease
-exponentially fast, of the order of $\exp(-t)$ when the imaginary part of the
-variable tends to $\pm\infty$. Or it is a two component vector
-$[\sigma,\alpha]$, where $\sigma$ is as before, and either $\alpha=0$ for
-slowly decreasing functions, or $\alpha>0$ for functions decreasing like
-$\exp(-\alpha t)$, such as gamma products. Note that it is not necessary to
-choose the exact value of $\alpha$, and that $\alpha=1$ (equivalent to $sig$
-alone) is usually sufficient. \var{tab} is as in \kbd{intnum}.
-
-As all similar functions, this function is provided for the convenience of
-the user, who could use \kbd{intnum} directly. However it is in general
-better to use \kbd{intmellininvshort}.
-
-\bprog
-? \p 105
-? intmellininv(s=2,4, gamma(s)^3);
-time = 1,190 ms. \\@com reasonable.
-? \p 308
-? intmellininv(s=2,4, gamma(s)^3);
-time = 51,300 ms. \\@com slow because of $\Gamma(s)^3$.
- at eprog\noindent
-
-\synt{intmellininv}{void *E, GEN (*eval)(void*,GEN), GEN sig, GEN z, GEN tab, long prec}.
-
-\subsec{intmellininvshort$(\var{sig},z,\var{tab})$}\kbdsidx{intmellininvshort}\label{se:intmellininvshort}
-Numerical integration
-of $(2i\pi)^{-1}s(X)z^{-X}$ with respect to $X$ on the line $\Re(X)=sig$.
-In other words, inverse Mellin transform of $s(X)$ at the value $z$.
-Here $s(X)$ is implicitly contained in \var{tab} in \kbd{intfuncinit} format,
-typically
-\bprog
-tab = intfuncinit(T = [-1], [1], s(sig + I*T))
- at eprog\noindent
-or similar commands. Take the example of the inverse Mellin transform of
-$\Gamma(s)^3$ given in \kbd{intmellininv}:
-
-\bprog
-? \p 105
-? A = intmellininv(s=2,4, gamma(s)^3);
-time = 2,500 ms. \\@com not too fast because of $\Gamma(s)^3$.
-\\ @com function of real type, decreasing as $\exp(-3\pi/2\cdot |t|)$
-? tab = intfuncinit(t=[-oo, 3*Pi/2],[oo, 3*Pi/2], gamma(2+I*t)^3, 1);
-time = 1,370 ms.
-? intmellininvshort(2,4, tab) - A
-time = 50 ms.
-%4 = -1.26... - 3.25...E-109*I \\@com 50 times faster than \kbd{A} and perfect.
-? tab2 = intfuncinit(t=-oo, oo, gamma(2+I*t)^3, 1);
-? intmellininvshort(2,4, tab2)
-%6 = -1.2...E-42 - 3.2...E-109*I \\@com 63 digits lost
+\subsec{intfuncinit$(t=a,b,f,\{m=0\})$}\kbdsidx{intfuncinit}\label{se:intfuncinit}
+Initialize tables for use with integral transforms such Fourier,
+Laplace or Mellin transforms, in order to compute
+$$ \int_a^b f(t) k(t,z) \, dt $$
+for some kernel $k(t,z)$.
+The endpoints $a$ and $b$ are coded as in \kbd{intnum}, $f$ is the
+function to which the integral transform is to be applied and the
+non-negative integer $m$ is as in \kbd{intnum}: multiply the number of
+sampling points roughly by $2^m$, hopefully increasing the accuracy. This
+function is particularly useful when the function $f$ is hard to compute,
+such as a gamma product.
+
+\misctitle{Limitation} the endpoints $a$ and $b$ must be at infinity,
+with the same asymptotic behaviour. Oscillating types are not supported.
+This is easily overcome by integrating vectors of functions, see example
+below.
+
+\misctitle{Examples}
+
+\item numerical Fourier transform
+$$F(z) = \int_{-\infty}^{+\infty} f(t)e^{-2i\pi z t}\, dt. $$
+First the easy case, assume that $f$ decrease exponentially:
+\bprog
+ f(t) = exp(-t^2);
+ A = [-oo,1];
+ B = [+oo,1];
+ \p200
+ T = intfuncinit(t = A,B , f(t));
+ F(z) =
+ { my(a = -2*I*Pi*z);
+ intnum(t = A,B, exp(a*t), T);
+ }
+ ? F(1) - sqrt(Pi)*exp(-Pi^2)
+ %1 = -1.3... E-212
@eprog\noindent
-In the computation of \var{tab}, it was not essential to include the
-\emph{exact} exponential decrease of $\Gamma(2+it)^3$. But as the last
-example shows, a rough indication \emph{must} be given, otherwise slow
-decrease is assumed, resulting in catastrophic loss of accuracy.
-
-The library syntax is \fun{GEN}{intmellininvshort}{GEN sig, GEN z, GEN tab, long prec}.
+Now the harder case, $f$ decrease slowly: we must specify the oscillating
+behaviour. Thus, we cannot precompute usefully since everything depends on
+the point we evaluate at:
+\bprog
+ f(t) = 1 / (1+ abs(t));
+ \p200
+ \\ Fourier cosine transform
+ FC(z) =
+ { my(a = 2*Pi*z);
+ intnum(t = [-oo, a*I], [+oo, a*I], cos(a*t)*f(t));
+ }
+ FC(1)
+ at eprog
+\item Fourier coefficients: we must integrate over a period, but
+\kbd{intfuncinit} does not support finite endpoints.
+The solution is to integrate a vector of functions !
+\bprog
+FourierSin(f, T, k) = \\ first k sine Fourier coeffs
+{
+ my (w = 2*Pi/T);
+ my (v = vector(k+1));
+ intnum(t = -T/2, T/2,
+ my (z = exp(I*w*t));
+ v[1] = z;
+ for (j = 2, k, v[j] = v[j-1]*z);
+ f(t) * imag(v)) * 2/T;
+}
+FourierSin(t->sin(2*t), 2*Pi, 10)
+ at eprog\noindent The same technique can be used instead of \kbd{intfuncinit}
+to integrate $f(t) k(t,z)$ whenever the list of $z$-values is known
+beforehand.
+
+Note that the above code includes an unrelated optimization: the
+$\sin(j w t)$ are computed as imaginary parts of $\exp(i j w t)$ and the
+latter by successive multiplications.
+
+\item numerical Mellin inversion
+$$F(z) = (2i\pi)^{-1} \int_{c -i\infty}^{c+i\infty} f(s)z^{-s}\, ds
+ = (2\pi)^{-1} \int_{-\infty}^{+\infty}
+ f(c + i t)e^{-\log z(c + it)}\, dt. $$
+We take $c = 2$ in the program below:
+\bprog
+ f(s) = gamma(s)^3; \\ f(c+it) decrease as exp(-3Pi|t|/2)
+ c = 2; \\ arbitrary
+ A = [-oo,3*Pi/2];
+ B = [+oo,3*Pi/2];
+ T = intfuncinit(t=A,B, f(c + I*t));
+ F(z) =
+ { my (a = -log(z));
+ intnum(t=A,B, exp(a*I*t), T)*exp(a*c) / (2*Pi);
+ }
+ at eprog
+
+\synt{intfuncinit}{void *E, GEN (*eval)(void*,GEN), GEN a,GEN b,long m, long prec}.
\subsec{intnum$(X=a,b,\var{expr},\{\var{tab}\})$}\kbdsidx{intnum}\label{se:intnum}
Numerical integration
-of \var{expr} on $]a,b[$ with respect to $X$. The integrand may have values
+of \var{expr} on $]a,b[$ with respect to $X$, using the
+double-exponential method, and thus $O(D\log D)$ evaluation of
+the integrand in precision $D$. The integrand may have values
belonging to a vector space over the real numbers; in particular, it can be
-complex-valued or vector-valued. But it is assumed that the function is regular
-on $]a,b[$. If the endpoints $a$ and $b$ are finite and the function is regular
-there, the situation is simple:
+complex-valued or vector-valued. But it is assumed that the function is
+regular on $]a,b[$. If the endpoints $a$ and $b$ are finite and the
+function is regular there, the situation is simple:
\bprog
? intnum(x = 0,1, x^2)
%1 = 0.3333333333333333333333333333
? intnum(x = 0,Pi/2, [cos(x), sin(x)])
%2 = [1.000000000000000000000000000, 1.000000000000000000000000000]
@eprog\noindent
-An endpoint equal to $\pm\infty$ is coded as \kbd{+oo} or \kbd{-oo}.
+An endpoint equal to $\pm\infty$ is coded as \kbd{+oo} or \kbd{-oo}, as
+expected:
\bprog
? intnum(x = 1,+oo, 1/x^2)
-%2 = 1.000000000000000000000000000
+%3 = 1.000000000000000000000000000
@eprog\noindent
In basic usage, it is assumed that the function does not decrease
exponentially fast at infinity:
@@ -15500,26 +15725,28 @@ exponentially fast at infinity:
? intnum(x=0,+oo, exp(-x))
*** at top-level: intnum(x=0,+oo,exp(-
*** ^--------------------
- *** exp: exponent (expo) overflow
+ *** exp: overflow in expo().
@eprog\noindent
-We shall see in a moment how to avoid the last problem, after describing
-the last argument \var{tab}, which is both optional and technical. The
-routine uses weights, which are mostly independent of the function being
-integrated, evaluated at many sampling points. If \var{tab} is
-
-\item a positive integer $m$, we use $2^m$ sampling points, hopefully
-increasing accuracy. But note that the running time is roughly proportional
-to $2^m$. One may try consecutive values of $m$ until they give the same
-value up to an accepted error. If \var{tab} is omitted, the algorithm guesses
-a reasonable value for $m$ depending on the current precision only, which
-should be sufficient for regular functions. That value may be obtained from
-\tet{intnumstep}, and increased in case of difficulties.
-
-\item a set of integration tables as output by \tet{intnuminit},
-they are used directly. This is useful if several integrations of the same
-type are performed (on the same kind of interval and functions, for a given
-accuracy), in particular for multivariate integrals, since we then skip
-expensive precomputations.
+We shall see in a moment how to avoid that last problem, after describing
+the last \emph{optional} argument \var{tab}.
+
+\misctitle{The \var{tab} argument}
+The routine uses weights $w_i$, which are mostly independent of the function
+being integrated, evaluated at many sampling points $x_i$ and
+approximates the integral by $\sum w_i f(x_i)$. If \var{tab} is
+
+\item a positive integer $m$, we multiply the number of sampling points
+by $2^m$, hopefully increasing accuracy. Note that the running time
+increases roughly by a factor $2^m$. One may try consecutive values of $m$
+until they give the same value up to an accepted error.
+
+\item a set of integration tables containing precomputed $x_i$ and $w_i$
+as output by \tet{intnuminit}. This is useful if several integrations of
+the same type are performed (on the same kind of interval and functions,
+for a given accuracy): we skip a precomputation of $O(D\log D)$
+elementary functions in accuracy $D$, whose running time has the same order
+of magnitude as the evaluation of the integrand. This is in particular
+usefule for multivariate integrals.
\misctitle{Specifying the behavior at endpoints}
This is done as follows. An endpoint $a$ is either given as such (a scalar,
@@ -15534,19 +15761,19 @@ If a wrong singularity exponent is used, the result will lose a catastrophic
number of decimals:
\bprog
? intnum(x=0, 1, x^(-1/2)) \\@com assume $x^{-1/2}$ is regular at 0
-%1 = 1.999999999999999999990291881
+%1 = 1.9999999999999999999999999999827931660
? intnum(x=[0,-1/2], 1, x^(-1/2)) \\@com no, it's not
-%2 = 2.000000000000000000000000000
-? intnum(x=[0,-1/10], 1, x^(-1/2))
-%3 = 1.999999999999999999999946438 \\@com using a wrong exponent is bad
+%2 = 2.0000000000000000000000000000000000000
+? intnum(x=[0,-1/10], 1, x^(-1/2)) \\@com using a wrong exponent is bad
+%3 = 1.9999999999999999999999999999999901912
@eprog
If $a$ is $\pm\infty$, which is coded as \kbd{+oo} or \kbd{-oo},
the situation is more complicated, and $[\pm\kbd{oo},\alpha]$ means:
\item $\alpha=0$ (or no $\alpha$ at all, i.e. simply $\pm\kbd{oo}$)
-assumes that the integrand tends to zero, but not exponentially fast, and
-not oscillating such as $\sin(x)/x$.
+assumes that the integrand tends to zero moderately quickly, at least as
+$O(x^{-2})$ but not exponentially fast.
\item $\alpha>0$ assumes that the function tends to zero exponentially fast
approximately as $\exp(-\alpha x)$. This includes oscillating but quickly
@@ -15556,18 +15783,28 @@ decreasing functions such as $\exp(-x)\sin(x)$.
*** at top-level: intnum(x=0,+oo,exp(-
*** ^--------------------
*** exp: exponent (expo) overflow
-? intnum(x=0, [+oo, 2], exp(-2*x))
-%1 = 0.5000000000000000000000000000 \\@com OK!
-? intnum(x=0, [+oo, 4], exp(-2*x))
-%2 = 0.4999999999999999999961990984 \\@com wrong exponent $\Rightarrow$ imprecise result
-? intnum(x=0, [+oo, 20], exp(-2*x))
-%2 = 0.4999524997739071283804510227 \\@com disaster
- at eprog
+? intnum(x=0, [+oo, 2], exp(-2*x)) \\@com OK!
+%1 = 0.50000000000000000000000000000000000000
+? intnum(x=0, [+oo, 3], exp(-2*x)) \\@com imprecise exponent, still OK !
+%2 = 0.50000000000000000000000000000000000000
+? intnum(x=0, [+oo, 10], exp(-2*x)) \\@com wrong exponent $\Rightarrow$ disaster
+%3 = 0.49999999999952372962457451698256707393
+ at eprog\noindent As the last exemple shows, the exponential decrease rate
+\emph{must} be indicated to avoid overflow, but the method is robust enough
+for a rough guess to be acceptable.
\item $\alpha<-1$ assumes that the function tends to $0$ slowly, like
-$x^{\alpha}$. Here it is essential to give the correct $\alpha$, if possible,
-but on the other hand $\alpha\le -2$ is equivalent to $\alpha=0$, in other
-words to no $\alpha$ at all.
+$x^{\alpha}$. Here the algorithm is less robust and it is essential to give a
+sharp $\alpha$, unless $\alpha \le -2$ in which case we use
+the default algorithm as if $\alpha$ were missing (or equal to $0$).
+\bprog
+? intnum(x=1, +oo, x^(-3/2)) \\ default
+%1 = 1.9999999999999999999999999999646391207
+? intnum(x=1, [+oo,-3/2], x^(-3/2)) \\ precise decrease rate
+%2 = 2.0000000000000000000000000000000000000
+? intnum(x=1, [+oo,-11/10], x^(-3/2)) \\ worse than default
+%3 = 2.0000000000000000000000000089298011973
+ at eprog
\smallskip The last two codes are reserved for oscillating functions.
Let $k > 0$ real, and $g(x)$ a non-oscillating function tending slowly to $0$
@@ -15588,7 +15825,7 @@ $\cos(kx+a)$.
exponentially fast as $\exp(-\alpha x)$, it is up to the user to choose
between $[\pm\kbd{oo},\alpha]$ and $[\pm\kbd{oo},k* I]$, but a good rule of
thumb is that
-if the oscillations are much weaker than the exponential decrease, choose
+if the oscillations are weaker than the exponential decrease, choose
$[\pm\kbd{oo},\alpha]$, otherwise choose $[\pm\kbd{oo},k*I]$, although the
latter can
reasonably be used in all cases, while the former cannot. To take a specific
@@ -15597,97 +15834,99 @@ product of an exponentially decreasing and an oscillating factor. If we
choose the oscillating type of integral we perhaps obtain the best results,
at the expense of having to recompute our functions for a different value of
the variable $z$ giving the transform, preventing us to use a function such
-as \kbd{intmellininvshort}. On the other hand using the exponential type of
+as \kbd{intfuncinit}. On the other hand using the exponential type of
integral, we obtain less accurate results, but we skip expensive
-recomputations. See \kbd{intmellininvshort} and \kbd{intfuncinit} for more
-explanations.
+recomputations. See \kbd{intfuncinit} for more explanations.
\smallskip
We shall now see many examples to get a feeling for what the various
-parameters achieve. All examples below assume precision is set to $105$
+parameters achieve. All examples below assume precision is set to $115$
decimal digits. We first type
\bprog
-? \p 105
+? \p 115
@eprog
-\misctitle{Apparent singularities} Even if the function $f(x)$ represented
-by \var{expr} has no singularities, it may be important to define the
-function differently near special points. For instance, if $f(x) = 1
+\misctitle{Apparent singularities} In many cases, apparent singularities
+can be ignored. For instance, if $f(x) = 1
/(\exp(x)-1) - \exp(-x)/x$, then $\int_0^\infty f(x)\,dx=\gamma$, Euler's
constant \kbd{Euler}. But
\bprog
? f(x) = 1/(exp(x)-1) - exp(-x)/x
? intnum(x = 0, [oo,1], f(x)) - Euler
-%1 = 6.00... E-67
+%1 = 0.E-115
@eprog\noindent
-thus only correct to $67$ decimal digits. This is because close to $0$ the
-function $f$ is computed with an enormous loss of accuracy.
-A better solution is
+But close to $0$ the function $f$ is computed with an enormous loss of
+accuracy, and we are in fact lucky that it get multiplied by weights which are
+sufficiently close to $0$ to hide this:
+\bprog
+? f(1e-200)
+%2 = -3.885337784451458142 E84
+ at eprog
+A more robust solution is to define the function differently near special
+points, e.g. by a Taylor expansion
\bprog
-? f(x) = 1/(exp(x)-1)-exp(-x)/x
-? F = truncate( f(t + O(t^7)) ); \\@com expansion around t = 0
-? g(x) = if (x > 1e-18, f(x), subst(F,t,x)) \\@com note that $6 \cdot 18 > 105$
+? F = truncate( f(t + O(t^10)) ); \\@com expansion around t = 0
+? poldegree(F)
+%4 = 7
+? g(x) = if (x > 1e-18, f(x), subst(F,t,x)); \\@com note that $7 \cdot 18 > 105$
? intnum(x = 0, [oo,1], g(x)) - Euler
-%2 = 0.E-106 \\@com perfect
- at eprog\noindent
-It is up to the user to determine constants such as the $10^{-18}$ and $7$
-used above.
+%2 = 0.E-115
+ at eprog\noindent It is up to the user to determine constants such as the
+$10^{-18}$ and $10$ used above.
\misctitle{True singularities} With true singularities the result is worse.
For instance
\bprog
-? intnum(x = 0, 1, 1/sqrt(x)) - 2
-%1 = -1.92... E-59 \\@com only $59$ correct decimals
+? intnum(x = 0, 1, x^(-1/2)) - 2
+%1 = -3.5... E-68 \\@com only $68$ correct decimals
-? intnum(x = [0,-1/2], 1, 1/sqrt(x)) - 2
-%2 = 0.E-105 \\@com better
+? intnum(x = [0,-1/2], 1, x^(-1/2)) - 2
+%2 = 0.E-114 \\@com better
@eprog
\misctitle{Oscillating functions}
\bprog
? intnum(x = 0, oo, sin(x) / x) - Pi/2
-%1 = 20.78.. \\@com nonsense
+%1 = 16.19.. \\@com nonsense
? intnum(x = 0, [oo,1], sin(x)/x) - Pi/2
-%2 = 0.004.. \\@com bad
+%2 = -0.006.. \\@com bad
? intnum(x = 0, [oo,-I], sin(x)/x) - Pi/2
-%3 = 0.E-105 \\@com perfect
+%3 = 0.E-115 \\@com perfect
? intnum(x = 0, [oo,-I], sin(2*x)/x) - Pi/2 \\@com oops, wrong $k$
-%4 = 0.07...
+%4 = 0.06...
? intnum(x = 0, [oo,-2*I], sin(2*x)/x) - Pi/2
-%5 = 0.E-105 \\@com perfect
+%5 = 0.E-115 \\@com perfect
? intnum(x = 0, [oo,-I], sin(x)^3/x) - Pi/4
-%6 = 0.0092... \\@com bad
+%6 = -0.0008... \\@com bad
? sin(x)^3 - (3*sin(x)-sin(3*x))/4
%7 = O(x^17)
@eprog\noindent
We may use the above linearization and compute two oscillating integrals with
-``infinite endpoints'' \kbd{[oo, -I]} and \kbd{[oo, -3*I]} respectively, or
+endpoints \kbd{[oo, -I]} and \kbd{[oo, -3*I]} respectively, or
notice the obvious change of variable, and reduce to the single integral
${1\over 2}\int_0^\infty \sin(x)/x\,dx$. We finish with some more complicated
examples:
\bprog
? intnum(x = 0, [oo,-I], (1-cos(x))/x^2) - Pi/2
-%1 = -0.0004... \\@com bad
+%1 = -0.0003... \\@com bad
? intnum(x = 0, 1, (1-cos(x))/x^2) \
+ intnum(x = 1, oo, 1/x^2) - intnum(x = 1, [oo,I], cos(x)/x^2) - Pi/2
-%2 = -2.18... E-106 \\@com OK
+%2 = 0.E-115 \\@com perfect
? intnum(x = 0, [oo, 1], sin(x)^3*exp(-x)) - 0.3
-%3 = 5.45... E-107 \\@com OK
+%3 = -7.34... E-55 \\@com bad
? intnum(x = 0, [oo,-I], sin(x)^3*exp(-x)) - 0.3
-%4 = -1.33... E-89 \\@com lost 16 decimals. Try higher $m$:
-? m = intnumstep()
-%5 = 7 \\@com the value of $m$ actually used above.
-? tab = intnuminit(0,[oo,-I], m+1); \\@com try $m$ one higher.
+%4 = 8.9... E-103 \\@com better. Try higher $m$
+? tab = intnuminit(0,[oo,-I], 1); \\@com double number of sampling points
? intnum(x = 0, oo, sin(x)^3*exp(-x), tab) - 0.3
-%6 = 5.45... E-107 \\@com OK this time.
+%6 = 0.E-115 \\@com perfect
@eprog
\misctitle{Warning} Like \tet{sumalt}, \kbd{intnum} often assigns a
@@ -15713,79 +15952,137 @@ For example, to compute the double integral on the unit disc $x^2+y^2\le1$
of the function $x^2+y^2$, we can write
\bprog
? tab = intnuminit(-1,1);
-? intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2, tab), tab)
+? intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2, tab),tab) - Pi/2
+%2 = -7.1... E-115 \\@com OK
+
@eprog\noindent
The first \var{tab} is essential, the second optional. Compare:
\bprog
? tab = intnuminit(-1,1);
-time = 30 ms.
+time = 4 ms.
? intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2));
-time = 54,410 ms. \\@com slow
+time = 3,092 ms. \\@com slow
? intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2, tab), tab);
-time = 7,210 ms. \\@com faster
- at eprog\noindent
-However, the \kbd{intnuminit} program is usually pessimistic when it comes to
-choosing the integration step $2^{-m}$. It is often possible to improve the
-speed by trial and error. Continuing the above example:
-\bprog
-? test(M) =
-{
-tab = intnuminit(-1,1, M);
-intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2,tab), tab) - Pi/2
-}
-? m = intnumstep() \\@com what value of $m$ did it take?
-%1 = 7
-? test(m - 1)
-time = 1,790 ms.
-%2 = -2.05... E-104 \\@com $4 = 2^2$ times faster and still OK.
-? test(m - 2)
-time = 430 ms.
-%3 = -1.11... E-104 \\@com $16 = 2^4$ times faster and still OK.
-? test(m - 3)
-time = 120 ms.
-%3 = -7.23... E-60 \\@com $64 = 2^6$ times faster, lost $45$ decimals.
+time = 252 ms. \\@com faster
+? intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2, tab));
+time = 261 ms. \\@com the \emph{internal} integral matters most
@eprog
\synt{intnum}{void *E, GEN (*eval)(void*,GEN), GEN a,GEN b,GEN tab, long prec},
where an omitted \var{tab} is coded as \kbd{NULL}.
+\subsec{intnumgauss$(X=a,b,\var{expr},\{\var{tab}\})$}\kbdsidx{intnumgauss}\label{se:intnumgauss}
+Numerical integration of \var{expr} on the compact interval $[a,b]$ with
+respect to $X$ using Gauss-Legendre quadrature; \kbd{tab} is either omitted
+or precomputed with \kbd{intnumgaussinit}. As a convenience, it can be an
+integer $n$ in which case we call
+\kbd{intnumgaussinit}$(n)$ and use $n$-point quadrature.
+\bprog
+? test(n, b = 1) = T=intnumgaussinit(n);\
+ intnumgauss(x=-b,b, 1/(1+x^2),T) - 2*atan(b);
+? test(0) \\ default
+%1 = -9.490148553624725335 E-22
+? test(40)
+%2 = -6.186629001816965717 E-31
+? test(50)
+%3 = -1.1754943508222875080 E-38
+? test(50, 2) \\ double interval length
+%4 = -4.891779568527713636 E-21
+? test(90, 2) \\ n must almost be doubled as well!
+%5 = -9.403954806578300064 E-38
+ at eprog\noindent On the other hand, we recommend to split the integral
+and change variables rather than increasing $n$ too much:
+\bprog
+? f(x) = 1/(1+x^2);
+? a = 0; b = 100;
+? intnum(x = 0, 1, f(x)) + intnum(x = 1, 1/b, f(1/x)*(-1/x^2)) - atan(100)
+%3 = 0.E-38 \\ perfect with default n
+ at eprog
+
+The library syntax is \fun{GEN}{intnumgauss0}{GEN X, GEN b, GEN expr, GEN tab = NULL, long prec}.
+
+\subsec{intnumgaussinit$(\{n\})$}\kbdsidx{intnumgaussinit}\label{se:intnumgaussinit}
+Initialize tables for $n$-point Gauss-Legendre integration of
+a smooth function $f$ lon a compact
+interval $[a,b]$ at current \kbd{realprecision}. If $n$ is omitted, make a
+default choice $n \approx \kbd{realprecision}$, suitable for analytic
+functions on $[-1,1]$. The error is bounded by
+$$
+ \dfrac{(b-a)^{2n+1} (n!)^4}{(2n+1)[(2n)!]^3} f^{(2n)} (\xi) ,
+ \qquad a < \xi < b
+$$
+so, if the interval length increases, $n$ should be increased as well.
+\bprog
+? T = intnumgaussinit();
+? intnumgauss(t=-1,1,exp(t), T) - exp(1)+exp(-1)
+%1 = -5.877471754111437540 E-39
+? intnumgauss(t=-10,10,exp(t), T) - exp(10)+exp(-10)
+%2 = -8.358367809712546836 E-35
+? intnumgauss(t=-1,1,1/(1+t^2), T) - Pi/2
+%3 = -9.490148553624725335 E-22
+
+? T = intnumgaussinit(50);
+? intnumgauss(t=-1,1,1/(1+t^2), T) - Pi/2
+%5 = -1.1754943508222875080 E-38
+? intnumgauss(t=-5,5,1/(1+t^2), T) - 2*atan(5)
+%6 = -1.2[...]E-8
+ at eprog
+On the other hand, we recommend to split the integral and change variables
+rather than increasing $n$ too much, see \tet{intnumgauss}.
+
+The library syntax is \fun{GEN}{intnumgaussinit}{long n, long prec}.
+
\subsec{intnuminit$(a,b,\{m=0\})$}\kbdsidx{intnuminit}\label{se:intnuminit}
Initialize tables for integration from
$a$ to $b$, where $a$ and $b$ are coded as in \kbd{intnum}. Only the
compactness, the possible existence of singularities, the speed of decrease
or the oscillations at infinity are taken into account, and not the values.
For instance {\tt intnuminit(-1,1)} is equivalent to {\tt intnuminit(0,Pi)},
-and {\tt intnuminit([0,-1/2],[1])} is equivalent to {\tt
-intnuminit([-1],[-1,-1/2])}. If $m$ is not given, it is computed according to
-the current precision. Otherwise the integration step is $1/2^m$. Reasonable
-values of $m$ are $m=6$ or $m=7$ for $100$ decimal digits, and $m=9$ for
-$1000$ decimal digits.
-
-The result is technical, but in some cases it is useful to know the output.
-Let $x=\phi(t)$ be the change of variable which is used. \var{tab}[1] contains
-the integer $m$ as above, either given by the user or computed from the default
-precision, and can be recomputed directly using the function \kbd{intnumstep}.
-\var{tab}[2] and \var{tab}[3] contain respectively the abscissa and weight
-corresponding to $t=0$ ($\phi(0)$ and $\phi'(0)$). \var{tab}[4] and
-\var{tab}[5] contain the abscissas and weights corresponding to positive
-$t=nh$ for $1\le n\le N$ and $h=1/2^m$ ($\phi(nh)$ and $\phi'(nh)$). Finally
-\var{tab}[6] and \var{tab}[7] contain either the abscissas and weights
-corresponding to negative $t=nh$ for $-N\le n\le -1$, or may be empty (but
-not always) if $\phi(t)$ is an odd function (implicitly we would have
-$\var{tab}[6]=-\var{tab}[4]$ and $\var{tab}[7]=\var{tab}[5]$).
+and {\tt intnuminit([0,-1/2],oo)} is equivalent to
+{\tt intnuminit([-1,-1/2], -oo)}; on the other hand, the order matters
+and
+{\tt intnuminit([0,-1/2], [1,-1/3])} is \emph{not} equivalent to
+{\tt intnuminit([0,-1/3], [1,-1/2])} !
-The library syntax is \fun{GEN}{intnuminit}{GEN a, GEN b, long m, long prec}.
+If $m$ is multiply the default number of sampling points by $2^m$ (increasing
+the running time by a similar factor).
-\subsec{intnuminitgen$(t,a,b,\var{ph},\{m=0\},\{\fl=0\})$}\kbdsidx{intnuminitgen}\label{se:intnuminitgen}
-Initialize tables for integrations from $a$ to $b$ using abscissas
-$ph(t)$ and weights $ph'(t)$. Note that there is no equal sign after the
-variable name $t$ since $t$ always goes from $-\infty$ to $+\infty$, but it
-is $ph(t)$ which goes from $a$ to $b$, and this is not checked. If \fl = 1
-or 2, multiply the reserved table length by $4^{\fl}$, to avoid corresponding
-error.
+The result is technical and liable to change in the future, but we document
+it here for completeness. Let $x=\phi(t)$, $t\in ]-\infty,\infty[$ be an
+internally chosen change of variable, achieving double exponential decrease of
+the integrand at infinity. The integrator \kbd{intnum} will compute
+$$ h \sum_{|n| < N} \phi'(nh) F(\phi(nh)) $$
+for some integration step $h$ and truncation parameter $N$.
+In basic use, let
+\bprog
+[h, x0, w0, xp, wp, xm, wm] = intnuminit(a,b);
+ at eprog
+
+\item $h$ is the integration step
+
+\item $x_0 = \phi(0)$ and $w_0 = \phi'(0)$,
+
+\item \var{xp} contains the $\phi(nh)$, $0 < n < N$,
+
+\item \var{xm} contains the $\phi(nh)$, $0 < -n < N$, or is empty.
-\synt{intnuminitgen}{void *E, GEN (*eval)(void*,GEN), GEN a, GEN b, long m, long flag, long prec}
+\item \var{wp} contains the $\phi'(nh)$, $0 < n < N$,
+
+\item \var{wm} contains the $\phi'(nh)$, $0 < -n < N$, or is empty.
+
+The arrays \var{xm} and \var{wm} are left empty when $\phi$ is an odd
+function. In complicated situations when non-default behaviour is specified at
+end points, \kbd{intnuminit} may return up to $3$ such arrays, corresponding
+to a splitting of up to $3$ integrals of basic type.
+
+If the functions to be integrated later are of the form $F = f(t) k(t,z)$
+for some kernel $k$ (e.g. Fourier, Laplace, Mellin, \dots), it is
+useful to also precompute the values of $f(\phi(nh))$, which is accomplished
+by \tet{intfuncinit}. The hard part is to determine the behaviour
+of $F$ at endpoints, depending on $z$.
+
+The library syntax is \fun{GEN}{intnuminit}{GEN a, GEN b, long m, long prec}.
\subsec{intnumromb$(X=a,b,\var{expr},\{\fl=0\})$}\kbdsidx{intnumromb}\label{se:intnumromb}
Numerical integration of \var{expr} (smooth in $]a,b[$), with respect to
@@ -15828,12 +16125,63 @@ where $\kbd{eval}(x, E)$ returns the value of the function at $x$.
You may store any additional information required by \kbd{eval} in $E$, or set
it to \kbd{NULL}.
-\subsec{intnumstep$()$}\kbdsidx{intnumstep}\label{se:intnumstep}
-Give the value of $m$ used in all the
-\kbd{intnum} and \kbd{sumnum} programs, hence such that the integration
-step is equal to $1/2^m$.
-
-The library syntax is \fun{long}{intnumstep}{long prec}.
+\subsec{limitnum$(\var{expr},\{k = {20}\},\{\var{alpha}=1\})$}\kbdsidx{limitnum}\label{se:limitnum}
+Lagrange-Zagier numerical extrapolation of \var{expr}, corresponding to a
+sequence
+$u_n$, either given by a closure \kbd{n->u(n)} or by a vector of values
+I.e., assuming that $u_n$ tends to a finite limit $\ell$, try to determine
+$\ell$. This routine is purely numerical and heuristic, thus may or may not
+work on your examples; $k$ is ignored if $u$ is given by a vector,
+and otherwise is a multiplier such that we extrapolate from $u(kn)$.
+
+Assume that $u_n$ has an asymptotic expansion in $n^{-\alpha}$ :
+$$u_n = \ell + \sum_{i\geq 1} a_i n^{-i\alpha}$$
+for some $a_i$.
+\bprog
+? limitnum(n -> n*sin(1/n))
+%1 = 1.0000000000000000000000000000000000000
+
+? limitnum(n -> (1+1/n)^n) - exp(1)
+%2 = 0.E-37
+
+? limitnum(n -> 2^(4*n+1)*(n!)^4 / (2*n)! /(2*n+1)! )
+%3 = 3.1415926535897932384626433832795028842
+? Pi
+%4 = 3.1415926535897932384626433832795028842
+ at eprog\noindent
+If $u_n$ is given by a vector, it must be long enough for the extrapolation
+to make sense: at least $k$ times the current \kbd{realprecision}. The
+preferred format is thus a closure, although it becomes inconvenient
+when $u_n$ cannot be directly computed in time polynomial in $\log n$,
+for instance if it is defined as a sum or by induction. In that case,
+passing a vector of values is the best option. It usually pays off to
+interpolate $u(kn)$ for some $k > 1$:
+\bprog
+? limitnum(vector(10,n,(1+1/n)^n))
+ *** ^--------------------
+ *** limitnum: non-existent component in limitnum: index < 20
+\\ at this accuracy, we must have at least 20 values
+? limitnum(vector(20,n,(1+1/n)^n)) - exp(1)
+%5 = -2.05... E-20
+? limitnum(vector(20,n, m=10*n;(1+1/m)^m)) - exp(1) \\ better accuracy
+%6 = 0.E-37
+
+? v = vector(20); s = 0;
+? for(i=1,#v, s += 1/i; v[i]= s - log(i));
+? limitnum(v) - Euler
+%9 = -1.6... E-19
+
+? V = vector(200); s = 0;
+? for(i=1,#V, s += 1/i; V[i]= s);
+? v = vector(#V \ 10, i, V[10*i] - log(10*i));
+? limitnum(v) - Euler
+%13 = 6.43... E-29
+ at eprog
+
+\synt{limitnum}{void *E, GEN (*u)(void *,GEN,long), long muli, GEN alpha, long prec}, where \kbd{u(E, n, prec)} must return $u(n)$ in precision \kbd{prec}.
+Also available is
+\fun{GEN}{limitnum0}{GEN u, long muli, GEN alpha, long prec}, where $u$
+must be a vector of sufficient length as above.
\subsec{prod$(X=a,b,\var{expr},\{x=1\})$}\kbdsidx{prod}\label{se:prod}
Product of expression
@@ -15920,19 +16268,37 @@ time = 8 ms.
\subsec{sumalt$(X=a,\var{expr},\{\fl=0\})$}\kbdsidx{sumalt}\label{se:sumalt}
Numerical summation of the series \var{expr}, which should be an
-\idx{alternating series}, the formal variable $X$ starting at $a$. Use an
-algorithm of Cohen, Villegas and Zagier (\emph{Experiment. Math.} {\bf 9}
-(2000), no.~1, 3--12).
-
-If $\fl=1$, use a variant with slightly different polynomials. Sometimes
-faster.
-
-The routine is heuristic and a rigorous proof assumes that the values of
-\var{expr} are the moments of a positive measure on $[0,1]$. Divergent
-alternating series can sometimes be summed by this method, as well as series
-which are not exactly alternating (see for example
-\secref{se:user_defined}). It should be used to try and guess the value of
-an infinite sum. (However, see the example at the end of
+\idx{alternating series} $(-1)^k a_k$, the formal variable $X$ starting at
+$a$. Use an algorithm of Cohen, Villegas and Zagier (\emph{Experiment. Math.}
+{\bf 9} (2000), no.~1, 3--12).
+
+If $\fl=0$, assuming that that the $a_k$ are the moments of a positive
+measure on $[0,1]$, the relative error is $O(3+\sqrt8)^(-n)$ after using
+$a_k$ for $k\leq n$. If \kbd{realprecision} is $p$, we thus set
+$n = \log(10)p/\log(3+\sqrt8)\approx 1.3 p$; besides the time needed to
+compute the $a_k$, $k\leq n$, the algorithm overhead is negligible: time
+$O(p^2)$ and space $O(p)$.
+
+If $\fl=1$, use a variant with more complicated polynomials, see
+\tet{polzagier}. If the $a_k$ are the moments of $w(x)dx$ where $w$
+(or only $xw(x^2)$) is a smooth function extending analytically to the whole
+complex plane, convergence is in $O(14.4^(-n))$. If $xw(x^2)$ extends
+analytically to a smaller region, we still have exponential convergence,
+with worse constants. Usually faster when the computation of $a_k$ is
+expensive. If \kbd{realprecision} is $p$, we thus set
+$n = \log(10)p/\log(14.4)\approx 0.86 p$; besides the time needed to
+compute the $a_k$, $k\leq n$, the algorithm overhead is \emph{not}
+negligible: time $O(p^3)$ and space $O(p^2)$. Thus, even if the analytic
+conditions for rigorous use are met, this variant is only worthwile if the
+$a_k$ are hard to compute, at least $O(p^2)$ individually on average:
+otherwise we gain a small constant factor (1.5, say) in the number of
+needed $a_k$ at the expense of a large overhead.
+
+The conditions for rigorous use are hard to check but the routine is best used
+heuristically: even divergent alternating series can sometimes be summed by
+this method, as well as series which are not exactly alternating (see for
+example \secref{se:user_defined}). It should be used to try and guess the
+value of an infinite sum. (However, see the example at the end of
\secref{se:userfundef}.)
If the series already converges geometrically,
@@ -16004,168 +16370,268 @@ time = 0 ms.
\synt{suminf}{void *E, GEN (*eval)(void*,GEN), GEN a, long prec}.
-\subsec{sumnum$(X=a,\var{sig},\var{expr},\{\var{tab}\},\{\fl=0\})$}\kbdsidx{sumnum}\label{se:sumnum}
-Numerical summation of \var{expr}, the variable $X$ taking integer values
-from ceiling of $a$ to $+\infty$, where \var{expr} is assumed to be a
-holomorphic function $f(X)$ for $\Re(X)\ge \sigma$.
-
-The parameter $\sigma\in\R$ is coded in the argument \kbd{sig} as follows: it
-is either
-
-\item a real number $\sigma$. Then the function $f$ is assumed to
-decrease at least as $1/X^2$ at infinity, but not exponentially;
-
-\item a two-component vector $[\sigma,\alpha]$, where $\sigma$ is as
-before, $\alpha < -1$. The function $f$ is assumed to decrease like
-$X^{\alpha}$. In particular, $\alpha\le-2$ is equivalent to no $\alpha$ at all.
-
-\item a two-component vector $[\sigma,\alpha]$, where $\sigma$ is as
-before, $\alpha > 0$. The function $f$ is assumed to decrease like
-$\exp(-\alpha X)$. In this case it is essential that $\alpha$ be exactly the
-rate of exponential decrease, and it is usually a good idea to increase
-the default value of $m$ used for the integration step. In practice, if
-the function is exponentially decreasing \kbd{sumnum} is slower and less
-accurate than \kbd{sumpos} or \kbd{suminf}, so should not be used.
-
-The function uses the \tet{intnum} routines and integration on the line
-$\Re(s) = \sigma$. The optional argument \var{tab} is as in intnum, except it
-must be initialized with \kbd{sumnuminit} instead of \kbd{intnuminit}.
-
-When \var{tab} is not precomputed, \kbd{sumnum} can be slower than
-\kbd{sumpos}, when the latter is applicable. It is in general faster for
-slowly decreasing functions.
-
-Finally, if $\fl$ is nonzero, we assume that the function $f$ to be summed is
-of real type, i.e. satisfies $\overline{f(z)}=f(\overline{z})$, which
-speeds up the computation.
-
-\bprog
-? \p 308
-? a = sumpos(n=1, 1/(n^3+n+1));
-time = 1,410 ms.
-? tab = sumnuminit(2);
-time = 1,620 ms. \\@com slower but done once and for all.
-? b = sumnum(n=1, 2, 1/(n^3+n+1), tab);
-time = 460 ms. \\@com 3 times as fast as \kbd{sumpos}
-? a - b
-%4 = -1.0... E-306 + 0.E-320*I \\@com perfect.
-? sumnum(n=1, 2, 1/(n^3+n+1), tab, 1) - a; \\@com function of real type
+\subsec{sumnum$(n=a,f,\{\var{tab}\})$}\kbdsidx{sumnum}\label{se:sumnum}
+Numerical summation of $f(n)$ at high accuracy using Euler-MacLaurin,
+the variable $n$ taking values from $a$ to $+\infty$, where $f$ is assumed to
+have positive values and is a $C^\infty$ function; \kbd{a} must be an integer
+and \kbd{tab}, if given, is the output of \kbd{sumnuminit}. The latter
+precomputes abcissas and weights, speeding up the computation; it also allows
+to specify the behaviour at infinity via \kbd{sumnuminit([+oo, asymp])}.
+\bprog
+? \p500
+? z3 = zeta(3);
+? sumpos(n = 1, n^-3) - z3
+time = 2,332 ms.
+%2 = 2.438468843 E-501
+? sumnum(n = 1, n^-3) - z3 \\ here slower than sumpos
+time = 2,752 ms.
+%3 = 0.E-500
+ at eprog
+
+\misctitle{Complexity}
+The function $f$ is evaluated at $O(D \log D)$ real arguments,
+where $D \approx \kbd{realprecision} \cdot \log(10)$. The routine is geared
+towards slowly decreasing functions: if $f$ decreases exponentially fast,
+then one of \kbd{suminf} or \kbd{sumpos} should be preferred.
+If $f$ satisfies the stronger hypotheses required for Monien summation,
+i.e. if $f(1/z)$ is holomorphic in a complex neighbourhood of $[0,1]$,
+then \tet{sumnummonien} will be faster since it only requires $O(D/\log D)$
+evaluations:
+\bprog
+? sumnummonien(n = 1, 1/n^3) - z3
+time = 1,985 ms.
+%3 = 0.E-500
+ at eprog\noindent The \kbd{tab} argument precomputes technical data
+not depending on the expression being summed and valid for a given accuracy,
+speeding up immensely later calls:
+\bprog
+? tab = sumnuminit();
+time = 2,709 ms.
+? sumnum(n = 1, 1/n^3, tab) - z3 \\ now much faster than sumpos
+time = 40 ms.
+%5 = 0.E-500
+
+? tabmon = sumnummonieninit(); \\ Monien summation allows precomputations too
+time = 1,781 ms.
+? sumnummonien(n = 1, 1/n^3, tabmon) - z3
+time = 2 ms.
+%7 = 0.E-500
+ at eprog\noindent The speedup due to precomputations becomes less impressive
+when the function $f$ is expensive to evaluate, though:
+\bprog
+? sumnum(n = 1, lngamma(1+1/n)/n, tab);
+time = 14,180 ms.
+
+? sumnummonien(n = 1, lngamma(1+1/n)/n, tabmon); \\ fewer function evaluations!
+time = 717 ms.
+ at eprog
+
+\misctitle{Behaviour at infinity}
+By default, \kbd{sumnum} assumes that \var{expr} decreases slowly at infinity,
+but at least like $O(n^{-2})$. If the function decreases like $n^{\alpha}$
+for some $-2 < \alpha < -1$, then it must be indicated via
+\bprog
+ tab = sumnuminit([+oo, alpha]); /* alpha < 0 slow decrease */
+ at eprog\noindent otherwise loss of accuracy is expected.
+If the functions decreases quickly, like $\exp(-\alpha n)$ for some
+$\alpha > 0$, then it must be indicated via
+\bprog
+ tab = sumnuminit([+oo, alpha]); /* alpha > 0 exponential decrease */
+ at eprog\noindent otherwise exponent overflow will occur.
+\bprog
+? sumnum(n=1,2^-n)
+ *** at top-level: sumnum(n=1,2^-n)
+ *** ^----
+ *** _^_: overflow in expo().
+? tab = sumnuminit([+oo,log(2)]); sumnum(n=1,2^-n, tab)
+%1 = 1.000[...]
+ at eprog
+
+As a shortcut, one can also input
+\bprog
+ sumnum(n = [a, asymp], f)
+ at eprog\noindent instead of
+\bprog
+ tab = sumnuminit(asymp);
+ sumnum(n = a, f, tab)
+ at eprog
+
+\misctitle{Further examples}
+\bprog
+? \p200
+? sumnum(n = 1, n^(-2)) - zeta(2) \\ accurate, fast
+time = 200 ms.
+%1 = -2.376364457868949779 E-212
+? sumpos(n = 1, n^(-2)) - zeta(2) \\ even faster
+time = 96 ms.
+%2 = 0.E-211
+? sumpos(n=1,n^(-4/3)) - zeta(4/3) \\ now much slower
+time = 13,045 ms.
+%3 = -9.980730723049589073 E-210
+? sumnum(n=1,n^(-4/3)) - zeta(4/3) \\ fast but inaccurate
+time = 365 ms.
+%4 = -9.85[...]E-85
+? sumnum(n=[1,-4/3],n^(-4/3)) - zeta(4/3) \\ with decrease rate, now accurate
+time = 416 ms.
+%5 = -4.134874156691972616 E-210
+
+? tab = sumnuminit([+oo,-4/3]);
+time = 196 ms.
+? sumnum(n=1, n^(-4/3), tab) - zeta(4/3) \\ faster with precomputations
+time = 216 ms.
+%5 = -4.134874156691972616 E-210
+? sumnum(n=1,-log(n)*n^(-4/3), tab) - zeta'(4/3)
+time = 321 ms.
+%7 = 7.224147951921607329 E-210
+ at eprog
+
+Note that in the case of slow decrease ($\alpha < 0$), the exact
+decrease rate must be indicated, while in the case of exponential decrease,
+a rough value will do. In fact, for exponentially decreasing functions,
+\kbd{sumnum} is given for completeness and comparison purposes only: one
+of \kbd{suminf} or \kbd{sumpos} should always be preferred.
+\bprog
+? sumnum(n=[1, 1], 2^-n) \\ pretend we decrease as exp(-n)
time = 240 ms.
-%2 = -1.0... E-306 \\@com twice as fast, no imaginary part.
-? c = sumnum(n=1, 2, 1/(n^2+1), tab, 1);
-time = 170 ms. \\@com fast
-? d = sumpos(n=1, 1 / (n^2+1));
-time = 2,700 ms. \\@com slow.
-? d - c
-time = 0 ms.
-%5 = 1.97... E-306 \\@com perfect.
+%8 = 1.000[...] \\ perfect
+? sumpos(n=1, 2^-n)
+%9 = 1.000[...] \\ perfect and instantaneous
@eprog
-For slowly decreasing function, we must indicate singularities:
+\synt{sumnum}{(void *E, GEN (*eval)(void*, GEN), GEN a, GEN tab, long prec)}
+where an omitted \var{tab} is coded as \kbd{NULL}.
+
+\subsec{sumnuminit$(\{\var{asymp}\})$}\kbdsidx{sumnuminit}\label{se:sumnuminit}
+Initialize tables for Euler--MacLaurin delta summation of a series with
+positive terms. If given, \kbd{asymp} is of the form $[\kbd{+oo}, \alpha]$,
+as in \tet{intnum} and indicates the decrease rate at infinity of functions
+to be summed. A positive
+$\alpha > 0$ encodes an exponential decrease of type $\exp(-\alpha n)$ and
+a negative $-2 < \alpha < -1$ encodes a slow polynomial decrease of type
+$n^{\alpha}$.
\bprog
-? \p 308
-? a = sumnum(n=1, 2, n^(-4/3));
-time = 9,930 ms. \\@com slow because of the computation of $n^{-4/3}$.
-? a - zeta(4/3)
-time = 110 ms.
-%1 = -2.42... E-107 \\@com lost 200 decimals because of singularity at $\infty$
-? b = sumnum(n=1, [2,-4/3], n^(-4/3), /*omitted*/, 1); \\@com of real type
-time = 12,210 ms.
-? b - zeta(4/3)
-%3 = 1.05... E-300 \\@com better
- at eprog
-
-Since the \emph{complex} values of the function are used, beware of
-determination problems. For instance:
-\bprog
-? \p 308
-? tab = sumnuminit([2,-3/2]);
-time = 1,870 ms.
-? sumnum(n=1,[2,-3/2], 1/(n*sqrt(n)), tab,1) - zeta(3/2)
-time = 690 ms.
-%1 = -1.19... E-305 \\@com fast and correct
-? sumnum(n=1,[2,-3/2], 1/sqrt(n^3), tab,1) - zeta(3/2)
-time = 730 ms.
-%2 = -1.55... \\@com nonsense. However
-? sumnum(n=1,[2,-3/2], 1/n^(3/2), tab,1) - zeta(3/2)
-time = 8,990 ms.
-%3 = -1.19... E-305 \\@com perfect, as $1/(n*\sqrt{n})$ above but much slower
- at eprog
-
-For exponentially decreasing functions, \kbd{sumnum} is given for
-completeness, but one of \tet{suminf} or \tet{sumpos} should always be
-preferred. If you experiment with such functions and \kbd{sumnum} anyway,
-indicate the exact rate of decrease and increase $m$ by $1$ or $2$:
-
-\bprog
-? suminf(n=1, 2^(-n)) - 1
-time = 10 ms.
-%1 = -1.11... E-308 \\@com fast and perfect
-? sumpos(n=1, 2^(-n)) - 1
-time = 10 ms.
-%2 = -2.78... E-308 \\@com also fast and perfect
-? sumnum(n=1,2, 2^(-n)) - 1
-%3 = -1.321115060 E320 + 0.E311*I \\@com nonsense
-? sumnum(n=1, [2,log(2)], 2^(-n), /*omitted*/, 1) - 1 \\@com of real type
-time = 5,860 ms.
-%4 = -1.5... E-236 \\@com slow and lost $70$ decimals
-? m = intnumstep()
-%5 = 9
-? sumnum(n=1,[2,log(2)], 2^(-n), m+1, 1) - 1
-time = 11,770 ms.
-%6 = -1.9... E-305 \\@com now perfect, but slow.
- at eprog
-
-\synt{sumnum}{void *E, GEN (*eval)(void*,GEN), GEN a,GEN sig,GEN tab,long flag, long prec}.
-
-\subsec{sumnumalt$(X=a,\var{sig},\var{expr},\{\var{tab}\},\{\fl=0\})$}\kbdsidx{sumnumalt}\label{se:sumnumalt}
-Numerical
-summation of $(-1)^X\var{expr}(X)$, the variable $X$ taking integer values from
-ceiling of $a$ to $+\infty$, where \var{expr} is assumed to be a holomorphic
-function for $\Re(X)\ge sig$ (or $sig[1]$).
-
-\misctitle{Warning} This function uses the \kbd{intnum} routines and is
-orders of magnitude slower than \kbd{sumalt}. It is only given for
-completeness and should not be used in practice.
-
-\misctitle{Warning 2} The expression \var{expr} must \emph{not} include the
-$(-1)^X$ coefficient. Thus $\kbd{sumalt}(n=a,(-1)^nf(n))$ is (approximately)
-equal to $\kbd{sumnumalt}(n=a,sig,f(n))$.
-
-$sig$ is coded as in \kbd{sumnum}. However for slowly decreasing functions
-(where $sig$ is coded as $[\sigma,\alpha]$ with $\alpha<-1$), it is not
-really important to indicate $\alpha$. In fact, as for \kbd{sumalt}, the
-program will often give meaningful results (usually analytic continuations)
-even for divergent series. On the other hand the exponential decrease must be
-indicated.
-
-\var{tab} is as in \kbd{intnum}, but if used must be initialized with
-\kbd{sumnuminit}. If $\fl$ is nonzero, assumes that the function $f$ to be
-summed is of real type, i.e. satisfies $\overline{f(z)}=f(\overline{z})$, and
-then twice faster when \var{tab} is precomputed.
-
-\bprog
-? \p 308
-? tab = sumnuminit(2, /*omitted*/, -1); \\@com abscissa $\sigma=2$, alternating sums.
-time = 1,620 ms. \\@com slow, but done once and for all.
-? a = sumnumalt(n=1, 2, 1/(n^3+n+1), tab, 1);
-time = 230 ms. \\@com similar speed to \kbd{sumnum}
-? b = sumalt(n=1, (-1)^n/(n^3+n+1));
-time = 0 ms. \\@com infinitely faster!
-? a - b
-time = 0 ms.
-%1 = -1.66... E-308 \\@com perfect
+? \p200
+? sumnum(n=1, n^-2);
+time = 200 ms.
+? tab = sumnuminit();
+time = 188 ms.
+? sumnum(n=1, n^-2, tab); \\ faster
+time = 8 ms.
+
+? tab = sumnuminit([+oo, log(2)]); \\ decrease like 2^-n
+time = 200 ms.
+? sumnum(n=1, 2^-n, tab)
+time = 44 ms.
+
+? tab = sumnuminit([+oo, -4/3]); \\ decrease like n^(-4/3)
+time = 200 ms.
+? sumnum(n=1, n^(-4/3), tab);
+time = 221 ms.
@eprog
-\synt{sumnumalt}{void *E, GEN (*eval)(void*,GEN), GEN a, GEN sig, GEN tab, long flag, long prec}.
+The library syntax is \fun{GEN}{sumnuminit}{GEN asymp = NULL, long prec}.
+
+\subsec{sumnummonien$(n=a,f,\{\var{tab}\})$}\kbdsidx{sumnummonien}\label{se:sumnummonien}
+Numerical summation $\sum_{n\geq a} f(n)$ at high accuracy, the variable
+$n$ taking values from the integer $a$ to $+\infty$ using Monien summation,
+which assumes that $f(1/z)$ has a complex analytic continuation in a (complex)
+neighbourhood of the segment $[0,1]$.
+
+The function $f$ is evaluated at $O(D / \log D)$ real arguments,
+where $D \approx \kbd{realprecision} \cdot \log(10)$.
+By default, assume that $f(n) = O(n^{-2})$ and has a non-zero asymptotic
+expansion
+$$f(n) = \sum_{i\geq 2} a_i n^{-i}$$
+at infinity. To handle more complicated behaviours and allow time-saving
+precomputations (for a given \kbd{realprecision}), see \kbd{sumnummonieninit}.
-\subsec{sumnuminit$(\var{sig}, \{m=0\}, \{\var{sgn}=1\})$}\kbdsidx{sumnuminit}\label{se:sumnuminit}
-Initialize tables for numerical summation using \kbd{sumnum} (with
-$\var{sgn}=1$) or \kbd{sumnumalt} (with $\var{sgn}=-1$), $sig$ is the
-abscissa of integration coded as in \kbd{sumnum}, and $m$ is as in
-\kbd{intnuminit}.
+The library syntax is \fun{GEN}{sumnummonien0}{GEN n, GEN f, GEN tab = NULL, long prec}.
-The library syntax is \fun{GEN}{sumnuminit}{GEN sig, long m, long sgn, long prec}.
+\subsec{sumnummonieninit$(\{\var{asymp}\},\{w\},\{\var{n0} = 1\})$}\kbdsidx{sumnummonieninit}\label{se:sumnummonieninit}
+Initialize tables for Monien summation of a series $\sum_{n\geq n_0}
+f(n)$ where $f(1/z)$ has a complex analytic continuation in a (complex)
+neighbourhood of the segment $[0,1]$.
+
+By default, assume that $f(n) = O(n^{-2})$ and has a non-zero asymptotic
+expansion
+$$f(n) = \sum_{i\geq 2} a_i / n^i$$
+at infinity. Note that the sum starts at $i = 2$! The argument \kbd{asymp}
+allows to specify different expansions:
+
+\item a real number $\alpha > 1$ means
+ $$f(n) = \sum_{i\geq 1} a_i / n^\alpha$$
+(Now the summation starts at $1$.)
+
+\item a vector $[\alpha,\beta]$ of reals, where we must have $\alpha > 0$
+and $\alpha + \beta > 1$ to ensure convergence, means that
+ $$f(n) = \sum_{i\geq 1} a_i / n^{\alpha i + \beta}$$
+Note that $\kbd{asymp} = [\alpha, \alpha]$ is equivalent to
+$\kbd{asymp}=\alpha$.
+
+\bprog
+? \p38
+? s = sumnum(n = 1, sin(1/sqrt(n)) / n)
+%1 = 2.3979771206715998375659850036324914714
+
+? sumnummonien(n = 1, sin(1/sqrt(n)) / n) - s
+%2 = -0.001[...] \\ completely wrong !
+
+? t = sumnummonieninit([1/2,1]); \\ f(n) = \sum_i 1 / n^(i/2+1)
+? sumnummonien(n = 1, sin(1/sqrt(n)) / n, t) - s
+%3 = 0.E-37 \\ now correct
+ at eprog
+
+The argument $w$ is used to sum expressions of the form
+$$ \sum_{n\geq n_0} f(n) w(n),$$
+for varying $f$ \emph{as above}, and fixed weight function $w$, where we
+further assume that the auxiliary sums
+$$g_w(m) = \sum_{n\geq n_0} w(n) / n^{\alpha m + \beta} $$
+converge for all $m\geq 1$. Note that for non-negative integers $k$,
+and weight $w(n) = (\log n)^k$, the function $g_w(m) = \zeta^{(k)}(\alpha m +
+\beta)$ has a simple expression; for general weights, $g_w$ is
+computed using \kbd{sumnum}. The following variants are available
+
+\item an integer $k \geq 0$, to code $w(n) = (\log n)^k$;
+only the cases $k = 0,1$ are presently implemented; due to a poor
+implementation of $\zeta$ derivatives, it is not currently worth it
+to exploit the special shape of $g_w$ when $k > 0$;
+
+\item a \typ{CLOSURE} computing the values $w(n)$, where we
+assume that $w(n) = O(n^\epsilon)$ for all $\epsilon > 0$;
+
+\item a vector $[w, \kbd{fast}]$, where $w$ is a closure as above
+and \kbd{fast} is a scalar;
+we assume that $w(n) = O(n^{\kbd{fast}+\epsilon})$; note that
+$\kbd{w} = [w, 0]$ is equivalent to $\kbd{w} = w$.
+
+\item a vector $[w, \kbd{oo}]$, where $w$ is a closure as above;
+we assume that $w(n)$ decreases exponentially. Note that in this case,
+\kbd{sumnummonien} is provided for completeness and comparison purposes only:
+one of \kbd{suminf} or \kbd{sumpos} should be preferred in practice.
+
+The cases where $w$ is a closure or $w(n) = \log n$ are the only ones where
+$n_0$ is taken into account and stored in the result. The subsequent call to
+\kbd{sumnummonien} \emph{must} use the same value.
+
+\bprog
+? \p300
+? sumnummonien(n = 1, n^-2*log(n)) + zeta'(2)
+time = 536 ms.
+%1 = -1.323[...]E-6 \\ completely wrong, f does not satisfy hypotheses !
+? tab = sumnummonieninit(, 1); \\ codes w(n) = log(n)
+time = 18,316 ms.
+? sumnummonien(n = 1, n^-2, tab) + zeta'(2)
+time = 44 ms.
+%3 = -5.562684646268003458 E-309 \\ now perfect
+
+? tab = sumnummonieninit(, n->log(n)); \\ generic, about as fast
+time = 18,693 ms.
+? sumnummonien(n = 1, n^-2, tab) + zeta'(2)
+time = 40 ms.
+%5 = -5.562684646268003458 E-309 \\ identical result
+ at eprog
+
+The library syntax is \fun{GEN}{sumnummonieninit}{GEN asymp = NULL, GEN w = NULL, GEN n0 = NULL, long prec}.
\subsec{sumpos$(X=a,\var{expr},\{\fl=0\})$}\kbdsidx{sumpos}\label{se:sumpos}
Numerical summation of the series \var{expr}, which must be a series of
@@ -16181,7 +16647,19 @@ wrong if \var{expr} is 0 too often. We do not check either that all terms
have the same sign. As \tet{sumalt}, this function should be used to
try and guess the value of an infinite sum.
-If $\fl=1$, use slightly different polynomials. Sometimes faster.
+If $\fl=1$, use \kbd{sumalt}$(,1)$ instead of \kbd{sumalt}$(,0)$, see
+\secref{se:sumalt}. Requiring more stringent analytic properties for
+rigorous use, but allowing to compute fewer series terms.
+
+To reach accuracy $10^{-p}$, both algorithms require $O(p^2)$ space;
+furthermore, assuming the terms decrease polynomially (in $O(n^-C)$), both
+need to compute $O(p^2)$ terms. The \kbd{sumpos}$(,1)$ variant has a smaller
+implied constant (roughly 1.5 times smaller). Since the \kbd{sumalt}$(,1)$
+overhead is now small compared to the time needed to compute series terms,
+this last variant should be about 1.5 faster. On the other hand, the
+achieved accuracy may be much worse: as for \tet{sumalt}, since
+conditions for rigorous use are hard to check, the routine is best used
+heuristically.
\synt{sumpos}{void *E, GEN (*eval)(void*,GEN),GEN a,long prec}. Also
available is \tet{sumpos2} with the same arguments ($\fl = 1$).
@@ -17724,6 +18202,69 @@ functions.
The library syntax is \fun{void}{kill0}{const char *sym}.
+\subsec{listcreate$()$}\kbdsidx{listcreate}\label{se:listcreate}
+Creates an empty list. This routine used to have a mandatory argument,
+which is now ignored (for backward compatibility). In fact, this function
+has become redundant and obsolete; it will disappear in future versions of
+PARI: just use \kbd{List()}
+% \syn{NO}
+
+\subsec{listinsert$(L,x,n)$}\kbdsidx{listinsert}\label{se:listinsert}
+Inserts the object $x$ at
+position $n$ in $L$ (which must be of type \typ{LIST}). This has
+complexity $O(\#L - n + 1)$: all the
+remaining elements of \var{list} (from position $n+1$ onwards) are shifted
+to the right.
+
+The library syntax is \fun{GEN}{listinsert}{GEN L, GEN x, long n}.
+
+\subsec{listkill$(L)$}\kbdsidx{listkill}\label{se:listkill}
+Obsolete, retained for backward compatibility. Just use \kbd{L = List()}
+instead of \kbd{listkill(L)}. In most cases, you won't even need that, e.g.
+local variables are automatically cleared when a user function returns.
+
+The library syntax is \fun{void}{listkill}{GEN L}.
+
+\subsec{listpop$(\var{list},\{n\})$}\kbdsidx{listpop}\label{se:listpop}
+Removes the $n$-th element of the list
+\var{list} (which must be of type \typ{LIST}). If $n$ is omitted,
+or greater than the list current length, removes the last element.
+If the list is already empty, do nothing. This runs in time $O(\#L - n + 1)$.
+
+The library syntax is \fun{void}{listpop0}{GEN list, long n}.
+
+\subsec{listput$(\var{list},x,\{n\})$}\kbdsidx{listput}\label{se:listput}
+Sets the $n$-th element of the list
+\var{list} (which must be of type \typ{LIST}) equal to $x$. If $n$ is omitted,
+or greater than the list length, appends $x$.
+You may put an element into an occupied cell (not changing the
+list length), but it is easier to use the standard \kbd{list[n] = x}
+construct. This runs in time $O(\#L)$ in the worst case (when the list must
+be reallocated), but in time $O(1)$ on average: any number of successive
+\kbd{listput}s run in time $O(\#L)$, where $\#L$ denotes the list
+\emph{final} length.
+
+The library syntax is \fun{GEN}{listput0}{GEN list, GEN x, long n}.
+
+\subsec{listsort$(L,\{\fl=0\})$}\kbdsidx{listsort}\label{se:listsort}
+Sorts the \typ{LIST} \var{list} in place, with respect to the (somewhat
+arbitrary) universal comparison function \tet{cmp}. In particular, the
+ordering is the same as for sets and \tet{setsearch} can be used on a sorted
+list.
+\bprog
+? L = List([1,2,4,1,3,-1]); listsort(L); L
+%1 = List([-1, 1, 1, 2, 3, 4])
+? setsearch(L, 4)
+%2 = 6
+? setsearch(L, -2)
+%3 = 0
+ at eprog\noindent This is faster than the \kbd{vecsort} command since the list
+is sorted in place: no copy is made. No value returned.
+
+If $\fl$ is non-zero, suppresses all repeated coefficients.
+
+The library syntax is \fun{void}{listsort}{GEN L, long flag}.
+
\subsec{localprec$(p)$}\kbdsidx{localprec}\label{se:localprec}
Set the real precision to $p$ in the dynamic scope. All computations
are performed as if \tet{realprecision} was $p$:
@@ -17772,6 +18313,79 @@ we leave \kbd{localprec} scope, \kbd{realprecision} only regains precedence,
it is not ``restored'' to the original value.
%\syn{NO}
+\subsec{mapdelete$(M,x)$}\kbdsidx{mapdelete}\label{se:mapdelete}
+Remove $x$ from the domain of the map $M$.
+\bprog
+? M = Map(["a",1; "b",3; "c",7]);
+? mapdelete(M,"b");
+? Mat(M)
+["a" 1]
+
+["c" 7]
+ at eprog
+
+The library syntax is \fun{void}{mapdelete}{GEN M, GEN x}.
+
+\subsec{mapget$(M,x)$}\kbdsidx{mapget}\label{se:mapget}
+Return the image of $x$ by the map $M$.
+\bprog
+? M=Map(["a",23;"b",43]);
+? mapget(M,"a")
+%2 = 23
+? mapget(M,"b")
+%3 = 43
+ at eprog\noindent Raises an exception when the key $x$ is not present in $M$
+\bprog
+? mapget(M,"c")
+ *** at top-level: mapget(M,"c")
+ *** ^-------------
+ *** mapget: non-existent component in mapget: index not in map
+ at eprog
+
+The library syntax is \fun{GEN}{mapget}{GEN M, GEN x}.
+
+\subsec{mapisdefined$(M,x,\{\&z\})$}\kbdsidx{mapisdefined}\label{se:mapisdefined}
+Return true ($1$) if \kbd{x} has an image by the map $M$, false ($0$)
+otherwise. If \kbd{z} is present, set it to the image of $x$, if it exists.
+\bprog
+? M = Map(); N = 19;
+? for (a=0, N-1, mapput(M, a^3%N, a));
+? {for (a=0, N-1,
+ if (mapisdefined(M, a, &b),
+ printf("%d is the cube of %d mod %d\n",a,b,N)));}
+0 is the cube of 0 mod 19
+1 is the cube of 11 mod 19
+7 is the cube of 9 mod 19
+8 is the cube of 14 mod 19
+11 is the cube of 17 mod 19
+12 is the cube of 15 mod 19
+18 is the cube of 18 mod 19
+ at eprog
+
+The library syntax is \fun{GEN}{mapisdefined}{GEN M, GEN x, GEN *z = NULL}.
+
+\subsec{mapput$(M,x,y)$}\kbdsidx{mapput}\label{se:mapput}
+Associate $x$ to $y$ in the map $M$. The value $y$ can the be retrieved
+with \tet{mapget}.
+\bprog
+? M = Map();
+? mapput(M, "foo", 23);
+? mapput(M, 7718, "bill");
+? mapget(M, "foo")
+%4 = 23
+? mapget(M, 7718)
+%5 = "bill"
+? Vec(M) \\ keys
+%6 = [7718, "foo"]
+? Mat(M)
+%7 =
+[ 7718 "bill"]
+
+["foo" 23]
+ at eprog
+
+The library syntax is \fun{void}{mapput}{GEN M, GEN x, GEN y}.
+
\subsec{print$(\{\var{str}\}*)$}\kbdsidx{print}\label{se:print}
Outputs its (string) arguments in raw format, ending with a newline.
%\syn{NO}
diff --git a/doc/usersch5.tex b/doc/usersch5.tex
index aedc078..78ea068 100644
--- a/doc/usersch5.tex
+++ b/doc/usersch5.tex
@@ -481,8 +481,9 @@ used for \typ{INT}, \typ{REAL}, \typ{POL} and \typ{SER} (for the last two
types, only 0 or 1 are possible).
\fun{long}{gsigne}{GEN x} returns the sign of a real number $x$,
-valid for \typ{INT}, \typ{REAL} as \kbd{signe}, but also for \typ{FRAC}.
-Raise a type error if \kbd{typ(x)} is not among those three.
+valid for \typ{INT}, \typ{REAL} as \kbd{signe}, but also for \typ{FRAC}
+and \typ{QUAD} of positive discriminants. Raise a type error if \kbd{typ(x)}
+is not among those.
\fun{long}{expi}{GEN x} returns the binary exponent of the real number equal
to the \typ{INT}~\kbd{x}. This is a special case of \kbd{gexpo}.
@@ -3763,8 +3764,8 @@ all columns.
\fun{GEN}{zero_Flv}{long n} creates a \kbd{Flv} with \kbd{n} components set to
$0$.
-\fun{GEN}{row_Flm}{GEN A, long x0} return $A[i,]$, the $i$-th row of the
-\kbd{Flm} (or \kbd{zm}) $A$.
+\fun{GEN}{Flm_row}{GEN A, long x0} return $A[i,]$, the $i$-th row of the
+\kbd{Flm} $A$.
\fun{GEN}{Flm_add}{GEN x, GEN y, ulong p} adds \kbd{x} and \kbd{y}
(assumed to have compatible dimensions).
@@ -5042,6 +5043,9 @@ vector $V$ (thus, returns a \kbd{FlxV}).
\fun{GEN}{FlxV_red}{GEN V, ulong p} reduces each components with \kbd{Flx\_red}.
+\fun{GEN}{FlxV_prod}{GEN V, ulong p}, \kbd{V} being a vector of \kbd{Flx},
+returns their product.
+
\subsec{\kbd{FlxT}} See \kbd{FpXT} operations.
\fun{GEN}{FlxT_red}{GEN V, ulong p} reduces each leaf with \kbd{Flx\_red}.
@@ -6813,7 +6817,7 @@ $0$ otherwise.
\fun{GEN}{zero_zv}{long n} as \kbd{zero\_Flv}.
-\fun{GEN}{row_zm}{GEN A, long x0} as \kbd{row\_Flm}.
+\fun{GEN}{zm_row}{GEN A, long x0} as \kbd{Flm\_row}.
\fun{int}{zvV_equal}{GEN x, GEN y} returns $1$ if the two \kbd{zvV} (vectors
of \kbd{zv}) are equal and $0$ otherwise.
@@ -6930,6 +6934,9 @@ a column matrix $n\times 1$, error otherwise.
\smallskip
\fun{GEN}{RgV_sum}{GEN v} sum of the entries of $v$
+\fun{GEN}{RgV_prod}{GEN v} product of the entries of $v$, using
+a divide and conquer strategy
+
\fun{GEN}{RgV_sumpart}{GEN v, long n} returns the sum $v[1] + \dots + v[n]$
(assumes that \kbd{lg}$(v) > n$).
@@ -7091,6 +7098,16 @@ invertible \typ{MAT} with \typ{INT} or \typ{REAL} coefficients, returns
matrix from the $QR$ decomposition of $x$, renormalized to accomodate
\kbd{qfgaussred} conventions. Not memory clean.
+\fun{GEN}{RgM_gram_schmidt}{GEN e, GEN *ptB} naive (unstable) Gram-Schmidt
+orthogonalization of the basis $(e_i)$ given by the columns of \typ{MAT} $e$.
+Return the $e_i^*$ (as columns of a \typ{MAT}) and set \kbd{*ptB} to the
+vector of squared lengths $|e_i^*|^2$.
+
+\fun{GEN}{RgM_Babai}{GEN M, GEN y} given an LLL-reduced \typ{MAT} $M$ and
+a \typ{COL} $y$ of the same dimension, apply Babai's nearest plane algorithm
+to return an \emph{integral} $x$ such that $y - Mx$ has small $L_2$ norm.
+This yields an approximate solution to the closest vector problem.
+
\subsec{\kbd{ZG}}
Let $G$ be a multiplicative group with neutral element $1_G$ whose
@@ -7847,6 +7864,12 @@ by the \kbd{long}~\kbd{s}.
\fun{GEN}{RgX_Rg_divexact}{GEN x, GEN y} exact division of the \kbd{RgX}
\kbd{y} by the scalar \kbd{x}.
+\fun{GEN}{RgX_Rg_eval_bk}{GEN f, GEN x} returns $\kbd{f}(\kbd{x})$ using
+Brent and Kung algorithm. (Use \tet{poleval} for Horner algorithm.)
+
+\fun{GEN}{RgX_RgV_eval}{GEN f, GEN V} as \kbd{RgX\_Rg\_eval\_bk(f, x)},
+assuming $V$ was output by \kbd{gpowers(x, n)} for some $n\geq 1$.
+
\fun{GEN}{RgX_normalize}{GEN x} divides $x$ by its
leading coefficient. If the latter is~$1$, $x$ itself is returned, not a
copy. Leading coefficients equal to $0$ are stripped, e.g.
@@ -8182,6 +8205,8 @@ is similar to \tet{itos}, slightly slower since it checks the type of \kbd{x}.
\fun{double}{dbllog2r}{GEN x} assuming \kbd{x} is a non-zero \typ{REAL},
returns an approximation to \kbd{log2(|x|)}.
+\fun{double}{dblmodulus}{GEN x} return an approximation to \kbd{|x|}.
+
\fun{long}{gtolong}{GEN x} if \kbd{x} is an integer (not necessarily
a~\typ{INT}), converts \kbd{x} into a \kbd{long} if possible.
@@ -8802,8 +8827,7 @@ polynomials, return their roots, i.e. the $- L[i](0)$.
\fun{GEN}{roots_to_pol}{GEN L, long v} given a vector of scalars $L$,
returns the monic polynomial in variable $v$ whose roots are the $L[i]$.
-Calls \tet{divide_conquer_prod}, so leaves some garbage on stack, but
-suitable for \kbd{gerepileupto}.
+Leaves some garbage on stack, but suitable for \kbd{gerepileupto}.
\fun{GEN}{roots_to_pol_r1}{GEN L, long v, long r1} as \kbd{roots\_to\_pol}
assuming the first $r_1$ roots are ``real'', and the following ones are
@@ -8811,10 +8835,8 @@ representatives of conjugate pairs of ``complex'' roots. So if $L$ has $r_1 +
r_2$ elements, we obtain a polynomial of degree $r_1 + 2r_2$. In most
applications, the roots are indeed real and complex, but the implementation
assumes only that each ``complex'' root $z$ introduces a quadratic
-factor $X^2 - \kbd{trace}(z) X + \kbd{norm}(z)$. Calls
-\tet{divide_conquer_prod}.
-Calls \tet{divide_conquer_prod}, so leaves some garbage on stack, but
-suitable for \kbd{gerepileupto}.
+factor $X^2 - \kbd{trace}(z) X + \kbd{norm}(z)$.
+Leaves some garbage on stack, but suitable for \kbd{gerepileupto}.
\section{Integer parts}
@@ -9431,21 +9453,6 @@ In addition we also have the obsolete forms:
\section{Generic operators: product, powering, factorback}
-\fun{GEN}{divide_conquer_prod}{GEN v, GEN (*mul)(GEN,GEN)} $v$ is a vector of
-objects, which can be ``multiplied'' using the \kbd{mul} function. Return
-the ``product'' of the $v[i]$ using a product tree: by convention
-return \kbd{gen\_1} if $v$ is the empty vector, a copy of $v[1]$ if it has a
-single entry; and otherwise apply the function recursively on the vector
-(twice smaller)
-
-\kbd{mul}$(v[1],v[2])$, \kbd{mul}$(v[3],v[4])$, \dots
-
-\noindent Only requires that \kbd{mul} is an associative binary operator,
-which need not correspond to a true multiplication. \kbd{D} is meant to encode
-an arbitrary evaluation context, set it to \kbd{NULL} in simple cases where you
-do not need this. Leaves some garbage on stack, but suitable for
-\kbd{gerepileupto} if \kbd{mul} is.
-
To describe the following functions, we use the following private typedefs
to simplify the description:
\bprog
@@ -9457,12 +9464,13 @@ to simplify the description:
respectively (the \kbd{void*} argument provides some arbitrary evaluation
context).
-\fun{GEN}{divide_conquer_assoc}{GEN v, void *D, F2 op}
-general version of \tet{divide_conquer_prod}. Given two objects
-$x,y$, assume that \kbd{op(D, $x$, $y$)} implements an associative binary
-operator. If $v$ has $k$ entries, return
+\fun{GEN}{gen_product}{GEN v, void *D, F2 op}
+Given two objects $x,y$, assume that \kbd{op(D, $x$, $y$)} implements an
+associative binary operator. If $v$ has $k$ entries, return
$$v[1]~\var{op}~v[2]~\var{op}~\ldots ~\var{op}~v[k];$$
returns \kbd{gen\_1} if $k = 0$ and a copy of $v[1]$ if $k = 1$.
+Use divide an conquer strategy. Leave some garbage on stack, but suitable for
+\kbd{gerepileupto} if \kbd{mul} is.
\fun{GEN}{gen_pow}{GEN x, GEN n, void *D, F1 sqr, F2 mul} $n > 0$ a
\typ{INT}, returns $x^n$; \kbd{mul(D, $x$, $y$)} implements the multiplication
@@ -9574,6 +9582,12 @@ into~\kbd{x} for the variable number~\kbd{v}.
$q$ at $x$. For convenience, a \typ{VEC} or \typ{COL} is also recognized as
the \typ{POL} \kbd{gtovecrev(q)}.
+\fun{GEN}{RgX_cxeval}{GEN T, GEN x, GEN xi} evaluate the \typ{POL} $T$
+at $x$ via Horner's scheme. If \var{xi} is not \kbd{NULL} it must be equal to
+$1/x$ and we evaluate $x^{\deg T}T(1/x)$ instead. This is useful when
+$|x| > 1$ is a \typ{REAL} or an inexact \typ{COMPLEX} and $T$ has
+``balanced'' coefficients, since the evaluation becomes numerically stable.
+
\fun{GEN}{RgX_RgM_eval}{GEN q, GEN x} evaluates the \typ{POL} $q$ at the
square matrix $x$.
@@ -11157,6 +11171,10 @@ return the matrix with $i$-th row and $j$-th column removed.
and $B$ of compatible dimensions. A \kbd{NULL} pointer is accepted for an
empty matrix. See \tet{shallowconcat}.
+\fun{GEN}{matslice}{GEN A, long i1, long i2, long j1, long j2}
+return the submatrix $A[i_1..i_2,j_1..j_2]$.
+Assume $i_1 \leq i_2$, $i_1 \leq i_2$.
+
\fun{GEN}{row}{GEN A, long i} return $A[i,]$, the $i$-th row of the \typ{MAT}
$A$.
diff --git a/misc/tex2mail.in b/misc/tex2mail.in
index ed14707..f9dad59 100755
--- a/misc/tex2mail.in
+++ b/misc/tex2mail.in
@@ -2500,10 +2500,10 @@ $type{"\\leftarrow"}="string";
$contents{"\\leftarrow"}=" <--- ";
$type{"\\mapsto"}="string";
-$contents{"\\mapsto"}=" |--> ";
+$contents{"\\mapsto"}=" :--> ";
$type{"\\longmapsto"}="string";
-$contents{"\\longmapsto"}=" |----> ";
+$contents{"\\longmapsto"}=" :----> ";
$type{"\\cap"}="string";
$contents{"\\cap"}=" /~\\ ";
diff --git a/src/basemath/Flx.c b/src/basemath/Flx.c
index bfa4826..8dd9d85 100644
--- a/src/basemath/Flx.c
+++ b/src/basemath/Flx.c
@@ -1687,7 +1687,11 @@ if [a',b']~=M*[a,b]~ then degpol(a')>= (lgpol(a)>>1) >degpol(b')
static GEN
Flx_halfgcd_i(GEN x, GEN y, ulong p)
{
- if (lg(x)<=Flx_HALFGCD_LIMIT) return Flx_halfgcd_basecase(x,y,p);
+ if (!Flx_multhreshold(x,p, Flx_HALFGCD_HALFMULII_LIMIT,
+ Flx_HALFGCD_MULII_LIMIT,
+ Flx_HALFGCD_MULII2_LIMIT,
+ Flx_HALFGCD_KARATSUBA_LIMIT))
+ return Flx_halfgcd_basecase(x,y,p);
return Flx_halfgcd_split(x,y,p);
}
@@ -2009,6 +2013,12 @@ _Flx_mul(void *p, GEN a, GEN b)
return Flx_mul(a,b, *(ulong*)p);
}
+GEN
+FlxV_prod(GEN V, ulong p)
+{
+ return gen_product(V, (void *)&p, &_Flx_mul);
+}
+
/* compute prod (x - a[i]) */
GEN
Flv_roots_to_pol(GEN a, ulong p, long vs)
@@ -2022,7 +2032,7 @@ Flv_roots_to_pol(GEN a, ulong p, long vs)
Fl_neg(Fl_add(a[i],a[i+1],p),p), 1);
if (i < lx)
gel(p1,k++) = mkvecsmall3(vs, Fl_neg(a[i],p), 1);
- setlg(p1, k); return divide_conquer_assoc(p1, (void *)&p, _Flx_mul);
+ setlg(p1, k); return gen_product(p1, (void *)&p, _Flx_mul);
}
INLINE void
@@ -2669,8 +2679,8 @@ Flxq_log(GEN a, GEN g, GEN ord, GEN T, ulong p)
const struct bb_group *S = get_Flxq_star(&E,T,p);
GEN v = dlog_get_ordfa(ord), F = gmael(v,2,1);
if (Flxq_log_use_index(gel(F,lg(F)-1), T, p))
- ord = mkvec2(gel(v,1),ZM_famat_limit(gel(v,2),int2n(27)));
- return gerepileuptoleaf(av, gen_PH_log(a,g,ord,E,S));
+ v = mkvec2(gel(v, 1), ZM_famat_limit(gel(v, 2), int2n(27)));
+ return gerepileuptoleaf(av, gen_PH_log(a, g, v, E, S));
}
GEN
@@ -4002,7 +4012,7 @@ GEN
FlxqXV_prod(GEN V, GEN T, ulong p)
{
struct _FlxqX d; d.p=p; d.T=T;
- return divide_conquer_assoc(V, (void*)&d, &_FlxqX_mul);
+ return gen_product(V, (void*)&d, &_FlxqX_mul);
}
GEN
diff --git a/src/basemath/FpV.c b/src/basemath/FpV.c
index 8d9ee5d..4a5f7ed 100644
--- a/src/basemath/FpV.c
+++ b/src/basemath/FpV.c
@@ -786,7 +786,7 @@ Flm_transpose(GEN x)
GEN y;
if (lx == 1) return cgetg(1,t_MAT);
dx = lgcols(x); y = cgetg(dx,t_MAT);
- for (i=1; i<dx; i++) gel(y,i) = row_Flm(x,i);
+ for (i=1; i<dx; i++) gel(y,i) = Flm_row(x,i);
return y;
}
diff --git a/src/basemath/FpX.c b/src/basemath/FpX.c
index a058ccb..f601efe 100644
--- a/src/basemath/FpX.c
+++ b/src/basemath/FpX.c
@@ -913,7 +913,7 @@ FpX_disc(GEN x, GEN p)
GEN
FpXV_prod(GEN V, GEN p)
{
- return divide_conquer_assoc(V, (void *)p, &_FpX_mul);
+ return gen_product(V, (void *)p, &_FpX_mul);
}
GEN
@@ -1739,9 +1739,18 @@ FpXQ_log(GEN a, GEN g, GEN ord, GEN T, GEN p)
pari_sp av=avma;
if (lgefint(p)==3)
{
- ulong pp = to_Flxq(&a, &T, p);
- GEN z = Flxq_log(a, ZX_to_Flx(g, pp), ord, T, pp);
- return gerepileuptoleaf(av, z);
+ if (uel(p,2) == 2)
+ {
+ GEN z = F2xq_log(ZX_to_F2x(a), ZX_to_F2x(g), ord,
+ ZX_to_F2x(get_FpX_mod(T)));
+ return gerepileuptoleaf(av, z);
+ }
+ else
+ {
+ ulong pp = to_Flxq(&a, &T, p);
+ GEN z = Flxq_log(a, ZX_to_Flx(g, pp), ord, T, pp);
+ return gerepileuptoleaf(av, z);
+ }
}
else
{
@@ -1751,6 +1760,7 @@ FpXQ_log(GEN a, GEN g, GEN ord, GEN T, GEN p)
return gerepileuptoleaf(av, z);
}
}
+
GEN
Fq_log(GEN a, GEN g, GEN ord, GEN T, GEN p)
{
@@ -1781,12 +1791,22 @@ FpXQ_sqrtn(GEN a, GEN n, GEN T, GEN p, GEN *zeta)
}
if (lgefint(p)==3)
{
- ulong pp = to_Flxq(&a, &T, p);
- z = Flxq_sqrtn(a, n, T, pp, zeta);
- if (!z) return NULL;
- if (!zeta) return Flx_to_ZX_inplace(gerepileuptoleaf(av, z));
- z = Flx_to_ZX(z);
- *zeta=Flx_to_ZX(*zeta);
+ if (uel(p,2) == 2)
+ {
+ z = F2xq_sqrtn(ZX_to_F2x(a), n, ZX_to_F2x(get_Flx_mod(T)), zeta);
+ if (!z) return NULL;
+ z = F2x_to_ZX(z);
+ if (!zeta) return gerepileuptoleaf(av, z);
+ *zeta=F2x_to_ZX(*zeta);
+ } else
+ {
+ ulong pp = to_Flxq(&a, &T, p);
+ z = Flxq_sqrtn(a, n, T, pp, zeta);
+ if (!z) return NULL;
+ if (!zeta) return Flx_to_ZX_inplace(gerepileuptoleaf(av, z));
+ z = Flx_to_ZX(z);
+ *zeta=Flx_to_ZX(*zeta);
+ }
}
else
{
diff --git a/src/basemath/FpXX.c b/src/basemath/FpXX.c
index 0e0ff80..ee6b8f3 100644
--- a/src/basemath/FpXX.c
+++ b/src/basemath/FpXX.c
@@ -802,7 +802,7 @@ FpXQXV_prod(GEN V, GEN T, GEN p)
struct _FpXQX d;
d.p=p;
d.T=T;
- return divide_conquer_assoc(V, (void*)&d, &_FpXQX_mul);
+ return gen_product(V, (void*)&d, &_FpXQX_mul);
}
}
diff --git a/src/basemath/QX_factor.c b/src/basemath/QX_factor.c
index 2d24409..fb4628d 100644
--- a/src/basemath/QX_factor.c
+++ b/src/basemath/QX_factor.c
@@ -811,10 +811,10 @@ DDF_roots(GEN A)
e = logint(addiu(shifti(bound, 1), 1), p, &pe);
pes2 = shifti(pe, -1);
if (DEBUGLEVEL>2) timer_printf(&T, "Root bound");
+ av = avma;
z = ZpX_roots(A, p, e); lz = lg(z);
z = deg1_from_roots(z, varn(A));
if (DEBUGLEVEL>2) timer_printf(&T, "Hensel lift (mod %lu^%ld)", pp,e);
- av = avma;
for (m=1, i=1; i < lz; i++)
{
GEN q, r, y = gel(z,i);
@@ -822,19 +822,19 @@ DDF_roots(GEN A)
y = centermod_i(y, pe, pes2);
if (! (q = ZX_divides(lcpol, y)) ) continue;
- lcpol = A = q;
+ lcpol = q;
r = negi( constant_term(y) );
if (lc) {
r = gdiv(r,lc);
- A = Q_primpart(A);
- lc = absi_shallow( leading_term(A) );
- if (is_pm1(lc)) lc = NULL; else lcpol = ZX_Z_mul(A, lc);
+ lcpol = Q_primpart(lcpol);
+ lc = absi_shallow( leading_term(lcpol) );
+ if (is_pm1(lc)) lc = NULL; else lcpol = ZX_Z_mul(lcpol, lc);
}
gel(z,m++) = r;
if (gc_needed(av,2))
{
if (DEBUGMEM>1) pari_warn(warnmem,"DDF_roots, m = %ld", m);
- gerepileall(av, lc? 3:1, &A, &lc, &lcpol);
+ gerepileall(av, lc? 3:2, &z, &lcpol, &lc);
}
}
diff --git a/src/basemath/Qfb.c b/src/basemath/Qfb.c
index ec293e7..e08fd0e 100644
--- a/src/basemath/Qfb.c
+++ b/src/basemath/Qfb.c
@@ -502,7 +502,7 @@ mul_nucomp(void *l, GEN x, GEN y) { return nucomp(x, y, (GEN)l); }
static GEN
mul_nudupl(void *l, GEN x) { return nudupl(x, (GEN)l); }
GEN
-nupow(GEN x, GEN n)
+nupow(GEN x, GEN n, GEN L)
{
pari_sp av;
GEN y, D;
@@ -514,7 +514,8 @@ nupow(GEN x, GEN n)
D = qfb_disc(x);
y = qfi_1_by_disc(D);
if (!signe(n)) return y;
- y = gen_pow(x, n, (void*)sqrtnint(absi(D), 4), &mul_nudupl, &mul_nucomp);
+ if (!L) L = sqrtnint(absi(D), 4);
+ y = gen_pow(x, n, (void*)L, &mul_nudupl, &mul_nucomp);
if (signe(n) < 0
&& !absi_equal(gel(y,1),gel(y,2))
&& !absi_equal(gel(y,1),gel(y,3))) togglesign(gel(y,2));
diff --git a/src/basemath/RgV.c b/src/basemath/RgV.c
index 24d934d..98ef4c8 100644
--- a/src/basemath/RgV.c
+++ b/src/basemath/RgV.c
@@ -203,6 +203,16 @@ RgM_sumcol(GEN A)
return v;
}
+static GEN
+_gmul(void *data, GEN x, GEN y)
+{ (void)data; return gmul(x,y); }
+
+GEN
+RgV_prod(GEN x)
+{
+ return gen_product(x, NULL, _gmul);
+}
+
/* ADDITION SCALAR + MATRIX */
/* x square matrix, y scalar; create the square matrix x + y*Id */
GEN
@@ -516,6 +526,8 @@ RgM_mul(GEN x, GEN y)
lx = lg(x);
if (lx != lgcols(y)) pari_err_OP("operation 'RgM_mul'", x,y);
if (lx == 1) return zeromat(0,ly-1);
+ if (RgM_is_ZM(x) && RgM_is_ZM(y))
+ return ZM_mul(x, y);
if (is_modular_mul(x,y,&z)) return gerepileupto(av, z);
if (RgM_is_FFM(x, &ffx) && RgM_is_FFM(y, &ffy)) {
if (!FF_samefield(ffx, ffy))
@@ -618,6 +630,7 @@ RgM_sqr(GEN x)
GEN z, ffx = NULL;
if (lx == 1) return cgetg(1, t_MAT);
if (lx != lgcols(x)) pari_err_OP("operation 'RgM_mul'", x,x);
+ if (RgM_is_ZM(x)) return ZM_sqr(x);
if (is_modular_sqr(x,&z)) return gerepileupto(av, z);
if (RgM_is_FFM(x, &ffx)) return FFM_mul(x, x, ffx);
z = cgetg(lx, t_MAT);
diff --git a/src/basemath/RgX.c b/src/basemath/RgX.c
index f41d7e7..3daeda1 100644
--- a/src/basemath/RgX.c
+++ b/src/basemath/RgX.c
@@ -103,6 +103,38 @@ gen_bkeval(GEN Q, long d, GEN x, int use_sqr, void *E, const struct bb_algebra *
return gerepileupto(av, z);
}
+static GEN
+_gen_nored(void *E, GEN x) { (void)E; return x; }
+static GEN
+_gen_add(void *E, GEN x, GEN y) { (void)E; return gadd(x, y); }
+static GEN
+_gen_mul(void *E, GEN x, GEN y) { (void)E; return gmul(x, y); }
+static GEN
+_gen_sqr(void *E, GEN x) { (void)E; return gsqr(x); }
+static GEN
+_gen_one(void *E) { (void)E; return gen_1; }
+static GEN
+_gen_zero(void *E) { (void)E; return gen_0; }
+
+static struct bb_algebra Rg_algebra = { _gen_nored,_gen_add,_gen_mul,_gen_sqr,
+ _gen_one,_gen_zero };
+
+static GEN
+_gen_cmul(void *E, GEN P, long a, GEN x)
+{(void)E; return gmul(gel(P,a+2), x);}
+
+GEN
+RgX_RgV_eval(GEN Q, GEN x)
+{
+ return gen_bkeval_powers(Q, degpol(Q), x, NULL, &Rg_algebra, _gen_cmul);
+}
+
+GEN
+RgX_Rg_eval_bk(GEN Q, GEN x)
+{
+ return gen_bkeval(Q, degpol(Q), x, 1, NULL, &Rg_algebra, _gen_cmul);
+}
+
/*******************************************************************/
/* */
/* RgX */
diff --git a/src/basemath/ZG.c b/src/basemath/ZG.c
index 22635ea..8492723 100644
--- a/src/basemath/ZG.c
+++ b/src/basemath/ZG.c
@@ -70,14 +70,23 @@ ZG_Z_mul(GEN x, GEN c)
GEN
ZG_mul(GEN x, GEN y)
{
+ pari_sp av;
GEN z, XG, XE;
long i, l;
if (typ(x) == t_INT) return ZG_Z_mul(y, x);
if (typ(y) == t_INT) return ZG_Z_mul(x, y);
+ av = avma;
XG = gel(x,1); XE = gel(x,2); l = lg(XG);
z = ZG_Z_mul(G_ZG_mul(gel(XG,1), y), gel(XE,1));
for (i = 2; i < l; i++)
+ {
z = ZG_add(z, ZG_Z_mul(G_ZG_mul(gel(XG,i), y), gel(XE,i)));
+ if (gc_needed(av,3))
+ {
+ if(DEBUGMEM>1) pari_warn(warnmem,"ZG_mul, i = %ld/%ld",i,l-1);
+ z = gerepilecopy(av, z);
+ }
+ }
return z;
}
#if 0
@@ -107,7 +116,7 @@ ZG_G_mul(GEN x, GEN y)
X = gel(x,1);
z = cgetg_copy(X, &l);
for (i = 1; i < l; i++) gel(z,i) = gmul(gel(X,i), y);
- return ZG_normalize( mkmat2(z, gel(x,2)) );
+ return ZG_normalize( mkmat2(z, shallowcopy(gel(x,2))) );
}
GEN
G_ZG_mul(GEN x, GEN y)
@@ -118,7 +127,7 @@ G_ZG_mul(GEN x, GEN y)
Y = gel(y,1);
z = cgetg_copy(Y, &l);
for (i = 1; i < l; i++) gel(z,i) = gmul(x, gel(Y,i));
- return ZG_normalize( mkmat2(z, gel(y,2)) );
+ return ZG_normalize( mkmat2(z, shallowcopy(gel(y,2))) );
}
GEN
ZGC_G_mul(GEN v, GEN x)
diff --git a/src/basemath/ZV.c b/src/basemath/ZV.c
index 222c559..0b3cc3e 100644
--- a/src/basemath/ZV.c
+++ b/src/basemath/ZV.c
@@ -164,6 +164,173 @@ ZM_nm_mul(GEN x, GEN y)
return z;
}
+/* Strassen-Winograd algorithm */
+
+/*
+ Return A[ma+1..ma+da, na+1..na+ea] - B[mb+1..mb+db, nb+1..nb+eb]
+ as an (m x n)-matrix, padding the input with zeroes as necessary.
+*/
+static GEN
+add_slices(long m, long n,
+ GEN A, long ma, long da, long na, long ea,
+ GEN B, long mb, long db, long nb, long eb)
+{
+ long min_d = minss(da, db), min_e = minss(ea, eb), i, j;
+ GEN M = cgetg(n + 1, t_MAT), C;
+
+ for (j = 1; j <= min_e; j++) {
+ gel(M, j) = C = cgetg(m + 1, t_COL);
+ for (i = 1; i <= min_d; i++)
+ gel(C, i) = addii(gcoeff(A, ma + i, na + j),
+ gcoeff(B, mb + i, nb + j));
+ for (; i <= da; i++)
+ gel(C, i) = gcoeff(A, ma + i, na + j);
+ for (; i <= db; i++)
+ gel(C, i) = gcoeff(B, mb + i, nb + j);
+ for (; i <= m; i++)
+ gel(C, i) = gen_0;
+ }
+ for (; j <= ea; j++) {
+ gel(M, j) = C = cgetg(m + 1, t_COL);
+ for (i = 1; i <= da; i++)
+ gel(C, i) = gcoeff(A, ma + i, na + j);
+ for (; i <= m; i++)
+ gel(C, i) = gen_0;
+ }
+ for (; j <= eb; j++) {
+ gel(M, j) = C = cgetg(m + 1, t_COL);
+ for (i = 1; i <= db; i++)
+ gel(C, i) = gcoeff(B, mb + i, nb + j);
+ for (; i <= m; i++)
+ gel(C, i) = gen_0;
+ }
+ for (; j <= n; j++)
+ gel(M, j) = zerocol(m);
+ return M;
+}
+
+/*
+ Return A[ma+1..ma+da, na+1..na+ea] - B[mb+1..mb+db, nb+1..nb+eb]
+ as an (m x n)-matrix, padding the input with zeroes as necessary.
+*/
+static GEN
+subtract_slices(long m, long n,
+ GEN A, long ma, long da, long na, long ea,
+ GEN B, long mb, long db, long nb, long eb)
+{
+ long min_d = minss(da, db), min_e = minss(ea, eb), i, j;
+ GEN M = cgetg(n + 1, t_MAT), C;
+
+ for (j = 1; j <= min_e; j++) {
+ gel(M, j) = C = cgetg(m + 1, t_COL);
+ for (i = 1; i <= min_d; i++)
+ gel(C, i) = subii(gcoeff(A, ma + i, na + j),
+ gcoeff(B, mb + i, nb + j));
+ for (; i <= da; i++)
+ gel(C, i) = gcoeff(A, ma + i, na + j);
+ for (; i <= db; i++)
+ gel(C, i) = negi(gcoeff(B, mb + i, nb + j));
+ for (; i <= m; i++)
+ gel(C, i) = gen_0;
+ }
+ for (; j <= ea; j++) {
+ gel(M, j) = C = cgetg(m + 1, t_COL);
+ for (i = 1; i <= da; i++)
+ gel(C, i) = gcoeff(A, ma + i, na + j);
+ for (; i <= m; i++)
+ gel(C, i) = gen_0;
+ }
+ for (; j <= eb; j++) {
+ gel(M, j) = C = cgetg(m + 1, t_COL);
+ for (i = 1; i <= db; i++)
+ gel(C, i) = negi(gcoeff(B, mb + i, nb + j));
+ for (; i <= m; i++)
+ gel(C, i) = gen_0;
+ }
+ for (; j <= n; j++)
+ gel(M, j) = zerocol(m);
+ return M;
+}
+
+static GEN ZM_mul_i(GEN x, GEN y, long l, long lx, long ly);
+
+/* Strassen-Winograd matrix product A (m x n) * B (n x p) */
+static GEN
+ZM_mul_sw(GEN A, GEN B, long m, long n, long p)
+{
+ pari_sp av = avma;
+ long m1 = (m + 1)/2, m2 = m/2,
+ n1 = (n + 1)/2, n2 = n/2,
+ p1 = (p + 1)/2, p2 = p/2;
+ GEN A11, A12, A22, B11, B21, B22,
+ S1, S2, S3, S4, T1, T2, T3, T4,
+ M1, M2, M3, M4, M5, M6, M7,
+ V1, V2, V3, C11, C12, C21, C22, C;
+
+ T2 = subtract_slices(n1, p2, B, 0, n1, p1, p2, B, n1, n2, p1, p2);
+ S1 = subtract_slices(m2, n1, A, m1, m2, 0, n1, A, 0, m2, 0, n1);
+ M2 = ZM_mul_i(S1, T2, m2 + 1, n1 + 1, p2 + 1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 2, &T2, &M2); /* destroy S1 */
+ T3 = subtract_slices(n1, p1, T2, 0, n1, 0, p2, B, 0, n1, 0, p1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 2, &M2, &T3); /* destroy T2 */
+ S2 = add_slices(m2, n1, A, m1, m2, 0, n1, A, m1, m2, n1, n2);
+ T1 = subtract_slices(n1, p1, B, 0, n1, p1, p2, B, 0, n1, 0, p2);
+ M3 = ZM_mul_i(S2, T1, m2 + 1, n1 + 1, p2 + 1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 4, &M2, &T3, &S2, &M3); /* destroy T1 */
+ S3 = subtract_slices(m1, n1, S2, 0, m2, 0, n1, A, 0, m1, 0, n1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 4, &M2, &T3, &M3, &S3); /* destroy S2 */
+ A11 = matslice(A, 1, m1, 1, n1);
+ B11 = matslice(B, 1, n1, 1, p1);
+ M1 = ZM_mul_i(A11, B11, m1 + 1, n1 + 1, p1 + 1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 5, &M2, &T3, &M3, &S3, &M1); /* destroy A11, B11 */
+ A12 = matslice(A, 1, m1, n1 + 1, n);
+ B21 = matslice(B, n1 + 1, n, 1, p1);
+ M4 = ZM_mul_i(A12, B21, m1 + 1, n2 + 1, p1 + 1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 6, &M2, &T3, &M3, &S3, &M1, &M4); /* destroy A12, B21 */
+ C11 = add_slices(m1, p1, M1, 0, m1, 0, p1, M4, 0, m1, 0, p1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 6, &M2, &T3, &M3, &S3, &M1, &C11); /* destroy M4 */
+ M5 = ZM_mul_i(S3, T3, m1 + 1, n1 + 1, p1 + 1);
+ S4 = subtract_slices(m1, n2, A, 0, m1, n1, n2, S3, 0, m1, 0, n2);
+ if (gc_needed(av, 1))
+ gerepileall(av, 7, &M2, &T3, &M3, &M1, &C11, &M5, &S4); /* destroy S3 */
+ T4 = add_slices(n2, p1, B, n1, n2, 0, p1, T3, 0, n2, 0, p1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 7, &M2, &M3, &M1, &C11, &M5, &S4, &T4); /* destroy T3 */
+ V1 = subtract_slices(m1, p1, M1, 0, m1, 0, p1, M5, 0, m1, 0, p1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 6, &M2, &M3, &S4, &T4, &C11, &V1); /* destroy M1, M5 */
+ B22 = matslice(B, n1 + 1, n, p1 + 1, p);
+ M6 = ZM_mul_i(S4, B22, m1 + 1, n2 + 1, p2 + 1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 6, &M2, &M3, &T4, &C11, &V1, &M6); /* destroy S4, B22 */
+ A22 = matslice(A, m1 + 1, m, n1 + 1, n);
+ M7 = ZM_mul_i(A22, T4, m2 + 1, n2 + 1, p1 + 1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 6, &M2, &M3, &C11, &V1, &M6, &M7); /* destroy A22, T4 */
+ V3 = add_slices(m1, p2, V1, 0, m1, 0, p2, M3, 0, m2, 0, p2);
+ C12 = add_slices(m1, p2, V3, 0, m1, 0, p2, M6, 0, m1, 0, p2);
+ if (gc_needed(av, 1))
+ gerepileall(av, 6, &M2, &M3, &C11, &V1, &M7, &C12); /* destroy V3, M6 */
+ V2 = add_slices(m2, p1, V1, 0, m2, 0, p1, M2, 0, m2, 0, p2);
+ if (gc_needed(av, 1))
+ gerepileall(av, 5, &M3, &C11, &M7, &C12, &V2); /* destroy V1, M2 */
+ C21 = add_slices(m2, p1, V2, 0, m2, 0, p1, M7, 0, m2, 0, p1);
+ if (gc_needed(av, 1))
+ gerepileall(av, 5, &M3, &C11, &C12, &V2, &C21); /* destroy M7 */
+ C22 = add_slices(m2, p2, V2, 0, m2, 0, p2, M3, 0, m2, 0, p2);
+ if (gc_needed(av, 1))
+ gerepileall(av, 4, &C11, &C12, &C21, &C22); /* destroy V2, M3 */
+ C = mkmat2(mkcol2(C11, C21), mkcol2(C12, C22));
+ return gerepileupto(av, matconcat(C));
+}
+
/* x[i,]*y. Assume lg(x) > 1 and 0 < i < lgcols(x) */
static GEN
ZMrow_ZC_mul_i(GEN x, GEN y, long i, long lx)
@@ -191,16 +358,36 @@ ZM_ZC_mul_i(GEN x, GEN y, long lx, long l)
for (i=1; i<l; i++) gel(z,i) = ZMrow_ZC_mul_i(x,y,i,lx);
return z;
}
+
+static GEN
+ZM_mul_classical(GEN x, GEN y, long l, long lx, long ly)
+{
+ long j;
+ GEN z = cgetg(ly, t_MAT);
+ for (j = 1; j < ly; j++)
+ gel(z, j) = ZM_ZC_mul_i(x, gel(y, j), lx, l);
+ return z;
+}
+
+/* Strassen-Winograd used for dim >= ZM_sw_bound */
+static const long ZM_sw_bound = 36;
+
+static GEN
+ZM_mul_i(GEN x, GEN y, long l, long lx, long ly)
+{
+ if (l <= ZM_sw_bound || lx <= ZM_sw_bound || ly <= ZM_sw_bound)
+ return ZM_mul_classical(x, y, l, lx, ly);
+ else
+ return ZM_mul_sw(x, y, l - 1, lx - 1, ly - 1);
+}
+
GEN
ZM_mul(GEN x, GEN y)
{
- long j, l, lx=lg(x), ly=lg(y);
- GEN z;
+ long lx=lg(x), ly=lg(y);
if (ly==1) return cgetg(1,t_MAT);
if (lx==1) return zeromat(0, ly-1);
- l = lgcols(x); z = cgetg(ly,t_MAT);
- for (j=1; j<ly; j++) gel(z,j) = ZM_ZC_mul_i(x, gel(y,j), lx, l);
- return z;
+ return ZM_mul_i(x, y, lgcols(x), lx, ly);
}
/* assume result is symmetric */
GEN
@@ -278,15 +465,22 @@ ZM_transmul(GEN x, GEN y)
}
return M;
}
+
+static GEN
+ZM_sqr_i(GEN x, long l)
+{
+ if (l <= ZM_sw_bound)
+ return ZM_mul_classical(x, x, l, l, l);
+ else
+ return ZM_mul_sw(x, x, l - 1, l - 1, l - 1);
+}
+
GEN
ZM_sqr(GEN x)
{
- long j, l, lx=lg(x);
- GEN z;
+ long lx=lg(x);
if (lx==1) return cgetg(1,t_MAT);
- l = lgcols(x); z = cgetg(lx,t_MAT);
- for (j=1; j<lx; j++) gel(z,j) = ZM_ZC_mul_i(x, gel(x,j), lx, l);
- return z;
+ return ZM_sqr_i(x, lx);
}
GEN
ZM_ZC_mul(GEN x, GEN y)
@@ -377,7 +571,7 @@ _ZM_mul(void *data /*ignored*/, GEN x, GEN y)
{ (void)data; return ZM_mul(x,y); }
static GEN
_ZM_sqr(void *data /*ignored*/, GEN x)
-{ (void)data; return ZM_mul(x,x); }
+{ (void)data; return ZM_sqr(x); }
GEN
ZM_pow(GEN x, GEN n)
{
@@ -1017,6 +1211,11 @@ zv_prod(GEN v)
n = v[1]; for (i = 2; i < l; i++) n *= v[i];
return n;
}
+
+static GEN
+_mulii(void *E, GEN a, GEN b)
+{ (void) E; return mulii(a, b); }
+
/* product of ulongs */
GEN
zv_prod_Z(GEN v)
@@ -1031,7 +1230,7 @@ zv_prod_Z(GEN v)
x = cgetg(m + (odd(n)? 2: 1), t_VEC);
for (k = 1; k <= m; k++) gel(x,k) = muluu(v[k<<1], v[(k<<1)-1]);
if (odd(n)) gel(x,k) = utoipos(v[n]);
- return gerepileuptoint(av, divide_conquer_prod(x, mulii));
+ return gerepileuptoint(av, gen_product(x, NULL, _mulii));
}
GEN
@@ -1041,7 +1240,7 @@ ZV_prod(GEN v)
long i, l = lg(v);
GEN n;
if (l == 1) return gen_1;
- if (l > 7) return gerepileuptoint(av, divide_conquer_prod(v, mulii));
+ if (l > 7) return gerepileuptoint(av, gen_product(v, NULL, _mulii));
n = gel(v,1);
if (l == 2) return icopy(n);
for (i = 2; i < l; i++) n = mulii(n, gel(v,i));
diff --git a/src/basemath/alglin3.c b/src/basemath/alglin3.c
index 91c1fc6..3ace717 100644
--- a/src/basemath/alglin3.c
+++ b/src/basemath/alglin3.c
@@ -551,7 +551,7 @@ genselect(void *E, long (*f)(void* E, GEN x), GEN A)
y = cgetg(3, t_LIST);
v = genindexselect(E, f, z);
B = extract_copy(z, v);
- list_nmax(y) = lg(B)-1;
+ y[1] = lg(B)-1;
list_data(y) = B;
}
break;
@@ -638,6 +638,19 @@ vecapply1(void *E, GEN (*f)(void* E, GEN x), GEN x)
for (i=1; i<lx; i++) gel(y,i) = f(E, gel(x,i));
return y;
}
+static GEN
+mapapply1(void *E, GEN (*f)(void* E, GEN x), GEN x)
+{
+ long i, lx;
+ GEN y = cgetg_copy(x, &lx);
+ for (i=1; i<lx; i++)
+ {
+ GEN xi = gel(x, i);
+ gel(y,i) = mkvec2(mkvec2(gcopy(gmael(xi, 1, 1)), f(E,gmael(xi, 1, 2))),
+ gcopy(gel(xi, 2)));
+ }
+ return y;
+}
/* as genapply, but treat A [ t_VEC,t_COL, or t_MAT] as a t_VEC */
GEN
vecapply(void *E, GEN (*f)(void* E, GEN x), GEN x)
@@ -659,14 +672,25 @@ genapply(void *E, GEN (*f)(void* E, GEN x), GEN x)
y = ser_isexactzero(x)? gcopy(x): normalize(vecapply2(E,f,x));
break;
case t_LIST:
- z = list_data(x);
- if (!z)
- y = listcreate();
- else
{
- y = cgetg(3, t_LIST);
- list_nmax(y) = lg(z)-1;
- list_data(y) = vecapply1(E,f,z);
+ long t = list_typ(x);
+ z = list_data(x);
+ if (!z)
+ y = listcreate_typ(t);
+ else
+ {
+ y = cgetg(3, t_LIST);
+ y[1] = evaltyp(t)|evallg(lg(z)-1);
+ switch(t)
+ {
+ case t_LIST_RAW:
+ list_data(y) = vecapply1(E,f,z);
+ break;
+ case t_LIST_MAP:
+ list_data(y) = mapapply1(E,f,z);
+ break;
+ }
+ }
}
break;
case t_MAT:
@@ -773,6 +797,8 @@ gtomat(GEN x)
switch(typ(x))
{
case t_LIST:
+ if (list_typ(x)==t_LIST_MAP)
+ return maptomat(x);
x = list_data(x);
if (!x) return cgetg(1, t_MAT);
/* fall through */
diff --git a/src/basemath/arith1.c b/src/basemath/arith1.c
index fcf34a2..705f672 100644
--- a/src/basemath/arith1.c
+++ b/src/basemath/arith1.c
@@ -3774,7 +3774,7 @@ mulu_interval(ulong a, ulong b)
}
if (l == k) gel(x,lx++) = utoipos(k);
setlg(x, lx);
- return gerepileuptoint(av, divide_conquer_prod(x, mulii));
+ return gerepileuptoint(av, ZV_prod(x));
}
GEN
@@ -4527,8 +4527,10 @@ quadregulator(GEN x, long prec)
/** **/
/*************************************************************************/
static int qfb_is_1(GEN f) { return equali1(gel(f,1)); }
-static GEN qfb_pow(void *E, GEN f, GEN n) { (void)E; return powgi(f,n); }
-static GEN qfi_comp(void *E, GEN f, GEN g) { (void)E; return qficomp(f,g); }
+static GEN qfb_pow(void *E, GEN f, GEN n)
+{ return E? nupow(f,n,(GEN)E): powgi(f,n); }
+static GEN qfi_comp(void *E, GEN f, GEN g)
+{ return E? nucomp(f,g,(GEN)E): qficomp(f,g); }
static ulong qfb_hash(GEN x)
{
GEN a = gel(x,1);
@@ -4554,9 +4556,9 @@ qfbclassno0(GEN x,long flag)
/* f^h = 1, return order(f). Set *pfao to its factorization */
static GEN
-find_order(GEN f, GEN h, GEN *pfao)
+find_order(void *E, GEN f, GEN h, GEN *pfao)
{
- GEN v = gen_factored_order(f, h, NULL, &qfi_group);
+ GEN v = gen_factored_order(f, h, E, &qfi_group);
*pfao = gel(v,2); return gel(v,1);
}
@@ -4726,23 +4728,23 @@ get_forms(GEN D, GEN *pL)
/* h ~ #G, return o = order of f, set fao = its factorization */
static GEN
-Shanks_order(GEN f, GEN h, GEN *pfao)
+Shanks_order(void *E, GEN f, GEN h, GEN *pfao)
{
long s = minss(itos(sqrti(h)), 10000);
- GEN T = gen_Shanks_init(f, s, NULL, &qfi_group);
- GEN v = gen_Shanks(T, ginv(f), ULONG_MAX, NULL, &qfi_group);
- return find_order(f, addiu(v,1), pfao);
+ GEN T = gen_Shanks_init(f, s, E, &qfi_group);
+ GEN v = gen_Shanks(T, ginv(f), ULONG_MAX, E, &qfi_group);
+ return find_order(E, f, addiu(v,1), pfao);
}
/* if g = 1 in G/<f> ? */
static int
-equal1(GEN T, ulong N, GEN g)
-{ return !!gen_Shanks(T, g, N, NULL, &qfi_group); }
+equal1(void *E, GEN T, ulong N, GEN g)
+{ return !!gen_Shanks(T, g, N, E, &qfi_group); }
/* Order of 'a' in G/<f>, T = gen_Shanks_init(f,n), order(f) < n*N
* FIXME: should be gen_order, but equal1 has the wrong prototype */
static GEN
-relative_order(GEN a, GEN o, ulong N, GEN T)
+relative_order(void *E, GEN a, GEN o, ulong N, GEN T)
{
pari_sp av = avma;
long i, l;
@@ -4763,12 +4765,12 @@ relative_order(GEN a, GEN o, ulong N, GEN T)
t = diviiexact(o, powiu(p,e));
y = powgi(a, t);
}
- if (equal1(T,N,y)) o = t;
+ if (equal1(E, T,N,y)) o = t;
else {
for (j = 1; j < e; j++)
{
y = powgi(y, p);
- if (equal1(T,N,y)) break;
+ if (equal1(E, T,N,y)) break;
}
if (j < e) {
if (j > 1) p = powiu(p, j);
@@ -4789,6 +4791,7 @@ classno(GEN x)
pari_sp av = avma;
long r2, k, s, i, l;
GEN forms, hin, Hf, D, g1, d1, d2, q, L, fad1, order_bound;
+ void *E;
if (signe(x) >= 0) return classno2(x);
@@ -4803,8 +4806,9 @@ classno(GEN x)
l = lg(forms);
order_bound = const_vec(l-1, NULL);
+ E = expi(D) > 60? (void*)sqrtnint(shifti(absi(D),-2),4): NULL;
g1 = gel(forms,1);
- gel(order_bound,1) = d1 = Shanks_order(g1, hin, &fad1);
+ gel(order_bound,1) = d1 = Shanks_order(E, g1, hin, &fad1);
q = diviiround(hin, d1); /* approximate order of G/<g1> */
d2 = NULL; /* not computed yet */
if (is_pm1(q)) goto END;
@@ -4814,10 +4818,10 @@ classno(GEN x)
fd = powgi(f, d1); if (is_pm1(gel(fd,1))) continue;
F = powgi(fd, q);
a = gel(F,1);
- o = is_pm1(a)? find_order(fd, q, &fao): Shanks_order(fd, q, &fao);
+ o = is_pm1(a)? find_order(E, fd, q, &fao): Shanks_order(E, fd, q, &fao);
/* f^(d1 q) = 1 */
fao = merge_factor(fad1,fao, (void*)&cmpii, &cmp_nodata);
- o = find_order(f, fao, &fao);
+ o = find_order(E, f, fao, &fao);
gel(order_bound,i) = o;
/* o = order of f, fao = factor(o) */
update_g1(&g1,&d1,&fad1, f,o,fao);
@@ -4828,18 +4832,18 @@ classno(GEN x)
if (expi(q) > 3)
{ /* q large: compute d2, 2nd elt divisor */
ulong N, n = 2*itou(sqrti(d1));
- GEN D = d1, T = gen_Shanks_init(g1, n, NULL, &qfi_group);
+ GEN D = d1, T = gen_Shanks_init(g1, n, E, &qfi_group);
d2 = gen_1;
N = itou( gceil(gdivgs(d1,n)) ); /* order(g1) <= n*N */
for (i = 1; i < l; i++)
{
GEN d, f = gel(forms,i), B = gel(order_bound,i);
- if (!B) B = find_order(f, fad1, /*junk*/&d);
+ if (!B) B = find_order(E, f, fad1, /*junk*/&d);
f = powgi(f,d2);
- if (equal1(T,N,f)) continue;
+ if (equal1(E, T,N,f)) continue;
B = gdiv(B,d2); if (typ(B) == t_FRAC) B = gel(B,1);
/* f^B = 1 */
- d = relative_order(f, B, N,T);
+ d = relative_order(E, f, B, N,T);
d2= mulii(d,d2);
D = mulii(d1,d2);
q = diviiround(hin,D);
diff --git a/src/basemath/base1.c b/src/basemath/base1.c
index 639d68b..a7310f2 100644
--- a/src/basemath/base1.c
+++ b/src/basemath/base1.c
@@ -1431,10 +1431,12 @@ make_M(nffp_t *F, int trunc)
long i, j, l = lg(ro), n = lg(bas);
M = cgetg(n,t_MAT);
gel(M,1) = const_col(l-1, gen_1); /* bas[1] = 1 */
- for (j=2; j<n; j++)
+ for (j=2; j<n; j++) gel(M,j) = cgetg(l,t_COL);
+ for (i=1; i<l; i++)
{
- m = cgetg(l,t_COL); gel(M,j) = m;
- for (i=1; i<l; i++) gel(m,i) = poleval(gel(bas,j), gel(ro,i));
+ GEN r = gel(ro,i), ri;
+ ri = (gexpo(r) > 1)? ginv(r): NULL;
+ for (j=2; j<n; j++) gcoeff(M,i,j) = RgX_cxeval(gel(bas,j), r, ri);
}
if (den)
for (j=2; j<n; j++)
diff --git a/src/basemath/base2.c b/src/basemath/base2.c
index a323df6..07c0b27 100644
--- a/src/basemath/base2.c
+++ b/src/basemath/base2.c
@@ -53,7 +53,8 @@ fact_from_factors(GEN D, GEN P, long flag)
if (!is_pm1(D))
{
long k = Z_isanypower(D, &D);
- gel(Q,iq) = D; gel(E,iq) = utoipos(k ? k: 1);
+ if (!k) k = 1;
+ gel(Q,iq) = D; gel(E,iq) = utoipos(k); iq++;
}
setlg(Q,iq);
setlg(E,iq); return mkmat2(Q,E);
@@ -2317,7 +2318,7 @@ primedec_end(GEN nf, GEN L, GEN p)
static GEN
primedec_aux(GEN nf, GEN p, long flim)
{
- GEN E, F, L, Ip, H, phi, mat1, f, g, h, p1, UN, T = nf_get_pol(nf);
+ GEN E, F, L, Ip, phi, f, g, h, p1, UN, T = nf_get_pol(nf);
long i, k, c, iL, N;
int kummer;
@@ -2335,7 +2336,7 @@ primedec_aux(GEN nf, GEN p, long flim)
if (flim && degpol(t) > flim) { setlg(L, i); break; }
gel(L,i) = primedec_apply_kummer(nf, t, E[i],p);
}
- return gen_sort(L, (void*)&cmp_prime_over_p, &cmp_nodata);
+ return L;
}
kummer = 0;
@@ -2378,22 +2379,21 @@ primedec_aux(GEN nf, GEN p, long flim)
UN = col_ei(N, 1);
for (c=1; c; c--)
- { /* Let A:= (Z_K/p) / Ip; try to split A2 := A / Im H ~ Im M2
+ { /* Let A:= (Z_K/p) / Ip etale; split A2 := A / Im H ~ Im M2
H * ? + M2 * Mi2 = Id_N ==> M2 * Mi2 projector A --> A2 */
- GEN M, Mi, M2, Mi2, phi2;
- long dim;
+ GEN M, Mi, M2, Mi2, phi2, mat1, H = gel(h,c); /* maximal rank */
+ long dim, r = lg(H)-1;
- H = gel(h,c); k = lg(H)-1;
M = FpM_suppl(shallowconcat(H,UN), p);
Mi = FpM_inv(M, p);
- M2 = vecslice(M, k+1,N); /* M = (H|M2) invertible */
- Mi2 = rowslice(Mi,k+1,N);
+ M2 = vecslice(M, r+1,N); /* M = (H|M2) invertible */
+ Mi2 = rowslice(Mi,r+1,N);
/* FIXME: FpM_mul(,M2) could be done with vecpermute */
phi2 = FpM_mul(Mi2, FpM_mul(phi,M2, p), p);
mat1 = FpM_ker(phi2, p);
dim = lg(mat1)-1; /* A2 product of 'dim' fields */
if (dim > 1)
- { /* phi2 v = 0 <==> a = M2 v in Ker phi */
+ { /* phi2 v = 0 => a = M2 v in Ker phi, a not in Fp.1 + H */
GEN R, a, mula, mul2, v = gel(mat1,2);
long n;
@@ -2402,17 +2402,16 @@ primedec_aux(GEN nf, GEN p, long flim)
mula = FpM_red(mula, p);
mul2 = FpM_mul(Mi2, FpM_mul(mula,M2, p), p);
R = FpX_roots(pol_min(mul2,p), p); /* totally split mod p */
-
n = lg(R)-1;
for (i=1; i<=n; i++)
{
- GEN r = gel(R,i), I = RgM_Rg_add_shallow(mula, negi(r));
+ GEN I = RgM_Rg_sub_shallow(mula, gel(R,i));
gel(h,c++) = FpM_image(shallowconcat(H, I), p);
}
if (n == dim)
for (i=1; i<=n; i++) gel(L,iL++) = gel(h,--c);
}
- else /* A2 field ==> H maximal, f = N-k = dim(A2) */
+ else /* A2 field ==> H maximal, f = N-r = dim(A2) */
gel(L,iL++) = H;
}
setlg(L, iL);
diff --git a/src/basemath/base5.c b/src/basemath/base5.c
index 42c6c91..869dcdb 100644
--- a/src/basemath/base5.c
+++ b/src/basemath/base5.c
@@ -1375,7 +1375,7 @@ nfsnf0(GEN nf, GEN x, long flag)
if (gc_needed(av,1))
{
if(DEBUGMEM>1) pari_warn(warnmem,"nfsnf");
- gerepileall(av,U?4:6, &A,&I,&J,&z,&U,&V);
+ gerepileall(av,U?6:4, &A,&I,&J,&z,&U,&V);
}
if (c) i++; /* iterate on row/column i */
}
diff --git a/src/basemath/bb_group.c b/src/basemath/bb_group.c
index ebb0330..7eecd4d 100644
--- a/src/basemath/bb_group.c
+++ b/src/basemath/bb_group.c
@@ -286,6 +286,30 @@ gen_powers(GEN x, long l, int use_sqr, void *E, GEN (*sqr)(void*,GEN),
return V;
}
+GEN
+gen_product(GEN x, void *data, GEN (*mul)(void *,GEN,GEN))
+{
+ pari_sp ltop;
+ long i,k,lx = lg(x);
+
+ if (lx == 1) return gen_1;
+ if (lx == 2) return gcopy(gel(x,1));
+ x = leafcopy(x); k = lx;
+ ltop=avma;
+ while (k > 2)
+ {
+ if (DEBUGLEVEL>7)
+ err_printf("prod: remaining objects %ld\n",k-1);
+ lx = k; k = 1;
+ for (i=1; i<lx-1; i+=2)
+ gel(x,k++) = mul(data,gel(x,i),gel(x,i+1));
+ if (i < lx) gel(x,k++) = gel(x,i);
+ if (gc_needed(ltop,1))
+ gerepilecoeffs(ltop,x+1,k-1);
+ }
+ return gel(x,1);
+}
+
/***********************************************************************/
/** **/
/** DISCRETE LOGARITHM **/
diff --git a/src/basemath/bibli1.c b/src/basemath/bibli1.c
index 93cf5a1..1959508 100644
--- a/src/basemath/bibli1.c
+++ b/src/basemath/bibli1.c
@@ -224,7 +224,7 @@ R_from_QR(GEN x, long prec)
/* return Gram-Schmidt orthogonal basis (f) associated to (e), B is the
* vector of the (f_i . f_i)*/
GEN
-gram_schmidt(GEN e, GEN *ptB)
+RgM_gram_schmidt(GEN e, GEN *ptB)
{
long i,j,lx = lg(e);
GEN f = RgM_shallowcopy(e), B, iB;
@@ -250,6 +250,27 @@ gram_schmidt(GEN e, GEN *ptB)
*ptB = B; return f;
}
+/* Assume B an LLL-reduced basis, t a vector. Apply Babai's nearest plane
+ * algorithm to (B,t) */
+GEN
+RgM_Babai(GEN B, GEN t)
+{
+ GEN C, N, G = RgM_gram_schmidt(B, &N), b = t;
+ long j, n = lg(B)-1;
+
+ C = cgetg(n+1,t_COL);
+ for (j = n; j > 0; j--)
+ {
+ GEN c = gdiv( RgV_dotproduct(b, gel(G,j)), gel(N,j) );
+ long e;
+ c = grndtoi(c,&e);
+ if (e >= 0) return NULL;
+ if (signe(c)) b = RgC_sub(b, RgC_Rg_mul(gel(G,j), c));
+ gel(C,j) = c;
+ }
+ return C;
+}
+
/********************************************************************/
/** **/
/** LLL ALGORITHM **/
@@ -1150,12 +1171,14 @@ minim0_dolll(GEN a, GEN BORNE, GEN STOCKMAX, long flag, long dolll)
break;
case min_FIRST:
if (n == 1) return cgetg(1,t_VEC);
+ if (!sBORNE && BORNE) return cgetg(1, t_VEC);
break;
case min_PERF:
if (n == 1) return gen_0;
break;
default:
- if (n == 1) retmkvec3(gen_0, gen_0, cgetg(1, t_MAT));
+ if (n == 1 || (!sBORNE && BORNE))
+ retmkvec3(gen_0, gen_0, cgetg(1, t_MAT));
break;
}
minim_alloc(n, &q, &x, &y, &z, &v);
@@ -1380,7 +1403,7 @@ minim2(GEN a, GEN borne, GEN stockmax)
GEN
perf(GEN a)
{
- return minim0(a,gen_0,gen_0,min_PERF);
+ return minim0(a,NULL,NULL,min_PERF);
}
static GEN
@@ -1529,7 +1552,9 @@ smallvectors(GEN q, GEN BORNE, long maxnum, FP_chk_fun *CHECK)
borne1 = BORNE;
if (typ(borne1) != t_REAL)
{
- long prec = nbits2prec(gexpo(borne1) + 10);
+ long prec;
+ if (gequal0(borne1)) retmkvec3(gen_0, gen_0, cgetg(1,t_MAT));
+ prec = nbits2prec(gexpo(borne1) + 10);
borne1 = gtofp(borne1, maxss(prec, DEFAULTPREC));
}
}
diff --git a/src/basemath/bibli2.c b/src/basemath/bibli2.c
index f985d08..5622dc2 100644
--- a/src/basemath/bibli2.c
+++ b/src/basemath/bibli2.c
@@ -826,7 +826,7 @@ binomial(GEN n, long k)
{
y = cgetg(k+1,t_VEC);
for (i=1; i<=k; i++) gel(y,i) = subis(n,i-1);
- y = divide_conquer_prod(y,mulii);
+ y = ZV_prod(y);
}
y = diviiexact(y, mpfact(k));
return gerepileuptoint(av, y);
@@ -840,9 +840,7 @@ binomial(GEN n, long k)
y = cgetg(k+1,t_VEC);
for (i=1; i<=k; i++) gel(y,i) = gsubgs(n,i-1);
- y = divide_conquer_prod(y,gmul);
- y = gdiv(y, mpfact(k));
- return gerepileupto(av, y);
+ return gerepileupto(av, gdiv(RgV_prod(y), mpfact(k)));
}
/* Assume n >= 0, return bin, bin[k+1] = binomial(n, k) */
@@ -1355,7 +1353,9 @@ static void
init_sort(GEN *x, long *tx, long *lx)
{
*tx = typ(*x);
- if (*tx == t_LIST) {
+ if (*tx == t_LIST)
+ {
+ if (list_typ(*x)!=t_LIST_RAW) pari_err_TYPE("sort",*x);
*x = list_data(*x);
*lx = *x? lg(*x): 1;
} else {
@@ -1789,7 +1789,9 @@ gtoset(GEN x)
{
case t_VEC:
case t_COL: lx = lg(x); break;
- case t_LIST: x = list_data(x); lx = x? lg(x): 1; break;
+ case t_LIST:
+ if (list_typ(x)==t_LIST_MAP) return mapdomain(x);
+ x = list_data(x); lx = x? lg(x): 1; break;
case t_VECSMALL: lx = lg(x); x = zv_to_ZV(x); break;
default: return mkveccopy(x);
}
@@ -1818,7 +1820,9 @@ setsearch(GEN T, GEN y, long flag)
switch(typ(T))
{
case t_VEC: lx = lg(T); break;
- case t_LIST: T = list_data(T); lx = T? lg(T): 1; break;
+ case t_LIST:
+ if (list_typ(T) != t_LIST_RAW) pari_err_TYPE("setsearch",T);
+ T = list_data(T); lx = T? lg(T): 1; break;
default: pari_err_TYPE("setsearch",T);
return 0; /*not reached*/
}
diff --git a/src/basemath/buch2.c b/src/basemath/buch2.c
index 09186b8..db4e303 100644
--- a/src/basemath/buch2.c
+++ b/src/basemath/buch2.c
@@ -531,7 +531,7 @@ cache_prime_dec(GRHcheck_t *S, ulong LIM, GEN nf)
}
static double
-tailresback(long LIMC, long LIMC2, long LIMC3, long R1, long R2, double rK, double r1K, double r2K, double logLIMC, double logLIMC2, double logLIMC3)
+tailresback(long LIMC, double LIMC2, double LIMC3, long R1, long R2, double rK, double r1K, double r2K, double logLIMC, double logLIMC2, double logLIMC3)
{
const double rQ = 1.83787706641;
const double r1Q = 1.98505372441;
@@ -550,7 +550,7 @@ tailres(long R1, long R2, double al2K, double rKm, double rKM, double r1Km, doub
const double logLIMC = log(LIMC), logLIMC2 = logLIMC*logLIMC;
const double logLIMC3 = logLIMC*logLIMC2;
const double E1 = rtodbl(eint1(dbltor(logLIMC/2), DEFAULTPREC));
- const long LIMC2 = LIMC*LIMC, LIMC3 = LIMC*LIMC2;
+ const double LIMC2 = LIMC*LIMC, LIMC3 = LIMC*LIMC2;
return
al2K*((33*logLIMC2+22*logLIMC+8)/(8*logLIMC3*sqrt(LIMC))+15*E1/16)
+ maxdd(
@@ -763,8 +763,11 @@ FBgen(FB_t *F, GEN nf, long N, ulong C1, ulong C2, GRHcheck_t *S)
if (DEBUGLEVEL>1) { err_printf(" %ld",p); err_flush(); }
f = gel(pr->dec, 1); nb = gel(pr->dec, 2);
- if (f[1] == N) continue; /* p inert */
- /* compute l such that p^f <= C2 <=> f <= l */
+ if (f[1] == N)
+ {
+ if (p == C2) break;
+ continue; /* p inert */
+ }/* compute l such that p^f <= C2 <=> f <= l */
l = (long)(L/pr->logp);
for (k=0, m=1; m < lg(f) && f[m]<=l; m++) k += nb[m];
if (!k) /* p too inert to appear in FB */
@@ -3931,7 +3934,8 @@ Buchall_param(GEN P, double cbach, double cbach2, long nbrelpid, long flun, long
long MAXDEPSIZESFB, MAXDEPSFB;
long nreldep, sfb_trials, need, old_need, precdouble = 0, precadd = 0;
long done_small, small_fail, fail_limit, squash_index, small_norm_prec;
- double lim, drc, LOGD, LOGD2;
+ long lim;
+ double LOGD, LOGD2;
GEN computed = NULL, zu, nf, M_sn, D, A, W, R, h, PERM, fu = NULL /*-Wall*/;
GEN small_multiplier;
GEN res, L, invhr, B, C, C0, lambda, dep, clg1, clg2, Vbase;
@@ -3971,11 +3975,13 @@ Buchall_param(GEN P, double cbach, double cbach2, long nbrelpid, long flun, long
nf_get_sign(nf, &R1, &R2); RU = R1+R2;
compute_vecG(nf, &F, minss(RU, 9));
if (DEBUGLEVEL) timer_printf(&T, "weighted G matrices");
- D = absi(nf_get_disc(nf)); drc = gtodouble(D);
+ D = absi(nf_get_disc(nf));
if (DEBUGLEVEL) err_printf("R1 = %ld, R2 = %ld\nD = %Ps\n",R1,R2, D);
- LOGD = log(drc); LOGD2 = LOGD*LOGD;
- lim = exp(-N + R2 * log(4/M_PI)) * sqrt(2*M_PI*N*drc);
- if (lim < 3.) lim = 3.;
+ LOGD = dbllog2(D) * LOG2; LOGD2 = LOGD*LOGD;
+ if (expi(D) < 1024)
+ lim = maxuu(3, exp(-N + R2 * log(4/M_PI) + LOGD/2) * sqrt(2*M_PI*N));
+ else
+ lim = LONG_MAX;
if (cbach > 12.) {
if (cbach2 < cbach) cbach2 = cbach;
cbach = 12.;
@@ -4064,7 +4070,7 @@ START:
M_sn = nf_get_M(nf);
if (small_norm_prec < PRECREG) M_sn = gprec_w(M_sn, small_norm_prec);
else if (precdouble) M_sn = gcopy(M_sn);
- subFBgen(&F,nf,auts,cyclic,mindd(lim,LIMC2) + 0.5,MINSFB);
+ subFBgen(&F,nf,auts,cyclic,minss(lim,LIMC2),MINSFB);
if (DEBUGLEVEL)
{
if (lg(F.subFB) > 1)
diff --git a/src/basemath/concat.c b/src/basemath/concat.c
index d0b9151..543d705 100644
--- a/src/basemath/concat.c
+++ b/src/basemath/concat.c
@@ -27,6 +27,7 @@ listconcat(GEN A, GEN B)
GEN L, z, L1, L2;
if (typ(A) != t_LIST) {
+ if (list_typ(B)!=t_LIST_RAW) pari_err_TYPE("listconcat",B);
L2 = list_data(B);
if (!L2) return mklistcopy(A);
lx = lg(L2) + 1;
@@ -35,6 +36,7 @@ listconcat(GEN A, GEN B)
for (i = 2; i < lx; i++) gel(L,i) = gcopy(gel(L2,i-1));
gel(L,1) = gcopy(A); return z;
} else if (typ(B) != t_LIST) {
+ if (list_typ(A)!=t_LIST_RAW) pari_err_TYPE("listconcat",A);
L1 = list_data(A);
if (!L1) return mklistcopy(B);
lx = lg(L1) + 1;
@@ -44,13 +46,15 @@ listconcat(GEN A, GEN B)
gel(L,i) = gcopy(B); return z;
}
/* A, B both t_LISTs */
+ if (list_typ(A)!=t_LIST_RAW) pari_err_TYPE("listconcat",A);
+ if (list_typ(B)!=t_LIST_RAW) pari_err_TYPE("listconcat",B);
L1 = list_data(A); if (!L1) return listcopy(B);
L2 = list_data(B); if (!L2) return listcopy(A);
l1 = lg(L1);
lx = l1-1 + lg(L2);
z = cgetg(3, t_LIST);
- list_nmax(z) = 0;
+ z[1] = 0UL;
list_data(z) = L = cgetg(lx, t_VEC);
L2 -= l1-1;
for (i=1; i<l1; i++) gel(L,i) = gclone(gel(L1,i));
@@ -293,6 +297,7 @@ shallowconcat1(GEN x)
if (lx==1) pari_err_DOMAIN("concat","vector","=",x,x);
break;
case t_LIST:
+ if (list_typ(x)!=t_LIST_RAW) pari_err_TYPE("concat",x);
if (!list_data(x)) pari_err_DOMAIN("concat","vector","=",x,x);
x = list_data(x); lx = lg(x);
break;
diff --git a/src/basemath/ellanal.c b/src/basemath/ellanal.c
index 95331a4..f54e55b 100644
--- a/src/basemath/ellanal.c
+++ b/src/basemath/ellanal.c
@@ -32,8 +32,7 @@ struct bg_data
GEN E, N; /* ell, conductor */
GEN bnd; /* t_INT; will need all an for n <= bnd */
ulong rootbnd; /* sqrt(bnd) */
- GEN an; /* t_VECSMALL: cache of ap, n <= rootbnd */
- GEN ap; /* t_VECSMALL: cache of ap, p <= rootbnd */
+ GEN an; /* t_VECSMALL: cache of an, n <= rootbnd */
GEN p; /* t_VECSMALL: primes <= rootbnd */
};
@@ -63,7 +62,7 @@ gen_BG_add(void *E, bg_fun *fun, struct bg_data *bg, GEN n, long i, GEN a, GEN l
ulong p = bg->p[j];
GEN nexta, pn = mului(p, n);
if (cmpii(pn, bg->bnd) > 0) return;
- nexta = mulis(a, bg->ap[j]);
+ nexta = mulis(a, bg->an[p]);
if (i == j && umodiu(bg->N, p)) nexta = subii(nexta, mului(p, lasta));
gen_BG_add(E, fun, bg, pn, j, nexta, a);
avma = av;
@@ -71,26 +70,14 @@ gen_BG_add(void *E, bg_fun *fun, struct bg_data *bg, GEN n, long i, GEN a, GEN l
}
static void
-gen_BG_init(struct bg_data *bg, GEN E, GEN N, GEN bnd, GEN ap)
+gen_BG_init(struct bg_data *bg, GEN E, GEN N, GEN bnd)
{
- pari_sp av;
- long i = 1, l;
- bg->E = E; bg->N = N;
+ bg->E = E;
+ bg->N = N;
bg->bnd = bnd;
bg->rootbnd = itou(sqrtint(bnd));
bg->p = primes_upto_zv(bg->rootbnd);
- l = lg(bg->p);
- if (ap)
- { /* reuse known values */
- i = lg(ap);
- bg->ap = vecsmall_lengthen(ap, maxss(l,i)-1);
- }
- else bg->ap = cgetg(l, t_VECSMALL);
- av = avma;
- for ( ; i < l; i++, avma = av) bg->ap[i] = itos(ellap(E, utoipos(bg->p[i])));
- avma = av;
- bg->an = zero_zv(bg->rootbnd);
- bg->an[1] = 1;
+ bg->an = anellsmall(E, bg->rootbnd);
}
static void
@@ -108,7 +95,7 @@ gen_BG_rec(void *E, bg_fun *fun, struct bg_data *bg)
for (i = 1; i <= lp; i++)
{
ulong pp = bg->p[i];
- long ap = bg->ap[i];
+ long ap = bg->an[pp];
gen_BG_add(E, fun, bg, utoipos(pp), i, stoi(ap), gen_1);
avma = av2;
}
@@ -295,7 +282,7 @@ vecF2_lk_bsgs(GEN E, GEN bnd, GEN rbnd, GEN Q, GEN sleh, GEN N, long prec)
long k, L = lg(bnd)-1;
GEN S;
baby_init(&bb, Q, bnd, rbnd, prec);
- gen_BG_init(&bg, E, N, gel(bnd,1), NULL);
+ gen_BG_init(&bg, E, N, gel(bnd,1));
gen_BG_rec((void*) &bb, ellL1_add, &bg);
S = cgetg(L+1, t_VEC);
for (k = 1; k <= L; ++k)
@@ -393,7 +380,7 @@ ellgammafactor(GEN N, GEN s, long prec)
static GEN
ellL1_eval(GEN e, GEN vec, struct lcritical *C, GEN t, long prec)
{
- GEN gam = ellgammafactor(ellQ_get_N(e), gaddgs(t, 1), prec);
+ GEN gam = ellgammafactor(ellQ_get_N(e), gaddgs(gmul(gen_I(),t), 1), prec);
return gdiv(Llambda(vec, C, t, prec), gam);
}
@@ -401,7 +388,7 @@ static GEN
ellL1_der(GEN e, GEN vec, struct lcritical *C, GEN t, long der, long prec)
{
GEN r = polcoeff0(ellL1_eval(e, vec, C, t, prec), der, 0);
- if (odd(der>>1)) r = gneg(r);
+ r = gdiv(r,gpowgs(gen_I(), C->real == 1 ? der: der-1));
return gmul(r, mpfact(der));
}
@@ -572,7 +559,7 @@ heegner_psi(GEN E, GEN N, GEN points, long bitprec)
}
gerepileall(av2, 2, &bnd, &Q);
bndmax = gel(bnd,vecindexmax(bnd));
- gen_BG_init(&bg, E, N, bndmax, NULL);
+ gen_BG_init(&bg, E, N, bndmax);
if (bitprec >= 1900)
{
GEN S;
diff --git a/src/basemath/elliptic.c b/src/basemath/elliptic.c
index 65a741d..0800781 100644
--- a/src/basemath/elliptic.c
+++ b/src/basemath/elliptic.c
@@ -1366,11 +1366,49 @@ ellisoncurve(GEN e, GEN x)
return oncurve(e, x)? gen_1: gen_0;
}
+/* y1 = y2 or -LHS0-y2 */
+static GEN
+slope_samex(GEN e, GEN x, GEN y1, GEN y2)
+{
+ GEN dy,dx;
+ if (y1 != y2)
+ {
+ int eq;
+ if (precision(y1) || precision(y2))
+ eq = (gexpo(gadd(ec_h_evalx(e,x),gadd(y1,y2))) >= gexpo(y1));
+ else
+ eq = gequal(y1,y2);
+ if (!eq) return NULL;
+ }
+ dx = ec_dmFdy_evalQ(e,mkvec2(x,y1));
+ if (gequal0(dx)) return NULL;
+ dy = gadd(gsub(ell_get_a4(e),gmul(ell_get_a1(e),y1)),
+ gmul(x,gadd(gmul2n(ell_get_a2(e),1),gmulsg(3,x))));
+ return gdiv(dy,dx);
+}
+static GEN
+get_slope(GEN e, GEN x1, GEN x2, GEN y1, GEN y2)
+{
+ GEN dy,dx;
+ if (x1 == x2 || gequal(x1,x2))
+ return slope_samex(e, x1, y1, y2);
+ dx = gsub(x2,x1);
+ if (typ(dx) == t_COMPLEX) /* its Norm may be 0 */
+ {
+ GEN N = gnorm(dx);
+ if (gequal0(N)) return slope_samex(e,x1,y1,y2);
+ dy = gsub(y2,y1);
+ return gdiv(gmul(dy,gconj(dx)),N); /* dy/dx */
+ }
+ dy = gsub(y2,y1);
+ return gdiv(dy,dx);
+}
+
GEN
elladd(GEN e, GEN z1, GEN z2)
{
- GEN p1, p2, x, y, x1, x2, y1, y2;
- pari_sp av = avma, tetpil;
+ GEN s, z, x, y, x1, x2, y1, y2;
+ pari_sp av = avma;
checkell(e); checkellpt(z1); checkellpt(z2);
if (ell_is_inf(z1)) return gcopy(z2);
@@ -1386,32 +1424,13 @@ elladd(GEN e, GEN z1, GEN z2)
y1 = nftoalg(nf, y1);
y2 = nftoalg(nf, y2);
}
- if (x1 == x2 || gequal(x1,x2))
- { /* y1 = y2 or -LHS0-y2 */
- if (y1 != y2)
- {
- int eq;
- if (precision(y1) || precision(y2))
- eq = (gexpo(gadd(ec_h_evalx(e,x1),gadd(y1,y2))) >= gexpo(y1));
- else
- eq = gequal(y1,y2);
- if (!eq) { avma = av; return ellinf(); }
- }
- p2 = ec_dmFdy_evalQ(e,z1);
- if (gequal0(p2)) { avma = av; return ellinf(); }
- p1 = gadd(gsub(ell_get_a4(e),gmul(ell_get_a1(e),y1)),
- gmul(x1,gadd(gmul2n(ell_get_a2(e),1),gmulsg(3,x1))));
- }
- else {
- p1 = gsub(y2,y1);
- p2 = gsub(x2,x1);
- }
- p1 = gdiv(p1,p2);
- x = gsub(gmul(p1,gadd(p1,ell_get_a1(e))), gadd(gadd(x1,x2),ell_get_a2(e)));
- y = gadd(gadd(y1, ec_h_evalx(e,x)), gmul(p1,gsub(x,x1)));
- tetpil = avma; p1 = cgetg(3,t_VEC);
- gel(p1,1) = gcopy(x);
- gel(p1,2) = gneg(y); return gerepile(av,tetpil,p1);
+ s = get_slope(e,x1,x2,y1,y2);
+ if (!s) { avma = av; return ellinf(); }
+ x = gsub(gmul(s,gadd(s,ell_get_a1(e))), gadd(gadd(x1,x2),ell_get_a2(e)));
+ y = gadd(gadd(y1, ec_h_evalx(e,x)), gmul(s,gsub(x,x1)));
+ z = cgetg(3,t_VEC);
+ gel(z,1) = gcopy(x);
+ gel(z,2) = gneg(y); return gerepileupto(av, z);
}
static GEN
@@ -2978,12 +2997,12 @@ ellwpnum_all(GEN e, GEN z, long flall, long prec)
u = expIxy(pi2, T.Z, prec);
u1 = gsubsg(1,u);
u2 = gsqr(u1); /* (1-u)^2 = -4u sin^2(Pi Z) */
- if (gequal0(u2)) return NULL; /* possible if loss of accuracy */
+ if (gequal0(gnorm(u2))) return NULL; /* possible if loss of accuracy */
y = gdiv(u,u2); /* -1/4(sin^2(Pi Z)) */
if (T.abs_u_is_1) y = real_i(y);
simple_case = T.abs_u_is_1 && T.q_is_real;
y = gadd(mkfrac(gen_1, utoipos(12)), y);
- yp = flall? gdiv(gaddsg(1,u), gmul(u1,u2)): NULL;
+ yp = flall? gen_0: NULL;
toadd = (long)ceil(get_toadd(T.Z));
av1 = avma; qn = q;
@@ -2995,12 +3014,8 @@ ellwpnum_all(GEN e, GEN z, long flall, long prec)
GEN a = gsubsg(1,qnu);/* 1 - q^n u */
GEN a2 = gsqr(a); /* (1 - q^n u)^2 */
if (yp) ypadd = gdiv(gaddsg(1,qnu),gmul(a,a2));
- if (simple_case)
- { /* conj(u) = 1/u: formula simplifies */
- yadd = gdiv(u, a2);
- yadd = gmul2n(real_i(yadd), 1);
- if (yp) ypadd = gmul2n(real_i(ypadd), 1);
- }
+ if (simple_case) /* conj(u) = 1/u: formula simplifies */
+ yadd = gmul2n(real_i(gdiv(u,a2)), 1);
else
{
GEN b = gsub(qn,u);/* q^n - u */
@@ -3020,6 +3035,11 @@ ellwpnum_all(GEN e, GEN z, long flall, long prec)
gerepileall(av1, flall? 3: 2, &y, &qn, &yp);
}
}
+ if (yp)
+ {
+ if (simple_case) yp = gsub(yp, gconj(gmul(yp,gsqr(u))));
+ yp = gadd(yp, gdiv(gaddsg(1,u), gmul(u1,u2)));
+ }
u1 = gdiv(pi2, mulcxmI(T.W2));
u2 = gsqr(u1);
@@ -3722,16 +3742,16 @@ static GEN
nflocalred_p(GEN e, GEN P)
{
GEN nf = ellnf_get_nf(e), T,p, modP = nf_to_Fq_init(nf,&P,&T,&p);
- long c, f, vc4, vc6, vD, kod, m;
+ long c, f, vD, nuj, kod, m;
GEN ch, c4, c6, D, z, pi, piinv;
c4 = ell_get_c4(e);
c6 = ell_get_c6(e);
D = ell_get_disc(e);
- vc4= nfval(nf,c4,P);
- vc6= nfval(nf,c6,P);
vD = nfval(nf,D,P);
- m = minss(vc4/4, vc6/6);
+ nuj = nfval(nf,ell_get_j(e),P);
+ nuj = nuj >= 0? 0: -nuj; /* v_P(denom(j)) */
+ m = (vD - nuj)/12;
piinv = pr_get_tau(P);
if (typ(piinv) == t_MAT) piinv = gel(piinv,1);
piinv = gdiv(piinv, p); /* v_P(piinv) = -1, v_Q(piinv) >= 0, Q!=P */
@@ -3747,8 +3767,8 @@ nflocalred_p(GEN e, GEN P)
ui4 = nfsqr(nf,ui2);
ui6 = nfmul(nf,ui2,ui4);
ui12 = nfsqr(nf,ui6);
- c4 = nfmul(nf,c4,ui4); vc4-= 4*m;
- c6 = nfmul(nf,c6,ui6); vc6-= 6*m;
+ c4 = nfmul(nf,c4,ui4);
+ c6 = nfmul(nf,c6,ui6);
D = nfmul(nf,D,ui12); vD -= 12*m;
a1 = nf_to_scalar_or_basis(nf, ell_get_a1(e));
a2 = nf_to_scalar_or_basis(nf, ell_get_a2(e));
@@ -3763,9 +3783,9 @@ nflocalred_p(GEN e, GEN P)
kod = 0; c = 1;
/* minimal at P */
- if (3*vc4 < vD)
+ if (nuj > 0)
{ /* v(j) < 0 */
- if (vc4==0)
+ if (vD == nuj)
{ /* v(c4) = v(c6) = 0, multiplicative reduction */
f = 1; kod = 4+vD;
z = Fq_neg(nf_to_Fq(nf,c6,modP), T,p);
@@ -4856,74 +4876,91 @@ ellQ_get_CM(GEN e)
}
return CM;
}
+
+/* bad reduction at p */
+static void
+sievep_bad(ulong p, GEN an, ulong n)
+{
+ ulong m, N;
+ switch (an[p]) /* (-c6/p) */
+ {
+ case -1: /* non-split */
+ N = n/p;
+ for (m=2; m<=N; m++)
+ if (an[m] != LONG_MAX) an[m*p] = -an[m];
+ break;
+ case 0: /* additive */
+ for (m=2*p; m<=n; m+=p) an[m] = 0;
+ break;
+ case 1: /* split */
+ N = n/p;
+ for (m=2; m<=N; m++)
+ if (an[m] != LONG_MAX) an[m*p] = an[m];
+ break;
+ }
+}
+/* good reduction at p */
+static void
+sievep_good(ulong p, GEN an, ulong n, ulong SQRTn)
+{
+ const long ap = an[p];
+ ulong m;
+ if (p <= SQRTn) {
+ ulong pk, oldpk = 1;
+ for (pk=p; pk <= n; oldpk=pk, pk *= p)
+ {
+ if (pk != p) an[pk] = ap * an[oldpk] - p * an[oldpk/p];
+ for (m = n/pk; m > 1; m--)
+ if (an[m] != LONG_MAX && m%p) an[m*pk] = an[m] * an[pk];
+ }
+ } else {
+ for (m = n/p; m > 1; m--)
+ if (an[m] != LONG_MAX) an[m*p] = ap * an[m];
+ }
+}
+static void
+sievep(ulong p, GEN an, ulong n, ulong SQRTn, int good_red)
+{
+ if (good_red)
+ sievep_good(p, an, n, SQRTn);
+ else
+ sievep_bad(p, an, n);
+}
+
+static long
+ellan_get_ap(ulong p, int *good_red, int CM, GEN e)
+{
+ if (!umodiu(ell_get_disc(e),p)) /* p|D, bad reduction or non-minimal model */
+ return is_minimal_ap_small(e, p, good_red);
+ else /* good reduction */
+ {
+ *good_red = 1;
+ return ellap_CM_fast(e, p, CM);
+ }
+}
GEN
anellsmall(GEN e, long n0)
{
pari_sp av;
- ulong p, m, SQRTn, n = (ulong)n0;
- GEN an, D;
- long CM;
+ ulong p, SQRTn, n = (ulong)n0;
+ GEN an;
+ int CM;
checkell_int(e);
if (n0 <= 0) return cgetg(1,t_VEC);
if (n >= LGBITS)
pari_err_IMPL( stack_sprintf("ellan for n >= %lu", LGBITS) );
SQRTn = (ulong)sqrt(n);
- D = ell_get_disc(e);
CM = ellQ_get_CM(e);
- an = cgetg(n+1,t_VECSMALL); an[1] = 1;
- av = avma;
- for (p=2; p <= n; p++) an[p] = LONG_MAX; /* not computed yet */
+ an = const_vecsmall(n, LONG_MAX);
+ an[1] = 1; av = avma;
for (p=2; p<=n; p++)
{
- long ap;
+ int good_red;
if (an[p] != LONG_MAX) continue; /* p not prime */
- if (!umodiu(D,p)) /* p | D, bad reduction or non-minimal model */
- {
- int good_red;
- ap = is_minimal_ap_small(e, p, &good_red);
- if (good_red) goto GOOD_RED;
- switch (ap) /* (-c6/p) */
- {
- case -1: { /* non-split */
- ulong N = n/p;
- for (m=1; m<=N; m++)
- if (an[m] != LONG_MAX) an[m*p] = -an[m];
- break;
- }
- case 0: /* additive */
- for (m=p; m<=n; m+=p) an[m] = 0;
- break;
- case 1: { /* split */
- ulong N = n/p;
- for (m=1; m<=N; m++)
- if (an[m] != LONG_MAX) an[m*p] = an[m];
- break;
- }
- }
- }
- else /* good reduction */
- {
- ap = ellap_CM_fast(e, p, CM);
-GOOD_RED:
- if (p <= SQRTn) {
- ulong pk, oldpk = 1;
- for (pk=p; pk <= n; oldpk=pk, pk *= p)
- {
- if (pk == p)
- an[pk] = ap;
- else
- an[pk] = ap * an[oldpk] - p * an[oldpk/p];
- for (m = n/pk; m > 1; m--)
- if (an[m] != LONG_MAX && m%p) an[m*pk] = an[m] * an[pk];
- }
- } else {
- an[p] = ap;
- for (m = n/p; m > 1; m--)
- if (an[m] != LONG_MAX) an[m*p] = ap * an[m];
- }
- }
+ an[p] = ellan_get_ap(p, &good_red, CM, e);
+ sievep(p, an, n, SQRTn, good_red);
}
avma = av; return an;
}
diff --git a/src/basemath/galconj.c b/src/basemath/galconj.c
index f0a6528..4fe8a65 100644
--- a/src/basemath/galconj.c
+++ b/src/basemath/galconj.c
@@ -228,7 +228,7 @@ vandermondeinverseprep(GEN L)
long k = 1;
for (j = 1; j < n; j++)
if (i != j) gel(W, k++) = gsub(gel(L,i),gel(L,j));
- gel(V,i) = gerepileupto(ltop,divide_conquer_prod(W,&gmul));
+ gel(V,i) = gerepileupto(ltop, RgV_prod(W));
}
return V;
}
@@ -332,7 +332,7 @@ initgaloisborne(GEN T, GEN dn, long prec, GEN *ptL, GEN *ptprep, GEN *ptdis)
prep = vandermondeinverseprep(L);
if (!dn)
{
- GEN dis, res = divide_conquer_prod(gabs(prep,prec), mpmul);
+ GEN dis, res = RgV_prod(gabs(prep,prec));
dis = ZX_disc_all(T, expi(ceil_safe(res)));
den = indexpartial(T,dis);
if (ptdis) *ptdis = dis;
diff --git a/src/basemath/gen1.c b/src/basemath/gen1.c
index 480a587..aa22299 100644
--- a/src/basemath/gen1.c
+++ b/src/basemath/gen1.c
@@ -3356,15 +3356,9 @@ ginv(GEN x)
togglesign(gel(y,2));
return y;
case t_MAT:
- {
- GEN ff = NULL;
- if (RgM_is_FFM(x,&ff))
- y = FFM_inv(x, ff);
- else
- y = RgM_inv(x);
+ y = RgM_inv(x);
if (!y) pari_err_INV("ginv",x);
return y;
- }
case t_VECSMALL:
{
long i, lx = lg(x)-1;
diff --git a/src/basemath/gen2.c b/src/basemath/gen2.c
index f30c789..4bff60c 100644
--- a/src/basemath/gen2.c
+++ b/src/basemath/gen2.c
@@ -64,6 +64,13 @@ map_proto_lGL(long f(GEN,long), GEN x, long y)
return stoi(f(x,y));
}
+static GEN
+_domul(void *data, GEN x, GEN y)
+{
+ GEN (*mul)(GEN,GEN)=(GEN (*)(GEN,GEN)) data;
+ return mul(x,y);
+}
+
GEN
gassoc_proto(GEN f(GEN,GEN), GEN x, GEN y)
{
@@ -78,7 +85,8 @@ gassoc_proto(GEN f(GEN,GEN), GEN x, GEN y)
case t_COL: break;
default: pari_err_TYPE("association",x);
}
- return gerepileupto(av, divide_conquer_prod(x,f));
+ return gerepileupto(av, gen_product(x, (void *)f, _domul));
+
}
return f(x,y);
}
@@ -528,12 +536,27 @@ cmp_universal(GEN x, GEN y)
return cmp_universal_rec(x, y, 2);
case t_LIST:
- x = list_data(x);
- y = list_data(y);
- if (!x) return y? -1: 0;
- if (!y) return 1;
- return cmp_universal_rec(x, y, 1);
-
+ {
+ long tx = list_typ(x), ty = list_typ(y);
+ GEN vx, vy;
+ if (tx < ty) return -1;
+ if (tx > ty) return 1;
+ vx = list_data(x);
+ vy = list_data(y);
+ if (!vx) return vy? -1: 0;
+ if (!vy) return 1;
+ switch (tx)
+ {
+ case t_LIST_MAP:
+ {
+ pari_sp av = avma;
+ int ret = cmp_universal_rec(maptomat_shallow(x), maptomat_shallow(y),1);
+ avma = av; return ret;
+ }
+ default:
+ return cmp_universal_rec(vx, vy, 1);
+ }
+ }
default:
return cmp_universal_rec(x, y, lontyp[tx]);
}
@@ -564,6 +587,13 @@ cmprfrac(GEN a, GEN y)
int r = cmpri(mulri(a, d), c);
avma = av; return r;
}
+static int
+cmpgen(GEN x, GEN y)
+{
+ pari_sp av = avma;
+ int s = gsigne(gsub(x,y));
+ avma = av; return s;
+}
/* returns the sign of x - y when it makes sense. 0 otherwise */
int
@@ -577,6 +607,7 @@ gcmp(GEN x, GEN y)
case t_INT: return cmpii(x, y);
case t_REAL: return cmprr(x, y);
case t_FRAC: return cmpfrac(x, y);
+ case t_QUAD: return cmpgen(x, y);
case t_STR: return cmp_str(GSTR(x), GSTR(y));
case t_INFINITY:
{
@@ -586,6 +617,7 @@ gcmp(GEN x, GEN y)
return 0;
}
}
+ if (ty == t_INFINITY) return -inf_get_sign(y);
switch(tx)
{
case t_INT:
@@ -593,7 +625,7 @@ gcmp(GEN x, GEN y)
{
case t_REAL: return cmpir(x, y);
case t_FRAC: return cmpifrac(x, y);
- case t_INFINITY: return inf_get_sign(y) == 1? -1: 1;
+ case t_QUAD: return cmpgen(x, y);
}
break;
case t_REAL:
@@ -601,7 +633,7 @@ gcmp(GEN x, GEN y)
{
case t_INT: return cmpri(x, y);
case t_FRAC: return cmprfrac(x, y);
- case t_INFINITY: return inf_get_sign(y) == 1? -1: 1;
+ case t_QUAD: return cmpgen(x, y);
}
break;
case t_FRAC:
@@ -609,10 +641,12 @@ gcmp(GEN x, GEN y)
{
case t_INT: return -cmpifrac(y, x);
case t_REAL: return -cmprfrac(y, x);
- case t_INFINITY: return inf_get_sign(y) == 1? -1: 1;
+ case t_QUAD: return cmpgen(x, y);
}
break;
- case t_INFINITY: return inf_get_sign(x) == 1? 1: -1;
+ case t_QUAD:
+ return cmpgen(x, y);
+ case t_INFINITY: return inf_get_sign(x);
}
pari_err_TYPE2("comparison",x,y);
return 0;/*not reached*/
@@ -834,6 +868,31 @@ closure_identical(GEN x, GEN y)
return gidentical(gel(x,7),gel(y,7));
}
+static int
+list_cmp(GEN x, GEN y, int cmp(GEN x, GEN y))
+{
+ int t = list_typ(x);
+ GEN vx, vy;
+ if (list_typ(y)!=t) return 0;
+ vx = list_data(x);
+ vy = list_data(y);
+ if (!vx) return vy? 0: 1;
+ if (!vy) return 0;
+ if (lg(vx) != lg(vy)) return 0;
+ switch (t)
+ {
+ case t_LIST_MAP:
+ {
+ pari_sp av = avma;
+ GEN mx = maptomat_shallow(x), my = maptomat_shallow(y);
+ int ret = gidentical(gel(mx, 1), gel(my, 1)) && cmp(gel(mx, 2), gel(my, 2));
+ avma = av; return ret;
+ }
+ default:
+ return cmp(vx, vy);
+ }
+}
+
int
gidentical(GEN x, GEN y)
{
@@ -892,11 +951,7 @@ gidentical(GEN x, GEN y)
case t_CLOSURE:
return closure_identical(x,y);
case t_LIST:
- x = list_data(x);
- y = list_data(y);
- if (!x) return y? 0: 1;
- if (!y) return 0;
- return vecidentical(x, y);
+ return list_cmp(x, y, gidentical);
case t_INFINITY: return gidentical(gel(x,1),gel(y,1));
}
return 0;
@@ -1006,11 +1061,7 @@ gequal(GEN x, GEN y)
case t_VECSMALL:
return zv_equal(x,y);
case t_LIST:
- x = list_data(x);
- y = list_data(y);
- if (!x) return y? 0: 1;
- if (!y) return 0;
- return gequal(x, y);
+ return list_cmp(x, y, gequal);
case t_CLOSURE:
return closure_identical(x,y);
case t_INFINITY:
@@ -2563,6 +2614,21 @@ gsigne(GEN x)
{
case t_INT: case t_REAL: return signe(x);
case t_FRAC: return signe(gel(x,1));
+ case t_QUAD:
+ {
+ pari_sp av = avma;
+ GEN T = gel(x,1), a = gel(x,2), b = gel(x,3);
+ long sa, sb;
+ if (signe(gel(T,2)) > 0) break;
+ a = gmul2n(a,1);
+ if (signe(gel(T,3))) a = gadd(a,b);
+ /* a + b sqrt(D) > 0 ? */
+ sa = gsigne(a);
+ sb = gsigne(b); if (sa == sb) { avma = av; return sa; }
+ /* different signs, take conjugate expression */
+ sb = gsigne(gsub(gsqr(a), gmul(quad_disc(x), gsqr(b))));
+ avma = av; return sb * sa;
+ }
case t_INFINITY: return inf_get_sign(x);
}
pari_err_TYPE("gsigne",x);
@@ -2597,7 +2663,7 @@ ensure_nb(GEN L, long l)
v[0] = evaltyp(t_VEC) | _evallg(1);
}
list_data(L) = v;
- list_nmax(L) = nmax;
+ L[1] = evaltyp(list_typ(L))|evallg(nmax);
}
void
@@ -2610,30 +2676,36 @@ listkill(GEN L)
long i, l = lg(v);
for (i=1; i<l; i++) gunclone_deep(gel(v,i));
pari_free(v);
- list_nmax(L) = 0;
+ L[1] = evaltyp(list_typ(L));
list_data(L) = NULL;
}
}
GEN
-listcreate(void)
+listcreate_typ(long t)
{
GEN L = cgetg(3,t_LIST);
- list_nmax(L) = 0;
+ L[1] = evaltyp(t);
list_data(L) = NULL; return L;
}
GEN
+listcreate(void)
+{
+ return listcreate_typ(t_LIST_RAW);
+}
+
+GEN
listput(GEN L, GEN x, long index)
{
long l;
GEN z;
- if (typ(L) != t_LIST) pari_err_TYPE("listput",L);
if (index < 0) pari_err_COMPONENT("listput", "<", gen_0, stoi(index));
z = list_data(L);
l = z? lg(z): 1;
+ x = gclone(x);
if (!index || index >= l)
{
ensure_nb(L, l);
@@ -2642,26 +2714,38 @@ listput(GEN L, GEN x, long index)
l++;
} else
gunclone_deep( gel(z, index) );
- gel(z,index) = gclone(x);
+ gel(z,index) = x;
z[0] = evaltyp(t_VEC) | evallg(l); /*must be after gel(z,index) is set*/
return gel(z,index);
}
GEN
+listput0(GEN L, GEN x, long index)
+{
+ if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
+ pari_err_TYPE("listput",L);
+ return listput(L, x, index);
+}
+
+GEN
listinsert(GEN L, GEN x, long index)
{
long l, i;
GEN z;
- if (typ(L) != t_LIST) pari_err_TYPE("listinsert",L);
+ if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
+ pari_err_TYPE("listinsert",L);
z = list_data(L); l = z? lg(z): 1;
if (index <= 0) pari_err_COMPONENT("listinsert", "<=", gen_0, stoi(index));
if (index > l) pari_err_COMPONENT("listinsert", ">", stoi(l), stoi(index));
ensure_nb(L, l);
+ BLOCK_SIGINT_START
z = list_data(L);
for (i=l; i > index; i--) gel(z,i) = gel(z,i-1);
z[0] = evaltyp(t_VEC) | evallg(l+1);
- return gel(z,index) = gclone(x);
+ gel(z,index) = gclone(x);
+ BLOCK_SIGINT_END
+ return gel(z,index);
}
void
@@ -2676,9 +2760,19 @@ listpop(GEN L, long index)
if (!z || (l = lg(z)-1) == 0) return;
if (!index || index > l) index = l;
+ BLOCK_SIGINT_START
gunclone_deep( gel(z, index) );
z[0] = evaltyp(t_VEC) | evallg(l);
for (i=index; i < l; i++) z[i] = z[i+1];
+ BLOCK_SIGINT_END
+}
+
+void
+listpop0(GEN L, long index)
+{
+ if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
+ pari_err_TYPE("listpop",L);
+ listpop(L, index);
}
/* return a list with single element x, allocated on stack */
diff --git a/src/basemath/gen3.c b/src/basemath/gen3.c
index a0c803e..1915e23 100644
--- a/src/basemath/gen3.c
+++ b/src/basemath/gen3.c
@@ -1175,8 +1175,8 @@ checkdeflate(GEN x)
{
ulong d = 0, i, lx = (ulong)lg(x);
for (i=3; i<lx; i++)
- if (!gequal0(gel(x,i))) { d = ugcd(d,i-2); if (d == 1) break; }
- return (long)d;
+ if (!gequal0(gel(x,i))) { d = ugcd(d,i-2); if (d == 1) return 1; }
+ return d? (long)d: 1;
}
/* deflate (non-leaf) x recursively */
@@ -2907,6 +2907,7 @@ gtovec(GEN x)
for (i=1; i<lx; i++) gel(y,i) = gcopy(gel(x,i));
return y;
case t_LIST:
+ if (list_typ(x) == t_LIST_MAP) return mapdomain(x);
x = list_data(x); lx = x? lg(x): 1;
y = cgetg(lx, t_VEC);
for (i=1; i<lx; i++) gel(y,i) = gcopy(gel(x,i));
@@ -2934,7 +2935,7 @@ gtovec(GEN x)
GEN
gtovecrev0(GEN x, long n)
{
- GEN y = gtovec0(x, n);
+ GEN y = gtovec0(x, -n);
vecreverse_inplace(y);
return y;
}
@@ -2968,7 +2969,7 @@ gtocol(GEN x)
GEN
gtocolrev0(GEN x, long n)
{
- GEN y = gtocol0(x, n);
+ GEN y = gtocol0(x, -n);
long ly = lg(y), lim = ly>>1, i;
for (i = 1; i <= lim; i++) swap(gel(y,i), gel(y,ly-i));
return y;
@@ -4041,3 +4042,27 @@ poleval(GEN x, GEN y)
}
return gerepileupto(av0, gadd(p2, gmul(y,p1)));
}
+
+/* Evaluate a polynomial using Horner. Unstable!
+ * If ui != NULL, ui = 1/u, evaluate P(1/u)*u^(deg P): useful for |u|>1 */
+GEN
+RgX_cxeval(GEN T, GEN u, GEN ui)
+{
+ pari_sp ltop = avma;
+ GEN S;
+ long n, lim = lg(T)-1;
+ if (lim == 1) return gen_0;
+ if (lim == 2) return gcopy(gel(T,2));
+ if (!ui)
+ {
+ n = lim; S = gel(T,n);
+ for (n--; n >= 2; n--) S = gadd(gmul(u,S), gel(T,n));
+ }
+ else
+ {
+ n = 2; S = gel(T,2);
+ for (n++; n <= lim; n++) S = gadd(gmul(ui,S), gel(T,n));
+ S = gmul(gpowgs(u, lim-2), S);
+ }
+ return gerepileupto(ltop, S);
+}
diff --git a/src/basemath/hyperell.c b/src/basemath/hyperell.c
index da5bee8..a157aa3 100644
--- a/src/basemath/hyperell.c
+++ b/src/basemath/hyperell.c
@@ -33,6 +33,18 @@ Harrison, M. An extension of Kedlaya's algorithm for hyperelliptic
http://arxiv.org/pdf/1006.4206v3.pdf
*/
+/* We use the basis of differentials (x^i*dx/y^k) (i=1 to 2*g-1),
+ with k either 1 or 3, depending on p and d, see Harrison paper */
+
+static long
+get_basis(long p, long d)
+{
+ if (odd(d))
+ return p < d-1 ? 3 : 1;
+ else
+ return 2*p <= d-2 ? 3 : 1;
+}
+
static GEN
FpXXQ_red(GEN S, GEN T, GEN p)
{
@@ -135,7 +147,7 @@ frac_to_Fp(GEN a, GEN b, GEN p)
}
static GEN
-ZpXXQ_frob(GEN S, GEN U, GEN V, GEN T, ulong p, long e)
+ZpXXQ_frob(GEN S, GEN U, GEN V, long k, GEN T, ulong p, long e)
{
pari_sp av = avma, av2;
long i, pr = degpol(S), dT = degpol(T);
@@ -143,7 +155,7 @@ ZpXXQ_frob(GEN S, GEN U, GEN V, GEN T, ulong p, long e)
GEN Tp = FpX_deriv(T, q), Tp1 = RgX_shift_shallow(Tp, 1);
GEN M = gel(S,pr+2), R;
av2 = avma;
- for(i = pr-1; i>=0; i--)
+ for(i = pr-1; i>=k; i--)
{
GEN A, B, H, Bc;
ulong v, r;
@@ -280,7 +292,7 @@ static GEN
ZlX_hyperellpadicfrobenius(GEN H, ulong p, long n)
{
pari_sp av = avma;
- long N, i, d;
+ long k, N, i, d;
GEN F, s, Q, pN1, U, V;
pari_timer ti;
if (typ(H) != t_POL) pari_err_TYPE("hyperellpadicfrobenius",H);
@@ -288,12 +300,9 @@ ZlX_hyperellpadicfrobenius(GEN H, ulong p, long n)
d = degpol(H);
if (d <= 0)
pari_err_CONSTPOL("hyperellpadicfrobenius");
- if (odd(d) && p < (ulong) d)
- pari_err_DOMAIN("hyperellpadicfrobenius","p","<", utoi(d), utoi(p));
- if (!odd(d) && 2*p < (ulong) d)
- pari_err_DOMAIN("hyperellpadicfrobenius","2*p","<", utoi(d), utoi(2*p));
if (n < 1)
pari_err_DOMAIN("hyperellpadicfrobenius","n","<", gen_1, utoi(n));
+ k = get_basis(p, d);
N = n + logint(stoi(2*n), stoi(p), NULL);
pN1 = powuu(p,N+1);
Q = RgX_to_FpX(H, pN1);
@@ -303,6 +312,8 @@ ZlX_hyperellpadicfrobenius(GEN H, ulong p, long n)
s = revdigits(FpX_digits(RgX_inflate(Q, p), Q, pN1));
if (DEBUGLEVEL>1) timer_printf(&ti,"s1");
s = ZpXXQ_invsqrt(s, Q, p, N);
+ if (k==3)
+ s = FpXXQ_mul(s, FpXXQ_sqr(s, Q, pN1), Q, pN1);
if (DEBUGLEVEL>1) timer_printf(&ti,"invsqrt");
get_UV(&U, &V, Q, p, N+1);
F = cgetg(d, t_MAT);
@@ -310,9 +321,9 @@ ZlX_hyperellpadicfrobenius(GEN H, ulong p, long n)
{
pari_sp av2 = avma;
GEN M, D;
- D = diff_red(s, monomial(utoi(p),p*i-1,1),p>>1, Q, pN1);
+ D = diff_red(s, monomial(utoi(p),p*i-1,1),(k*p-1)>>1, Q, pN1);
if (DEBUGLEVEL>1) timer_printf(&ti,"red");
- M = ZpXXQ_frob(D, U, V, Q, p, N + 1);
+ M = ZpXXQ_frob(D, U, V, (k-1)>>1, Q, p, N + 1);
if (DEBUGLEVEL>1) timer_printf(&ti,"frob");
gel(F, i) = gerepilecopy(av2, RgX_to_RgC(M, d-1));
}
@@ -440,7 +451,7 @@ frac_to_Fq(GEN a, GEN b, GEN T, GEN p)
}
static GEN
-ZpXQXXQ_frob(GEN F, GEN U, GEN V, GEN S, GEN T, ulong p, long e)
+ZpXQXXQ_frob(GEN F, GEN U, GEN V, long k, GEN S, GEN T, ulong p, long e)
{
pari_sp av = avma, av2;
long i, pr = degpol(F), dS = degpol(S), v = varn(T);
@@ -448,7 +459,7 @@ ZpXQXXQ_frob(GEN F, GEN U, GEN V, GEN S, GEN T, ulong p, long e)
GEN Sp = RgX_deriv(S), Sp1 = RgX_shift_shallow(Sp, 1);
GEN M = gel(F,pr+2), R;
av2 = avma;
- for(i = pr-1; i>=0; i--)
+ for(i = pr-1; i>=k; i--)
{
GEN A, B, H, Bc;
ulong v, r;
@@ -528,7 +539,7 @@ Fq_get_UV(GEN *U, GEN *V, GEN S, GEN T, ulong p, long e)
GEN R = polresultantext(S, dS), C;
long v = varn(S);
if (signe(FpX_red(to_ZX(gel(R,3),v),utoi(p)))==0) is_sing(S, p);
- C = FpXQ_red(gel(R, 3), T, q);
+ C = FpXQ_red(to_ZX(gel(R, 3),v), T, q);
d = ZpXQ_inv(C, T, utoi(p), e);
*U = FpXQX_FpXQ_mul(FpXQX_red(to_ZX(gel(R,1),v),T,q),d,T,q);
*V = FpXQX_FpXQ_mul(FpXQX_red(to_ZX(gel(R,2),v),T,q),d,T,q);
@@ -556,7 +567,7 @@ GEN
ZlXQX_hyperellpadicfrobenius(GEN H, GEN T, ulong p, long n)
{
pari_sp av = avma;
- long N, i, d;
+ long k, N, i, d;
GEN xp, F, s, q, Q, pN1, U, V;
pari_timer ti;
if (typ(H) != t_POL) pari_err_TYPE("hyperellpadicfrobenius",H);
@@ -564,12 +575,9 @@ ZlXQX_hyperellpadicfrobenius(GEN H, GEN T, ulong p, long n)
d = degpol(H);
if (d <= 0)
pari_err_CONSTPOL("hyperellpadicfrobenius");
- if (odd(d) && p < (ulong) d)
- pari_err_DOMAIN("hyperellpadicfrobenius","p","<", utoi(d), utoi(p));
- if (!odd(d) && 2*p < (ulong) d)
- pari_err_DOMAIN("hyperellpadicfrobenius","2*p","<", utoi(d), utoi(p));
if (n < 1)
pari_err_DOMAIN("hyperellpadicfrobenius","n","<", gen_1, utoi(n));
+ k = get_basis(p, d);
N = n + logint(stoi(2*n), stoi(p), NULL);
q = powuu(p,n); pN1 = powuu(p,N+1); T = FpX_get_red(T, pN1);
Q = RgX_to_FqX(H, T, pN1);
@@ -580,6 +588,8 @@ ZlXQX_hyperellpadicfrobenius(GEN H, GEN T, ulong p, long n)
s = revdigits(FpXQX_digits(s, Q, T, pN1));
if (DEBUGLEVEL>1) timer_printf(&ti,"s1");
s = ZpXQXXQ_invsqrt(s, Q, T, p, N);
+ if (k==3)
+ s = FpXQXXQ_mul(s, FpXQXXQ_sqr(s, Q, T, pN1), Q, T, pN1);
if (DEBUGLEVEL>1) timer_printf(&ti,"invsqrt");
Fq_get_UV(&U, &V, Q, T, p, N+1);
if (DEBUGLEVEL>1) timer_printf(&ti,"get_UV");
@@ -588,9 +598,9 @@ ZlXQX_hyperellpadicfrobenius(GEN H, GEN T, ulong p, long n)
{
pari_sp av2 = avma;
GEN M, D;
- D = Fq_diff_red(s, monomial(utoi(p),p*i-1,1),p>>1, Q, T, pN1);
+ D = Fq_diff_red(s, monomial(utoi(p),p*i-1,1),(k*p-1)>>1, Q, T, pN1);
if (DEBUGLEVEL>1) timer_printf(&ti,"red");
- M = ZpXQXXQ_frob(D, U, V, Q, T, p, N + 1);
+ M = ZpXQXXQ_frob(D, U, V, (k - 1)>>1, Q, T, p, N + 1);
if (DEBUGLEVEL>1) timer_printf(&ti,"frob");
gel(F, i) = gerepileupto(av2, ZXX_to_FpXC(M, d-1, q, varn(T)));
}
@@ -682,7 +692,7 @@ hyperellcharpoly(GEN H)
}
if (!odd(d))
{
- GEN q = T ? powuu(p, degpol(T)): pp;
+ GEN q = get_basis(p, d) == 3 ? gen_1 : T ? powuu(p, degpol(T)): pp;
GEN v, Rx = RgX_div_by_X_x(R, eps? q: negi(q), &v);
if (signe(v)) pari_err_BUG("hyperellcharpoly");
return gerepilecopy(av, Rx);
diff --git a/src/basemath/ifactor1.c b/src/basemath/ifactor1.c
index 0f12711..1dc37f9 100644
--- a/src/basemath/ifactor1.c
+++ b/src/basemath/ifactor1.c
@@ -1420,11 +1420,12 @@ fin:
static long
squfof_ambig(long a, long B, long dd, GEN D)
{
- long b, c, q, qc, qcb, a0, b0, b1, c0;
+ long b, c, q, qa, qc, qcb, a0, b0, b1, c0;
long cnt = 0; /* count reduction steps on the cycle */
q = (dd + (B>>1)) / a;
- b = ((q*a) << 1) - B;
+ qa = q * a;
+ b = (qa - B) + qa; /* avoid overflow */
{
pari_sp av = avma;
c = itos(divis(shifti(subii(D, sqrs(b)), -2), a));
diff --git a/src/basemath/map.c b/src/basemath/map.c
new file mode 100644
index 0000000..8f4e2ba
--- /dev/null
+++ b/src/basemath/map.c
@@ -0,0 +1,461 @@
+/* Copyright (C) 2015 The PARI group.
+
+This file is part of the PARI package.
+
+PARI/GP is free software; you can redistribute it and/or modify it under the
+terms of the GNU General Public License as published by the Free Software
+Foundation. It is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY WHATSOEVER.
+
+Check the License for details. You should have received a copy of it, along
+with the package; see the file 'COPYING'. If not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+#include "pari.h"
+#include "paripriv.h"
+
+#define tvalue(i) gmael(t,(i),1)
+#define tleft(i) mael3(t,(i),2,1)
+#define tright(i) mael3(t,(i),2,2)
+
+static GEN
+treesearch(GEN T, GEN x, long mode)
+{
+ long i = 1;
+ GEN t = list_data(T);
+ if (!t) return NULL;
+ while(i)
+ {
+ long c = mode == 0 ? cmp_universal(x, tvalue(i)):
+ cmp_universal(x, gel(tvalue(i),1));
+ if (c)
+ i = c < 0 ? tleft(i): tright(i);
+ else
+ return tvalue(i);
+ }
+ return NULL;
+}
+
+static long
+treeparent_r(GEN t, GEN x, long i, long mode, long parent)
+{
+ long c;
+ if (i==0) return parent;
+ c = mode == 0 ? cmp_universal(x, tvalue(i)):
+ cmp_universal(x, gel(tvalue(i),1));
+ if (c < 0)
+ return treeparent_r(t,x,tleft(i),mode,i);
+ else if (c > 0)
+ return treeparent_r(t,x,tright(i),mode,i);
+ else
+ return parent;
+}
+
+static long
+treeparent(GEN T, GEN x, long mode)
+{
+ GEN t = list_data(T);
+ return t ? treeparent_r(t, x, 1, mode, 0): 0;
+}
+
+static void
+treekeys_r(GEN t, long i, GEN V, long *n, long mode)
+{
+ if (i==0) return;
+ treekeys_r(t, tleft(i), V, n, mode);
+ gel(V, ++*n) = gcopy(mode == 0 ? tvalue(i): gel(tvalue(i),1));
+ treekeys_r(t, tright(i), V, n, mode);
+}
+
+static GEN
+treekeys(GEN T, long mode)
+{
+ long n = 0;
+ GEN t = list_data(T);
+ GEN V;
+ if (!t) return cgetg(1, t_VEC);
+ V = cgetg(lg(t), t_VEC);
+ treekeys_r(t, 1, V, &n, mode);
+ return V;
+}
+
+static void
+treekeys_i_r(GEN t, long i, GEN V, long *n, long mode)
+{
+ if (i==0) return;
+ treekeys_i_r(t, tleft(i), V, n, mode);
+ gel(V, ++*n) = mode == 0 ? tvalue(i): gel(tvalue(i),1);
+ treekeys_r(t, tright(i), V, n, mode);
+}
+
+static GEN
+treekeys_i(GEN T, long mode)
+{
+ long n = 0;
+ GEN t = list_data(T);
+ GEN V;
+ if (!t) return cgetg(1, t_VEC);
+ V = cgetg(lg(t), t_VEC);
+ treekeys_i_r(t, 1, V, &n, mode);
+ return V;
+}
+
+static void
+treemat_r(GEN t, long i, GEN V, long *n)
+{
+ if (i==0) return;
+ treemat_r(t, tleft(i), V, n);
+ ++*n;
+ gmael(V, 1, *n) = gcopy(gel(tvalue(i), 1));
+ gmael(V, 2, *n) = gcopy(gel(tvalue(i), 2));
+ treemat_r(t, tright(i), V, n);
+}
+
+static GEN
+treemat(GEN T)
+{
+ long n = 0;
+ GEN t = list_data(T);
+ GEN V;
+ if (!t) return cgetg(1, t_MAT);
+ V = cgetg(3, t_MAT);
+ gel(V,1) = cgetg(lg(t), t_COL);
+ gel(V,2) = cgetg(lg(t), t_COL);
+ treemat_r(t, 1, V, &n);
+ return V;
+}
+
+static void
+treemat_i_r(GEN t, long i, GEN V, long *n)
+{
+ if (i==0) return;
+ treemat_i_r(t, tleft(i), V, n);
+ ++*n;
+ gmael(V, 1, *n) = gel(tvalue(i), 1);
+ gmael(V, 2, *n) = gel(tvalue(i), 2);
+ treemat_r(t, tright(i), V, n);
+}
+
+static GEN
+treemat_i(GEN T)
+{
+ long n = 0;
+ GEN t = list_data(T);
+ GEN V;
+ if (!t) return cgetg(1, t_MAT);
+ V = cgetg(3, t_MAT);
+ gel(V,1) = cgetg(lg(t), t_COL);
+ gel(V,2) = cgetg(lg(t), t_COL);
+ treemat_i_r(t, 1, V, &n);
+ return V;
+}
+
+#define value(i) gmael(list_data(T),(i),1)
+#define left(i) mael3(list_data(T),(i),2,1)
+#define right(i) mael3(list_data(T),(i),2,2)
+#define height(i) mael3(list_data(T),(i),2,3)
+
+static long
+treeheight(GEN T, long i)
+{ return i? height(i): 0; }
+
+static void
+change_leaf(GEN T, GEN x, long p)
+{
+ pari_sp av = avma;
+ listput(T, mkvec2(x, gmael(list_data(T), p, 2)), p);
+ avma = av;
+}
+
+static long
+new_leaf(GEN T, GEN x)
+{
+ pari_sp av = avma;
+ listput(T, mkvec2(x, mkvecsmall3(0,0,1)), 0);
+ avma = av;
+ return lg(list_data(T))-1;
+}
+
+static void
+fix_height(GEN T, long x)
+{
+ height(x) = maxss(treeheight(T,left(x)), treeheight(T,right(x)))+1;
+}
+static long
+treebalance(GEN T, long i)
+{
+ return i ? treeheight(T,left(i)) - treeheight(T,right(i)): 0;
+}
+
+static long
+rotright(GEN T, long y)
+{
+ long x = left(y);
+ long t = right(x);
+ right(x) = y;
+ left(y) = t;
+ fix_height(T, y);
+ fix_height(T, x);
+ return x;
+}
+
+static long
+rotleft(GEN T, long x)
+{
+ long y = right(x);
+ long t = left(y);
+ left(y) = x;
+ right(x) = t;
+ fix_height(T, x);
+ fix_height(T, y);
+ return y;
+}
+
+static long
+treeinsert_r(GEN T, GEN x, long i, long *d, long mode)
+{
+ long b, c;
+ if (i==0 || !list_data(T))
+ return new_leaf(T, x);
+ c = mode == 0 ? cmp_universal(x, value(i)):
+ cmp_universal(gel(x,1), gel(value(i),1));
+ if (c < 0)
+ {
+ long s = treeinsert_r(T, x, left(i), d, mode);
+ if (s < 0) return s;
+ left(i) = s;
+ }
+ else if (c > 0)
+ {
+ long s = treeinsert_r(T, x, right(i), d, mode);
+ if (s < 0) return s;
+ right(i) = s;
+ }
+ else return -i;
+ fix_height(T, i);
+ b = treebalance(T, i);
+ if (b > 1)
+ {
+ if (*d > 0)
+ left(i) = rotleft(T, left(i));
+ return rotright(T, i);
+ }
+ if (b < -1)
+ {
+ if (*d < 0)
+ right(i) = rotright(T, right(i));
+ return rotleft(T, i);
+ }
+ *d = c;
+ return i;
+}
+
+static long
+treeinsert(GEN T, GEN x, long mode)
+{
+ GEN d;
+ long c = 0;
+ long r = treeinsert_r(T, x, 1, &c, mode);
+ if (r < 0) return -r;
+ if (r == 1) return 0;
+ d = list_data(T);
+ /* By convention we want the root to be 1 */
+ swap(gel(d,1), gel(d,r));
+ if (left(1) == 1) left(1)=r;
+ else if (right(1) == 1) right(1)=r;
+ else pari_err_BUG("treeadd");
+ return 0;
+}
+
+static long
+treedelete_r(GEN T, GEN x, long i, long mode, long *dead)
+{
+ long b, c;
+ if (i==0 || !list_data(T))
+ return 0;
+ c = mode == 0 ? cmp_universal(x, value(i)):
+ cmp_universal(x, gel(value(i),1));
+ if (c < 0)
+ {
+ long s = treedelete_r(T, x, left(i), mode, dead);
+ if (s < 0) return s;
+ left(i) = s;
+ }
+ else if (c > 0)
+ {
+ long s = treedelete_r(T, x, right(i), mode, dead);
+ if (s < 0) return s;
+ right(i) = s;
+ }
+ else
+ {
+ *dead = i;
+ if (left(i)==0 && right(i)==0)
+ return 0;
+ else if (left(i)==0)
+ return right(i);
+ else if (right(i)==0)
+ return left(i);
+ else
+ {
+ GEN v;
+ GEN d = list_data(T);
+ long j = right(i);
+ while (left(j)) j = left(j);
+ v = mode == 0 ? value(j): gel(value(j), 1);
+ right(i) = treedelete_r(T, v, right(i), mode, dead);
+ swap(gel(d,i), gel(d,j));
+ lswap(left(i),left(j));
+ lswap(right(i),right(j));
+ lswap(height(i),height(j));
+ }
+ }
+ fix_height(T, i);
+ b = treebalance(T, i);
+ if (b > 1 && treebalance(T, left(i)) >= 0)
+ return rotright(T, i);
+ if (b > 1 && treebalance(T, left(i)) < 0)
+ {
+ left(i) = rotleft(T, left(i));
+ return rotright(T, i);
+ }
+ if (b < -1 && treebalance(T, right(i)) <= 0)
+ return rotleft(T,i);
+ if (b < -1 && treebalance(T, right(i)) > 0)
+ {
+ right(i) = rotright(T, right(i));
+ return rotleft(T, i);
+ }
+ return i;
+}
+
+static long
+treedelete(GEN T, GEN x, long mode)
+{
+ GEN d = list_data(T);
+ long dead, l;
+ long r = treedelete_r(T, x, 1, mode, &dead);
+ if (r > 1)
+ {
+ /* By convention we want the root to be 1 */
+ if (r==0) pari_err_BUG("treedelete0");
+ swap(gel(d,1), gel(d,r));
+ if (left(1) == 1) left(1) = r;
+ else if (right(1) == 1) right(1) = r;
+ else dead = r;
+ }
+ /* We want the dead to be last */
+ l = lg(d)-1;
+ if (dead != l)
+ {
+ long p = treeparent(T, gel(value(l), 1), mode);
+ if (left(p) == l) left(p) = dead;
+ else if (right(p) == l) right(p) = dead;
+ else pari_err_BUG("treedelete2");
+ swap(gel(d, dead),gel(d, l));
+ }
+ listpop(T, 0);
+ return 0;
+}
+
+void
+mapput(GEN T, GEN a, GEN b)
+{
+ pari_sp av = avma;
+ long i;
+ GEN p;
+ if (typ(T)!=t_LIST || list_typ(T)!=t_LIST_MAP)
+ pari_err_TYPE("mapput",T);
+ p = mkvec2(a, b);
+ i = treeinsert(T, p, 1);
+ if (i) change_leaf(T, p, i);
+ avma = av;
+}
+
+void
+mapdelete(GEN T, GEN a)
+{
+ pari_sp av = avma;
+ if (typ(T)!=t_LIST || list_typ(T)!=t_LIST_MAP)
+ pari_err_TYPE("mapdelete",T);
+ treedelete(T, a, 1);
+ avma = av;
+}
+
+GEN
+mapget(GEN T, GEN a)
+{
+ GEN x;
+ if (typ(T)!=t_LIST || list_typ(T)!=t_LIST_MAP)
+ pari_err_TYPE("mapget",T);
+ x = treesearch(T, a, 1);
+ if (!x) pari_err_COMPONENT("mapget", "not in", strtoGENstr("map"), a);
+ return gcopy(gel(x, 2));
+}
+
+int
+mapisdefined(GEN T, GEN a, GEN *pt_z)
+{
+ GEN x;
+ if (typ(T)!=t_LIST || list_typ(T)!=t_LIST_MAP)
+ pari_err_TYPE("mapisdefined",T);
+ x = treesearch(T, a, 1);
+ if (!x) return 0;
+ if (pt_z) *pt_z = gcopy(gel(x, 2));
+ return 1;
+}
+
+GEN
+mapdomain(GEN T)
+{
+ if (typ(T)!=t_LIST || list_typ(T)!=t_LIST_MAP)
+ pari_err_TYPE("mapdomain",T);
+ return treekeys(T,1);
+}
+
+GEN
+mapdomain_shallow(GEN T)
+{
+ if (typ(T)!=t_LIST || list_typ(T)!=t_LIST_MAP)
+ pari_err_TYPE("mapdomain_shallow",T);
+ return treekeys_i(T,1);
+}
+
+GEN
+maptomat(GEN T)
+{
+ if (typ(T)!=t_LIST || list_typ(T)!=t_LIST_MAP)
+ pari_err_TYPE("maptomat",T);
+ return treemat(T);
+}
+
+GEN
+maptomat_shallow(GEN T)
+{
+ if (typ(T)!=t_LIST || list_typ(T)!=t_LIST_MAP)
+ pari_err_TYPE("maptomap_shallow",T);
+ return treemat_i(T);
+}
+
+GEN
+gtomap(GEN x)
+{
+ if (!x) return listcreate_typ(t_LIST_MAP);
+ switch(typ(x))
+ {
+ case t_MAT:
+ {
+ long i, n, l = lg(x);
+ GEN M = listcreate_typ(t_LIST_MAP);
+ if (l == 1) return M;
+ if (l != 3) pari_err_TYPE("Map",x);
+ n = lgcols(x);
+ for (i=1; i < n; i++)
+ mapput(M, gcoeff(x,i,1), gcoeff(x,i,2));
+ return M;
+ }
+ default:
+ pari_err_TYPE("Map",x);
+ }
+ return NULL; /* NOT REACHED */
+}
diff --git a/src/basemath/mellininv.c b/src/basemath/mellininv.c
new file mode 100644
index 0000000..46186a8
--- /dev/null
+++ b/src/basemath/mellininv.c
@@ -0,0 +1,497 @@
+/* Copyright (C) 2015 The PARI group.
+
+This file is part of the PARI/GP package.
+
+PARI/GP is free software; you can redistribute it and/or modify it under the
+terms of the GNU General Public License as published by the Free Software
+Foundation. It is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY WHATSOEVER.
+
+Check the License for details. You should have received a copy of it, along
+with the package; see the file 'COPYING'. If not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+#include "pari.h"
+#include "paripriv.h"
+
+/*******************************************************************/
+/* Computation of inverse Mellin */
+/* transforms of gamma products. */
+/*******************************************************************/
+
+#ifndef M_E
+#define M_E 2.7182818284590452354
+#endif
+
+static const double MELLININV_CUTOFF = 121.; /* C*C */
+
+static GEN
+MOD2(GEN x) { GEN q = gdivent(x,gen_2); return gsub(x,gmul2n(q,1)); }
+static GEN
+RgV_MOD2(GEN v)
+{
+ long i, l;
+ GEN w = cgetg_copy(v,&l);
+ for (i=1; i<l; i++) gel(w,i) = MOD2(gel(v,i));
+ return w;
+}
+
+/* poles of the gamma factor */
+static GEN
+gammapoles(GEN Vga)
+{
+ long i, m, d = lg(Vga)-1;
+ GEN P, V, B = RgV_MOD2(Vga);
+ P = gen_indexsort(B, (void*)gcmp, cmp_nodata);
+ V = cgetg(d+1, t_VEC);
+ for (i = 1, m = 1; i <= d;)
+ {
+ GEN u = gel(B, P[i]);
+ long k;
+ for(k = i+1; k <= d; ++k)
+ if (!gequal(gel(B, P[k]), u)) break;
+ gel(V, m++) = vecpermute(Vga, vecslice(P,i,k-1));
+ i = k;
+ }
+ setlg(V, m); return V;
+}
+
+static GEN
+sercoeff(GEN x, long n, long prec)
+{
+ long N = n - valp(x);
+ return (N < 0)? gen_0: gtofp(gel(x, N+2), prec);
+}
+
+/* generalized power series expansion of inverse Mellin around x = 0;
+ * m-th derivative */
+static GEN
+Kderivsmallinit(GEN Vga, long m, long bitprec)
+{
+ pari_sp av = avma;
+ long d = lg(Vga)-1, N, j, l, limn, prec;
+ GEN LA, lj, mj, mat;
+ double C2 = MELLININV_CUTOFF;
+
+ LA = gammapoles(Vga);
+ N = lg(LA)-1;
+ lj = cgetg(N+1, t_VECSMALL);
+ mj = cgetg(N+1, t_VEC);
+ for (j = 1; j <= N; ++j)
+ {
+ GEN L = gel(LA,j);
+ lj[j] = lg(L)-1;
+ gel(mj,j) = gsubsg(2, vecmin(L));
+ }
+ prec = nbits2prec((long)(1+bitprec*(1+M_PI*d/C2)));
+ limn = ceil(2*LOG2*bitprec/(d*rtodbl(mplambertW(dbltor(C2/(M_PI*M_E))))));
+ mat = cgetg(N+1, t_VEC);
+ l = limn + 2;
+ for (j=1; j <= N; j++)
+ {
+ GEN C, c, mjj = gel(mj,j), pr = gen_1, t = gen_1;
+ long i, k, n, ljj = lj[j], precdl = ljj+3;
+ for (i=1; i <= d; i++)
+ {
+ GEN a = gmul2n(gadd(mjj, gel(Vga,i)), -1);
+ GEN u = deg1pol_shallow(ghalf, a, 0);
+ pr = gmul(pr, ggamma(RgX_to_ser(u, precdl), prec));
+ t = gmul(t, u);
+ }
+ c = cgetg(limn+2,t_COL);
+ gel(c,1) = pr;
+ for (n=1; n <= limn; n++)
+ gel(c,n+1) = gdiv(gel(c,n), RgX_translate(t, stoi(-2*n)));
+
+ gel(mat, j) = C = cgetg(ljj+1, t_COL);
+ for (k = 1; k <= ljj; k++)
+ {
+ GEN L = cgetg(l, t_POL);
+ L[1] = evalsigne(1)|evalvarn(0);
+ for (n = 2; n < l; n++) gel(L,n) = sercoeff(gel(c,n), -k, prec);
+ gel(C,k) = L;
+ }
+ /* C[k] = \sum_n c_{j,k} t^n =: C_k(t) in Dokchitser's Algo 3.3 */
+ /* Take m-th derivative of t^(-mj+2) sum_k (-ln t)^k/k! C_k(t^2) */
+ if (m)
+ {
+ mjj = gsubgs(mjj, 2);
+ for (i = 1; i <= m; i++, mjj = gaddgs(mjj, 1))
+ {
+ for (k = 1; k <= ljj; k++)
+ {
+ GEN c = gel(C,k), d = RgX_shift_shallow(gmul2n(RgX_deriv(c),1), 1);
+ c = RgX_Rg_mul(c, mjj);
+ if (k < ljj) c = RgX_add(c, gel(C,k+1));
+ gel(C,k) = RgX_sub(d, c);
+ }
+ }
+ gel(mj,j) = gaddgs(mjj,2);
+ }
+ for (k = 1; k <= ljj; k++)
+ {
+ GEN c = gel(C,k);
+ if (k > 2) c = RgX_Rg_div(c, mpfact(k-1));
+ gel(C,k) = RgX_to_RgC(c, lgpol(c));
+ }
+ }
+ /* Algo 3.3: * \phi^(m)(t) = sum_j t^m_j sum_k (-ln t)^k mat[j,k](t^2) */
+ return gerepilecopy(av, mkvec3(lj,RgV_neg(mj),mat));
+}
+
+/* Evaluate a vector considered as a polynomial using Horner. Unstable!
+ * If ui != NULL, ui = 1/u, evaluate P(1/u)*u^(deg P): useful for |u|>1 */
+static GEN
+evalvec(GEN vec, long lim, GEN u, GEN ui)
+{
+ pari_sp ltop = avma;
+ GEN S = gen_0;
+ long n;
+ lim = minss(lim, lg(vec)-1);
+ if (!ui)
+ for (n = lim; n >= 1; --n) S = gmul(u, gadd(gel(vec,n), S));
+ else
+ {
+ for (n = 1; n <= lim; ++n) S = gmul(ui, gadd(gel(vec,n), S));
+ S = gmul(gpowgs(u, n), S);
+ }
+ return gerepileupto(ltop, S);
+}
+
+/* Compute m-th derivative of inverse Mellin at x by generalized power series
+ * around x = 0; x2d = x^(2/d), x is possibly NULL (don't bother about
+ * complex branches). Assume |x|^(2/d) <= tmax = LOG2*bitprec/MELLININV_CUTOFF*/
+static GEN
+Kderivsmall(GEN K, GEN x, GEN x2d, long bitprec)
+{
+ pari_sp ltop = avma;
+ GEN Vga = gel(K,2), VS = gel(K,4);
+ GEN lj = gel(VS,1), mj = gel(VS,2), mat = gel(VS,3);
+ GEN d2, Lx, x2, x2i, A, S, pi;
+ long prec, d, N, j, k, limn, m = itos(gel(K, 3));
+ double Ed, xd, Wd, Wd0;
+
+ N = lg(lj)-1; d = lg(Vga)-1; A = vecsum(Vga);
+ Ed = LOG2*bitprec / d;
+ xd = maxdd(M_PI*dblmodulus(x2d), 1E-13); /* pi |x|^2/d unless x tiny */
+ if (xd > Ed) pari_err_BUG("Kderivsmall (x2d too large)");
+ Wd0 = Ed/(M_E*xd); /* >= 1/e */
+ Wd = log(1.+Wd0);
+ Wd *= (1.-log(Wd/Wd0))/(1.+Wd);
+ Wd *= (1.-log(Wd/Wd0))/(1.+Wd);
+ /* Wd solution of w exp(-w) = w0 */
+ limn = (long) ceil(2*Ed/Wd);
+ prec = nbits2prec((long) ceil(bitprec+d*xd/LOG2));
+ if (!gequal0(imag_i(x2d)) && !RgV_is_ZV(Vga))
+ pari_err_IMPL("complex argument in gammamellininv with nonintegral Vga");
+ pi = mppi(prec);
+ d2 = gdivsg(d,gen_2);
+ if (x)
+ x = gmul(gtofp(x,prec), gpow(pi,d2,prec));
+ else
+ x = gpow(gmul(gtofp(x2d,prec),pi), d2, prec);
+ /* at this stage, x has been replaced by pi^(d/2) x */
+ x2 = gsqr(x);
+ Lx = gpowers(gneg(glog(x,prec)), vecsmall_max(lj));
+ x2i = (gcmp(gnorml2(x2), gen_1) <= 0)? NULL: ginv(x2);
+ S = gen_0;
+ for (j = 1; j <= N; ++j)
+ {
+ long ljj = lj[j];
+ GEN s = gen_0;
+ for (k = 1; k <= ljj; k++)
+ s = gadd(s, gmul(gel(Lx,k), evalvec(gmael(mat,j,k), limn, x2, x2i)));
+ S = gadd(S, gmul(gpow(x, gel(mj,j), prec), s));
+ }
+ A = gsubsg(m*d, A);
+ if (!gequal0(A)) S = gmul(S, gsqrt(gpow(pi, A, prec), prec));
+ return gerepileupto(ltop, gtofp(S, nbits2prec(bitprec)));
+}
+
+static void
+Kderivlarge_optim(GEN K, GEN t2d, long bitprec, long *pprec, long *pnlim)
+{
+ GEN Vga = gel(K,2), VL = gel(K,5), A2 = gel(VL,3);
+ long prec, d = lg(Vga)-1;
+ double a, td = dblmodulus(t2d);
+ double E = LOG2*bitprec;
+ double CC = d <= 2 ? 81. : 101.; /* heuristic */
+
+ a = BITS_IN_LONG + ceil((gtodouble(A2)*log(td)/2 - M_PI*d*td)/LOG2);
+ if (a > 0) bitprec += a;
+ prec = nbits2prec(bitprec);
+ if (prec < LOWDEFAULTPREC) prec = LOWDEFAULTPREC;
+ *pprec = prec;
+ *pnlim = ceil(E*E / (CC*td));
+}
+
+/* Compute m-th derivative of inverse Mellin at t by continued fraction of
+ * asymptotic expansion; t2d = t^(2/d); t is possibly NULL (don't bother
+ * about complex branches)*/
+static GEN
+Kderivlarge(GEN K, GEN t, GEN t2d, long bitprec)
+{
+ pari_sp ltop = avma;
+ GEN tdA, P, S, pi, z, Vga = gel(K,2);
+ const long d = lg(Vga)-1;
+ GEN M, VL = gel(K,5), Ms = gel(VL,1), cd = gel(VL,2), A2 = gel(VL,3);
+ long status, prec, nlim, m = itos(gel(K, 3));
+
+ Kderivlarge_optim(K, t2d, bitprec, &prec, &nlim);
+ t2d = gtofp(t2d, prec);
+ if (t)
+ tdA = gpow(t, gdivgs(A2,d), prec);
+ else
+ tdA = gpow(t2d, gdivgs(A2,2), prec);
+ tdA = gmul(cd, tdA);
+
+ pi = mppi(prec);
+ z = gmul(pi, t2d);
+ P = gmul(tdA, gexp(gmulsg(-d, z), prec));
+ if (m) P = gmul(P, gpowgs(mulsr(-2, pi), m));
+ M = gel(Ms,1);
+ status = itos(gel(Ms,2));
+ if (status == 2)
+ S = poleval(RgV_to_RgX(M, 0), ginv(z));
+ else
+ {
+ S = contfraceval(M, ginv(z), nlim/2);
+ if (status == 1) S = gmul(S, gsubsg(1, ginv(gmul(z, pi))));
+ }
+ return gerepileupto(ltop, gmul(P, S));
+}
+
+/* Dokchitser's coefficients used for asymptotic expansion of inverse Mellin
+ * 2 <= p <= min(n+1, d) */
+static GEN
+fun_vp(long p, long n, long d, GEN SM, GEN vsinh)
+{
+ pari_sp ltop = avma;
+ long m, j, k;
+ GEN s = gen_0;
+ for (m = 0; m <= p; ++m)
+ {
+ GEN pr = gen_1, s2 = gen_0, sh = gel(vsinh, d-p+1);/* (sh(x)/x)^(d-p) */
+ long pm = p-m;
+ for (j = m; j < p; ++j) pr = muliu(pr, d-j);
+ for (k = 0; k <= pm; k+=2)
+ {
+ GEN e = gdiv(powuu(2*n-p+1, pm-k), mpfact(pm-k));
+ s2 = gadd(s2, gmul(e, RgX_coeff(sh, k)));
+ }
+ s = gadd(s, gmul(gmul(gel(SM, m+1), pr), s2));
+ if (gc_needed(ltop, 1)) s = gerepilecopy(ltop, s);
+ }
+ return gerepileupto(ltop, gmul(gdivsg(-d, powuu(2*d, p)), s));
+}
+
+/* Asymptotic expansion of inverse Mellin, to length nlimmax. Set status = 0
+ * (regular), 1 (one Hankel determinant vanishes => contfracinit will fail)
+ * or 2 (same as 1, but asymptotic expansion is finite!)
+ *
+ * If status = 2, the asymptotic expansion is finite so return only
+ * the necessary number of terms nlim <= nlimmax + d. */
+static GEN
+Klargeinit0(GEN Vga, long nlimmax, long *status)
+{
+ const long prec = LOWDEFAULTPREC;
+ const long d = lg(Vga)-1;
+ long k, n, m, cnt;
+ GEN pol, SM, nS1, se, vsinh, M, dk;
+
+ if (d==1 || (d==2 && gequal1(gabs(gsub(gel(Vga,1), gel(Vga,2)), prec))))
+ { /* shortcut */
+ *status = 2; return mkvec(gen_1);
+ }
+ /* d >= 2 */
+ *status = 0;
+ pol = roots_to_pol(gneg(Vga), 0); /* deg(pol) = d */
+ nS1 = gpowers(gneg(RgX_coeff(pol, d-1)), d);
+ dk = gpowers(utoi(d), d-1);
+ SM = cgetg(d+3, t_VEC);
+ for (m = 0; m <= d; ++m)
+ {
+ pari_sp btop = avma;
+ GEN s = gmul(gdivgs(gel(nS1, m+1), d), binomialuu(d, m));
+ for (k = 1; k <= m; ++k)
+ {
+ GEN e = gmul(gel(nS1, m-k+1), gel(dk, k));
+ s = gadd(s, gmul(gmul(e, binomialuu(d-k, m-k)), RgX_coeff(pol, d-k)));
+ }
+ gel(SM, m+1) = gerepileupto(btop, s);
+ }
+ se = gdiv(gsinh(RgX_to_ser(pol_x(0), d+2), prec), pol_x(0));
+ vsinh = gpowers(se, d);
+ M = vectrunc_init(nlimmax + d);
+ vectrunc_append(M, gen_1);
+ for (n=2, cnt=0; (n <= nlimmax) || cnt; ++n)
+ {
+ pari_sp btop = avma;
+ long p, ld = minss(d, n);
+ GEN s = gen_0;
+ for (p = 2; p <= ld; ++p)
+ s = gadd(s, gmul(fun_vp(p, n-1, d, SM, vsinh), gel(M, n+1-p)));
+ s = gerepileupto(btop, gdivgs(s, n-1));
+ vectrunc_append(M, s);
+ if (!isintzero(s))
+ {
+ if (n >= nlimmax) break;
+ cnt = 0;
+ }
+ else
+ {
+ cnt++; *status = 1;
+ if (cnt >= d-1) { *status = 2; setlg(M, lg(M) - (d-1)); break; }
+ }
+ }
+ return M;
+}
+
+/* remove trailing zeros from vector. */
+static void
+stripzeros(GEN M)
+{
+ long i;
+ for(i = lg(M)-1; i >= 1; --i)
+ if (!gequal0(gel(M, i))) break;
+ setlg(M, i+1);
+}
+
+/* Asymptotic expansion of the m-th derivative of inverse Mellin, to length
+ * nlimmax. If status = 2, the asymptotic expansion is finite so return only
+ * the necessary number of terms nlim <= nlimmax + d. */
+static GEN
+gammamellininvasymp_i(GEN Vga, long nlimmax, long m, long *status)
+{
+ pari_sp ltop = avma;
+ GEN M, A, Aadd;
+ long d, i, nlim, n;
+
+ M = Klargeinit0(Vga, nlimmax, status);
+ if (!m) return gerepilecopy(ltop, M);
+ d = lg(Vga)-1;
+ /* half the exponent of t in asymptotic expansion. */
+ A = gdivgs(gaddsg(1-d, vecsum(Vga)), 2*d);
+ if (*status == 2) M = shallowconcat(M, zerovec(m));
+ nlim = lg(M)-1;
+ Aadd = gdivgs(stoi(2-d), 2*d); /* (1/d) - (1/2) */
+ for (i = 1; i <= m; i++, A = gadd(A,Aadd))
+ for (n = nlim-1; n >= 1; --n)
+ gel(M, n+1) = gsub(gel(M, n+1),
+ gmul(gel(M, n), gsub(A, gdivgs(stoi(n-1), d))));
+ stripzeros(M);
+ return gerepilecopy(ltop, M);
+}
+GEN
+gammamellininvasymp(GEN Vga, long nlimmax, long m)
+{ long status;
+ if (!is_vec_t(typ(Vga))) pari_err_TYPE("gammamellininvinit",Vga);
+ return gammamellininvasymp_i(Vga, nlimmax, m, &status);
+}
+
+/* Does the continued fraction of the asymptotic expansion M at oo of inverse
+ * Mellin transform associated to Vga have zero Hankel determinants ? */
+static long
+ishankelspec(GEN Vga, GEN M)
+{
+ long status, i, d = lg(Vga)-1;
+
+ if (d == 5 || d == 7)
+ { /* known bad cases: a x 5 and a x 7 */
+ GEN v1 = gel(Vga, 1);
+ for (i = 2; i <= d; ++i)
+ if (!gequal(gel(Vga,i), v1)) break;
+ if (i > d) return 1;
+ }
+ status = 0;
+ /* Heuristic: if 6 first terms in contfracinit don't fail, assume it's OK */
+ pari_CATCH(e_INV) { status = 1; }
+ pari_TRY { contfracinit(M, 6); }
+ pari_ENDCATCH; return status;
+}
+
+/* Initialize data for computing m-th derivative of inverse Mellin */
+GEN
+gammamellininvinit_bitprec(GEN Vga, long m, long bitprec)
+{
+ pari_sp ltop = avma;
+ GEN A2, M, VS, VL, cd;
+ long d = lg(Vga)-1, status;
+ double tmax = LOG2*bitprec / MELLININV_CUTOFF;
+ const double C2 = MELLININV_CUTOFF, CC = d <= 2 ? 81. : 101.;
+ const long nlimmax = ceil(bitprec*C2*LOG2/CC);
+
+ if (!is_vec_t(typ(Vga))) pari_err_TYPE("gammamellininvinit",Vga);
+ A2 = gaddsg(m*(2-d) + 1-d, vecsum(Vga));
+ cd = (d <= 2)? gen_2: gsqrt(gdivgs(int2n(d+1), d), nbits2prec(bitprec));
+ /* if in Klarge, we have |t| > tmax = LOG2*D/C2, thus nlim < LOG2*D*C2/CC. */
+ M = gammamellininvasymp_i(Vga, nlimmax, m, &status);
+ if (status == 2)
+ {
+ tmax = -1.; /* only use Klarge */
+ VS = gen_0;
+ }
+ else
+ {
+ long prec = nbits2prec((4*bitprec)/3);
+ VS = Kderivsmallinit(Vga, m, bitprec);
+ if (status == 0 && ishankelspec(Vga, M)) status = 1;
+ if (status == 1)
+ { /* a Hankel determinant vanishes => contfracinit is undefined.
+ So compute K(t) / (1 - 1/(pi^2*t)) instead of K(t)*/
+ GEN t = ginv(mppi(prec));
+ long i;
+ for (i = 2; i < lg(M); ++i)
+ gel(M, i) = gadd(gel(M, i), gmul(gel(M, i-1), t));
+ }
+ else
+ M = RgC_gtofp(M, prec); /* convert from rationals to t_REAL: faster */
+ M = contfracinit(M, lg(M)-2);
+ }
+ VL = mkvec3(mkvec2(M, stoi(status)), cd, A2);
+ return gerepilecopy(ltop, mkvec5(dbltor(tmax), Vga, stoi(m), VS, VL));
+}
+GEN
+gammamellininvinit(GEN Vga, long m, long prec)
+{ return gammamellininvinit_bitprec(Vga, m, prec2nbits(prec)); }
+
+/* Compute m-th derivative of inverse Mellin at s2d = s^(d/2) using
+ * initialization data. Use Taylor expansion at 0 for |s2d| < tmax, and
+ * asymptotic expansion at oo otherwise. WARNING: assume that accuracy
+ * has been increased according to tmax by the CALLING program. */
+GEN
+gammamellininvrt_bitprec(GEN K, GEN s2d, long bitprec)
+{
+ GEN tmax = gel(K,1);
+ if (dblmodulus(s2d) < rtodbl(tmax))
+ return Kderivsmall(K, NULL, s2d, bitprec);
+ else
+ return Kderivlarge(K, NULL, s2d, bitprec);
+}
+GEN
+gammamellininvrt(GEN K, GEN s2d, long prec)
+{ return gammamellininvrt_bitprec(K, s2d, prec2nbits(prec)); }
+
+/* Compute inverse Mellin at s. K from gammamellininv OR a Vga, in which
+ * case the initialization data is computed. */
+GEN
+gammamellininv_bitprec(GEN K, GEN s, long m, long bitprec)
+{
+ pari_sp av = avma;
+ GEN z, s2d, tmax;
+ long d;
+ if (!is_vec_t(typ(K))) pari_err_TYPE("gammamellininvinit",K);
+ if (lg(K) != 6 || !is_vec_t(typ(gel(K,2))))
+ K = gammamellininvinit_bitprec(K, m, bitprec);
+ tmax = gel(K,1);
+ d = lg(gel(K,2))-1;
+ s2d = gpow(s, gdivgs(gen_2, d), nbits2prec(bitprec));
+ if (dblmodulus(s2d) < rtodbl(tmax))
+ z = Kderivsmall(K, s, s2d, bitprec);
+ else
+ z = Kderivlarge(K, s, s2d, bitprec);
+ return gerepileupto(av, z);
+}
+GEN
+gammamellininv(GEN Vga, GEN s, long m, long prec)
+{ return gammamellininv_bitprec(Vga, s, m, prec2nbits(prec)); }
diff --git a/src/basemath/modsym.c b/src/basemath/modsym.c
index ea8c732..3a5dc59 100644
--- a/src/basemath/modsym.c
+++ b/src/basemath/modsym.c
@@ -1998,7 +1998,7 @@ getMorphism_basis(GEN W, GEN vecT)
GEN link = msk_get_link(W);
GEN invphiblock = msk_get_invphiblock(W);
long s = st[1], t = st[2];
- GEN R = zerovec(dim), Q, Ls, T0, T1, Ts, mu_st;
+ GEN R = zerocol(dim), Q, Ls, T0, T1, Ts, mu_st;
for (r = 2; r < lvecT; r++)
{
GEN Tr, L;
diff --git a/src/basemath/nffactor.c b/src/basemath/nffactor.c
index f996dd0..d0b5824 100644
--- a/src/basemath/nffactor.c
+++ b/src/basemath/nffactor.c
@@ -304,14 +304,32 @@ proper_nf(GEN nf)
{ return (lg(nf) == 3)? gel(nf,1): nf; }
static GEN
-get_den(GEN *pnf, GEN T)
+fix_nf(GEN *pnf, GEN *pT, GEN *pA)
{
GEN den = gen_1;
if (!*pnf)
{
- GEN fa, P, q, D;
- *pnf = nfinitall(T, nf_PARTIALFACT, DEFAULTPREC);
- D = nf_get_disc(proper_nf(*pnf));
+ GEN fa, P, q, D, T = *pT;
+ GEN nf, NF = nfinitall(T, nf_PARTIALFACT, DEFAULTPREC);
+ *pnf = nf = proper_nf(NF);
+ if (nf != NF) { /* t_POL defining base field changed (not monic) */
+ long i, l;
+ GEN A = *pA, a = cgetg_copy(A, &l);
+ GEN rev = gel(NF,2), pow, dpow;
+
+ *pT = T = nf_get_pol(nf); /* need to update T */
+ pow = QXQ_powers(lift_intern(rev), degpol(T)-1, T);
+ pow = Q_remove_denom(pow, &dpow);
+ a[1] = A[1];
+ for (i=2; i<l; i++) {
+ GEN c = gel(A,i);
+ if (typ(c) == t_POL) c = QX_ZXQV_eval(c, pow, dpow);
+ gel(a,i) = c;
+ }
+ *pA = Q_primpart(a); /* need to update A */
+ }
+
+ D = nf_get_disc(nf);
if (is_pm1(D)) return gen_1;
fa = absi_factor_limit(D, 0);
P = gel(fa,1); q = gel(P, lg(P)-1);
@@ -328,33 +346,17 @@ get_nfsqff_data(GEN *pnf, GEN *pT, GEN *pA, GEN *pB, GEN *ptbad)
long n = degpol(T);
if (nfsqff_use_Trager(n, degpol(A)))
{
- *pnf = T; bad = den = ZX_disc(T);
+ *pnf = T;
+ bad = den = ZX_disc(T);
if (is_pm1(leading_term(T))) den = indexpartial(T, den);
}
else
{
- GEN nf;
- den = get_den(pnf, T);
- nf = proper_nf(*pnf);
- bad = nf_get_index(nf);
+ den = fix_nf(pnf, pT, pA);
+ bad = nf_get_index(*pnf);
if (den != gen_1) bad = mulii(bad, den);
- if (nf != *pnf) { /* t_POL defining base field changed (not monic) */
- long i, l;
- GEN a = cgetg_copy(A, &l);
- GEN rev = gel(*pnf,2), pow, dpow;
-
- *pT = T = nf_get_pol(nf); /* need to update T */
- pow = QXQ_powers(lift_intern(rev), n-1, T);
- pow = Q_remove_denom(pow, &dpow);
- a[1] = A[1];
- for (i=2; i<l; i++) {
- GEN c = gel(A,i);
- if (typ(c) == t_POL) c = QX_ZXQV_eval(c, pow, dpow);
- gel(a,i) = c;
- }
- *pA = A = Q_primpart(a); /* need to update A */
- *pnf = nf; /* now discard change of variable */
- }
+ A = *pA;
+ T = *pT;
}
(void)nfgcd_all(A, RgX_deriv(A), T, bad, pB);
if (ptbad) *ptbad = bad;
@@ -1910,7 +1912,7 @@ nfsqff(GEN nf, GEN pol, long fl, GEN den)
GEN
nfroots_split(GEN nf, GEN pol)
{
- GEN T = get_nfpol(nf,&nf), den = get_den(&nf, T);
+ GEN T = get_nfpol(nf,&nf), den = fix_nf(&nf, &T, &pol);
pari_sp av = avma;
GEN z = gerepilecopy(av, nfsqff(nf, pol, ROOTS_SPLIT, den));
return (lg(z) == 1)? NULL: mkvec2(z, nf);
diff --git a/src/basemath/polarit2.c b/src/basemath/polarit2.c
index d922830..7adda9f 100644
--- a/src/basemath/polarit2.c
+++ b/src/basemath/polarit2.c
@@ -679,9 +679,10 @@ factor(GEN x)
/* */
/*******************************************************************/
static GEN
-normalized_mul(GEN x, GEN y)
+normalized_mul(void *E, GEN x, GEN y)
{
long a = gel(x,1)[1], b = gel(y,1)[1];
+ (void) E;
return mkvec2(mkvecsmall(a + b),
RgX_mul_normalized(gel(x,2),a, gel(y,2),b));
}
@@ -716,7 +717,7 @@ roots_to_pol(GEN a, long v)
}
if (i < lx) gel(L,k++) = mkvec2(mkvecsmall(1),
scalarpol_shallow(gneg(gel(a,i)), v));
- setlg(L, k); L = divide_conquer_prod(L, normalized_mul);
+ setlg(L, k); L = gen_product(L, NULL, normalized_mul);
return gerepileupto(av, normalized_to_RgX(L));
}
@@ -745,44 +746,10 @@ roots_to_pol_r1(GEN a, long v, long r1)
GEN x1 = gneg(gtrace(s));
gel(L,k++) = mkvec2(mkvecsmall(2), deg1pol_shallow(x1,x0,v));
}
- setlg(L, k); L = divide_conquer_prod(L, normalized_mul);
+ setlg(L, k); L = gen_product(L, NULL, normalized_mul);
return gerepileupto(av, normalized_to_RgX(L));
}
-GEN
-divide_conquer_assoc(GEN x, void *data, GEN (*mul)(void *,GEN,GEN))
-{
- pari_sp ltop;
- long i,k,lx = lg(x);
-
- if (lx == 1) return gen_1;
- if (lx == 2) return gcopy(gel(x,1));
- x = leafcopy(x); k = lx;
- ltop=avma;
- while (k > 2)
- {
- if (DEBUGLEVEL>7)
- err_printf("prod: remaining objects %ld\n",k-1);
- lx = k; k = 1;
- for (i=1; i<lx-1; i+=2)
- gel(x,k++) = mul(data,gel(x,i),gel(x,i+1));
- if (i < lx) gel(x,k++) = gel(x,i);
- if (gc_needed(ltop,1))
- gerepilecoeffs(ltop,x+1,k-1);
- }
- return gel(x,1);
-}
-
-static GEN
-_domul(void *data, GEN x, GEN y)
-{
- GEN (*mul)(GEN,GEN)=(GEN (*)(GEN,GEN)) data;
- return mul(x,y);
-}
-GEN
-divide_conquer_prod(GEN x, GEN (*mul)(GEN,GEN))
-{ return divide_conquer_assoc(x, (void *)mul, _domul); }
-
/*******************************************************************/
/* */
/* FACTORBACK */
@@ -828,7 +795,7 @@ gen_factorback(GEN L, GEN e, GEN (*_mul)(void*,GEN,GEN),
switch(typ(L)) {
case t_VEC:
case t_COL: /* product of the L[i] */
- return gerepileupto(av, divide_conquer_assoc(L, data, _mul));
+ return gerepileupto(av, gen_product(L, data, _mul));
case t_MAT: /* genuine factorization */
l = lg(L);
if (l == 1) return gen_1;
@@ -866,7 +833,7 @@ gen_factorback(GEN L, GEN e, GEN (*_mul)(void*,GEN,GEN),
return NULL;
}
x[0] = evaltyp(t_VEC) | _evallg(l);
- return gerepileupto(av, divide_conquer_assoc(x, data, _mul));
+ return gerepileupto(av, gen_product(x, data, _mul));
}
GEN
diff --git a/src/basemath/qfsolve.c b/src/basemath/qfsolve.c
index bf258c7..c74a6a1 100644
--- a/src/basemath/qfsolve.c
+++ b/src/basemath/qfsolve.c
@@ -73,8 +73,7 @@ kermodp(GEN M, GEN p, long *d)
/* INVARIANTS COMPUTATIONS */
static GEN
-principal_minor(GEN G, long i)
-{ return rowslice(vecslice(G,1,i), 1,i); }
+principal_minor(GEN G, long i) { return matslice(G,1,i,1,i); }
static GEN
det_minors(GEN G)
{
@@ -308,7 +307,7 @@ qflllgram_indefgoon(GEN G)
U = ZM_mul(U,U3);
if (n == 3) return mkvec2(G4,U);
- red = qflllgram_indefgoon(rowslice(vecslice(G4,2,n-1),2,n-1));
+ red = qflllgram_indefgoon(matslice(G4,2,n-1,2,n-1));
if (typ(red) == t_MAT) return mkvec2(G4,U);
/* Let U5:=matconcat(diagonal[1,red[2],1])
* return [qf_apply_ZM(G5, U5), U*U5] */
diff --git a/src/basemath/rootpol.c b/src/basemath/rootpol.c
index 9714adc..d9c129b 100644
--- a/src/basemath/rootpol.c
+++ b/src/basemath/rootpol.c
@@ -360,7 +360,7 @@ polgraeffe(GEN p)
/** **/
/********************************************************************/
-/* Quick approximation to log2(|x); first define y s.t. |y-x| < 2^-32 then
+/* Quick approximation to log2(|x|); first define y s.t. |y-x| < 2^-32 then
* return y rounded to 2 ulp. In particular, if result < 2^21, absolute error
* is bounded by 2^-31. If result > 2^21, it is correct to 2 ulp */
static double
@@ -407,6 +407,7 @@ dbllog2(GEN z)
switch(typ(z))
{
case t_INT: return mydbllog2i(z);
+ case t_FRAC: return mydbllog2i(gel(z,1))-mydbllog2i(gel(z,2));
case t_REAL: return mydbllog2r(z);
default: /*t_COMPLEX*/
x = dbllog2mp(gel(z,1));
@@ -1949,10 +1950,25 @@ fix_roots(GEN r, GEN *m, long h, long bit)
}
static GEN
+RgX_normalize1(GEN x)
+{
+ long i, n = lg(x)-1;
+ GEN y;
+ for (i = n; i > 1; i--)
+ if (!gequal0( gel(x,i) )) break;
+ if (i == n) return x;
+ pari_warn(warner,"normalizing a polynomial with 0 leading term");
+ if (i == 1) pari_err_ROOTS0("roots");
+ y = cgetg(i+1, t_POL); y[1] = x[1];
+ for (; i > 1; i--) gel(y,i) = gel(x,i);
+ return y;
+}
+
+static GEN
all_roots(GEN p, long bit)
{
GEN lc, pd, q, roots_pol, m;
- long bit0, bit2, n = degpol(p), i, e, h;
+ long bit0, bit2, i, e, h, n = degpol(p);
pari_sp av;
pd = RgX_deflate_max(p, &h); lc = leading_term(pd);
@@ -2038,8 +2054,12 @@ roots_com(GEN q, long bit)
{
GEN L, p;
long v = RgX_valrem_inexact(q, &p);
- if (lg(p) == 3) L = cgetg(1,t_VEC); /* constant polynomial */
- else L = isexactpol(p)? solve_exact_pol(p,bit): all_roots(p,bit);
+ int ex = isexactpol(p);
+ if (!ex) p = RgX_normalize1(p);
+ if (lg(p) == 3)
+ L = cgetg(1,t_VEC); /* constant polynomial */
+ else
+ L = ex? solve_exact_pol(p,bit): all_roots(p,bit);
if (v)
{
GEN M, z, t = gel(q,2);
diff --git a/src/basemath/trans1.c b/src/basemath/trans1.c
index 28db5dd..ca87d6d 100644
--- a/src/basemath/trans1.c
+++ b/src/basemath/trans1.c
@@ -1140,6 +1140,10 @@ gpow(GEN x, GEN n, long prec)
case t_FFELT:
return gerepileupto(av,FF_pow(FF_sqrtn(x,d,NULL),a));
+ default:
+ if (gequal(d, gen_2))
+ return gerepileupto(av, gmul(powgi(x, shifti(subis(a, 1), -1)),
+ gsqrt(x, prec)));
}
}
i = (long) precision(n); if (i) prec=i;
@@ -3114,6 +3118,75 @@ gsincos(GEN x, GEN *s, GEN *c, long prec)
/********************************************************************/
/** **/
+/** SINC **/
+/** **/
+/********************************************************************/
+static GEN
+mpsinc(GEN x)
+{
+ pari_sp av = avma;
+ GEN s, c;
+
+ if (!signe(x)) {
+ long l = nbits2prec(-expo(x));
+ if (l < LOWDEFAULTPREC) l = LOWDEFAULTPREC;
+ return real_1(l);
+ }
+
+ mpsincos(x,&s,&c);
+ return gerepileuptoleaf(av, divrr(s,x));
+}
+
+GEN
+gsinc(GEN x, long prec)
+{
+ pari_sp av;
+ GEN r, u, v, y, u1, v1;
+ long i;
+
+ switch(typ(x))
+ {
+ case t_REAL: return mpsinc(x);
+ case t_COMPLEX:
+ if (isintzero(gel(x,1)))
+ {
+ av = avma;
+ return gerepileuptoleaf(av,gdiv(gsinh(gel(x,2),prec),gel(x,2)));
+ }
+ i = precision(x); if (!i) i = prec;
+ y = cgetc(i); av = avma;
+ r = gexp(gel(x,2),prec);
+ v1 = gmul2n(addrr(invr(r),r), -1); /* = cos(I*Im(x)) */
+ u1 = subrr(r, v1); /* = I*sin(I*Im(x)) */
+ gsincos(gel(x,1),&u,&v,prec);
+ affc_fixlg(gdiv(mkcomplex(gmul(v1,u), gmul(u1,v)), x), y);
+ avma = av; return y;
+
+ case t_INT:
+ if (!signe(x)) return real_1(prec); /*fall through*/
+ case t_FRAC:
+ y = cgetr(prec); av = avma;
+ affrr_fixlg(mpsinc(tofp_safe(x,prec)), y); avma = av; return y;
+
+ case t_PADIC:
+ if (gequal0(x)) return cvtop(gen_1, gel(x,2), valp(x));
+ av = avma; y = sin_p(x);
+ if (!y) pari_err_DOMAIN("gsinc(t_PADIC)","argument","",gen_0,x);
+ return gerepileuptoleaf(av,gdiv(y,x));
+
+ default:
+ av = avma; if (!(y = toser_i(x))) break;
+ if (gequal0(y)) return gerepileupto(av, gaddsg(1,y));
+ if (valp(y) < 0)
+ pari_err_DOMAIN("sinc","valuation", "<", gen_0, x);
+ gsincos(y,&u,&v,prec);
+ return gerepilecopy(av,gdiv(u,y));
+ }
+ return trans_eval("sinc",gsinc,x,prec);
+}
+
+/********************************************************************/
+/** **/
/** TANGENT and COTANGENT **/
/** **/
/********************************************************************/
diff --git a/src/basemath/trans2.c b/src/basemath/trans2.c
index 246dd7d..630d23d 100644
--- a/src/basemath/trans2.c
+++ b/src/basemath/trans2.c
@@ -497,6 +497,57 @@ gtanh(GEN x, long prec)
}
return trans_eval("tanh",gtanh,x,prec);
}
+
+static GEN
+mpcotanh(GEN x)
+{
+ long lx, s = signe(x);
+ GEN y;
+
+ if (!s) pari_err_DOMAIN("cotan", "argument", "=", gen_0, x);
+
+ lx = realprec(x);
+ if (absr_cmp(x, stor(prec2nbits(lx), LOWDEFAULTPREC)) >= 0) {
+ y = real_1(lx);
+ } else {
+ pari_sp av = avma;
+ long ex = expo(x);
+ GEN t;
+ if (ex < 1 - BITS_IN_LONG) x = rtor(x, lx + nbits2extraprec(-ex)-1);
+ t = exp1r_abs(gmul2n(x,1)); /* exp(|2x|) - 1 */
+ y = gerepileuptoleaf(av, divrr(addsr(2,t), t));
+ }
+ if (s < 0) togglesign(y); /* cotanh is odd */
+ return y;
+}
+
+GEN
+gcotanh(GEN x, long prec)
+{
+ pari_sp av;
+ GEN y, t;
+
+ switch(typ(x))
+ {
+ case t_REAL: return mpcotanh(x);
+ case t_COMPLEX:
+ if (isintzero(gel(x,1))) retmkcomplex(gen_0, gcotan(gel(x,2),prec));
+ /* fall through */
+ case t_PADIC:
+ av = avma;
+ t = gexp(gmul2n(x,1),prec);
+ t = gdivsg(2, gsubgs(t,1));
+ return gerepileupto(av, gaddsg(1,t));
+ default:
+ av = avma; if (!(y = toser_i(x))) break;
+ if (gequal0(y)) return gerepilecopy(av, y);
+ t = gexp(gmul2n(y, 1),prec);
+ t = gdivsg(2, gsubgs(t,1));
+ return gerepileupto(av, gaddsg(1,t));
+ }
+ return trans_eval("cotanh",gcotanh,x,prec);
+}
+
/********************************************************************/
/** **/
/** AREA HYPERBOLIC SINE **/
@@ -1003,6 +1054,26 @@ red_mod_2z(GEN x, GEN z)
}
#endif
+/* lngamma(1+z) = -Euler*z + sum_{i > 1} zeta(i)/i (-z)^i
+ * at relative precision prec, |z| < 1 is small */
+static GEN
+lngamma1(GEN z, long prec)
+{ /* sum_{i > l} |z|^(i-1) = |z|^l / (1-|z|) < 2^-B
+ * for l > (B+1) / |log2(|z|)| */
+ long i, l = ceil((bit_accuracy(prec) + 1) / - dbllog2(z));
+ GEN zet, me = mpeuler(prec), s = gen_0;
+ setsigne(me, -1); /* -Euler */
+ if (l <= 1) return gmul(me, z);
+ zet = veczeta(gen_1, gen_2, l-1, prec); /* z[i] = zeta(i+1) */
+ for (i = l; i > 1; i--)
+ {
+ GEN c = divru(gel(zet,i-1), i);
+ if (odd(i)) setsigne(c, -1);
+ s = gadd(gmul(s,z), c);
+ }
+ return gmul(z, gadd(gmul(s,z), me));
+}
+
static GEN
cxgamma(GEN s0, int dolog, long prec)
{
@@ -1066,15 +1137,14 @@ cxgamma(GEN s0, int dolog, long prec)
double st = typ(s) == t_REAL? 0.0: rtodbl(imag_i(s));
double la, l,l2,u,v, rlogs, ilogs;
- if (dolog)
- {
- /* loggamma(1+u) ~ - Euler * u: cancellation if u is small */
- if (fabs(ssig-1) + fabs(st) < 0.0001)
- { /* s ~ 1, take care */
- long e = gexpo(gsubgs(s,1));
- prec += nbits2nlong(-e);
- s = gprec_w(s, prec);
- }
+ if (fabs(ssig-1) + fabs(st) < 0.0001)
+ { /* s ~ 1: loggamma(1+u) ~ - Euler * u, cancellation */
+ if (funeq) /* s0 ~ 0: use lngamma(s0)+log(s0) = lngamma(s0+1) */
+ y = gsub(lngamma1(s0,prec), glog(s0,prec));
+ else
+ y = lngamma1(gsubgs(s0,1),prec);
+ if (!dolog) y = gexp(y,prec);
+ avma = av; return affc_fixlg(y, res);
}
dcxlog(ssig,st, &rlogs,&ilogs);
/* Re (s - 1/2) log(s) */
@@ -1409,7 +1479,6 @@ GEN
ggamma(GEN x, long prec)
{
pari_sp av;
- long m;
GEN y, z;
switch(typ(x))
@@ -1425,14 +1494,32 @@ ggamma(GEN x, long prec)
return cxgamma(x, 0, prec);
case t_FRAC:
- if (!equaliu(gel(x,2),2)) break;
- z = gel(x,1); /* true argument is z/2 */
- if (is_bigint(z) || labs(m = itos(z)) > 962354)
+ {
+ GEN a = gel(x,1), b = gel(x,2), c;
+ long m;
+ if (equaliu(b,2))
+ {
+ if (is_bigint(a) || labs(m = itos(a)) > 962354)
+ {
+ pari_err_OVERFLOW("gamma");
+ return NULL; /* not reached */
+ }
+ return gammahs(m-1, prec);
+ }
+ av = avma; c = subii(a,b);
+ if (expi(c) - expi(b) < -10)
{
- pari_err_OVERFLOW("gamma");
- return NULL; /* not reached */
+ x = mkfrac(c,b);
+ if (lgefint(b) >= prec) x = fractor(x,prec);
+ y = mpexp(lngamma1(x, prec));
}
- return gammahs(m-1, prec);
+ else
+ {
+ x = fractor(x, prec);
+ y = cxgamma(x, 0, prec);
+ }
+ return gerepileupto(av, y);
+ }
case t_PADIC: return Qp_gamma(x);
default:
@@ -1482,7 +1569,7 @@ mpfactr(long n, long prec)
GEN
glngamma(GEN x, long prec)
{
- pari_sp av;
+ pari_sp av = avma;
GEN y, p1;
switch(typ(x))
@@ -1493,33 +1580,37 @@ glngamma(GEN x, long prec)
strtoGENstr("non-positive integer"), x);
if (cmpiu(x,200 + 50*(prec-2)) > 0) /* heuristic */
return cxgamma(x, 1, prec);
- av = avma;
return gerepileuptoleaf(av, logr_abs( itor(mpfact(itos(x) - 1), prec) ));
case t_FRAC:
{
- GEN a, b;
- long e1, e2;
- av = avma;
- a = gel(x,1);
- b = gel(x,2);
- e1 = expi(subii(a,b)); e2 = expi(b);
- if (e2 > e1) prec += nbits2nlong(e2 - e1);
- x = fractor(x, prec);
- return gerepileupto(av, cxgamma(x, 1, prec));
+ GEN a = gel(x,1), b = gel(x,2), c = subii(a,b);
+ long e = expi(b) - expi(c);
+ if (e > 10)
+ {
+ x = mkfrac(c,b);
+ if (lgefint(b) >= prec) x = fractor(x,prec + nbits2nlong(e));
+ y = lngamma1(x, prec);
+ }
+ else
+ {
+ x = fractor(x, e > 1? prec+EXTRAPRECWORD: prec);
+ y = cxgamma(x, 1, prec);
+ }
+ return gerepileupto(av, y);
}
case t_REAL: case t_COMPLEX:
return cxgamma(x, 1, prec);
default:
- av = avma; if (!(y = toser_i(x))) break;
+ if (!(y = toser_i(x))) break;
if (valp(y)) pari_err_DOMAIN("lngamma","valuation", "!=", gen_0, x);
/* (lngamma y)' = y' psi(y) */
p1 = integser(gmul(derivser(y), gpsi(y, prec)));
if (!gequal1(gel(y,2))) p1 = gadd(p1, glngamma(gel(y,2),prec));
return gerepileupto(av, p1);
- case t_PADIC: av = avma; return gerepileupto(av, Qp_log(Qp_gamma(x)));
+ case t_PADIC: return gerepileupto(av, Qp_log(Qp_gamma(x)));
}
return trans_eval("lngamma",glngamma,x,prec);
}
@@ -1621,13 +1712,14 @@ static GEN
serpsi1(long n, long v, long prec)
{
long i, l = n+3;
- GEN g, s = cgetg(l, t_SER);
+ GEN z, g, s = cgetg(l, t_SER);
s[1] = evalsigne(1)|evalvalp(0)|evalvarn(v);
g = mpeuler(prec); setsigne(g, -1);
+ z = veczeta(gen_1, gen_2, n, prec); /* zeta(2..n) */
gel(s,2) = g;
for (i = 2; i < l-1; i++)
{
- GEN c = szeta(i, prec);
+ GEN c = gel(z,i-1); /* zeta(i) */
if (odd(i)) setsigne(c, -1);
gel(s,i+1) = c;
}
diff --git a/src/basemath/trans3.c b/src/basemath/trans3.c
index 54eb5de..273c36b 100644
--- a/src/basemath/trans3.c
+++ b/src/basemath/trans3.c
@@ -865,7 +865,7 @@ precision2(GEN x, GEN y)
#endif
/* return |x| */
-static double
+double
dblmodulus(GEN x)
{
if (typ(x) == t_COMPLEX)
@@ -1403,22 +1403,21 @@ bernreal(long n, long prec)
return B;
}
-/* zeta(s+h*j), j=0..N-1, s>1, using sumalt. Johansonn's thesis, Algo 4.7.1 */
-GEN
-zetaBorweinRecycled(long s, long h, long N, long prec)
+/* zeta(a*j+b), j=0..N-1, b>1, using sumalt. Johansonn'b thesis, Algo 4.7.1 */
+static GEN
+veczetas(long a, long b, long N, long prec)
{
- pari_sp av = avma, lim = stack_lim(av,3);
+ pari_sp av = avma;
const long n = ceil(2 + prec2nbits_mul(prec, LOG2/1.7627));
long j, k;
- GEN c, d, z = cgetg(N+1, t_VEC);
+ GEN c, d, z = zerovec(N);
c = d = int2n(2*n-1);
- for (j = 0; j < N; j++) gel(z,j+1) = gen_0;
for (k = n; k; k--)
{
- GEN u, t = divii(d, powuu(k,s));
+ GEN u, t = divii(d, powuu(k,b));
if (!odd(k)) t = negi(t);
gel(z,1) = addii(gel(z,1), t);
- u = powuu(k,h);
+ u = powuu(k,a);
for (j = 1; j < N; j++)
{
t = divii(t,u); if (!signe(t)) break;
@@ -1427,24 +1426,68 @@ zetaBorweinRecycled(long s, long h, long N, long prec)
c = muluui(k,2*k-1,c);
c = diviuuexact(c, 2*(n-k+1),n+k-1);
d = addii(d,c);
- if (low_stack(lim,stack_lim(av,3)))
+ if (gc_needed(av,3))
+ {
+ if(DEBUGMEM>1) pari_warn(warnmem,"zetaBorweinRecycled, k = %ld", k);
+ gerepileall(av, 3, &c,&d,&z);
+ }
+ }
+ for (j = 0; j < N; j++)
+ {
+ long u = b+a*j-1;
+ gel(z,j+1) = rdivii(shifti(gel(z,j+1), u), subii(shifti(d,u), d), prec);
+ }
+ return gerepilecopy(av, z);
+}
+/* zeta(a*j+b), j=0..N-1, b>1, using sumalt */
+GEN
+veczeta(GEN a, GEN b, long N, long prec)
+{
+ pari_sp av;
+ long n, j, k;
+ GEN L, c, d, z;
+ if (typ(a) == t_INT && typ(b) == t_INT)
+ return veczetas(itos(a), itos(b), N, prec);
+ av = avma; z = zerovec(N);
+ n = ceil(2 + prec2nbits_mul(prec, LOG2/1.7627));
+ c = d = int2n(2*n-1);
+ for (k = n; k; k--)
+ {
+ GEN u, t;
+ L = logr_abs(utor(k, prec)); /* log(k) */
+ t = gdiv(d, gexp(gmul(b, L), prec)); /* d / k^b */
+ if (!odd(k)) t = gneg(t);
+ gel(z,1) = gadd(gel(z,1), t);
+ u = gexp(gmul(a, L), prec);
+ for (j = 1; j < N; j++)
+ {
+ t = gdiv(t,u); if (gexpo(t) < 0) break;
+ gel(z,j+1) = gadd(gel(z,j+1), t);
+ }
+ c = muluui(k,2*k-1,c);
+ c = diviuuexact(c, 2*(n-k+1),n+k-1);
+ d = addii(d,c);
+ if (gc_needed(av,3))
{
- if(DEBUGMEM>1) pari_warn(warnmem,"zetaBorweinRecycled");
+ if(DEBUGMEM>1) pari_warn(warnmem,"veczeta, k = %ld", k);
gerepileall(av, 3, &c,&d,&z);
}
}
+ L = mplog2(prec);
for (j = 0; j < N; j++)
{
- long a = s+h*j-1;
- gel(z,j+1) = rdivii(shifti(gel(z,j+1), a), subii(shifti(d,a), d), prec);
+ GEN u = gsubgs(gadd(b, gmulgs(a,j)), 1);
+ GEN w = gexp(gmul(u, L), prec); /* 2^u */
+ gel(z,j+1) = gdiv(gmul(gel(z,j+1), w), gmul(d,gsubgs(w,1)));
}
return gerepilecopy(av, z);
}
+
/* zeta(s) using sumalt, case h=0,N=1. Assume s > 1 */
static GEN
zetaBorwein(long s, long prec)
{
- pari_sp av = avma, lim = stack_lim(av,3);
+ pari_sp av = avma;
const long n = ceil(2 + prec2nbits_mul(prec, LOG2/1.7627));
long k;
GEN c, d, z = gen_0;
@@ -1456,9 +1499,9 @@ zetaBorwein(long s, long prec)
c = muluui(k,2*k-1,c);
c = diviuuexact(c, 2*(n-k+1),n+k-1);
d = addii(d,c);
- if (low_stack(lim,stack_lim(av,3)))
+ if (gc_needed(av,3))
{
- if(DEBUGMEM>1) pari_warn(warnmem,"zetaBorwein");
+ if(DEBUGMEM>1) pari_warn(warnmem,"zetaBorwein, k = %ld", k);
gerepileall(av, 3, &c,&d,&z);
}
}
diff --git a/src/basemath/zetamult.c b/src/basemath/zetamult.c
new file mode 100644
index 0000000..1c5025b
--- /dev/null
+++ b/src/basemath/zetamult.c
@@ -0,0 +1,202 @@
+/* Copyright (C) 2000 The PARI group.
+This file is part of the PARI/GP package.
+
+PARI/GP is free software; you can redistribute it and/or modify it under the
+terms of the GNU General Public License as published by the Free Software
+Foundation. It is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY WHATSOEVER.
+
+Check the License for details. You should have received a copy of it, along
+with the package; see the file 'COPYING'. If not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+/********************************************************************/
+/** **/
+/** MULTIPLE ZETA VALUES **/
+/** **/
+/** ALGORITHM DUE TO P. AKHILESH. DO NOT REPRODUCE UNTIL PUBLISHED **/
+/** **/
+/********************************************************************/
+#include "pari.h"
+#include "paripriv.h"
+
+static GEN
+la(long e, long f, GEN s)
+{
+ if (e == f) return gmul2n(s,1);
+ return (e > f)? s: gmulgs(s,3);
+}
+
+static GEN
+rev(GEN evec)
+{
+ long i, le = lg(evec);
+ GEN res = cgetg(le, t_VECSMALL);
+ for (i = 1; i < le; ++i) res[i] = 1 - evec[le-i];
+ return res;
+}
+
+static GEN
+etoa(GEN evec)
+{
+ long ct, a, ia, le = lg(evec) - 1;
+ GEN avec;
+
+ if (evec[le] != 1) pari_err_TYPE("zetamult",evec);
+ avec = cgetg(le+1, t_VECSMALL);
+ ct = 0; a = 0; ia = 1;
+ while (ct < le)
+ {
+ ct++; a++;
+ if (evec[ct] == 1) { avec[ia++] = a; a = 0; }
+ }
+ setlg(avec, ia); return avec;
+}
+
+static GEN
+atoe(GEN avec)
+{
+ long i, j, l1 = lg(avec);
+ GEN evec = cgetg(l1, t_VEC);
+ for (i = 1; i < l1; ++i)
+ {
+ long a = avec[i];
+ GEN e = cgetg(a+1, t_VECSMALL);
+ for (j = 1; j < a; ++j) e[j] = 0;
+ e[a] = 1;
+ gel(evec,i) = e;
+ }
+ return shallowconcat1(evec);
+}
+
+/* phivec[i] contains phip(j,avec[i..r]) for 1<=j<=nlim > 2 */
+static GEN
+phip(long nlim, GEN avec, long prec)
+{
+ pari_sp av = avma;
+ long i, j, ar, r = lg(avec) - 1;
+ GEN u, r1, phivec = cgetg(r+1, t_VEC);
+
+ ar = avec[r]; r1 = real_1(prec);
+ gel(phivec, r) = u = cgetg(nlim, t_VEC);
+ for (j = 1; j < nlim; ++j) gel(u,j) = divri(r1, powuu(j,ar));
+ for (i = r-1; i >= 1; i--)
+ {
+ GEN t, phi = gel(phivec,i+1);
+ ar = avec[i];
+ gel(phivec, i) = u = cgetg(nlim, t_VEC);
+ gel(u,1) = gen_0; t = gel(phi,1);
+ gel(u,2) = gmul2n(t, -ar);
+ for (j = 3; j < nlim; j++)
+ {
+ t = gadd(t, gel(phi,j-1));
+ gel(u,j) = gdiv(t, powuu(j,ar));
+ }
+ }
+ return gerepilecopy(av, phivec);
+}
+
+/* Return 1 if vec2 RHS of vec1, -1 if vec1 RHS of vec2, 0 else */
+static long
+isrhs(GEN v1, GEN v2)
+{
+ long s = 1, i, l1 = lg(v1), l2 = lg(v2);
+ if (l1 < l2)
+ {
+ s = -1;
+ swap(v1,v2);
+ lswap(l1,l2);
+ }
+ for (i = l2-1; i >= 1; --i)
+ if (v2[i] != v1[l1-l2+i]) return 0;
+ return s;
+}
+
+static long
+istruerhs(GEN v1, GEN v2)
+{
+ long i, l1 = lg(v1), l2 = lg(v2);
+ if (l1 < l2) return 0;
+ for (i = l2-1; i >= 1; --i)
+ if (v2[i] != v1[l1-l2+i]) return 0;
+ return l1-l2+1;
+}
+
+static GEN
+isinphi(GEN v, GEN a, GEN phivec)
+{
+ long s, m, l1 = lg(v);
+ for (m = 1; m < l1; m++)
+ {
+ s = istruerhs(gel(v,m), a);
+ if (s) return gmael(phivec,m,s);
+ }
+ return NULL;
+}
+
+/* If v RHS of LR[i] for some i, return LR. If LR[i] RHS (strict) of v, replace
+ * LR[i] by v. If none, add v to LR. */
+static GEN
+addevec(GEN LR, GEN v)
+{
+ long s, i, l1 = lg(LR);
+ for (i = 1; i < l1; i++)
+ {
+ s = isrhs(gel(LR,i), v);
+ if (s == 1) return LR;
+ if (s == -1) { gel(LR,i) = v; return LR; }
+ }
+ return vec_append(LR,v);
+}
+
+GEN
+zetamult(GEN avec, long prec)
+{
+ pari_sp ltop = avma;
+ long k, n, i, j, nlim, l, bitprec, prec2;
+ GEN binvec, S, LR, phiall, MA, MR, evec = gen_0;
+
+ switch(typ(avec))
+ {
+ case t_INT: return gzeta(avec,prec);
+ case t_VEC:
+ case t_COL: avec = gtovecsmall(avec); break;
+ default: pari_err_TYPE("zetamult",avec);
+ }
+ if (lg(avec) == 1) return gen_1;
+ if (vecsmall_min(avec) <= 0) pari_err_TYPE("zetamult",avec);
+ if (avec[1] == 1) pari_err_DOMAIN("zetamult", "s[1]", "=", gen_1, avec);
+ evec = atoe(avec);
+ k = lg(evec)-1; /* weight */
+ bitprec = prec2nbits(prec) + 64*(1+(k>>5));
+ prec2 = nbits2prec(bitprec);
+ nlim = 5 + bitprec/2;
+ binvec = cgetg(nlim+1, t_VEC);
+ gel(binvec, 1) = gen_2;
+ for (n = 2; n <= nlim; ++n)
+ gel(binvec, n) = diviuexact(mului(4*n-2, gel(binvec, n-1)), n);
+ LR = cgetg(1, t_VEC);
+ MA = cgetg(k, t_VEC);
+ MR = cgetg(k, t_VEC);
+ for (i = 1; i < k; ++i)
+ {
+ gel(MA,i) = etoa(rev(vecslice(evec, 1, i)));
+ gel(MR,i) = etoa(vecslice(evec, i+1, k));
+ LR = addevec(addevec(LR, gel(MA,i)), gel(MR,i));
+ }
+ l = lg(LR);
+ phiall = cgetg(l, t_VEC);
+ for (j = 1; j < l; j++) gel(phiall,j) = phip(nlim+1, gel(LR,j), prec2);
+ S = real_0(prec2);
+ for (i = 1; i < k; i++)
+ {
+ GEN phi1 = isinphi(LR, gel(MA,i), phiall);
+ GEN phi2 = isinphi(LR, gel(MR,i), phiall);
+ GEN s = gmul2n(gmul(gel(phi1,1), gel(phi2,1)), -1);
+ for (n = 2; n <= nlim; ++n)
+ s = gadd(s, gdiv(gmul(gel(phi1,n), gel(phi2,n)), gel(binvec,n)));
+ S = gadd(S, la(evec[i], evec[i+1], s));
+ }
+ return gerepilecopy(ltop, rtor(S,prec));
+}
+
diff --git a/src/desc/deftune b/src/desc/deftune
index edbcbad..3384449 100644
--- a/src/desc/deftune
+++ b/src/desc/deftune
@@ -9,7 +9,10 @@ Flx_BARRETT_MULII_LIMIT 2715 433 1681 448
Flx_DIVREM_BARRETT_LIMIT 3942 1289 2804 768
Flx_EXTGCD_LIMIT 850 632 284 241
Flx_GCD_LIMIT 7165 2514 1890 1017
-Flx_HALFGCD_LIMIT 232 321 80 81
+Flx_HALFGCD_HALFMULII_LIMIT 116 78 60 48
+Flx_HALFGCD_KARATSUBA_LIMIT 230 139 58 77
+Flx_HALFGCD_MULII2_LIMIT 1045 537 64 25
+Flx_HALFGCD_MULII_LIMIT 168 91 90 71
Flx_INVBARRETT_HALFMULII_LIMIT 898 240 424 231
Flx_INVBARRETT_KARATSUBA_LIMIT 3471 3600 5120 5067
Flx_INVBARRETT_MULII2_LIMIT 3672 1815 36 26
diff --git a/src/funclist b/src/funclist
index 1a3ff97..3f577ef 100644
--- a/src/funclist
+++ b/src/funclist
@@ -55,8 +55,9 @@
2229708950 596 ../functions/algebras/algtrace
1995908831 1174 ../functions/algebras/algtype
1557685643 1558 ../functions/conversions/Col
-3234299882 400 ../functions/conversions/Colrev
+1677621679 591 ../functions/conversions/Colrev
4195552700 684 ../functions/conversions/List
+3614322898 605 ../functions/conversions/Map
981428093 924 ../functions/conversions/Mat
2678939693 1487 ../functions/conversions/Mod
3703587249 1772 ../functions/conversions/Pol
@@ -70,7 +71,7 @@
1117955044 413 ../functions/conversions/Strprintf
2125909664 423 ../functions/conversions/Strtex
1466495582 1560 ../functions/conversions/Vec
-2107834942 595 ../functions/conversions/Vecrev
+411920005 583 ../functions/conversions/Vecrev
1108364263 729 ../functions/conversions/Vecsmall
1275004057 370 ../functions/conversions/binary
130657493 883 ../functions/conversions/bitand
@@ -160,7 +161,7 @@
563829741 477 ../functions/default/threadsize
776813016 566 ../functions/default/threadsizemax
2044127399 929 ../functions/default/timer
-2727567316 1265 ../functions/elliptic_curves/ellL1
+4231264536 1192 ../functions/elliptic_curves/ellL1
1093349276 227 ../functions/elliptic_curves/elladd
288388107 1283 ../functions/elliptic_curves/ellak
994306239 581 ../functions/elliptic_curves/ellan
@@ -180,6 +181,7 @@
2038371915 674 ../functions/elliptic_curves/ellformallog
1595209028 977 ../functions/elliptic_curves/ellformalpoint
2758880974 748 ../functions/elliptic_curves/ellformalw
+2536329778 1866 ../functions/elliptic_curves/ellfromeqn
2802844850 287 ../functions/elliptic_curves/ellfromj
1592776600 870 ../functions/elliptic_curves/ellgenerators
2881662361 1249 ../functions/elliptic_curves/ellglobalred
@@ -227,7 +229,7 @@
36981238 1480 ../functions/elliptic_curves/ellzeta
1222568733 758 ../functions/elliptic_curves/ellztopoint
727315604 5711 ../functions/elliptic_curves/genus2red
-2832333632 729 ../functions/elliptic_curves/hyperellcharpoly
+4179269820 731 ../functions/elliptic_curves/hyperellcharpoly
3063493560 994 ../functions/elliptic_curves/hyperellpadicfrobenius
1668730040 123 ../functions/gp2c/DEBUGLEVEL
673657102 528 ../functions/gp2c/clone
@@ -247,7 +249,7 @@
667601403 171 ../functions/gp2c_internal/_strtoclosure
4035878089 888 ../functions/gp2c_internal/_tovec
722974942 2193 ../functions/gp2c_internal/_typedef
-3508241653 415 ../functions/gp2c_internal/_wrap
+915156773 521 ../functions/gp2c_internal/_wrap
1104882680 596 ../functions/graphic/plot
165946816 531 ../functions/graphic/plotbox
2126934426 451 ../functions/graphic/plotclip
@@ -282,12 +284,6 @@
3926371483 2388 ../functions/linear_algebra/concat
1496930793 912 ../functions/linear_algebra/forqfvec
1135559220 2367 ../functions/linear_algebra/lindep
-1885213010 438 ../functions/linear_algebra/listcreate
-3413287768 475 ../functions/linear_algebra/listinsert
-371937160 368 ../functions/linear_algebra/listkill
-2352976546 526 ../functions/linear_algebra/listpop
-1191932916 818 ../functions/linear_algebra/listput
-884227144 781 ../functions/linear_algebra/listsort
4182706108 1104 ../functions/linear_algebra/matadjoint
2523670318 202 ../functions/linear_algebra/matcompanion
3032582234 2098 ../functions/linear_algebra/matconcat
@@ -644,8 +640,8 @@
3694653558 2705 ../functions/number_theoretical/qfbclassno
3695050800 431 ../functions/number_theoretical/qfbcompraw
1940983238 339 ../functions/number_theoretical/qfbhclassno
-973965715 902 ../functions/number_theoretical/qfbnucomp
-2697822130 368 ../functions/number_theoretical/qfbnupow
+1449052717 868 ../functions/number_theoretical/qfbnucomp
+1508381386 557 ../functions/number_theoretical/qfbnupow
3393949890 338 ../functions/number_theoretical/qfbpowraw
3859788640 639 ../functions/number_theoretical/qfbprimeform
760904670 1434 ../functions/number_theoretical/qfbred
@@ -680,7 +676,7 @@
2383733157 207 ../functions/operators/powers
2356147055 550 ../functions/operators/shift
1941910361 424 ../functions/operators/shiftmul
-2474408050 291 ../functions/operators/sign
+2596830732 370 ../functions/operators/sign
2122378256 865 ../functions/operators/vecmax
3459801581 867 ../functions/operators/vecmin
3728482663 863 ../functions/polynomials/O
@@ -774,8 +770,18 @@
132054800 746 ../functions/programming/input
490792963 3434 ../functions/programming/install
2467288771 1469 ../functions/programming/kill
+1926401245 444 ../functions/programming/listcreate
+608243128 481 ../functions/programming/listinsert
+463439844 374 ../functions/programming/listkill
+403720273 533 ../functions/programming/listpop
+3674661200 825 ../functions/programming/listput
+2156669802 787 ../functions/programming/listsort
3065531026 125 ../functions/programming/local
1095397871 2220 ../functions/programming/localprec
+2826071546 293 ../functions/programming/mapdelete
+3644656067 512 ../functions/programming/mapget
+2770034226 779 ../functions/programming/mapisdefined
+3113578995 458 ../functions/programming/mapput
2557836032 115 ../functions/programming/my
1218387207 521 ../functions/programming/next
315903861 794 ../functions/programming/parapply
@@ -812,20 +818,18 @@
3083331806 313 ../functions/programming/write1
1788791396 1947 ../functions/programming/writebin
3395311360 248 ../functions/programming/writetex
-4162161133 1023 ../functions/sums/derivnum
-847633432 836 ../functions/sums/intcirc
-675879057 862 ../functions/sums/intfouriercos
-3481939193 904 ../functions/sums/intfourierexp
-3947097796 857 ../functions/sums/intfouriersin
-3096883269 1556 ../functions/sums/intfuncinit
-3456264235 2300 ../functions/sums/intlaplaceinv
-2519244525 2071 ../functions/sums/intmellininv
-3633417749 2041 ../functions/sums/intmellininvshort
-223149020 11817 ../functions/sums/intnum
-1298834224 1939 ../functions/sums/intnuminit
-3061973932 975 ../functions/sums/intnuminitgen
+694285188 1986 ../functions/sums/asympnum
+3698553184 538 ../functions/sums/contfraceval
+426768215 731 ../functions/sums/contfracinit
+279095148 1024 ../functions/sums/derivnum
+1735926827 852 ../functions/sums/intcirc
+2179179824 3366 ../functions/sums/intfuncinit
+2017373341 11920 ../functions/sums/intnum
+1738925400 1461 ../functions/sums/intnumgauss
+3935972398 1257 ../functions/sums/intnumgaussinit
+324700532 2520 ../functions/sums/intnuminit
2361868629 2774 ../functions/sums/intnumromb
-400964355 342 ../functions/sums/intnumstep
+1304134978 2642 ../functions/sums/limitnum
3675594259 1432 ../functions/sums/prod
238922829 499 ../functions/sums/prodeuler
4010920763 901 ../functions/sums/prodinf
@@ -835,9 +839,10 @@
2396474070 511 ../functions/sums/sumdiv
3260846671 413 ../functions/sums/sumdivmult
4053719439 1152 ../functions/sums/suminf
-2896834138 4953 ../functions/sums/sumnum
-1929035087 2463 ../functions/sums/sumnumalt
-763341576 559 ../functions/sums/sumnuminit
+2937189675 5047 ../functions/sums/sumnum
+179885008 999 ../functions/sums/sumnuminit
+3624752466 960 ../functions/sums/sumnummonien
+89272281 3543 ../functions/sums/sumnummonieninit
2459440955 2147 ../functions/sums/sumpos
3764491866 847 ../functions/symbolic_operators/add
3353925834 892 ../functions/symbolic_operators/adde
@@ -910,6 +915,7 @@
2865291733 112 ../functions/transcendental/cos
3610629014 137 ../functions/transcendental/cosh
3039924894 124 ../functions/transcendental/cotan
+1591771947 149 ../functions/transcendental/cotanh
3749138764 232 ../functions/transcendental/dilog
1358921222 1230 ../functions/transcendental/eint1
2742925928 351 ../functions/transcendental/erfc
@@ -918,6 +924,9 @@
3219425904 1030 ../functions/transcendental/expm1
283840075 815 ../functions/transcendental/gamma
2489052783 171 ../functions/transcendental/gammah
+1842163496 645 ../functions/transcendental/gammamellininv
+3892106685 1095 ../functions/transcendental/gammamellininvasymp
+727653555 1466 ../functions/transcendental/gammamellininvinit
1703809654 306 ../functions/transcendental/hyperu
2351714423 626 ../functions/transcendental/incgam
1394040053 409 ../functions/transcendental/incgamc
@@ -927,6 +936,7 @@
2637087612 1600 ../functions/transcendental/polylog
1987478852 188 ../functions/transcendental/psi
1520878203 108 ../functions/transcendental/sin
+4026529713 296 ../functions/transcendental/sinc
2704877408 133 ../functions/transcendental/sinh
473305427 963 ../functions/transcendental/sqr
685184966 819 ../functions/transcendental/sqrt
@@ -938,3 +948,4 @@
1059709706 476 ../functions/transcendental/thetanullk
2007207279 1064 ../functions/transcendental/weber
298482603 822 ../functions/transcendental/zeta
+296465907 407 ../functions/transcendental/zetamult
diff --git a/src/functions/conversions/Colrev b/src/functions/conversions/Colrev
index 3a1b421..64f485e 100644
--- a/src/functions/conversions/Colrev
+++ b/src/functions/conversions/Colrev
@@ -8,5 +8,8 @@ Help: Colrev(x, {n}): transforms the object x into a column vector of
Description:
(gen):vec gtocolrev($1)
Doc:
- as $\kbd{Col}(x, n)$, then reverse the result. In particular
+ as $\kbd{Col}(x, -n)$, then reverse the result. In particular,
+ \kbd{Colrev} is the reciprocal function of \kbd{Polrev}: the
+ coefficients of the vector start with the constant coefficient of the
+ polynomial and the others follow by increasing degree.
Variant: \fun{GEN}{gtocolrev}{GEN x} is also available.
diff --git a/src/functions/conversions/Map b/src/functions/conversions/Map
new file mode 100644
index 0000000..de8e1af
--- /dev/null
+++ b/src/functions/conversions/Map
@@ -0,0 +1,16 @@
+Function: Map
+Section: conversions
+C-Name: gtomap
+Prototype: DG
+Help: Map({x}): convert the matrix [a_1,b_1;a_2,b_2;...;a_n,b_n] to the map a_i->b_i
+Doc: A ``Map'' is an associative array, or dictionary: a data
+ type composed of a collection of (\emph{key}, \emph{value}) pairs, such that
+ each key appears just once in the collection. This function
+ converts the matrix $[a_1,b_1;a_2,b_2;\dots;a_n,b_n]$ to the map $a_i\mapsto
+ b_i$.
+ \bprog
+ ? M = Map(factor(13!));
+ ? mapget(M,3)
+ %2 = 5
+ @eprog\noindent If the argument $x$ is omitted, create an empty map, which
+ may be filled later via \tet{mapput}
diff --git a/src/functions/conversions/Vecrev b/src/functions/conversions/Vecrev
index cd3f277..c68bdb4 100644
--- a/src/functions/conversions/Vecrev
+++ b/src/functions/conversions/Vecrev
@@ -7,8 +7,8 @@ Help: Vecrev(x, {n}): transforms the object x into a vector of dimension n
Description:
(gen):vec gtovecrev($1)
Doc:
- as $\kbd{Vec}(x, n)$, then reverse the result. In particular
- In this case, \kbd{Vecrev} is the reciprocal function of \kbd{Polrev}: the
+ as $\kbd{Vec}(x, -n)$, then reverse the result. In particular,
+ \kbd{Vecrev} is the reciprocal function of \kbd{Polrev}: the
coefficients of the vector start with the constant coefficient of the
polynomial and the others follow by increasing degree.
Variant: \fun{GEN}{gtovecrev}{GEN x} is also available.
diff --git a/src/functions/elliptic_curves/ellL1 b/src/functions/elliptic_curves/ellL1
index 2f4dc43..dea607b 100644
--- a/src/functions/elliptic_curves/ellL1
+++ b/src/functions/elliptic_curves/ellL1
@@ -2,7 +2,7 @@ Function: ellL1
Section: elliptic_curves
C-Name: ellL1
Prototype: GD0,L,p
-Help: ellL1(e, {r = 0}): returns the value at s=1 of the derivative of order r of the L-function of the elliptic curve e assuming that r is at most the order of vanishing of the function at s=1.
+Help: ellL1(e, {r = 0}): returns the value at s=1 of the derivative of order r of the L-function of the elliptic curve e.
Doc: returns the value at $s=1$ of the derivative of order $r$ of the
$L$-function of the elliptic curve $e$.
\bprog
diff --git a/src/functions/elliptic_curves/ellfromeqn b/src/functions/elliptic_curves/ellfromeqn
new file mode 100644
index 0000000..4965e5b
--- /dev/null
+++ b/src/functions/elliptic_curves/ellfromeqn
@@ -0,0 +1,51 @@
+Function: ellfromeqn
+Section: elliptic_curves
+C-Name: ellfromeqn
+Prototype: G
+Help: ellfromeqn(P): Given a genus 1 plane curve, defined by the affine
+ equation f(x,y) = 0, return the coefficients [a1,a2,a3,a4,a6] of a
+ Weierstrass equation for its Jacobian.
+ This allows to recover a Weierstrass model for an elliptic curve given by a
+ general plane cubic or by a binary quartic or biquadratic model.
+Doc:
+ Given a genus $1$ plane curve, defined by the affine equation $f(x,y) = 0$,
+ return the coefficients $[a_1,a_2,a_3,a_4,a_6]$ of a Weierstrass equation
+ for its Jacobian. This allows to recover a Weierstrass model for an elliptic
+ curve given by a general plane cubic or by a binary quartic or biquadratic
+ model.
+
+ The function implements the $f \mapsto f^*$ formulae of Artin, Tate and
+ Villegas (Advances in Math. 198 (2005), pp. 366--382).
+
+ In the example below, the function is used to convert between twisted Edward
+ coordinates and Weierstrass coordinates.
+
+ \bprog
+ ? e = ellfromeqn(a*x^2+y^2-(1+d*x^2*y^2))
+ %1 = [0,-a-d,0,-4*d*a,4*d*a^2+4*d^2*a]
+ ? E = ellinit(ellfromeqn(y^2-x^2 - 1 +(121665/121666*x^2*y^2)),2^255-19);
+ ? ellcard(E)
+ %2 = 57896044618658097711785492504343953926856930875039260848015607506283634007912
+ @eprog
+
+ The elliptic curve associated to the sum of two cubes is given by
+ \bprog
+ ? ellfromeqn(x^3+y^3-a)
+ %1 = [0,0,-9*a,0,-27*a^2]
+ @eprog
+
+ Congruent number problem: Let $n$ be an integer,
+ if $a^2+b^2=c^2$ and $a\*b=2\*n$,
+ then by substituting $b$ by $2\*n/a$ in the first equation,
+ we get $((a^2+(2\*n/a)^2)-c^2)*a^2 = 0$.
+ We set $x=a$, $y=a*c$.
+ \bprog
+ ? ellfromeqn((x^2+(2*n/x)^2-(y/x)^2)*x^2)
+ %1 = [0,0,0,-16*n^2,0]
+ @eprog
+ For example $23$ is congruent since the curve has a point of infinite order,
+ namely:
+ \bprog
+ ? ellheegner(ellinit(subst([0,0,0,-16*n^2,0],n,23)))
+ %2 = [168100/289,68053440/4913]
+ @eprog
diff --git a/src/functions/elliptic_curves/hyperellcharpoly b/src/functions/elliptic_curves/hyperellcharpoly
index ccbd613..4b3f1fe 100644
--- a/src/functions/elliptic_curves/hyperellcharpoly
+++ b/src/functions/elliptic_curves/hyperellcharpoly
@@ -10,6 +10,6 @@ Help: hyperellcharpoly(X): X being a non-singular hyperelliptic curve defined
Doc:
$X$ being a non-singular hyperelliptic curve defined over a finite field,
return the characteristic polynomial of the Frobenius automorphism.
- $X$ can be given either by a squarefree polynomial P such that $X: y^2 = P(x)$
- or by a vector $[P,Q]$ such that $X: y^2 + Q(x)\*y = P(x)$ and $Q^2+4\*P$ is
- squarefree.
+ $X$ can be given either by a squarefree polynomial $P$ such that
+ $X: y^2 = P(x)$ or by a vector $[P,Q]$ such that
+ $X: y^2 + Q(x)\*y = P(x)$ and $Q^2+4\*P$ is squarefree.
diff --git a/src/functions/gp2c_internal/_wrap b/src/functions/gp2c_internal/_wrap
index 49dfc44..50f2ede 100644
--- a/src/functions/gp2c_internal/_wrap
+++ b/src/functions/gp2c_internal/_wrap
@@ -5,6 +5,13 @@ Prototype: G
Description:
(gen):gen $1
+Function: _wrap_Gp
+Class: gp2c_internal
+C-Name: gp_callprec
+Prototype: Gp
+Description:
+ (gen):gen $1
+
Function: _wrap_GG
Class: gp2c_internal
C-Name: gp_call2
diff --git a/src/functions/number_theoretical/qfbnucomp b/src/functions/number_theoretical/qfbnucomp
index bc9db59..9bfb2d9 100644
--- a/src/functions/number_theoretical/qfbnucomp
+++ b/src/functions/number_theoretical/qfbnucomp
@@ -7,12 +7,12 @@ Help: qfbnucomp(x,y,L): composite of primitive positive definite quadratic
Doc: \idx{composition} of the primitive positive
definite binary quadratic forms $x$ and $y$ (type \typ{QFI}) using the NUCOMP
and NUDUPL algorithms of \idx{Shanks}, \`a la Atkin. $L$ is any positive
- constant, but for optimal speed, one should take $L=|D|^{1/4}$, where $D$ is
- the common discriminant of $x$ and $y$. When $x$ and $y$ do not have the same
- discriminant, the result is undefined.
+ constant, but for optimal speed, one should take $L=|D/4|^{1/4}$, i.e.
+ \kbd{sqrtnint(abs(D)>>2,4)}, where $D$ is the common discriminant of $x$ and
+ $y$. When $x$ and $y$ do not have the same discriminant, the result is
+ undefined.
- The current implementation is straightforward and in general \emph{slower}
- than the generic routine (since the latter takes advantage of asymptotically
- fast operations and careful optimizations).
+ The current implementation is slower than the generic routine for small $D$,
+ and becomes faster when $D$ has about $45$ bits.
Variant: Also available is \fun{GEN}{nudupl}{GEN x, GEN L} when $x=y$.
diff --git a/src/functions/number_theoretical/qfbnupow b/src/functions/number_theoretical/qfbnupow
index caaf02f..a2b3b15 100644
--- a/src/functions/number_theoretical/qfbnupow
+++ b/src/functions/number_theoretical/qfbnupow
@@ -1,9 +1,14 @@
Function: qfbnupow
Section: number_theoretical
C-Name: nupow
-Prototype: GG
-Help: qfbnupow(x,n): n-th power of primitive positive definite quadratic
+Prototype: GGDG
+Help: qfbnupow(x,n,{L}): n-th power of primitive positive definite quadratic
form x using nucomp and nudupl.
Doc: $n$-th power of the primitive positive definite
- binary quadratic form $x$ using \idx{Shanks}'s NUCOMP and NUDUPL algorithms
- (see \kbd{qfbnucomp}, in particular the final warning).
+ binary quadratic form $x$ using \idx{Shanks}'s NUCOMP and NUDUPL algorithms;
+ if set, $L$ should be equal to \kbd{sqrtnint(abs(D)>>2,4)}, where $D < 0$ is
+ the discriminant of $x$.
+
+ The current implementation is slower than the generic routine for small
+ discriminant $D$, and becomes faster for $D \approx 2^45$.
+
diff --git a/src/functions/operators/sign b/src/functions/operators/sign
index f36b3a4..38e0ac9 100644
--- a/src/functions/operators/sign
+++ b/src/functions/operators/sign
@@ -7,4 +7,5 @@ Description:
(mp):small signe($1)
(gen):small gsigne($1)
Doc: \idx{sign} ($0$, $1$ or $-1$) of $x$, which must be of
- type integer, real or fraction.
+ type integer, real or fraction; \typ{QUAD} with positive discriminants and
+ \typ{INFINITY} are also supported.
diff --git a/src/functions/linear_algebra/listcreate b/src/functions/programming/listcreate
similarity index 93%
rename from src/functions/linear_algebra/listcreate
rename to src/functions/programming/listcreate
index e5868a4..bc6f22c 100644
--- a/src/functions/linear_algebra/listcreate
+++ b/src/functions/programming/listcreate
@@ -1,5 +1,5 @@
Function: listcreate
-Section: linear_algebra
+Section: programming/specific
C-Name: listcreate
Prototype: D0,L,
Help: listcreate(): creates an empty list.
diff --git a/src/functions/linear_algebra/listinsert b/src/functions/programming/listinsert
similarity index 93%
rename from src/functions/linear_algebra/listinsert
rename to src/functions/programming/listinsert
index 971f4fc..8d4ee8b 100644
--- a/src/functions/linear_algebra/listinsert
+++ b/src/functions/programming/listinsert
@@ -1,5 +1,5 @@
Function: listinsert
-Section: linear_algebra
+Section: programming/specific
C-Name: listinsert
Prototype: WGL
Help: listinsert(L,x,n): insert x at index n in list L, shifting the
diff --git a/src/functions/linear_algebra/listkill b/src/functions/programming/listkill
similarity index 91%
rename from src/functions/linear_algebra/listkill
rename to src/functions/programming/listkill
index c83a362..593e47b 100644
--- a/src/functions/linear_algebra/listkill
+++ b/src/functions/programming/listkill
@@ -1,5 +1,5 @@
Function: listkill
-Section: linear_algebra
+Section: programming/specific
C-Name: listkill
Prototype: vG
Help: listkill(L): obsolete, retained for backward compatibility.
diff --git a/src/functions/linear_algebra/listpop b/src/functions/programming/listpop
similarity index 91%
rename from src/functions/linear_algebra/listpop
rename to src/functions/programming/listpop
index 5246a6c..fa62d37 100644
--- a/src/functions/linear_algebra/listpop
+++ b/src/functions/programming/listpop
@@ -1,6 +1,6 @@
Function: listpop
-Section: linear_algebra
-C-Name: listpop
+Section: programming/specific
+C-Name: listpop0
Prototype: vWD0,L,
Help: listpop(list,{n}): removes n-th element from list. If n is
omitted or greater than the current list length, removes last element.
diff --git a/src/functions/linear_algebra/listput b/src/functions/programming/listput
similarity index 94%
rename from src/functions/linear_algebra/listput
rename to src/functions/programming/listput
index 6e3a457..73475b6 100644
--- a/src/functions/linear_algebra/listput
+++ b/src/functions/programming/listput
@@ -1,6 +1,6 @@
Function: listput
-Section: linear_algebra
-C-Name: listput
+Section: programming/specific
+C-Name: listput0
Prototype: WGD0,L,
Help: listput(list,x,{n}): sets n-th element of list equal to x. If n is
omitted or greater than the current list length, appends x.
diff --git a/src/functions/linear_algebra/listsort b/src/functions/programming/listsort
similarity index 96%
rename from src/functions/linear_algebra/listsort
rename to src/functions/programming/listsort
index c6f8e66..f1ebbea 100644
--- a/src/functions/linear_algebra/listsort
+++ b/src/functions/programming/listsort
@@ -1,5 +1,5 @@
Function: listsort
-Section: linear_algebra
+Section: programming/specific
C-Name: listsort
Prototype: vWD0,L,
Help: listsort(L,{flag=0}): sort the list L in place. If flag is non-zero,
diff --git a/src/functions/programming/mapdelete b/src/functions/programming/mapdelete
new file mode 100644
index 0000000..ac4453e
--- /dev/null
+++ b/src/functions/programming/mapdelete
@@ -0,0 +1,14 @@
+Function: mapdelete
+Section: programming/specific
+C-Name: mapdelete
+Prototype: vGG
+Help: mapdelete(M,x): remove x from the domain of the map M.
+Doc: remove $x$ from the domain of the map $M$.
+ \bprog
+ ? M = Map(["a",1; "b",3; "c",7]);
+ ? mapdelete(M,"b");
+ ? Mat(M)
+ ["a" 1]
+
+ ["c" 7]
+ @eprog
diff --git a/src/functions/programming/mapget b/src/functions/programming/mapget
new file mode 100644
index 0000000..7fa8ca4
--- /dev/null
+++ b/src/functions/programming/mapget
@@ -0,0 +1,19 @@
+Function: mapget
+Section: programming/specific
+C-Name: mapget
+Prototype: GG
+Help: mapget(M,x): return the image of x by the map M
+Doc: return the image of $x$ by the map $M$.
+ \bprog
+ ? M=Map(["a",23;"b",43]);
+ ? mapget(M,"a")
+ %2 = 23
+ ? mapget(M,"b")
+ %3 = 43
+ @eprog\noindent Raises an exception when the key $x$ is not present in $M$
+ \bprog
+ ? mapget(M,"c")
+ *** at top-level: mapget(M,"c")
+ *** ^-------------
+ *** mapget: non-existent component in mapget: index not in map
+ @eprog
diff --git a/src/functions/programming/mapisdefined b/src/functions/programming/mapisdefined
new file mode 100644
index 0000000..d426242
--- /dev/null
+++ b/src/functions/programming/mapisdefined
@@ -0,0 +1,22 @@
+Function: mapisdefined
+Section: programming/specific
+C-Name: mapisdefined
+Prototype: iGGD&
+Help: mapisdefined(M,x,{&z}): true (1) if x has an image by the map M, false (0) otherwise.
+ If z is present, set it to the image of x, if it exists.
+Doc: Return true ($1$) if \kbd{x} has an image by the map $M$, false ($0$)
+ otherwise. If \kbd{z} is present, set it to the image of $x$, if it exists.
+ \bprog
+ ? M = Map(); N = 19;
+ ? for (a=0, N-1, mapput(M, a^3%N, a));
+ ? {for (a=0, N-1,
+ if (mapisdefined(M, a, &b),
+ printf("%d is the cube of %d mod %d\n",a,b,N)));}
+ 0 is the cube of 0 mod 19
+ 1 is the cube of 11 mod 19
+ 7 is the cube of 9 mod 19
+ 8 is the cube of 14 mod 19
+ 11 is the cube of 17 mod 19
+ 12 is the cube of 15 mod 19
+ 18 is the cube of 18 mod 19
+ @eprog
diff --git a/src/functions/programming/mapput b/src/functions/programming/mapput
new file mode 100644
index 0000000..a9db530
--- /dev/null
+++ b/src/functions/programming/mapput
@@ -0,0 +1,23 @@
+Function: mapput
+Section: programming/specific
+C-Name: mapput
+Prototype: vWGG
+Help: mapput(M,x,y): associate x to y in the map M
+Doc: associate $x$ to $y$ in the map $M$. The value $y$ can the be retrieved
+ with \tet{mapget}.
+ \bprog
+ ? M = Map();
+ ? mapput(M, "foo", 23);
+ ? mapput(M, 7718, "bill");
+ ? mapget(M, "foo")
+ %4 = 23
+ ? mapget(M, 7718)
+ %5 = "bill"
+ ? Vec(M) \\ keys
+ %6 = [7718, "foo"]
+ ? Mat(M)
+ %7 =
+ [ 7718 "bill"]
+
+ ["foo" 23]
+ @eprog
diff --git a/src/functions/sums/asympnum b/src/functions/sums/asympnum
new file mode 100644
index 0000000..1c6bdb5
--- /dev/null
+++ b/src/functions/sums/asympnum
@@ -0,0 +1,49 @@
+Function: asympnum
+Section: sums
+C-Name: asympnum0
+Prototype: GD0,L,DGp
+Help: asympnum(expr,{k=20},{alpha = 1}): asymptotic expansion of expr assuming
+ it has rational coefficients with reasonable height; k and alpha are as
+ in extnum.
+Doc: Asymptotic expansion of \var{expr}, corresponding to a sequence $u(n)$,
+ assuming it has the shape
+ $$u(n) \approx \sum_{i \geq 0} a_i n^{-i\alpha}$$
+ with rational coefficients $a_i$ with reasonable height; the algorithm
+ is heuristic and performs repeated calls to limitnum, with
+ \kbd{k} and \kbd{alpha} are as in \kbd{limitnum}
+ \bprog
+ ? f(n) = n! / (n^n*exp(-n)*sqrt(n));
+ ? asympnum(f)
+ %2 = [] \\ failure !
+ ? l = limitnum(f)
+ %3 = 2.5066282746310005024157652848110452530
+ ? asympnum(n->f(n)/l) \\ normalize
+ %4 = [1, 1/12, 1/288, -139/51840]
+ @eprog\noindent and we indeed get a few terms of Stirling's expansion. Note
+ that it helps to normalize with a limit computed to higher accuracy:
+ \bprog
+ ? \p100
+ ? L = limitnum(f)
+ ? \p38
+ ? asympnum(n->f(n)/L) \\ we get more terms!
+ %6 = [1, 1/12, 1/288, -139/51840, -571/2488320, 163879/209018880,\
+ 5246819/75246796800, -534703531/902961561600]
+ @eprog\noindent If \kbd{alpha} is not an integer, loss of accuracy is
+ expected, so it should be precomputed to double accuracy, say:
+ \bprog
+ ? \p38
+ ? asympnum(n->-log(1-1/n^Pi),,Pi)
+ %1 = [0, 1, 1/2, 1/3]
+ ? asympnum(n->-log(1-1/sqrt(n)),,1/2)
+ %2 = [0, 1, 1/2, 1/3, 1/4, 1/5, 1/6, 1/7, 1/8, 1/9, 1/10, 1/11, 1/12, \
+ 1/13, 1/14, 1/15, 1/16, 1/17, 1/18, 1/19, 1/20, 1/21, 1/22]
+
+ ? localprec(100); a = Pi;
+ ? asympnum(n->-log(1-1/n^a),,a) \\ better !
+ %4 = [0, 1, 1/2, 1/3, 1/4, 1/5, 1/6, 1/7, 1/8, 1/9, 1/10, 1/11, 1/12]
+ @eprog
+
+ \synt{asympnum}{void *E, GEN (*u)(void *,GEN,long), long muli, GEN alpha, long prec}, where \kbd{u(E, n, prec)} must return $u(n)$ in precision \kbd{prec}.
+ Also available is
+ \fun{GEN}{asympnum0}{GEN u, long muli, GEN alpha, long prec}, where $u$
+ must be a vector of sufficient length as above.
diff --git a/src/functions/sums/contfraceval b/src/functions/sums/contfraceval
new file mode 100644
index 0000000..bcd1230
--- /dev/null
+++ b/src/functions/sums/contfraceval
@@ -0,0 +1,11 @@
+Function: contfraceval
+Section: sums
+C-Name: contfraceval
+Prototype: GGD-1,L,
+Help: contfraceval(CF,t,{lim=-1}): Given a continued fraction CF from
+ contfracinit, evaluate the first lim terms of the continued fraction at t
+ (all terms if lim is negative or omitted).
+Doc: Given a continued fraction \kbd{CF} output by \kbd{contfracinit}, evaluate
+ the first \kbd{lim} terms of the continued fraction at \kbd{t} (all
+ terms if \kbd{lim} is negative or omitted; if positive, \kbd{lim} must be
+ less than or equal to the length of \kbd{CF}.
diff --git a/src/functions/sums/contfracinit b/src/functions/sums/contfracinit
new file mode 100644
index 0000000..00beebd
--- /dev/null
+++ b/src/functions/sums/contfracinit
@@ -0,0 +1,15 @@
+Function: contfracinit
+Section: sums
+C-Name: contfracinit
+Prototype: GD-1,L,
+Help: contfracinit(M,{lim = -1}): Given M representing the power
+ series S = sum_{n>=0} M[n+1]z^n, transform it into a continued fraction
+ suitable for evaluation.
+Doc: Given $M$ representing the power series $S=\sum_{n\ge0} M[n+1]z^n$,
+ transform it into a continued fraction; restrict to $n\leq \kbd{lim}$
+ if latter is non-negative. $M$ can be a vector, a power
+ series, a polynomial, or a rational function.
+ The result is a 2-component vector $[A,B]$ such that
+ $S = M[1] / (1+A[1]z+B[1]z^2/(1+A[2]z+B[2]z^2/(1+...1/(1+A[lim/2]z))))$.
+ Does not work if any coefficient of $M$ vanishes, nor for series for
+ which certain partial denominators vanish.
diff --git a/src/functions/sums/derivnum b/src/functions/sums/derivnum
index bc55706..5423d8f 100644
--- a/src/functions/sums/derivnum
+++ b/src/functions/sums/derivnum
@@ -4,7 +4,7 @@ C-Name: derivnum0
Prototype: V=GEp
Help: derivnum(X=a,expr): numerical derivation of expr with respect to
X at X = a.
-Wrapper: (,G)
+Wrapper: (,Gp)
Description:
(gen,gen):gen:prec derivnum(${2 cookie}, ${2 wrapper}, $1, prec)
Doc: numerical derivation of \var{expr} with respect to $X$ at $X=a$.
diff --git a/src/functions/sums/intcirc b/src/functions/sums/intcirc
index ab91b07..162097f 100644
--- a/src/functions/sums/intcirc
+++ b/src/functions/sums/intcirc
@@ -11,14 +11,15 @@ Doc: numerical
integration of $(2i\pi)^{-1}\var{expr}$ with respect to $X$ on the circle
$|X-a| = R$.
In other words, when \var{expr} is a meromorphic
- function, sum of the residues in the corresponding disk. \var{tab} is as in
+ function, sum of the residues in the corresponding disk; \var{tab} is as in
\kbd{intnum}, except that if computed with \kbd{intnuminit} it should be with
the endpoints \kbd{[-1, 1]}.
\bprog
? \p105
? intcirc(s=1, 0.5, zeta(s)) - 1
- %1 = -2.398082982 E-104 - 7.94487211 E-107*I
+ time = 496 ms.
+ %1 = 1.2883911040127271720 E-101 + 0.E-118*I
@eprog
\synt{intcirc}{void *E, GEN (*eval)(void*,GEN), GEN a,GEN R,GEN tab, long prec}.
diff --git a/src/functions/sums/intfouriercos b/src/functions/sums/intfouriercos
deleted file mode 100644
index 87c403b..0000000
--- a/src/functions/sums/intfouriercos
+++ /dev/null
@@ -1,18 +0,0 @@
-Function: intfouriercos
-Section: sums
-C-Name: intfourcos0
-Prototype: V=GGGEDGp
-Help: intfouriercos(X=a,b,z,expr,{tab}): numerical integration from a to b
- of cos(2*Pi*z*X)*expr(X) from a to b, where a, b, and tab are as in intnum.
- This is the cosine-Fourier transform if a=-infty and b=+infty.
-Wrapper: (,,,G)
-Description:
- (gen,gen,gen,gen,?gen):gen:prec intfouriercos(${4 cookie}, ${4 wrapper}, $1, $2, $3, $5, prec)
-Doc: numerical
- integration of $\var{expr}(X)\cos(2\pi zX)$ from $a$ to $b$, in other words
- Fourier cosine transform (from $a$ to $b$) of the function represented by
- \var{expr}. Endpoints $a$ and $b$ are coded as in \kbd{intnum}, and are not
- necessarily at infinity, but if they are, oscillations (i.e. $[[\pm1],\alpha
- I]$) are forbidden.
-
- \synt{intfouriercos}{void *E, GEN (*eval)(void*,GEN), GEN a, GEN b, GEN z, GEN tab, long prec}.
diff --git a/src/functions/sums/intfourierexp b/src/functions/sums/intfourierexp
deleted file mode 100644
index ac895d8..0000000
--- a/src/functions/sums/intfourierexp
+++ /dev/null
@@ -1,19 +0,0 @@
-Function: intfourierexp
-Section: sums
-C-Name: intfourexp0
-Prototype: V=GGGEDGp
-Help: intfourierexp(X=a,b,z,expr,{tab}): numerical integration from a to b
- of exp(-2*I*Pi*z*X)*expr(X) from a to b, where a, b, and tab are as in intnum.
- This is the ordinary Fourier transform if a=-infty and b=+infty. Note the
- minus sign.
-Wrapper: (,,,G)
-Description:
- (gen,gen,gen,gen,?gen):gen:prec intfourierexp(${4 cookie}, ${4 wrapper}, $1, $2, $3, $5, prec)
-Doc: numerical
- integration of $\var{expr}(X)\exp(-2i\pi zX)$ from $a$ to $b$, in other words
- Fourier transform (from $a$ to $b$) of the function represented by
- \var{expr}. Note the minus sign. Endpoints $a$ and $b$ are coded as in
- \kbd{intnum}, and are not necessarily at infinity but if they are,
- oscillations (i.e. $[[\pm1],\alpha I]$) are forbidden.
-
- \synt{intfourierexp}{void *E, GEN (*eval)(void*,GEN), GEN a, GEN b, GEN z, GEN tab, long prec}.
diff --git a/src/functions/sums/intfouriersin b/src/functions/sums/intfouriersin
deleted file mode 100644
index 4fb8fea..0000000
--- a/src/functions/sums/intfouriersin
+++ /dev/null
@@ -1,18 +0,0 @@
-Function: intfouriersin
-Section: sums
-C-Name: intfoursin0
-Prototype: V=GGGEDGp
-Help: intfouriersin(X=a,b,z,expr,{tab}): numerical integration from a to b
- of sin(2*Pi*z*X)*expr(X) from a to b, where a, b, and tab are as in intnum.
- This is the sine-Fourier transform if a=-infty and b=+infty.
-Wrapper: (,,,G)
-Description:
- (gen,gen,gen,gen,?gen):gen:prec intfouriercos(${4 cookie}, ${4 wrapper}, $1, $2, $3, $5, prec)
-Doc: numerical
- integration of $\var{expr}(X)\sin(2\pi zX)$ from $a$ to $b$, in other words
- Fourier sine transform (from $a$ to $b$) of the function represented by
- \var{expr}. Endpoints $a$ and $b$ are coded as in \kbd{intnum}, and are not
- necessarily at infinity but if they are, oscillations (i.e. $[[\pm1],\alpha
- I]$) are forbidden.
-
- \synt{intfouriersin}{void *E, GEN (*eval)(void*,GEN), GEN a, GEN b, GEN z, GEN tab, long prec}.
diff --git a/src/functions/sums/intfuncinit b/src/functions/sums/intfuncinit
index 727a815..c0c611d 100644
--- a/src/functions/sums/intfuncinit
+++ b/src/functions/sums/intfuncinit
@@ -1,26 +1,98 @@
Function: intfuncinit
Section: sums
C-Name: intfuncinit0
-Prototype: V=GGED0,L,D0,L,p
-Help: intfuncinit(X=a,b,expr,{flag=0},{m=0}): initialize tables for integrations
- from a to b using a weight expr(X). Essential for integral transforms such
- as intmellininv, intlaplaceinv and intfourier, since it avoids recomputing
- all the time the same quantities. Must then be used with intmellininvshort
- (for intmellininv) and directly with intnum and not with the corresponding
- integral transforms for the others. See help for intnum for coding of a
- and b, and m is as in intnuminit. If flag is nonzero, assumes that
- expr(-X)=conj(expr(X)), which is twice faster.
+Prototype: V=GGED0,L,p
+Help: intfuncinit(t=a,b,f,{m=0}): initialize tables for integrations
+ from a to b using a weight f(t). For integral transforms such
+ as Fourier or Mellin transforms.
Wrapper: (,,G)
Description:
- (gen,gen,gen,?small,?small):gen:prec intfuncinit(${3 cookie}, ${3 wrapper}, $1, $2, $4, $5, prec)
-Doc: initialize tables for use with integral transforms such as \kbd{intmellininv},
- etc., where $a$ and $b$ are coded as in \kbd{intnum}, $\var{expr}$ is the
- function $s(X)$ to which the integral transform is to be applied (which will
- multiply the weights of integration) and $m$ is as in \kbd{intnuminit}. If
- $\fl$ is nonzero, assumes that $s(-X)=\overline{s(X)}$, which makes the
- computation twice as fast. See \kbd{intmellininvshort} for examples of the
- use of this function, which is particularly useful when the function $s(X)$
- is lengthy to compute, such as a gamma product.
+ (gen,gen,gen,?small):gen:prec intfuncinit(${3 cookie}, ${3 wrapper}, $1, $2, $4, prec)
+Doc: initialize tables for use with integral transforms such Fourier,
+ Laplace or Mellin transforms, in order to compute
+ $$ \int_a^b f(t) k(t,z) \, dt $$
+ for some kernel $k(t,z)$.
+ The endpoints $a$ and $b$ are coded as in \kbd{intnum}, $f$ is the
+ function to which the integral transform is to be applied and the
+ non-negative integer $m$ is as in \kbd{intnum}: multiply the number of
+ sampling points roughly by $2^m$, hopefully increasing the accuracy. This
+ function is particularly useful when the function $f$ is hard to compute,
+ such as a gamma product.
- \synt{intfuncinit}{void *E, GEN (*eval)(void*,GEN), GEN a,GEN b,long m, long flag, long prec}. Note that the order of $m$ and $\fl$ are reversed compared
- to the \kbd{GP} syntax.
+ \misctitle{Limitation} the endpoints $a$ and $b$ must be at infinity,
+ with the same asymptotic behaviour. Oscillating types are not supported.
+ This is easily overcome by integrating vectors of functions, see example
+ below.
+
+ \misctitle{Examples}
+
+ \item numerical Fourier transform
+ $$F(z) = \int_{-\infty}^{+\infty} f(t)e^{-2i\pi z t}\, dt. $$
+ First the easy case, assume that $f$ decrease exponentially:
+ \bprog
+ f(t) = exp(-t^2);
+ A = [-oo,1];
+ B = [+oo,1];
+ \p200
+ T = intfuncinit(t = A,B , f(t));
+ F(z) =
+ { my(a = -2*I*Pi*z);
+ intnum(t = A,B, exp(a*t), T);
+ }
+ ? F(1) - sqrt(Pi)*exp(-Pi^2)
+ %1 = -1.3... E-212
+ @eprog\noindent
+ Now the harder case, $f$ decrease slowly: we must specify the oscillating
+ behaviour. Thus, we cannot precompute usefully since everything depends on
+ the point we evaluate at:
+ \bprog
+ f(t) = 1 / (1+ abs(t));
+ \p200
+ \\ Fourier cosine transform
+ FC(z) =
+ { my(a = 2*Pi*z);
+ intnum(t = [-oo, a*I], [+oo, a*I], cos(a*t)*f(t));
+ }
+ FC(1)
+ @eprog
+ \item Fourier coefficients: we must integrate over a period, but
+ \kbd{intfuncinit} does not support finite endpoints.
+ The solution is to integrate a vector of functions !
+ \bprog
+ FourierSin(f, T, k) = \\ first k sine Fourier coeffs
+ {
+ my (w = 2*Pi/T);
+ my (v = vector(k+1));
+ intnum(t = -T/2, T/2,
+ my (z = exp(I*w*t));
+ v[1] = z;
+ for (j = 2, k, v[j] = v[j-1]*z);
+ f(t) * imag(v)) * 2/T;
+ }
+ FourierSin(t->sin(2*t), 2*Pi, 10)
+ @eprog\noindent The same technique can be used instead of \kbd{intfuncinit}
+ to integrate $f(t) k(t,z)$ whenever the list of $z$-values is known
+ beforehand.
+
+ Note that the above code includes an unrelated optimization: the
+ $\sin(j w t)$ are computed as imaginary parts of $\exp(i j w t)$ and the
+ latter by successive multiplications.
+
+ \item numerical Mellin inversion
+ $$F(z) = (2i\pi)^{-1} \int_{c -i\infty}^{c+i\infty} f(s)z^{-s}\, ds
+ = (2\pi)^{-1} \int_{-\infty}^{+\infty}
+ f(c + i t)e^{-\log z(c + it)}\, dt. $$
+ We take $c = 2$ in the program below:
+ \bprog
+ f(s) = gamma(s)^3; \\ f(c+it) decrease as exp(-3Pi|t|/2)
+ c = 2; \\ arbitrary
+ A = [-oo,3*Pi/2];
+ B = [+oo,3*Pi/2];
+ T = intfuncinit(t=A,B, f(c + I*t));
+ F(z) =
+ { my (a = -log(z));
+ intnum(t=A,B, exp(a*I*t), T)*exp(a*c) / (2*Pi);
+ }
+ @eprog
+
+ \synt{intfuncinit}{void *E, GEN (*eval)(void*,GEN), GEN a,GEN b,long m, long prec}.
diff --git a/src/functions/sums/intlaplaceinv b/src/functions/sums/intlaplaceinv
deleted file mode 100644
index 34ce596..0000000
--- a/src/functions/sums/intlaplaceinv
+++ /dev/null
@@ -1,56 +0,0 @@
-Function: intlaplaceinv
-Section: sums
-C-Name: intlaplaceinv0
-Prototype: V=GGEDGp
-Help: intlaplaceinv(X=sig,z,expr,{tab}): numerical integration on the line
- real(X) = sig of expr(X)exp(zX)dz/(2*I*Pi), i.e. inverse Laplace transform of
- expr at z. tab is as in intnum.
-Wrapper: (,,G)
-Description:
- (gen,gen,gen,?gen):gen:prec intlaplaceinv(${3 cookie}, ${3 wrapper}, $1, $2, $4, prec)
-Doc: numerical integration of $(2i\pi)^{-1}\var{expr}(X)e^{Xz}$ with respect
- to $X$ on the line $\Re(X)=sig$. In other words, inverse Laplace transform
- of the function corresponding to \var{expr} at the value $z$.
-
- $sig$ is coded as follows. Either it is a real number $\sigma$, equal to the
- abscissa of integration, and then the integrand is assumed to
- be slowly decreasing when the imaginary part of the variable tends to
- $\pm\infty$. Or it is a two component vector $[\sigma,\alpha]$, where
- $\sigma$ is as before, and either $\alpha=0$ for slowly decreasing functions,
- or $\alpha>0$ for functions decreasing like $\exp(-\alpha t)$. Note that it
- is not necessary to choose the exact value of $\alpha$. \var{tab} is as in
- \kbd{intnum}.
-
- It is often a good idea to use this function with a value of $m$ one or two
- higher than the one chosen by default (which can be viewed thanks to the
- function \kbd{intnumstep}), or to increase the abscissa of integration
- $\sigma$. For example:
-
- \bprog
- ? \p 105
- ? intlaplaceinv(x=2, 1, 1/x) - 1
- time = 350 ms.
- %1 = 7.37... E-55 + 1.72... E-54*I \\@com not so good
- ? m = intnumstep()
- %2 = 7
- ? intlaplaceinv(x=2, 1, 1/x, m+1) - 1
- time = 700 ms.
- %3 = 3.95... E-97 + 4.76... E-98*I \\@com better
- ? intlaplaceinv(x=2, 1, 1/x, m+2) - 1
- time = 1400 ms.
- %4 = 0.E-105 + 0.E-106*I \\@com perfect but slow.
- ? intlaplaceinv(x=5, 1, 1/x) - 1
- time = 340 ms.
- %5 = -5.98... E-85 + 8.08... E-85*I \\@com better than \%1
- ? intlaplaceinv(x=5, 1, 1/x, m+1) - 1
- time = 680 ms.
- %6 = -1.09... E-106 + 0.E-104*I \\@com perfect, fast.
- ? intlaplaceinv(x=10, 1, 1/x) - 1
- time = 340 ms.
- %7 = -4.36... E-106 + 0.E-102*I \\@com perfect, fastest, but why $sig=10$?
- ? intlaplaceinv(x=100, 1, 1/x) - 1
- time = 330 ms.
- %7 = 1.07... E-72 + 3.2... E-72*I \\@com too far now...
- @eprog
-
- \synt{intlaplaceinv}{void *E, GEN (*eval)(void*,GEN), GEN sig,GEN z, GEN tab, long prec}.
diff --git a/src/functions/sums/intmellininv b/src/functions/sums/intmellininv
deleted file mode 100644
index 6994e64..0000000
--- a/src/functions/sums/intmellininv
+++ /dev/null
@@ -1,43 +0,0 @@
-Function: intmellininv
-Section: sums
-C-Name: intmellininv0
-Prototype: V=GGEDGp
-Help: intmellininv(X=sig,z,expr,{tab}): numerical integration on the
- line real(X) = sig (or sig[1]) of expr(X)z^(-X)dX/(2*I*Pi), i.e. inverse Mellin
- transform of s at x. sig is coded as follows: either it is real, and then
- by default assume s(z) decreases like exp(-z). Or sig = [sigR, al], sigR is
- the abscissa of integration, and al = 0 for slowly decreasing functions, or
- al > 0 if s(z) decreases like exp(-al*z). tab is as in intnum. Use
- intmellininvshort if several values must be computed.
-Wrapper: (,,G)
-Description:
- (gen,gen,gen,?gen):gen:prec intmellininv(${3 cookie}, ${3 wrapper}, $1, $2, $4, prec)
-Doc: numerical
- integration of $(2i\pi)^{-1}\var{expr}(X)z^{-X}$ with respect to $X$ on the
- line $\Re(X)=sig$, in other words, inverse Mellin transform of
- the function corresponding to \var{expr} at the value $z$.
-
- $sig$ is coded as follows. Either it is a real number $\sigma$, equal to the
- abscissa of integration, and then the integrated is assumed to decrease
- exponentially fast, of the order of $\exp(-t)$ when the imaginary part of the
- variable tends to $\pm\infty$. Or it is a two component vector
- $[\sigma,\alpha]$, where $\sigma$ is as before, and either $\alpha=0$ for
- slowly decreasing functions, or $\alpha>0$ for functions decreasing like
- $\exp(-\alpha t)$, such as gamma products. Note that it is not necessary to
- choose the exact value of $\alpha$, and that $\alpha=1$ (equivalent to $sig$
- alone) is usually sufficient. \var{tab} is as in \kbd{intnum}.
-
- As all similar functions, this function is provided for the convenience of
- the user, who could use \kbd{intnum} directly. However it is in general
- better to use \kbd{intmellininvshort}.
-
- \bprog
- ? \p 105
- ? intmellininv(s=2,4, gamma(s)^3);
- time = 1,190 ms. \\@com reasonable.
- ? \p 308
- ? intmellininv(s=2,4, gamma(s)^3);
- time = 51,300 ms. \\@com slow because of $\Gamma(s)^3$.
- @eprog\noindent
-
- \synt{intmellininv}{void *E, GEN (*eval)(void*,GEN), GEN sig, GEN z, GEN tab, long prec}.
diff --git a/src/functions/sums/intmellininvshort b/src/functions/sums/intmellininvshort
deleted file mode 100644
index 0065456..0000000
--- a/src/functions/sums/intmellininvshort
+++ /dev/null
@@ -1,42 +0,0 @@
-Function: intmellininvshort
-Section: sums
-C-Name: intmellininvshort
-Prototype: GGGp
-Help: intmellininvshort(sig,z,tab): numerical integration on the
- line real(X) = sig (or sig[1]) of s(X)z^(-X)dX/(2*I*Pi), i.e. inverse Mellin
- transform of s at z. sig is coded as follows: either it is real, and then
- by default assume s(X) decreases like exp(-X). Or sig = [sigR, al], sigR is
- the abscissa of integration, and al = 0 for slowly decreasing functions, or
- al > 0 if s(X) decreases like exp(-al*X). Compulsory table tab has been
- precomputed using the command intfuncinit(t=[-oo,sig[2]],[oo,sig[2]],s)
- (with possibly its two optional additional parameters), where sig[2] = 1
- if not given. Orders of magnitude faster than intmellininv.
-Doc: numerical integration
- of $(2i\pi)^{-1}s(X)z^{-X}$ with respect to $X$ on the line $\Re(X)=sig$.
- In other words, inverse Mellin transform of $s(X)$ at the value $z$.
- Here $s(X)$ is implicitly contained in \var{tab} in \kbd{intfuncinit} format,
- typically
- \bprog
- tab = intfuncinit(T = -oo, oo, s(sig + I*T))
- @eprog\noindent
- or similar commands. Take the example of the inverse Mellin transform of
- $\Gamma(s)^3$ given in \kbd{intmellininv}:
-
- \bprog
- ? \p 105
- ? A = intmellininv(s=2,4, gamma(s)^3);
- time = 2,500 ms. \\@com not too fast because of $\Gamma(s)^3$.
- \\ @com function of real type, decreasing as $\exp(-3\pi/2\cdot |t|)$
- ? tab = intfuncinit(t=[-oo, 3*Pi/2],[oo, 3*Pi/2], gamma(2+I*t)^3, 1);
- time = 1,370 ms.
- ? intmellininvshort(2,4, tab) - A
- time = 50 ms.
- %4 = -1.26... - 3.25...E-109*I \\@com 50 times faster than \kbd{A} and perfect.
- ? tab2 = intfuncinit(t=-oo, oo, gamma(2+I*t)^3, 1);
- ? intmellininvshort(2,4, tab2)
- %6 = -1.2...E-42 - 3.2...E-109*I \\@com 63 digits lost
- @eprog\noindent
- In the computation of \var{tab}, it was not essential to include the
- \emph{exact} exponential decrease of $\Gamma(2+it)^3$. But as the last
- example shows, a rough indication \emph{must} be given, otherwise slow
- decrease is assumed, resulting in catastrophic loss of accuracy.
diff --git a/src/functions/sums/intnum b/src/functions/sums/intnum
index 4801db3..56dd4a9 100644
--- a/src/functions/sums/intnum
+++ b/src/functions/sums/intnum
@@ -10,21 +10,24 @@ Wrapper: (,,G)
Description:
(gen,gen,gen,?gen):gen:prec intnum(${3 cookie}, ${3 wrapper}, $1, $2, $4, prec)
Doc: numerical integration
- of \var{expr} on $]a,b[$ with respect to $X$. The integrand may have values
+ of \var{expr} on $]a,b[$ with respect to $X$, using the
+ double-exponential method, and thus $O(D\log D)$ evaluation of
+ the integrand in precision $D$. The integrand may have values
belonging to a vector space over the real numbers; in particular, it can be
- complex-valued or vector-valued. But it is assumed that the function is regular
- on $]a,b[$. If the endpoints $a$ and $b$ are finite and the function is regular
- there, the situation is simple:
+ complex-valued or vector-valued. But it is assumed that the function is
+ regular on $]a,b[$. If the endpoints $a$ and $b$ are finite and the
+ function is regular there, the situation is simple:
\bprog
? intnum(x = 0,1, x^2)
%1 = 0.3333333333333333333333333333
? intnum(x = 0,Pi/2, [cos(x), sin(x)])
%2 = [1.000000000000000000000000000, 1.000000000000000000000000000]
@eprog\noindent
- An endpoint equal to $\pm\infty$ is coded as \kbd{+oo} or \kbd{-oo}.
+ An endpoint equal to $\pm\infty$ is coded as \kbd{+oo} or \kbd{-oo}, as
+ expected:
\bprog
? intnum(x = 1,+oo, 1/x^2)
- %2 = 1.000000000000000000000000000
+ %3 = 1.000000000000000000000000000
@eprog\noindent
In basic usage, it is assumed that the function does not decrease
exponentially fast at infinity:
@@ -32,26 +35,28 @@ Doc: numerical integration
? intnum(x=0,+oo, exp(-x))
*** at top-level: intnum(x=0,+oo,exp(-
*** ^--------------------
- *** exp: exponent (expo) overflow
+ *** exp: overflow in expo().
@eprog\noindent
- We shall see in a moment how to avoid the last problem, after describing
- the last argument \var{tab}, which is both optional and technical. The
- routine uses weights, which are mostly independent of the function being
- integrated, evaluated at many sampling points. If \var{tab} is
-
- \item a positive integer $m$, we use $2^m$ sampling points, hopefully
- increasing accuracy. But note that the running time is roughly proportional
- to $2^m$. One may try consecutive values of $m$ until they give the same
- value up to an accepted error. If \var{tab} is omitted, the algorithm guesses
- a reasonable value for $m$ depending on the current precision only, which
- should be sufficient for regular functions. That value may be obtained from
- \tet{intnumstep}, and increased in case of difficulties.
-
- \item a set of integration tables as output by \tet{intnuminit},
- they are used directly. This is useful if several integrations of the same
- type are performed (on the same kind of interval and functions, for a given
- accuracy), in particular for multivariate integrals, since we then skip
- expensive precomputations.
+ We shall see in a moment how to avoid that last problem, after describing
+ the last \emph{optional} argument \var{tab}.
+
+ \misctitle{The \var{tab} argument}
+ The routine uses weights $w_i$, which are mostly independent of the function
+ being integrated, evaluated at many sampling points $x_i$ and
+ approximates the integral by $\sum w_i f(x_i)$. If \var{tab} is
+
+ \item a positive integer $m$, we multiply the number of sampling points
+ by $2^m$, hopefully increasing accuracy. Note that the running time
+ increases roughly by a factor $2^m$. One may try consecutive values of $m$
+ until they give the same value up to an accepted error.
+
+ \item a set of integration tables containing precomputed $x_i$ and $w_i$
+ as output by \tet{intnuminit}. This is useful if several integrations of
+ the same type are performed (on the same kind of interval and functions,
+ for a given accuracy): we skip a precomputation of $O(D\log D)$
+ elementary functions in accuracy $D$, whose running time has the same order
+ of magnitude as the evaluation of the integrand. This is in particular
+ usefule for multivariate integrals.
\misctitle{Specifying the behavior at endpoints}
This is done as follows. An endpoint $a$ is either given as such (a scalar,
@@ -66,19 +71,19 @@ Doc: numerical integration
number of decimals:
\bprog
? intnum(x=0, 1, x^(-1/2)) \\@com assume $x^{-1/2}$ is regular at 0
- %1 = 1.999999999999999999990291881
+ %1 = 1.9999999999999999999999999999827931660
? intnum(x=[0,-1/2], 1, x^(-1/2)) \\@com no, it's not
- %2 = 2.000000000000000000000000000
- ? intnum(x=[0,-1/10], 1, x^(-1/2))
- %3 = 1.999999999999999999999946438 \\@com using a wrong exponent is bad
+ %2 = 2.0000000000000000000000000000000000000
+ ? intnum(x=[0,-1/10], 1, x^(-1/2)) \\@com using a wrong exponent is bad
+ %3 = 1.9999999999999999999999999999999901912
@eprog
If $a$ is $\pm\infty$, which is coded as \kbd{+oo} or \kbd{-oo},
the situation is more complicated, and $[\pm\kbd{oo},\alpha]$ means:
\item $\alpha=0$ (or no $\alpha$ at all, i.e. simply $\pm\kbd{oo}$)
- assumes that the integrand tends to zero, but not exponentially fast, and
- not oscillating such as $\sin(x)/x$.
+ assumes that the integrand tends to zero moderately quickly, at least as
+ $O(x^{-2})$ but not exponentially fast.
\item $\alpha>0$ assumes that the function tends to zero exponentially fast
approximately as $\exp(-\alpha x)$. This includes oscillating but quickly
@@ -88,18 +93,28 @@ Doc: numerical integration
*** at top-level: intnum(x=0,+oo,exp(-
*** ^--------------------
*** exp: exponent (expo) overflow
- ? intnum(x=0, [+oo, 2], exp(-2*x))
- %1 = 0.5000000000000000000000000000 \\@com OK!
- ? intnum(x=0, [+oo, 4], exp(-2*x))
- %2 = 0.4999999999999999999961990984 \\@com wrong exponent $\Rightarrow$ imprecise result
- ? intnum(x=0, [+oo, 20], exp(-2*x))
- %2 = 0.4999524997739071283804510227 \\@com disaster
- @eprog
+ ? intnum(x=0, [+oo, 2], exp(-2*x)) \\@com OK!
+ %1 = 0.50000000000000000000000000000000000000
+ ? intnum(x=0, [+oo, 3], exp(-2*x)) \\@com imprecise exponent, still OK !
+ %2 = 0.50000000000000000000000000000000000000
+ ? intnum(x=0, [+oo, 10], exp(-2*x)) \\@com wrong exponent $\Rightarrow$ disaster
+ %3 = 0.49999999999952372962457451698256707393
+ @eprog\noindent As the last exemple shows, the exponential decrease rate
+ \emph{must} be indicated to avoid overflow, but the method is robust enough
+ for a rough guess to be acceptable.
\item $\alpha<-1$ assumes that the function tends to $0$ slowly, like
- $x^{\alpha}$. Here it is essential to give the correct $\alpha$, if possible,
- but on the other hand $\alpha\le -2$ is equivalent to $\alpha=0$, in other
- words to no $\alpha$ at all.
+ $x^{\alpha}$. Here the algorithm is less robust and it is essential to give a
+ sharp $\alpha$, unless $\alpha \le -2$ in which case we use
+ the default algorithm as if $\alpha$ were missing (or equal to $0$).
+ \bprog
+ ? intnum(x=1, +oo, x^(-3/2)) \\ default
+ %1 = 1.9999999999999999999999999999646391207
+ ? intnum(x=1, [+oo,-3/2], x^(-3/2)) \\ precise decrease rate
+ %2 = 2.0000000000000000000000000000000000000
+ ? intnum(x=1, [+oo,-11/10], x^(-3/2)) \\ worse than default
+ %3 = 2.0000000000000000000000000089298011973
+ @eprog
\smallskip The last two codes are reserved for oscillating functions.
Let $k > 0$ real, and $g(x)$ a non-oscillating function tending slowly to $0$
@@ -120,7 +135,7 @@ Doc: numerical integration
exponentially fast as $\exp(-\alpha x)$, it is up to the user to choose
between $[\pm\kbd{oo},\alpha]$ and $[\pm\kbd{oo},k* I]$, but a good rule of
thumb is that
- if the oscillations are much weaker than the exponential decrease, choose
+ if the oscillations are weaker than the exponential decrease, choose
$[\pm\kbd{oo},\alpha]$, otherwise choose $[\pm\kbd{oo},k*I]$, although the
latter can
reasonably be used in all cases, while the former cannot. To take a specific
@@ -129,97 +144,99 @@ Doc: numerical integration
choose the oscillating type of integral we perhaps obtain the best results,
at the expense of having to recompute our functions for a different value of
the variable $z$ giving the transform, preventing us to use a function such
- as \kbd{intmellininvshort}. On the other hand using the exponential type of
+ as \kbd{intfuncinit}. On the other hand using the exponential type of
integral, we obtain less accurate results, but we skip expensive
- recomputations. See \kbd{intmellininvshort} and \kbd{intfuncinit} for more
- explanations.
+ recomputations. See \kbd{intfuncinit} for more explanations.
\smallskip
We shall now see many examples to get a feeling for what the various
- parameters achieve. All examples below assume precision is set to $105$
+ parameters achieve. All examples below assume precision is set to $115$
decimal digits. We first type
\bprog
- ? \p 105
+ ? \p 115
@eprog
- \misctitle{Apparent singularities} Even if the function $f(x)$ represented
- by \var{expr} has no singularities, it may be important to define the
- function differently near special points. For instance, if $f(x) = 1
+ \misctitle{Apparent singularities} In many cases, apparent singularities
+ can be ignored. For instance, if $f(x) = 1
/(\exp(x)-1) - \exp(-x)/x$, then $\int_0^\infty f(x)\,dx=\gamma$, Euler's
constant \kbd{Euler}. But
\bprog
? f(x) = 1/(exp(x)-1) - exp(-x)/x
? intnum(x = 0, [oo,1], f(x)) - Euler
- %1 = 6.00... E-67
+ %1 = 0.E-115
@eprog\noindent
- thus only correct to $67$ decimal digits. This is because close to $0$ the
- function $f$ is computed with an enormous loss of accuracy.
- A better solution is
+ But close to $0$ the function $f$ is computed with an enormous loss of
+ accuracy, and we are in fact lucky that it get multiplied by weights which are
+ sufficiently close to $0$ to hide this:
+ \bprog
+ ? f(1e-200)
+ %2 = -3.885337784451458142 E84
+ @eprog
+ A more robust solution is to define the function differently near special
+ points, e.g. by a Taylor expansion
\bprog
- ? f(x) = 1/(exp(x)-1)-exp(-x)/x
- ? F = truncate( f(t + O(t^7)) ); \\@com expansion around t = 0
- ? g(x) = if (x > 1e-18, f(x), subst(F,t,x)) \\@com note that $6 \cdot 18 > 105$
+ ? F = truncate( f(t + O(t^10)) ); \\@com expansion around t = 0
+ ? poldegree(F)
+ %4 = 7
+ ? g(x) = if (x > 1e-18, f(x), subst(F,t,x)); \\@com note that $7 \cdot 18 > 105$
? intnum(x = 0, [oo,1], g(x)) - Euler
- %2 = 0.E-106 \\@com perfect
- @eprog\noindent
- It is up to the user to determine constants such as the $10^{-18}$ and $7$
- used above.
+ %2 = 0.E-115
+ @eprog\noindent It is up to the user to determine constants such as the
+ $10^{-18}$ and $10$ used above.
\misctitle{True singularities} With true singularities the result is worse.
For instance
\bprog
- ? intnum(x = 0, 1, 1/sqrt(x)) - 2
- %1 = -1.92... E-59 \\@com only $59$ correct decimals
+ ? intnum(x = 0, 1, x^(-1/2)) - 2
+ %1 = -3.5... E-68 \\@com only $68$ correct decimals
- ? intnum(x = [0,-1/2], 1, 1/sqrt(x)) - 2
- %2 = 0.E-105 \\@com better
+ ? intnum(x = [0,-1/2], 1, x^(-1/2)) - 2
+ %2 = 0.E-114 \\@com better
@eprog
\misctitle{Oscillating functions}
\bprog
? intnum(x = 0, oo, sin(x) / x) - Pi/2
- %1 = 20.78.. \\@com nonsense
+ %1 = 16.19.. \\@com nonsense
? intnum(x = 0, [oo,1], sin(x)/x) - Pi/2
- %2 = 0.004.. \\@com bad
+ %2 = -0.006.. \\@com bad
? intnum(x = 0, [oo,-I], sin(x)/x) - Pi/2
- %3 = 0.E-105 \\@com perfect
+ %3 = 0.E-115 \\@com perfect
? intnum(x = 0, [oo,-I], sin(2*x)/x) - Pi/2 \\@com oops, wrong $k$
- %4 = 0.07...
+ %4 = 0.06...
? intnum(x = 0, [oo,-2*I], sin(2*x)/x) - Pi/2
- %5 = 0.E-105 \\@com perfect
+ %5 = 0.E-115 \\@com perfect
? intnum(x = 0, [oo,-I], sin(x)^3/x) - Pi/4
- %6 = 0.0092... \\@com bad
+ %6 = -0.0008... \\@com bad
? sin(x)^3 - (3*sin(x)-sin(3*x))/4
%7 = O(x^17)
@eprog\noindent
We may use the above linearization and compute two oscillating integrals with
- ``infinite endpoints'' \kbd{[oo, -I]} and \kbd{[oo, -3*I]} respectively, or
+ endpoints \kbd{[oo, -I]} and \kbd{[oo, -3*I]} respectively, or
notice the obvious change of variable, and reduce to the single integral
${1\over 2}\int_0^\infty \sin(x)/x\,dx$. We finish with some more complicated
examples:
\bprog
? intnum(x = 0, [oo,-I], (1-cos(x))/x^2) - Pi/2
- %1 = -0.0004... \\@com bad
+ %1 = -0.0003... \\@com bad
? intnum(x = 0, 1, (1-cos(x))/x^2) \
+ intnum(x = 1, oo, 1/x^2) - intnum(x = 1, [oo,I], cos(x)/x^2) - Pi/2
- %2 = -2.18... E-106 \\@com OK
+ %2 = 0.E-115 \\@com perfect
? intnum(x = 0, [oo, 1], sin(x)^3*exp(-x)) - 0.3
- %3 = 5.45... E-107 \\@com OK
+ %3 = -7.34... E-55 \\@com bad
? intnum(x = 0, [oo,-I], sin(x)^3*exp(-x)) - 0.3
- %4 = -1.33... E-89 \\@com lost 16 decimals. Try higher $m$:
- ? m = intnumstep()
- %5 = 7 \\@com the value of $m$ actually used above.
- ? tab = intnuminit(0,[oo,-I], m+1); \\@com try $m$ one higher.
+ %4 = 8.9... E-103 \\@com better. Try higher $m$
+ ? tab = intnuminit(0,[oo,-I], 1); \\@com double number of sampling points
? intnum(x = 0, oo, sin(x)^3*exp(-x), tab) - 0.3
- %6 = 5.45... E-107 \\@com OK this time.
+ %6 = 0.E-115 \\@com perfect
@eprog
\misctitle{Warning} Like \tet{sumalt}, \kbd{intnum} often assigns a
@@ -245,38 +262,21 @@ Doc: numerical integration
of the function $x^2+y^2$, we can write
\bprog
? tab = intnuminit(-1,1);
- ? intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2, tab), tab)
+ ? intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2, tab),tab) - Pi/2
+ %2 = -7.1... E-115 \\@com OK
+
@eprog\noindent
The first \var{tab} is essential, the second optional. Compare:
\bprog
? tab = intnuminit(-1,1);
- time = 30 ms.
+ time = 4 ms.
? intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2));
- time = 54,410 ms. \\@com slow
+ time = 3,092 ms. \\@com slow
? intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2, tab), tab);
- time = 7,210 ms. \\@com faster
- @eprog\noindent
- However, the \kbd{intnuminit} program is usually pessimistic when it comes to
- choosing the integration step $2^{-m}$. It is often possible to improve the
- speed by trial and error. Continuing the above example:
- \bprog
- ? test(M) =
- {
- tab = intnuminit(-1,1, M);
- intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2,tab), tab) - Pi/2
- }
- ? m = intnumstep() \\@com what value of $m$ did it take?
- %1 = 7
- ? test(m - 1)
- time = 1,790 ms.
- %2 = -2.05... E-104 \\@com $4 = 2^2$ times faster and still OK.
- ? test(m - 2)
- time = 430 ms.
- %3 = -1.11... E-104 \\@com $16 = 2^4$ times faster and still OK.
- ? test(m - 3)
- time = 120 ms.
- %3 = -7.23... E-60 \\@com $64 = 2^6$ times faster, lost $45$ decimals.
+ time = 252 ms. \\@com faster
+ ? intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2), x^2+y^2, tab));
+ time = 261 ms. \\@com the \emph{internal} integral matters most
@eprog
\synt{intnum}{void *E, GEN (*eval)(void*,GEN), GEN a,GEN b,GEN tab, long prec},
diff --git a/src/functions/sums/intnumgauss b/src/functions/sums/intnumgauss
new file mode 100644
index 0000000..9c6ae6e
--- /dev/null
+++ b/src/functions/sums/intnumgauss
@@ -0,0 +1,37 @@
+Function: intnumgauss
+Section: sums
+C-Name: intnumgauss0
+Prototype: V=GGEDGp
+Help: intnumgauss(X=a,b,expr,{tab}): numerical integration of expr from
+ a to b, a compact interval, with respect to X using Gauss-Legendre
+ quadrature. tab is either omitted (and will be recomputed) or
+ precomputed with intnumgaussinit.
+Wrapper: (,,G)
+Description:
+ (gen,gen,gen,?gen):gen:prec intnumgauss(${3 cookie}, ${3 wrapper}, $1, $2, $4, prec)
+Doc: numerical integration of \var{expr} on the compact interval $[a,b]$ with
+ respect to $X$ using Gauss-Legendre quadrature; \kbd{tab} is either omitted
+ or precomputed with \kbd{intnumgaussinit}. As a convenience, it can be an
+ integer $n$ in which case we call
+ \kbd{intnumgaussinit}$(n)$ and use $n$-point quadrature.
+ \bprog
+ ? test(n, b = 1) = T=intnumgaussinit(n);\
+ intnumgauss(x=-b,b, 1/(1+x^2),T) - 2*atan(b);
+ ? test(0) \\ default
+ %1 = -9.490148553624725335 E-22
+ ? test(40)
+ %2 = -6.186629001816965717 E-31
+ ? test(50)
+ %3 = -1.1754943508222875080 E-38
+ ? test(50, 2) \\ double interval length
+ %4 = -4.891779568527713636 E-21
+ ? test(90, 2) \\ n must almost be doubled as well!
+ %5 = -9.403954806578300064 E-38
+ @eprog\noindent On the other hand, we recommend to split the integral
+ and change variables rather than increasing $n$ too much:
+ \bprog
+ ? f(x) = 1/(1+x^2);
+ ? a = 0; b = 100;
+ ? intnum(x = 0, 1, f(x)) + intnum(x = 1, 1/b, f(1/x)*(-1/x^2)) - atan(100)
+ %3 = 0.E-38 \\ perfect with default n
+ @eprog
diff --git a/src/functions/sums/intnumgaussinit b/src/functions/sums/intnumgaussinit
new file mode 100644
index 0000000..c72b0cb
--- /dev/null
+++ b/src/functions/sums/intnumgaussinit
@@ -0,0 +1,33 @@
+Function: intnumgaussinit
+Section: sums
+C-Name: intnumgaussinit
+Prototype: D0,L,p
+Help: intnumgaussinit({n}): initialize tables for n-point Gauss-Legendre
+ integration on a compact interval.
+Doc: initialize tables for $n$-point Gauss-Legendre integration of
+ a smooth function $f$ lon a compact
+ interval $[a,b]$ at current \kbd{realprecision}. If $n$ is omitted, make a
+ default choice $n \approx \kbd{realprecision}$, suitable for analytic
+ functions on $[-1,1]$. The error is bounded by
+ $$
+ \dfrac{(b-a)^{2n+1} (n!)^4}{(2n+1)[(2n)!]^3} f^{(2n)} (\xi) ,
+ \qquad a < \xi < b
+ $$
+ so, if the interval length increases, $n$ should be increased as well.
+ \bprog
+ ? T = intnumgaussinit();
+ ? intnumgauss(t=-1,1,exp(t), T) - exp(1)+exp(-1)
+ %1 = -5.877471754111437540 E-39
+ ? intnumgauss(t=-10,10,exp(t), T) - exp(10)+exp(-10)
+ %2 = -8.358367809712546836 E-35
+ ? intnumgauss(t=-1,1,1/(1+t^2), T) - Pi/2
+ %3 = -9.490148553624725335 E-22
+
+ ? T = intnumgaussinit(50);
+ ? intnumgauss(t=-1,1,1/(1+t^2), T) - Pi/2
+ %5 = -1.1754943508222875080 E-38
+ ? intnumgauss(t=-5,5,1/(1+t^2), T) - 2*atan(5)
+ %6 = -1.2[...]E-8
+ @eprog
+ On the other hand, we recommend to split the integral and change variables
+ rather than increasing $n$ too much, see \tet{intnumgauss}.
diff --git a/src/functions/sums/intnuminit b/src/functions/sums/intnuminit
index a832b51..4dad5ed 100644
--- a/src/functions/sums/intnuminit
+++ b/src/functions/sums/intnuminit
@@ -11,21 +11,45 @@ Doc: initialize tables for integration from
compactness, the possible existence of singularities, the speed of decrease
or the oscillations at infinity are taken into account, and not the values.
For instance {\tt intnuminit(-1,1)} is equivalent to {\tt intnuminit(0,Pi)},
- and {\tt intnuminit([0,-1/2],oo)} is equivalent to {\tt
- intnuminit(-oo,[-1,-1/2])}. If $m$ is not given, it is computed according to
- the current precision. Otherwise the integration step is $1/2^m$. Reasonable
- values of $m$ are $m=6$ or $m=7$ for $100$ decimal digits, and $m=9$ for
- $1000$ decimal digits.
-
- The result is technical, but in some cases it is useful to know the output.
- Let $x=\phi(t)$ be the change of variable which is used. \var{tab}[1] contains
- the integer $m$ as above, either given by the user or computed from the default
- precision, and can be recomputed directly using the function \kbd{intnumstep}.
- \var{tab}[2] and \var{tab}[3] contain respectively the abscissa and weight
- corresponding to $t=0$ ($\phi(0)$ and $\phi'(0)$). \var{tab}[4] and
- \var{tab}[5] contain the abscissas and weights corresponding to positive
- $t=nh$ for $1\le n\le N$ and $h=1/2^m$ ($\phi(nh)$ and $\phi'(nh)$). Finally
- \var{tab}[6] and \var{tab}[7] contain either the abscissas and weights
- corresponding to negative $t=nh$ for $-N\le n\le -1$, or may be empty (but
- not always) if $\phi(t)$ is an odd function (implicitly we would have
- $\var{tab}[6]=-\var{tab}[4]$ and $\var{tab}[7]=\var{tab}[5]$).
+ and {\tt intnuminit([0,-1/2],oo)} is equivalent to
+ {\tt intnuminit([-1,-1/2], -oo)}; on the other hand, the order matters
+ and
+ {\tt intnuminit([0,-1/2], [1,-1/3])} is \emph{not} equivalent to
+ {\tt intnuminit([0,-1/3], [1,-1/2])} !
+
+ If $m$ is multiply the default number of sampling points by $2^m$ (increasing
+ the running time by a similar factor).
+
+ The result is technical and liable to change in the future, but we document
+ it here for completeness. Let $x=\phi(t)$, $t\in ]-\infty,\infty[$ be an
+ internally chosen change of variable, achieving double exponential decrease of
+ the integrand at infinity. The integrator \kbd{intnum} will compute
+ $$ h \sum_{|n| < N} \phi'(nh) F(\phi(nh)) $$
+ for some integration step $h$ and truncation parameter $N$.
+ In basic use, let
+ \bprog
+ [h, x0, w0, xp, wp, xm, wm] = intnuminit(a,b);
+ @eprog
+
+ \item $h$ is the integration step
+
+ \item $x_0 = \phi(0)$ and $w_0 = \phi'(0)$,
+
+ \item \var{xp} contains the $\phi(nh)$, $0 < n < N$,
+
+ \item \var{xm} contains the $\phi(nh)$, $0 < -n < N$, or is empty.
+
+ \item \var{wp} contains the $\phi'(nh)$, $0 < n < N$,
+
+ \item \var{wm} contains the $\phi'(nh)$, $0 < -n < N$, or is empty.
+
+ The arrays \var{xm} and \var{wm} are left empty when $\phi$ is an odd
+ function. In complicated situations when non-default behaviour is specified at
+ end points, \kbd{intnuminit} may return up to $3$ such arrays, corresponding
+ to a splitting of up to $3$ integrals of basic type.
+
+ If the functions to be integrated later are of the form $F = f(t) k(t,z)$
+ for some kernel $k$ (e.g. Fourier, Laplace, Mellin, \dots), it is
+ useful to also precompute the values of $f(\phi(nh))$, which is accomplished
+ by \tet{intfuncinit}. The hard part is to determine the behaviour
+ of $F$ at endpoints, depending on $z$.
diff --git a/src/functions/sums/intnuminitgen b/src/functions/sums/intnuminitgen
deleted file mode 100644
index f4a91f1..0000000
--- a/src/functions/sums/intnuminitgen
+++ /dev/null
@@ -1,18 +0,0 @@
-Function: intnuminitgen
-Section: sums
-C-Name: intnuminitgen0
-Prototype: VGGED0,L,D0,L,p
-Help: intnuminitgen(t,a,b,ph,{m=0},{flag=0}): initialize tables for
- integrations from a to b using abscissas ph(t) and weights ph'(t). Note that
- there is no equal sign after the variable name t since t always goes from
- -infty to +infty, but it is ph(t) which goes from a to b, and this is not
- checked. If flag = 1 or 2, multiply the reserved table length by 4^flag, to
- avoid corresponding error.
-Doc: initialize tables for integrations from $a$ to $b$ using abscissas
- $ph(t)$ and weights $ph'(t)$. Note that there is no equal sign after the
- variable name $t$ since $t$ always goes from $-\infty$ to $+\infty$, but it
- is $ph(t)$ which goes from $a$ to $b$, and this is not checked. If \fl = 1
- or 2, multiply the reserved table length by $4^{\fl}$, to avoid corresponding
- error.
-
- \synt{intnuminitgen}{void *E, GEN (*eval)(void*,GEN), GEN a, GEN b, long m, long flag, long prec}
diff --git a/src/functions/sums/intnumstep b/src/functions/sums/intnumstep
deleted file mode 100644
index 1c82d3d..0000000
--- a/src/functions/sums/intnumstep
+++ /dev/null
@@ -1,9 +0,0 @@
-Function: intnumstep
-Section: sums
-C-Name: intnumstep
-Prototype: lp
-Help: intnumstep(): gives the default value of m used by all intnum and sumnum
- routines, such that the integration step is 1/2^m.
-Doc: give the value of $m$ used in all the
- \kbd{intnum} and \kbd{sumnum} programs, hence such that the integration
- step is equal to $1/2^m$.
diff --git a/src/functions/sums/limitnum b/src/functions/sums/limitnum
new file mode 100644
index 0000000..d99e296
--- /dev/null
+++ b/src/functions/sums/limitnum
@@ -0,0 +1,64 @@
+Function: limitnum
+Section: sums
+C-Name: limitnum0
+Prototype: GD0,L,DGp
+Help: limitnum(expr,{k = 20},{alpha=1}): numerical limit of sequence expr
+ using Lagrange-Zagier extrapolation; k is a multiplier so that we extrapolate
+ from expr(k*n). Assume u(n) ~ sum a_i n^(-alpha*i). flag=2, assuming that the
+ asymptotic expansion is in powers of 1/n^2.
+Doc: Lagrange-Zagier numerical extrapolation of \var{expr}, corresponding to a
+ sequence
+ $u_n$, either given by a closure \kbd{n->u(n)} or by a vector of values
+ I.e., assuming that $u_n$ tends to a finite limit $\ell$, try to determine
+ $\ell$. This routine is purely numerical and heuristic, thus may or may not
+ work on your examples; $k$ is ignored if $u$ is given by a vector,
+ and otherwise is a multiplier such that we extrapolate from $u(kn)$.
+
+ Assume that $u_n$ has an asymptotic expansion in $n^{-\alpha}$ :
+ $$u_n = \ell + \sum_{i\geq 1} a_i n^{-i\alpha}$$
+ for some $a_i$.
+ \bprog
+ ? limitnum(n -> n*sin(1/n))
+ %1 = 1.0000000000000000000000000000000000000
+
+ ? limitnum(n -> (1+1/n)^n) - exp(1)
+ %2 = 0.E-37
+
+ ? limitnum(n -> 2^(4*n+1)*(n!)^4 / (2*n)! /(2*n+1)! )
+ %3 = 3.1415926535897932384626433832795028842
+ ? Pi
+ %4 = 3.1415926535897932384626433832795028842
+ @eprog\noindent
+ If $u_n$ is given by a vector, it must be long enough for the extrapolation
+ to make sense: at least $k$ times the current \kbd{realprecision}. The
+ preferred format is thus a closure, although it becomes inconvenient
+ when $u_n$ cannot be directly computed in time polynomial in $\log n$,
+ for instance if it is defined as a sum or by induction. In that case,
+ passing a vector of values is the best option. It usually pays off to
+ interpolate $u(kn)$ for some $k > 1$:
+ \bprog
+ ? limitnum(vector(10,n,(1+1/n)^n))
+ *** ^--------------------
+ *** limitnum: non-existent component in limitnum: index < 20
+ \\ at this accuracy, we must have at least 20 values
+ ? limitnum(vector(20,n,(1+1/n)^n)) - exp(1)
+ %5 = -2.05... E-20
+ ? limitnum(vector(20,n, m=10*n;(1+1/m)^m)) - exp(1) \\ better accuracy
+ %6 = 0.E-37
+
+ ? v = vector(20); s = 0;
+ ? for(i=1,#v, s += 1/i; v[i]= s - log(i));
+ ? limitnum(v) - Euler
+ %9 = -1.6... E-19
+
+ ? V = vector(200); s = 0;
+ ? for(i=1,#V, s += 1/i; V[i]= s);
+ ? v = vector(#V \ 10, i, V[10*i] - log(10*i));
+ ? limitnum(v) - Euler
+ %13 = 6.43... E-29
+ @eprog
+
+ \synt{limitnum}{void *E, GEN (*u)(void *,GEN,long), long muli, GEN alpha, long prec}, where \kbd{u(E, n, prec)} must return $u(n)$ in precision \kbd{prec}.
+ Also available is
+ \fun{GEN}{limitnum0}{GEN u, long muli, GEN alpha, long prec}, where $u$
+ must be a vector of sufficient length as above.
diff --git a/src/functions/sums/sumnum b/src/functions/sums/sumnum
index cefeea9..3f0a431 100644
--- a/src/functions/sums/sumnum
+++ b/src/functions/sums/sumnum
@@ -1,126 +1,140 @@
Function: sumnum
Section: sums
C-Name: sumnum0
-Prototype: V=GGEDGD0,L,p
-Help: sumnum(X=a,sig,expr,{tab},{flag=0}): numerical summation of expr from
- X = ceiling(a) to +infinity. sig is either a scalar or a two-component vector
- coding the function's decrease rate at infinity. It is assumed that the
- scalar part of sig is to the right of all poles of expr. If present, tab
- must be initialized by sumnuminit. If flag is nonzero, assumes that
- conj(expr(z)) = expr(conj(z)).
-Wrapper: (,,G)
+Prototype: V=GEDGp
+Help: sumnum(n=a,f,{tab}): numerical summation of f(n) from
+ n = a to +infinity using Euler-MacLaurin summation. Assume that f
+ corresponds to a series with positive terms and is a C^oo function; a
+ must be an integer, and tab, if given, is the output of sumnuminit.
+Wrapper: (,G)
Description:
- (gen,gen,gen,?gen,?small):gen:prec sumnum(${3 cookie}, ${3 wrapper}, $1, $2, $4, $5, prec)
-Doc: numerical summation of \var{expr}, the variable $X$ taking integer values
- from ceiling of $a$ to $+\infty$, where \var{expr} is assumed to be a
- holomorphic function $f(X)$ for $\Re(X)\ge \sigma$.
-
- The parameter $\sigma\in\R$ is coded in the argument \kbd{sig} as follows: it
- is either
-
- \item a real number $\sigma$. Then the function $f$ is assumed to
- decrease at least as $1/X^2$ at infinity, but not exponentially;
-
- \item a two-component vector $[\sigma,\alpha]$, where $\sigma$ is as
- before, $\alpha < -1$. The function $f$ is assumed to decrease like
- $X^{\alpha}$. In particular, $\alpha\le-2$ is equivalent to no $\alpha$ at all.
-
- \item a two-component vector $[\sigma,\alpha]$, where $\sigma$ is as
- before, $\alpha > 0$. The function $f$ is assumed to decrease like
- $\exp(-\alpha X)$. In this case it is essential that $\alpha$ be exactly the
- rate of exponential decrease, and it is usually a good idea to increase
- the default value of $m$ used for the integration step. In practice, if
- the function is exponentially decreasing \kbd{sumnum} is slower and less
- accurate than \kbd{sumpos} or \kbd{suminf}, so should not be used.
-
- The function uses the \tet{intnum} routines and integration on the line
- $\Re(s) = \sigma$. The optional argument \var{tab} is as in intnum, except it
- must be initialized with \kbd{sumnuminit} instead of \kbd{intnuminit}.
+ (gen,gen,?gen):gen:prec sumnum(${2 cookie}, ${2 wrapper}, $1, $3, prec)
+Doc: Numerical summation of $f(n)$ at high accuracy using Euler-MacLaurin,
+ the variable $n$ taking values from $a$ to $+\infty$, where $f$ is assumed to
+ have positive values and is a $C^\infty$ function; \kbd{a} must be an integer
+ and \kbd{tab}, if given, is the output of \kbd{sumnuminit}. The latter
+ precomputes abcissas and weights, speeding up the computation; it also allows
+ to specify the behaviour at infinity via \kbd{sumnuminit([+oo, asymp])}.
+ \bprog
+ ? \p500
+ ? z3 = zeta(3);
+ ? sumpos(n = 1, n^-3) - z3
+ time = 2,332 ms.
+ %2 = 2.438468843 E-501
+ ? sumnum(n = 1, n^-3) - z3 \\ here slower than sumpos
+ time = 2,752 ms.
+ %3 = 0.E-500
+ @eprog
- When \var{tab} is not precomputed, \kbd{sumnum} can be slower than
- \kbd{sumpos}, when the latter is applicable. It is in general faster for
- slowly decreasing functions.
+ \misctitle{Complexity}
+ The function $f$ is evaluated at $O(D \log D)$ real arguments,
+ where $D \approx \kbd{realprecision} \cdot \log(10)$. The routine is geared
+ towards slowly decreasing functions: if $f$ decreases exponentially fast,
+ then one of \kbd{suminf} or \kbd{sumpos} should be preferred.
+ If $f$ satisfies the stronger hypotheses required for Monien summation,
+ i.e. if $f(1/z)$ is holomorphic in a complex neighbourhood of $[0,1]$,
+ then \tet{sumnummonien} will be faster since it only requires $O(D/\log D)$
+ evaluations:
+ \bprog
+ ? sumnummonien(n = 1, 1/n^3) - z3
+ time = 1,985 ms.
+ %3 = 0.E-500
+ @eprog\noindent The \kbd{tab} argument precomputes technical data
+ not depending on the expression being summed and valid for a given accuracy,
+ speeding up immensely later calls:
+ \bprog
+ ? tab = sumnuminit();
+ time = 2,709 ms.
+ ? sumnum(n = 1, 1/n^3, tab) - z3 \\ now much faster than sumpos
+ time = 40 ms.
+ %5 = 0.E-500
+ ? tabmon = sumnummonieninit(); \\ Monien summation allows precomputations too
+ time = 1,781 ms.
+ ? sumnummonien(n = 1, 1/n^3, tabmon) - z3
+ time = 2 ms.
+ %7 = 0.E-500
+ @eprog\noindent The speedup due to precomputations becomes less impressive
+ when the function $f$ is expensive to evaluate, though:
+ \bprog
+ ? sumnum(n = 1, lngamma(1+1/n)/n, tab);
+ time = 14,180 ms.
- Finally, if $\fl$ is nonzero, we assume that the function $f$ to be summed is
- of real type, i.e. satisfies $\overline{f(z)}=f(\overline{z})$, which
- speeds up the computation.
+ ? sumnummonien(n = 1, lngamma(1+1/n)/n, tabmon); \\ fewer function evaluations!
+ time = 717 ms.
+ @eprog
+ \misctitle{Behaviour at infinity}
+ By default, \kbd{sumnum} assumes that \var{expr} decreases slowly at infinity,
+ but at least like $O(n^{-2})$. If the function decreases like $n^{\alpha}$
+ for some $-2 < \alpha < -1$, then it must be indicated via
\bprog
- ? \p 308
- ? a = sumpos(n=1, 1/(n^3+n+1));
- time = 1,410 ms.
- ? tab = sumnuminit(2);
- time = 1,620 ms. \\@com slower but done once and for all.
- ? b = sumnum(n=1, 2, 1/(n^3+n+1), tab);
- time = 460 ms. \\@com 3 times as fast as \kbd{sumpos}
- ? a - b
- %4 = -1.0... E-306 + 0.E-320*I \\@com perfect.
- ? sumnum(n=1, 2, 1/(n^3+n+1), tab, 1) - a; \\@com function of real type
- time = 240 ms.
- %2 = -1.0... E-306 \\@com twice as fast, no imaginary part.
- ? c = sumnum(n=1, 2, 1/(n^2+1), tab, 1);
- time = 170 ms. \\@com fast
- ? d = sumpos(n=1, 1 / (n^2+1));
- time = 2,700 ms. \\@com slow.
- ? d - c
- time = 0 ms.
- %5 = 1.97... E-306 \\@com perfect.
+ tab = sumnuminit([+oo, alpha]); /* alpha < 0 slow decrease */
+ @eprog\noindent otherwise loss of accuracy is expected.
+ If the functions decreases quickly, like $\exp(-\alpha n)$ for some
+ $\alpha > 0$, then it must be indicated via
+ \bprog
+ tab = sumnuminit([+oo, alpha]); /* alpha > 0 exponential decrease */
+ @eprog\noindent otherwise exponent overflow will occur.
+ \bprog
+ ? sumnum(n=1,2^-n)
+ *** at top-level: sumnum(n=1,2^-n)
+ *** ^----
+ *** _^_: overflow in expo().
+ ? tab = sumnuminit([+oo,log(2)]); sumnum(n=1,2^-n, tab)
+ %1 = 1.000[...]
@eprog
- For slowly decreasing function, we must indicate singularities:
+ As a shortcut, one can also input
\bprog
- ? \p 308
- ? a = sumnum(n=1, 2, n^(-4/3));
- time = 9,930 ms. \\@com slow because of the computation of $n^{-4/3}$.
- ? a - zeta(4/3)
- time = 110 ms.
- %1 = -2.42... E-107 \\@com lost 200 decimals because of singularity at $\infty$
- ? b = sumnum(n=1, [2,-4/3], n^(-4/3), /*omitted*/, 1); \\@com of real type
- time = 12,210 ms.
- ? b - zeta(4/3)
- %3 = 1.05... E-300 \\@com better
+ sumnum(n = [a, asymp], f)
+ @eprog\noindent instead of
+ \bprog
+ tab = sumnuminit(asymp);
+ sumnum(n = a, f, tab)
@eprog
- Since the \emph{complex} values of the function are used, beware of
- determination problems. For instance:
+ \misctitle{Further examples}
\bprog
- ? \p 308
- ? tab = sumnuminit([2,-3/2]);
- time = 1,870 ms.
- ? sumnum(n=1,[2,-3/2], 1/(n*sqrt(n)), tab,1) - zeta(3/2)
- time = 690 ms.
- %1 = -1.19... E-305 \\@com fast and correct
- ? sumnum(n=1,[2,-3/2], 1/sqrt(n^3), tab,1) - zeta(3/2)
- time = 730 ms.
- %2 = -1.55... \\@com nonsense. However
- ? sumnum(n=1,[2,-3/2], 1/n^(3/2), tab,1) - zeta(3/2)
- time = 8,990 ms.
- %3 = -1.19... E-305 \\@com perfect, as $1/(n*\sqrt{n})$ above but much slower
- @eprog
+ ? \p200
+ ? sumnum(n = 1, n^(-2)) - zeta(2) \\ accurate, fast
+ time = 200 ms.
+ %1 = -2.376364457868949779 E-212
+ ? sumpos(n = 1, n^(-2)) - zeta(2) \\ even faster
+ time = 96 ms.
+ %2 = 0.E-211
+ ? sumpos(n=1,n^(-4/3)) - zeta(4/3) \\ now much slower
+ time = 13,045 ms.
+ %3 = -9.980730723049589073 E-210
+ ? sumnum(n=1,n^(-4/3)) - zeta(4/3) \\ fast but inaccurate
+ time = 365 ms.
+ %4 = -9.85[...]E-85
+ ? sumnum(n=[1,-4/3],n^(-4/3)) - zeta(4/3) \\ with decrease rate, now accurate
+ time = 416 ms.
+ %5 = -4.134874156691972616 E-210
- For exponentially decreasing functions, \kbd{sumnum} is given for
- completeness, but one of \tet{suminf} or \tet{sumpos} should always be
- preferred. If you experiment with such functions and \kbd{sumnum} anyway,
- indicate the exact rate of decrease and increase $m$ by $1$ or $2$:
+ ? tab = sumnuminit([+oo,-4/3]);
+ time = 196 ms.
+ ? sumnum(n=1, n^(-4/3), tab) - zeta(4/3) \\ faster with precomputations
+ time = 216 ms.
+ %5 = -4.134874156691972616 E-210
+ ? sumnum(n=1,-log(n)*n^(-4/3), tab) - zeta'(4/3)
+ time = 321 ms.
+ %7 = 7.224147951921607329 E-210
+ @eprog
+ Note that in the case of slow decrease ($\alpha < 0$), the exact
+ decrease rate must be indicated, while in the case of exponential decrease,
+ a rough value will do. In fact, for exponentially decreasing functions,
+ \kbd{sumnum} is given for completeness and comparison purposes only: one
+ of \kbd{suminf} or \kbd{sumpos} should always be preferred.
\bprog
- ? suminf(n=1, 2^(-n)) - 1
- time = 10 ms.
- %1 = -1.11... E-308 \\@com fast and perfect
- ? sumpos(n=1, 2^(-n)) - 1
- time = 10 ms.
- %2 = -2.78... E-308 \\@com also fast and perfect
- ? sumnum(n=1,2, 2^(-n)) - 1
- %3 = -1.321115060 E320 + 0.E311*I \\@com nonsense
- ? sumnum(n=1, [2,log(2)], 2^(-n), /*omitted*/, 1) - 1 \\@com of real type
- time = 5,860 ms.
- %4 = -1.5... E-236 \\@com slow and lost $70$ decimals
- ? m = intnumstep()
- %5 = 9
- ? sumnum(n=1,[2,log(2)], 2^(-n), m+1, 1) - 1
- time = 11,770 ms.
- %6 = -1.9... E-305 \\@com now perfect, but slow.
+ ? sumnum(n=[1, 1], 2^-n) \\ pretend we decrease as exp(-n)
+ time = 240 ms.
+ %8 = 1.000[...] \\ perfect
+ ? sumpos(n=1, 2^-n)
+ %9 = 1.000[...] \\ perfect and instantaneous
@eprog
- \synt{sumnum}{void *E, GEN (*eval)(void*,GEN), GEN a,GEN sig,GEN tab,long flag, long prec}.
+ \synt{sumnum}{(void *E, GEN (*eval)(void*, GEN), GEN a, GEN tab, long prec)}
+ where an omitted \var{tab} is coded as \kbd{NULL}.
diff --git a/src/functions/sums/sumnumalt b/src/functions/sums/sumnumalt
deleted file mode 100644
index 00e9487..0000000
--- a/src/functions/sums/sumnumalt
+++ /dev/null
@@ -1,53 +0,0 @@
-Function: sumnumalt
-Section: sums
-C-Name: sumnumalt0
-Prototype: V=GGEDGD0,L,p
-Help: sumnumalt(X=a,sig,expr,{tab},{flag=0}): numerical summation of (-1)^X
- expr(X)
- from X = ceiling(a) to +infinity. Note that the (-1)^X must not be included.
- sig is either a scalar or a two-component vector coded as in intnum, and the
- scalar part is larger than all the real parts of the poles of expr. Uses intnum,
- hence tab is as in intnum. If flag is nonzero, assumes that the function to
- be summed satisfies conj(f(z))=f(conj(z)), and then up to twice faster.
-Wrapper: (,,G)
-Description:
- (gen,gen,gen,?gen,?small):gen:prec sumnumalt(${3 cookie}, ${3 wrapper}, $1, $2, $4, $5, prec)
-Doc: numerical
- summation of $(-1)^X\var{expr}(X)$, the variable $X$ taking integer values from
- ceiling of $a$ to $+\infty$, where \var{expr} is assumed to be a holomorphic
- function for $\Re(X)\ge sig$ (or $sig[1]$).
-
- \misctitle{Warning} This function uses the \kbd{intnum} routines and is
- orders of magnitude slower than \kbd{sumalt}. It is only given for
- completeness and should not be used in practice.
-
- \misctitle{Warning 2} The expression \var{expr} must \emph{not} include the
- $(-1)^X$ coefficient. Thus $\kbd{sumalt}(n=a,(-1)^nf(n))$ is (approximately)
- equal to $\kbd{sumnumalt}(n=a,sig,f(n))$.
-
- $sig$ is coded as in \kbd{sumnum}. However for slowly decreasing functions
- (where $sig$ is coded as $[\sigma,\alpha]$ with $\alpha<-1$), it is not
- really important to indicate $\alpha$. In fact, as for \kbd{sumalt}, the
- program will often give meaningful results (usually analytic continuations)
- even for divergent series. On the other hand the exponential decrease must be
- indicated.
-
- \var{tab} is as in \kbd{intnum}, but if used must be initialized with
- \kbd{sumnuminit}. If $\fl$ is nonzero, assumes that the function $f$ to be
- summed is of real type, i.e. satisfies $\overline{f(z)}=f(\overline{z})$, and
- then twice faster when \var{tab} is precomputed.
-
- \bprog
- ? \p 308
- ? tab = sumnuminit(2, /*omitted*/, -1); \\@com abscissa $\sigma=2$, alternating sums.
- time = 1,620 ms. \\@com slow, but done once and for all.
- ? a = sumnumalt(n=1, 2, 1/(n^3+n+1), tab, 1);
- time = 230 ms. \\@com similar speed to \kbd{sumnum}
- ? b = sumalt(n=1, (-1)^n/(n^3+n+1));
- time = 0 ms. \\@com infinitely faster!
- ? a - b
- time = 0 ms.
- %1 = -1.66... E-308 \\@com perfect
- @eprog
-
- \synt{sumnumalt}{void *E, GEN (*eval)(void*,GEN), GEN a, GEN sig, GEN tab, long flag, long prec}.
diff --git a/src/functions/sums/sumnuminit b/src/functions/sums/sumnuminit
index 5898c99..0480086 100644
--- a/src/functions/sums/sumnuminit
+++ b/src/functions/sums/sumnuminit
@@ -1,12 +1,32 @@
Function: sumnuminit
Section: sums
C-Name: sumnuminit
-Prototype: GD0,L,D1,L,p
-Help: sumnuminit(sig, {m=0}, {sgn=1}): initialize tables for numerical
- summation. sgn is 1 (in fact >= 0), the default, for sumnum (ordinary sums)
- or -1 (in fact < 0) for sumnumalt (alternating sums). sig is as in sumnum and
- m is as in intnuminit.
-Doc: initialize tables for numerical summation using \kbd{sumnum} (with
- $\var{sgn}=1$) or \kbd{sumnumalt} (with $\var{sgn}=-1$), $sig$ is the
- abscissa of integration coded as in \kbd{sumnum}, and $m$ is as in
- \kbd{intnuminit}.
+Prototype: DGp
+Help: sumnuminit({asymp}): initialize tables for Euler-MacLaurin delta
+ summation of a series with positive terms.
+Doc: initialize tables for Euler--MacLaurin delta summation of a series with
+ positive terms. If given, \kbd{asymp} is of the form $[\kbd{+oo}, \alpha]$,
+ as in \tet{intnum} and indicates the decrease rate at infinity of functions
+ to be summed. A positive
+ $\alpha > 0$ encodes an exponential decrease of type $\exp(-\alpha n)$ and
+ a negative $-2 < \alpha < -1$ encodes a slow polynomial decrease of type
+ $n^{\alpha}$.
+ \bprog
+ ? \p200
+ ? sumnum(n=1, n^-2);
+ time = 200 ms.
+ ? tab = sumnuminit();
+ time = 188 ms.
+ ? sumnum(n=1, n^-2, tab); \\ faster
+ time = 8 ms.
+
+ ? tab = sumnuminit([+oo, log(2)]); \\ decrease like 2^-n
+ time = 200 ms.
+ ? sumnum(n=1, 2^-n, tab)
+ time = 44 ms.
+
+ ? tab = sumnuminit([+oo, -4/3]); \\ decrease like n^(-4/3)
+ time = 200 ms.
+ ? sumnum(n=1, n^(-4/3), tab);
+ time = 221 ms.
+ @eprog
diff --git a/src/functions/sums/sumnummonien b/src/functions/sums/sumnummonien
new file mode 100644
index 0000000..f952aad
--- /dev/null
+++ b/src/functions/sums/sumnummonien
@@ -0,0 +1,21 @@
+Function: sumnummonien
+Section: sums
+C-Name: sumnummonien0
+Prototype: V=GEDGp
+Help: sumnummonien(n=a,f,{tab}): numerical summation from
+ n = a to +infinity using Monien summation.
+Wrapper: (,G)
+Description:
+ (gen,gen,?gen):gen:prec sumnummonien(${2 cookie}, ${2 wrapper}, $1, $3, prec)
+Doc: numerical summation $\sum_{n\geq a} f(n)$ at high accuracy, the variable
+ $n$ taking values from the integer $a$ to $+\infty$ using Monien summation,
+ which assumes that $f(1/z)$ has a complex analytic continuation in a (complex)
+ neighbourhood of the segment $[0,1]$.
+
+ The function $f$ is evaluated at $O(D / \log D)$ real arguments,
+ where $D \approx \kbd{realprecision} \cdot \log(10)$.
+ By default, assume that $f(n) = O(n^{-2})$ and has a non-zero asymptotic
+ expansion
+ $$f(n) = \sum_{i\geq 2} a_i n^{-i}$$
+ at infinity. To handle more complicated behaviours and allow time-saving
+ precomputations (for a given \kbd{realprecision}), see \kbd{sumnummonieninit}.
diff --git a/src/functions/sums/sumnummonieninit b/src/functions/sums/sumnummonieninit
new file mode 100644
index 0000000..f5a7336
--- /dev/null
+++ b/src/functions/sums/sumnummonieninit
@@ -0,0 +1,87 @@
+Function: sumnummonieninit
+Section: sums
+C-Name: sumnummonieninit
+Prototype: DGDGDGp
+Help: sumnummonieninit({asymp},{w},{n0 = 1}): initialize tables for Monien summation of a series with positive terms.
+Doc: initialize tables for Monien summation of a series $\sum_{n\geq n_0}
+ f(n)$ where $f(1/z)$ has a complex analytic continuation in a (complex)
+ neighbourhood of the segment $[0,1]$.
+
+ By default, assume that $f(n) = O(n^{-2})$ and has a non-zero asymptotic
+ expansion
+ $$f(n) = \sum_{i\geq 2} a_i / n^i$$
+ at infinity. Note that the sum starts at $i = 2$! The argument \kbd{asymp}
+ allows to specify different expansions:
+
+ \item a real number $\alpha > 1$ means
+ $$f(n) = \sum_{i\geq 1} a_i / n^\alpha$$
+ (Now the summation starts at $1$.)
+
+ \item a vector $[\alpha,\beta]$ of reals, where we must have $\alpha > 0$
+ and $\alpha + \beta > 1$ to ensure convergence, means that
+ $$f(n) = \sum_{i\geq 1} a_i / n^{\alpha i + \beta}$$
+ Note that $\kbd{asymp} = [\alpha, \alpha]$ is equivalent to
+ $\kbd{asymp}=\alpha$.
+
+ \bprog
+ ? \p38
+ ? s = sumnum(n = 1, sin(1/sqrt(n)) / n)
+ %1 = 2.3979771206715998375659850036324914714
+
+ ? sumnummonien(n = 1, sin(1/sqrt(n)) / n) - s
+ %2 = -0.001[...] \\ completely wrong !
+
+ ? t = sumnummonieninit([1/2,1]); \\ f(n) = \sum_i 1 / n^(i/2+1)
+ ? sumnummonien(n = 1, sin(1/sqrt(n)) / n, t) - s
+ %3 = 0.E-37 \\ now correct
+ @eprog
+
+ The argument $w$ is used to sum expressions of the form
+ $$ \sum_{n\geq n_0} f(n) w(n),$$
+ for varying $f$ \emph{as above}, and fixed weight function $w$, where we
+ further assume that the auxiliary sums
+ $$g_w(m) = \sum_{n\geq n_0} w(n) / n^{\alpha m + \beta} $$
+ converge for all $m\geq 1$. Note that for non-negative integers $k$,
+ and weight $w(n) = (\log n)^k$, the function $g_w(m) = \zeta^{(k)}(\alpha m +
+ \beta)$ has a simple expression; for general weights, $g_w$ is
+ computed using \kbd{sumnum}. The following variants are available
+
+ \item an integer $k \geq 0$, to code $w(n) = (\log n)^k$;
+ only the cases $k = 0,1$ are presently implemented; due to a poor
+ implementation of $\zeta$ derivatives, it is not currently worth it
+ to exploit the special shape of $g_w$ when $k > 0$;
+
+ \item a \typ{CLOSURE} computing the values $w(n)$, where we
+ assume that $w(n) = O(n^\epsilon)$ for all $\epsilon > 0$;
+
+ \item a vector $[w, \kbd{fast}]$, where $w$ is a closure as above
+ and \kbd{fast} is a scalar;
+ we assume that $w(n) = O(n^{\kbd{fast}+\epsilon})$; note that
+ $\kbd{w} = [w, 0]$ is equivalent to $\kbd{w} = w$.
+
+ \item a vector $[w, \kbd{oo}]$, where $w$ is a closure as above;
+ we assume that $w(n)$ decreases exponentially. Note that in this case,
+ \kbd{sumnummonien} is provided for completeness and comparison purposes only:
+ one of \kbd{suminf} or \kbd{sumpos} should be preferred in practice.
+
+ The cases where $w$ is a closure or $w(n) = \log n$ are the only ones where
+ $n_0$ is taken into account and stored in the result. The subsequent call to
+ \kbd{sumnummonien} \emph{must} use the same value.
+
+ \bprog
+ ? \p300
+ ? sumnummonien(n = 1, n^-2*log(n)) + zeta'(2)
+ time = 536 ms.
+ %1 = -1.323[...]E-6 \\ completely wrong, f does not satisfy hypotheses !
+ ? tab = sumnummonieninit(, 1); \\ codes w(n) = log(n)
+ time = 18,316 ms.
+ ? sumnummonien(n = 1, n^-2, tab) + zeta'(2)
+ time = 44 ms.
+ %3 = -5.562684646268003458 E-309 \\ now perfect
+
+ ? tab = sumnummonieninit(, n->log(n)); \\ generic, about as fast
+ time = 18,693 ms.
+ ? sumnummonien(n = 1, n^-2, tab) + zeta'(2)
+ time = 40 ms.
+ %5 = -5.562684646268003458 E-309 \\ identical result
+ @eprog
diff --git a/src/functions/transcendental/cotanh b/src/functions/transcendental/cotanh
new file mode 100644
index 0000000..6829914
--- /dev/null
+++ b/src/functions/transcendental/cotanh
@@ -0,0 +1,6 @@
+Function: cotanh
+Section: transcendental
+C-Name: gcotanh
+Prototype: Gp
+Help: cotanh(x): hyperbolic cotangent of x.
+Doc: hyperbolic cotangent of $x$.
diff --git a/src/functions/transcendental/gammamellininv b/src/functions/transcendental/gammamellininv
new file mode 100644
index 0000000..07be345
--- /dev/null
+++ b/src/functions/transcendental/gammamellininv
@@ -0,0 +1,22 @@
+Function: gammamellininv
+Section: transcendental
+C-Name: gammamellininv
+Prototype: GGD0,L,p
+Help: gammamellininv(G,t,{m=0}): returns G(t), where G is as output
+ by gammamellininvinit. The alternative syntax gammamellininv(A,t,m)
+ is also available.
+Doc: returns the value at $t$ of the inverse Mellin transform
+ $G$ initialized by \tet{gammamellininvinit}.
+ \bprog
+ ? G = gammamellininvinit([0]);
+ ? gammamellininv(G, 2) - 2*exp(-Pi*2^2)
+ %2 = -4.484155085839414627 E-44
+ @eprog
+
+ The alternative shortcut
+ \bprog
+ gammamellininv(A,t,m)
+ @eprog\noindent for
+ \bprog
+ gammamellininv(gammamellininvinit(A,m), t)
+ @eprog\noindent is available.
diff --git a/src/functions/transcendental/gammamellininvasymp b/src/functions/transcendental/gammamellininvasymp
new file mode 100644
index 0000000..0a10526
--- /dev/null
+++ b/src/functions/transcendental/gammamellininvasymp
@@ -0,0 +1,23 @@
+Function: gammamellininvasymp
+Section: transcendental
+C-Name: gammamellininvasymp
+Prototype: GDPD0,L,
+Help: gammamellininvasymp(A,n,{m=0}): return the first n terms of the
+ asymptotic expansion at infinity of the m-th derivative K^m(t) of the
+ inverse Mellin transform of the function
+ f(s)=gamma_R(s+a_1)*...*gamma_(s+a_d), where Vga is the vector [a_1,...,a_d]
+ and gamma_R(s)=Pi^(-s/2)*gamma(s/2). The result is a vector [M[1]...M[n]]
+ with M[1]=1, such that
+ K^m(t) = sqrt(2^{d+1}/d)t^{1-d+a+m(2/d-1)}e^{-d pi t^{2/d}}\sum_{n\ge0}M[n+1]t^{-2n/d}
+ with a = (1-d+sum_ja_j)/d.
+Doc: Return the first $n$ terms of the asymptotic expansion at infinity
+ of the $m$-th derivative $K^{(m)}(t)$ of the inverse Mellin transform of the
+ function
+ $$f(s) = \Gamma_\R(s+a_1)\*\ldots\*\Gamma_\R(s+a_d)\;,$$
+ where \kbd{A} is the vector $[a_1,\ldots,a_d]$ and
+ $\Gamma_\R(s)=\pi^{-s/2}\*\Gamma(s/2)$.
+ The result is a vector
+ $[M[1]...M[n]]$ with M[1]=1, such that
+ $$K^{(m)}(t)=\sqrt(2^{d+1}/d)t^{1-d+a+m(2/d-1)}e^{-d\pi t^{2/d}}
+ \sum_{n\ge0} M[n+1]t^{-2n/d}$$
+ with $a=(1-d+\sum_{1\le j\le d}a_j)/d$.
diff --git a/src/functions/transcendental/gammamellininvinit b/src/functions/transcendental/gammamellininvinit
new file mode 100644
index 0000000..a913488
--- /dev/null
+++ b/src/functions/transcendental/gammamellininvinit
@@ -0,0 +1,37 @@
+Function: gammamellininvinit
+Section: transcendental
+C-Name: gammamellininvinit
+Prototype: GD0,L,p
+Help: gammamellininvinit(A,{m=0}): initialize data for the computation by
+ gammamellininv() of the m-th derivative of the inverse Mellin transform
+ of the function f(s) = gamma_R(s+a1)*...*gamma_R(s+ad), where
+ A is the vector [a1,...,ad] and gamma_R(s) = Pi^(-s/2)*gamma(s/2).
+Doc: initialize data for the computation by \tet{gammamellininv} of
+ the $m$-th derivative of the inverse Mellin transform of the function
+ $$f(s) = \Gamma_\R(s+a_1)\*\ldots\*\Gamma_\R(s+a_d)$$
+ where \kbd{A} is the vector $[a_1,\ldots,a_d]$ and
+ $\Gamma_\R(s)=\pi^{-s/2}\*\Gamma(s/2)$. This is the special case of Meijer's
+ $G$ functions used to compute $L$-values via the approximate functional
+ equation.
+
+ \misctitle{Caveat} Contrary to the PARI convention, this function
+ guarantees an \emph{absolute} (rather than relative) error bound.
+
+ For instance, the inverse Mellin transform of $\Gamma_\R(s)$ is
+ $2\exp(-\pi z^2)$:
+ \bprog
+ ? G = gammamellininvinit([0]);
+ ? gammamellininv(G, 2) - 2*exp(-Pi*2^2)
+ %2 = -4.484155085839414627 E-44
+ @eprog
+ The inverse Mellin transform of $\Gamma_\R(s+1)$ is
+ $2 z\exp(-\pi z^2)$, and its second derivative is
+ $ 4\pi z \exp(-\pi z^2)(2\pi z^2 - 3)$:
+ \bprog
+ ? G = gammamellininvinit([1], 2);
+ ? a(z) = 4*Pi*z*exp(-Pi*z^2)*(2*Pi*z^2-3);
+ ? b(z) = gammamellininv(G,z);
+ ? t(z) = b(z) - a(z);
+ ? t(3/2)
+ %3 = -1.4693679385278593850 E-39
+ @eprog
diff --git a/src/functions/transcendental/sinc b/src/functions/transcendental/sinc
new file mode 100644
index 0000000..351c752
--- /dev/null
+++ b/src/functions/transcendental/sinc
@@ -0,0 +1,9 @@
+Function: sinc
+Section: transcendental
+C-Name: gsinc
+Prototype: Gp
+Help: sinc(x): sinc function of x.
+Doc: cardinal sine of $x$, i.e. $\sin(x)/x$ if $x\neq 0$, $1$ otherwise.
+ Note that this function also allows to compute
+ $$(1-\cos(x)) / x^2 = \kbd{sinc}(x/2)^2 / 2$$
+ accurately near $x = 0$.
diff --git a/src/functions/transcendental/zetamult b/src/functions/transcendental/zetamult
new file mode 100644
index 0000000..1359f16
--- /dev/null
+++ b/src/functions/transcendental/zetamult
@@ -0,0 +1,12 @@
+Function: zetamult
+Section: transcendental
+C-Name: zetamult
+Prototype: Gp
+Help: zetamult(s): multiple zeta value at integral s = [s1,...,sd].
+Doc: For $s$ a vector of positive integers such that $s[1] \geq 2$,
+ returns the multiple zeta value (MZV)
+ $$\zeta(s_1,\dots, s_k) = \sum_{n_1>\dots>n_k>0} n_1^{-s_1}\dots n_k^{-s_k}.$$
+ \bprog
+ ? zetamult([2,1]) - zeta(3) \\ Euler's identity
+ %1 = 0.E-38
+ @eprog
diff --git a/src/headers/paridecl.h b/src/headers/paridecl.h
index c52e3fe..f0c3f01 100644
--- a/src/headers/paridecl.h
+++ b/src/headers/paridecl.h
@@ -72,7 +72,6 @@ GEN rootmod(GEN f, GEN p);
GEN rootmod2(GEN f, GEN p);
GEN factmod(GEN f, GEN p);
GEN simplefactmod(GEN f, GEN p);
-GEN listcreate(void);
void listkill(GEN list);
GEN discrayabs(GEN bnr,GEN subgroup);
GEN discrayabscond(GEN bnr,GEN subgroup);
@@ -281,10 +280,11 @@ GEN FlxC_to_ZXC(GEN x);
GEN FlxM_Flx_add_shallow(GEN x, GEN y, ulong p);
GEN FlxM_to_ZXM(GEN z);
GEN FlxT_red(GEN z, ulong p);
-GEN FlxV_to_ZXV(GEN x);
GEN FlxV_Flc_mul(GEN V, GEN W, ulong p);
+GEN FlxV_prod(GEN V, ulong p);
GEN FlxV_red(GEN z, ulong p);
GEN FlxV_to_Flm(GEN v, long n);
+GEN FlxV_to_ZXV(GEN x);
GEN FlxX_Fl_mul(GEN x, ulong y, ulong p);
GEN FlxX_Flx_add(GEN y, GEN x, ulong p);
GEN FlxX_Flx_mul(GEN x, GEN y, ulong p);
@@ -800,6 +800,7 @@ GEN RgV_dotsquare(GEN x);
int RgV_is_ZMV(GEN V);
long RgV_isin(GEN v, GEN x);
GEN RgV_neg(GEN x);
+GEN RgV_prod(GEN v);
GEN RgV_sub(GEN x, GEN y);
GEN RgV_sum(GEN v);
GEN RgV_sumpart(GEN v, long n);
@@ -841,8 +842,10 @@ GEN RgX_Rg_add(GEN y, GEN x);
GEN RgX_Rg_add_shallow(GEN y, GEN x);
GEN RgX_Rg_div(GEN y, GEN x);
GEN RgX_Rg_divexact(GEN x, GEN y);
+GEN RgX_Rg_eval_bk(GEN Q, GEN x);
GEN RgX_Rg_mul(GEN y, GEN x);
GEN RgX_Rg_sub(GEN y, GEN x);
+GEN RgX_RgV_eval(GEN Q, GEN x);
GEN RgX_add(GEN x, GEN y);
GEN RgX_blocks(GEN P, long n, long m);
GEN RgX_deflate(GEN x0, long d);
@@ -1432,9 +1435,9 @@ void check_quaddisc_imag(GEN x, long *r, const char *f);
void check_quaddisc_real(GEN x, long *r, const char *f);
long cornacchia(GEN d, GEN p, GEN *px, GEN *py);
long cornacchia2(GEN d, GEN p, GEN *px, GEN *py);
-GEN nucomp(GEN x, GEN y, GEN l);
-GEN nudupl(GEN x, GEN l);
-GEN nupow(GEN x, GEN n);
+GEN nucomp(GEN x, GEN y, GEN L);
+GEN nudupl(GEN x, GEN L);
+GEN nupow(GEN x, GEN n, GEN L);
GEN primeform(GEN x, GEN p, long prec);
GEN primeform_u(GEN x, ulong p);
GEN qfbcompraw(GEN x, GEN y);
@@ -1963,18 +1966,20 @@ GEN gen_powu(GEN x, ulong n, void *E, GEN (*sqr)(void*,GEN), GEN (*mul)(void*,GE
GEN gen_powu_i(GEN x, ulong n, void *E, GEN (*sqr)(void*,GEN), GEN (*mul)(void*,GEN,GEN));
GEN gen_powu_fold(GEN x, ulong n, void *E, GEN (*sqr)(void*,GEN), GEN (*msqr)(void*,GEN));
GEN gen_powu_fold_i(GEN x, ulong n, void *E, GEN (*sqr)(void*,GEN), GEN (*msqr)(void*,GEN));
+GEN gen_product(GEN x, void *data, GEN (*mul)(void*,GEN,GEN));
/* bibli1.c */
int QR_init(GEN x, GEN *pB, GEN *pQ, GEN *pL, long prec);
GEN R_from_QR(GEN x, long prec);
+GEN RgM_Babai(GEN B, GEN t);
int RgM_QR_init(GEN x, GEN *pB, GEN *pQ, GEN *pL, long prec);
+GEN RgM_gram_schmidt(GEN e, GEN *ptB);
GEN Xadic_lindep(GEN x);
GEN algdep(GEN x, long n);
GEN algdep0(GEN x, long n, long bit);
void forqfvec0(GEN a, GEN BORNE, GEN code);
GEN gaussred_from_QR(GEN x, long prec);
-GEN gram_schmidt(GEN e, GEN *ptB);
GEN lindep0(GEN x, long flag);
GEN lindep(GEN x);
GEN lindep2(GEN x, long bit);
@@ -2278,6 +2283,10 @@ GEN ellsearch(GEN A);
GEN ellsearchcurve(GEN name);
void forell(void *E, long call(void*, GEN), long a, long b);
+/* ellfromeqn.c */
+
+GEN ellfromeqn(GEN s);
+
/* elliptic.c */
enum { t_ELL_Rg = 0, t_ELL_Q, t_ELL_Qp, t_ELL_Fp, t_ELL_Fq, t_ELL_NF };
long ellQ_get_CM(GEN e);
@@ -2517,9 +2526,11 @@ enum { br_NONE = 0, br_BREAK, br_NEXT, br_MULTINEXT, br_RETURN };
void bincopy_relink(GEN C, GEN vi);
GEN break0(long n);
GEN closure_callgen1(GEN C, GEN x);
+GEN closure_callgen1prec(GEN C, GEN x, long prec);
GEN closure_callgen2(GEN C, GEN x, GEN y);
GEN closure_callgenall(GEN C, long n, ...);
GEN closure_callgenvec(GEN C, GEN args);
+GEN closure_callgenvecprec(GEN C, GEN args, long prec);
void closure_callvoid1(GEN C, GEN x);
long closure_context(long start, long level);
void closure_disassemble(GEN n);
@@ -2534,11 +2545,13 @@ GEN copybin_unlink(GEN C);
GEN get_lex(long vn);
long get_localprec(void);
GEN gp_call(void *E, GEN x);
+GEN gp_callprec(void *E, GEN x, long prec);
GEN gp_call2(void *E, GEN x, GEN y);
long gp_callbool(void *E, GEN x);
long gp_callvoid(void *E, GEN x);
GEN gp_eval(void *E, GEN x);
long gp_evalbool(void *E, GEN x);
+GEN gp_evalprec(void *E, GEN x, long prec);
GEN gp_evalupto(void *E, GEN x);
long gp_evalvoid(void *E, GEN x);
void localprec(long p);
@@ -2736,9 +2749,13 @@ int gsigne(GEN x);
GEN gtolist(GEN x);
long gtolong(GEN x);
int lexcmp(GEN x, GEN y);
+GEN listcreate_typ(long t);
+GEN listcreate(void);
GEN listinsert(GEN list, GEN object, long index);
void listpop(GEN L, long index);
+void listpop0(GEN L, long index);
GEN listput(GEN list, GEN object, long index);
+GEN listput0(GEN list, GEN object, long index);
void listsort(GEN list, long flag);
GEN matsize(GEN x);
GEN mklistcopy(GEN x);
@@ -2882,6 +2899,7 @@ GEN polcoeff_i(GEN x, long n, long v);
long poldegree(GEN x,long v);
long RgX_degree(GEN x,long v);
GEN poleval(GEN x, GEN y);
+GEN RgX_cxeval(GEN T, GEN u, GEN ui);
GEN pollead(GEN x,long v);
long precision(GEN x);
GEN precision0(GEN x,long n);
@@ -3109,22 +3127,19 @@ void traverseheap( void(*f)(GEN, void *), void *data );
/* intnum.c */
+GEN contfraceval(GEN CF, GEN t, long nlim);
+GEN contfracinit(GEN M, long lim);
GEN intcirc(void *E, GEN (*eval) (void *, GEN), GEN a, GEN R, GEN tab, long prec);
-GEN intfouriercos(void *E, GEN (*eval) (void *, GEN), GEN a, GEN b, GEN x, GEN tab, long prec);
-GEN intfourierexp(void *E, GEN (*eval)(void *, GEN), GEN a, GEN b, GEN x, GEN tab, long prec);
-GEN intfouriersin(void *E, GEN (*eval) (void *, GEN), GEN a, GEN b, GEN x, GEN tab, long prec);
-GEN intfuncinit(void *E, GEN (*eval) (void *, GEN), GEN a, GEN b, long m, long flag, long prec);
-GEN intlaplaceinv(void *E, GEN (*eval) (void *, GEN), GEN sig, GEN x, GEN tab, long prec);
-GEN intmellininv(void *E, GEN (*eval) (void *, GEN), GEN sig, GEN x, GEN tab, long prec);
-GEN intmellininvshort(GEN sig, GEN x, GEN tab, long prec);
+GEN intfuncinit(void *E, GEN (*eval) (void *, GEN), GEN a, GEN b, long m, long prec);
GEN intnum(void *E, GEN (*eval) (void *, GEN), GEN a, GEN b, GEN tab, long prec);
+GEN intnumgauss(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN tab, long prec);
+GEN intnumgaussinit(long n, long prec);
GEN intnuminit(GEN a, GEN b, long m, long prec);
-GEN intnuminitgen(void *E, GEN (*eval) (void *, GEN), GEN a, GEN b, long m, long flext, long prec);
GEN intnumromb(void *E, GEN (*eval) (void *, GEN), GEN a, GEN b, long flag, long prec);
-long intnumstep(long prec);
-GEN sumnum(void *E, GEN (*f) (void *, GEN), GEN a, GEN sig, GEN tab, long flag, long prec);
-GEN sumnumalt(void *E, GEN (*f) (void *, GEN), GEN a, GEN s, GEN tab, long flag, long prec);
-GEN sumnuminit(GEN sig, long m, long sgn, long prec);
+GEN sumnum(void *E, GEN (*eval)(void*, GEN), GEN a, GEN tab, long prec);
+GEN sumnuminit(GEN fast, long prec);
+GEN sumnummonien(void *E, GEN (*eval)(void*, GEN), GEN a, GEN tab, long prec);
+GEN sumnummonieninit(GEN asymp, GEN w, GEN n0, long prec);
/* krasner.c */
@@ -3155,6 +3170,28 @@ GEN matkerint0(GEN x,long flag);
GEN qflll0(GEN x, long flag);
GEN qflllgram0(GEN x, long flag);
+/* map.c */
+
+GEN gtomap(GEN M);
+void mapdelete(GEN T, GEN a);
+GEN mapdomain(GEN T);
+GEN mapdomain_shallow(GEN T);
+GEN mapget(GEN T, GEN a);
+int mapisdefined(GEN T, GEN a, GEN *pt_z);
+void mapput(GEN T, GEN a, GEN b);
+GEN maptomat(GEN T);
+GEN maptomat_shallow(GEN T);
+
+/* mellininv.c */
+
+GEN gammamellininv(GEN Vga, GEN s, long m, long prec);
+GEN gammamellininv_bitprec(GEN Vga, GEN s, long m, long bitprec);
+GEN gammamellininvasymp(GEN Vga, long nlimmax, long m);
+GEN gammamellininvinit(GEN Vga, long m, long prec);
+GEN gammamellininvinit_bitprec(GEN Vga, long m, long bitprec);
+GEN gammamellininvrt(GEN K, GEN x, long prec);
+GEN gammamellininvrt_bitprec(GEN K, GEN s, long bitprec);
+
/* members.c */
GEN member_a1(GEN x);
@@ -3435,8 +3472,6 @@ GEN centermod_i(GEN x, GEN p, GEN ps2);
GEN centermodii(GEN x, GEN p, GEN po2);
GEN content(GEN x);
GEN deg1_from_roots(GEN L, long v);
-GEN divide_conquer_assoc(GEN x, void *data, GEN (*mul)(void*,GEN,GEN));
-GEN divide_conquer_prod(GEN x, GEN (*mul)(GEN,GEN));
GEN factor(GEN x);
GEN factor0(GEN x,long flag);
GEN factorback(GEN fa);
@@ -3667,8 +3702,9 @@ GEN bnrstark(GEN bnr, GEN subgroup, long prec);
/* sumiter.c */
-GEN derivnum(void *E, GEN (*eval)(void *, GEN), GEN x, long prec);
-GEN derivfun(void *E, GEN (*eval)(void *, GEN), GEN x, long prec);
+GEN asympnum(void *E, GEN (*f)(void *,GEN,long), long muli, GEN alpha, long prec);
+GEN derivnum(void *E, GEN (*eval)(void *, GEN, long prec), GEN x, long prec);
+GEN derivfun(void *E, GEN (*eval)(void *, GEN, long prec), GEN x, long prec);
GEN direuler(void *E, GEN (*eval)(void *, GEN), GEN ga, GEN gb, GEN c);
int forcomposite_init(forcomposite_t *C, GEN a, GEN b);
GEN forcomposite_next(forcomposite_t *C);
@@ -3676,6 +3712,7 @@ GEN forprime_next(forprime_t *T);
int forprime_init(forprime_t *T, GEN a, GEN b);
int forvec_init(forvec_t *T, GEN x, long flag);
GEN forvec_next(forvec_t *T);
+GEN limitnum(void *E, GEN (*f)(void *,GEN,long), long muli, GEN alpha, long prec);
GEN polzag(long n, long m);
GEN prodeuler(void *E, GEN (*eval)(void *, GEN), GEN ga, GEN gb, long prec);
GEN prodinf(void *E, GEN (*eval)(void *, GEN), GEN a, long prec);
@@ -3721,6 +3758,7 @@ GEN expIr(GEN x);
GEN exp1r_abs(GEN x);
GEN gcos(GEN x, long prec);
GEN gcotan(GEN x, long prec);
+GEN gcotanh(GEN x, long prec);
GEN gexp(GEN x, long prec);
GEN gexpm1(GEN x, long prec);
GEN glog(GEN x, long prec);
@@ -3728,6 +3766,7 @@ GEN gpow(GEN x, GEN n, long prec);
GEN gpowers(GEN x, long n);
GEN gpowgs(GEN x, long n);
GEN gsin(GEN x, long prec);
+GEN gsinc(GEN x, long prec);
void gsincos(GEN x, GEN *s, GEN *c, long prec);
GEN gsqrt(GEN x, long prec);
GEN gsqrtn(GEN x, GEN n, GEN *zetan, long prec);
@@ -3788,6 +3827,7 @@ GEN sumformal(GEN T, long v);
/* trans3.c */
+double dblmodulus(GEN x);
GEN dilog(GEN x, long prec);
GEN eint1(GEN x, long prec);
GEN eta(GEN x, long prec);
@@ -3822,11 +3862,11 @@ GEN u_sumdedekind_coprime(long h, long k);
GEN veceint1(GEN nmax, GEN C, long prec);
GEN vecthetanullk(GEN q, long k, long prec);
GEN vecthetanullk_tau(GEN tau, long k, long prec);
+GEN veczeta(GEN a, GEN b, long N, long prec);
GEN weber0(GEN x, long flag,long prec);
GEN weberf(GEN x, long prec);
GEN weberf1(GEN x, long prec);
GEN weberf2(GEN x, long prec);
-GEN zetaBorweinRecycled(long s, long h, long N, long prec);
/* modsym.c */
GEN Eisenstein_symbol(GEN W, GEN c);
@@ -3852,6 +3892,9 @@ GEN msstar(GEN W, GEN);
GEN msqexpansion(GEN W, GEN proV, ulong B);
GEN mssplit(GEN W, GEN H);
+/* zetamult.c */
+GEN zetamult(GEN avec, long prec);
+
/* level1.h */
INLINE ulong Fl_add(ulong a, ulong b, ulong p);
@@ -4447,6 +4490,7 @@ INLINE GEN leading_term(GEN x);
INLINE long lgcols(GEN x);
INLINE long lgpol(GEN x);
INLINE GEN matpascal(long n);
+INLINE GEN matslice(GEN A, long x1, long x2, long y1, long y2);
INLINE GEN mkcol(GEN x);
INLINE GEN mkcol2(GEN x, GEN y);
INLINE GEN mkcol2s(long x, long y);
@@ -4538,9 +4582,9 @@ INLINE GEN quadnorm(GEN q);
INLINE long remsBIL(long n);
INLINE GEN resultant(GEN x, GEN y);
INLINE GEN row(GEN A, long x1);
-INLINE GEN row_Flm(GEN A, long x0);
+INLINE GEN Flm_row(GEN A, long x0);
INLINE GEN row_i(GEN A, long x0, long x1, long x2);
-INLINE GEN row_zm(GEN x, long i);
+INLINE GEN zm_row(GEN x, long i);
INLINE GEN rowcopy(GEN A, long x0);
INLINE GEN rowpermute(GEN A, GEN p);
INLINE GEN rowslice(GEN A, long x1, long x2);
diff --git a/src/headers/parierr.h b/src/headers/parierr.h
index b20b566..cdd207f 100644
--- a/src/headers/parierr.h
+++ b/src/headers/parierr.h
@@ -37,4 +37,4 @@ enum err_list {
e_NONE
};
-enum { warner, warnprec, warnfile, warnmem, warnuser };
+enum { warner, warnprec, warnfile, warnmem, warnuser, warnstack };
diff --git a/src/headers/parigen.h b/src/headers/parigen.h
index 68db00c..4e5d123 100644
--- a/src/headers/parigen.h
+++ b/src/headers/parigen.h
@@ -140,8 +140,14 @@ typedef unsigned long pari_ulong;
(((ulong*)(x))[1]&(~VARNBITS)) | (ulong)evalvarn(s))
/* t_LIST */
-#define list_nmax(x) x[1]
+
+#define list_typ(x) ((long)(((ulong)((x)[1])) >> TYPSHIFT))
+#define list_nmax(x) ((long)(((ulong)((x)[1])) & LGBITS))
#define list_data(x) ((GEN*)x)[2]
+enum {
+ t_LIST_RAW = 0,
+ t_LIST_MAP = 1
+};
/* DO NOT REORDER THESE
* actual values can be changed. Adapt lontyp in gen2.c */
diff --git a/src/headers/pariinl.h b/src/headers/pariinl.h
index d4d5a00..f1c896c 100644
--- a/src/headers/pariinl.h
+++ b/src/headers/pariinl.h
@@ -841,6 +841,12 @@ rowslice(GEN A, long x1, long x2)
return B;
}
+INLINE GEN
+matslice(GEN A, long x1, long x2, long y1, long y2)
+{
+ return rowslice(vecslice(A, y1, y2), x1, x2);
+}
+
/* shallow, remove coeff of index j */
INLINE GEN
vecsplice(GEN a, long j)
@@ -873,7 +879,7 @@ row(GEN A, long x0)
return B;
}
INLINE GEN
-row_Flm(GEN A, long x0)
+Flm_row(GEN A, long x0)
{
long i, lB = lg(A);
GEN B = cgetg(lB, t_VECSMALL);
@@ -1211,9 +1217,9 @@ bin_copy(GENbin *p)
y = (GEN)memcpy((void*)new_chunk(len), (void*)GENbinbase(p), len*sizeof(long));
y += dx;
if (p->canon)
- shiftaddress_canon(y, (y-x)*sizeof(long));
+ shiftaddress_canon(y, ((ulong)y-(ulong)x));
else
- shiftaddress(y, (y-x)*sizeof(long));
+ shiftaddress(y, ((ulong)y-(ulong)x));
pari_free(p); return y;
}
@@ -2039,7 +2045,7 @@ zm_copy(GEN x) { return Flm_copy(x); }
INLINE GEN
zv_copy(GEN x) { return Flv_copy(x); }
INLINE GEN
-row_zm(GEN x, long i) { return row_Flm(x,i); }
+zm_row(GEN x, long i) { return Flm_row(x,i); }
INLINE GEN
ZC_hnfrem(GEN x, GEN y) { return ZC_hnfremdiv(x,y,NULL); }
diff --git a/src/headers/paripriv.h b/src/headers/paripriv.h
index b820ea6..9bc3c41 100644
--- a/src/headers/paripriv.h
+++ b/src/headers/paripriv.h
@@ -86,6 +86,7 @@ GEN gsube(GEN *x, GEN y);
GEN gsub1e(GEN *x);
GEN gshift_right(GEN x, long n);
+GEN asympnum0(GEN u, long muli, GEN alpha, long prec);
GEN derivnum0(GEN a, GEN code, long prec);
GEN derivfun0(GEN code, GEN args, long prec);
GEN direuler0(GEN a, GEN b, GEN code, GEN c);
@@ -98,15 +99,11 @@ void forsubgroup0(GEN cyc, GEN bound, GEN code);
void forvec(GEN x, GEN code, long flag);
void forpart0(GEN k, GEN code , GEN nbound, GEN abound);
GEN intcirc0(GEN a, GEN R, GEN code, GEN tab, long prec);
-GEN intfourcos0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec);
-GEN intfourexp0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec);
-GEN intfoursin0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec);
-GEN intfuncinit0(GEN a, GEN b, GEN code, long flag, long m, long prec);
-GEN intlaplaceinv0(GEN sig, GEN x, GEN code, GEN tab, long prec);
-GEN intmellininv0(GEN sig, GEN x, GEN code, GEN tab, long prec);
+GEN intfuncinit0(GEN a, GEN b, GEN code, long m, long prec);
GEN intnum0(GEN a, GEN b, GEN code, GEN tab, long prec);
-GEN intnuminitgen0(GEN a, GEN b, GEN code, long m, long flag, long prec);
+GEN intnumgauss0(GEN a, GEN b, GEN code, GEN tab, long prec);
GEN intnumromb0(GEN a, GEN b, GEN code, long flag, long prec);
+GEN limitnum0(GEN u, long muli, GEN alpha, long prec);
GEN matrice(GEN nlig, GEN ncol, GEN code);
GEN prodeuler0(GEN a, GEN b, GEN code, long prec);
GEN prodinf0(GEN a, GEN code, long flag, long prec);
@@ -116,8 +113,8 @@ GEN sumalt0(GEN a, GEN code,long flag, long prec);
GEN sumdivexpr(GEN num, GEN code);
GEN sumdivmultexpr(GEN num, GEN code);
GEN suminf0(GEN a, GEN code, long prec);
-GEN sumnum0(GEN a, GEN sig, GEN code, GEN tab, long flag, long prec);
-GEN sumnumalt0(GEN a, GEN sig, GEN code, GEN tab, long flag, long prec);
+GEN sumnum0(GEN a, GEN code, GEN tab, long prec);
+GEN sumnummonien0(GEN a, GEN code, GEN tab, long prec);
GEN sumpos0(GEN a, GEN code, long flag,long prec);
GEN vecexpr0(GEN nmax, GEN code, GEN pred);
GEN vecexpr1(GEN nmax, GEN code, GEN pred);
@@ -307,6 +304,7 @@ void random_curves_with_m_torsion(
long ncurves, long m, ulong p);
/* Allocation / gerepile */
+long getdebugvar(void);
void setdebugvar(long n);
void debug_stack(void);
void fill_stack(void);
diff --git a/src/headers/paritune.h b/src/headers/paritune.h
index acb0d02..ea819d7 100644
--- a/src/headers/paritune.h
+++ b/src/headers/paritune.h
@@ -11,7 +11,10 @@ extern long Flx_BARRETT_MULII_LIMIT;
extern long Flx_DIVREM_BARRETT_LIMIT;
extern long Flx_EXTGCD_LIMIT;
extern long Flx_GCD_LIMIT;
-extern long Flx_HALFGCD_LIMIT;
+extern long Flx_HALFGCD_KARATSUBA_LIMIT;
+extern long Flx_HALFGCD_HALFMULII_LIMIT;
+extern long Flx_HALFGCD_MULII2_LIMIT;
+extern long Flx_HALFGCD_MULII_LIMIT;
extern long Flx_INVBARRETT_HALFMULII_LIMIT;
extern long Flx_INVBARRETT_KARATSUBA_LIMIT;
extern long Flx_INVBARRETT_MULII2_LIMIT;
@@ -56,7 +59,10 @@ extern long SQRI_KARATSUBA_LIMIT;
# define Flx_DIVREM_BARRETT_LIMIT __Flx_DIVREM_BARRETT_LIMIT
# define Flx_EXTGCD_LIMIT __Flx_EXTGCD_LIMIT
# define Flx_GCD_LIMIT __Flx_GCD_LIMIT
-# define Flx_HALFGCD_LIMIT __Flx_HALFGCD_LIMIT
+# define Flx_HALFGCD_KARATSUBA_LIMIT __Flx_HALFGCD_KARATSUBA_LIMIT
+# define Flx_HALFGCD_HALFMULII_LIMIT __Flx_HALFGCD_HALFMULII_LIMIT
+# define Flx_HALFGCD_MULII2_LIMIT __Flx_HALFGCD_MULII2_LIMIT
+# define Flx_HALFGCD_MULII_LIMIT __Flx_HALFGCD_MULII_LIMIT
# define Flx_INVBARRETT_HALFMULII_LIMIT __Flx_INVBARRETT_HALFMULII_LIMIT
# define Flx_INVBARRETT_KARATSUBA_LIMIT __Flx_INVBARRETT_KARATSUBA_LIMIT
# define Flx_INVBARRETT_MULII2_LIMIT __Flx_INVBARRETT_MULII2_LIMIT
diff --git a/src/kernel/gmp/tune.h b/src/kernel/gmp/tune.h
index 89d037c..1535103 100644
--- a/src/kernel/gmp/tune.h
+++ b/src/kernel/gmp/tune.h
@@ -9,7 +9,10 @@
#define __Flx_DIVREM_BARRETT_LIMIT 768
#define __Flx_EXTGCD_LIMIT 241
#define __Flx_GCD_LIMIT 1017
-#define __Flx_HALFGCD_LIMIT 81
+#define __Flx_HALFGCD_HALFMULII_LIMIT 48
+#define __Flx_HALFGCD_KARATSUBA_LIMIT 77
+#define __Flx_HALFGCD_MULII2_LIMIT 25
+#define __Flx_HALFGCD_MULII_LIMIT 71
#define __Flx_INVBARRETT_HALFMULII_LIMIT 231
#define __Flx_INVBARRETT_KARATSUBA_LIMIT 5067
#define __Flx_INVBARRETT_MULII2_LIMIT 26
@@ -54,7 +57,10 @@
#define __Flx_DIVREM_BARRETT_LIMIT 1289
#define __Flx_EXTGCD_LIMIT 632
#define __Flx_GCD_LIMIT 2514
-#define __Flx_HALFGCD_LIMIT 321
+#define __Flx_HALFGCD_HALFMULII_LIMIT 78
+#define __Flx_HALFGCD_KARATSUBA_LIMIT 139
+#define __Flx_HALFGCD_MULII2_LIMIT 537
+#define __Flx_HALFGCD_MULII_LIMIT 91
#define __Flx_INVBARRETT_HALFMULII_LIMIT 240
#define __Flx_INVBARRETT_KARATSUBA_LIMIT 3600
#define __Flx_INVBARRETT_MULII2_LIMIT 1815
diff --git a/src/kernel/none/add.c b/src/kernel/none/add.c
index cc3314e..2576d2b 100644
--- a/src/kernel/none/add.c
+++ b/src/kernel/none/add.c
@@ -37,7 +37,7 @@ addsi_sign(long x, GEN y, long sy)
ly=lgefint(y);
if (ly==3)
{
- const long d = y[2] - x;
+ const long d = (long)(uel(y,2) - (ulong)x);
if (!d) return gen_0;
z=cgeti(3);
if (y[2] < 0 || d > 0) {
diff --git a/src/kernel/none/tune-gen.h b/src/kernel/none/tune-gen.h
index 8cf5c99..64d74b8 100644
--- a/src/kernel/none/tune-gen.h
+++ b/src/kernel/none/tune-gen.h
@@ -9,7 +9,10 @@ long Flx_BARRETT_MULII_LIMIT = __Flx_BARRETT_MULII_LIMIT;
long Flx_DIVREM_BARRETT_LIMIT = __Flx_DIVREM_BARRETT_LIMIT;
long Flx_EXTGCD_LIMIT = __Flx_EXTGCD_LIMIT;
long Flx_GCD_LIMIT = __Flx_GCD_LIMIT;
-long Flx_HALFGCD_LIMIT = __Flx_HALFGCD_LIMIT;
+long Flx_HALFGCD_KARATSUBA_LIMIT = __Flx_HALFGCD_KARATSUBA_LIMIT;
+long Flx_HALFGCD_HALFMULII_LIMIT = __Flx_HALFGCD_HALFMULII_LIMIT;
+long Flx_HALFGCD_MULII2_LIMIT = __Flx_HALFGCD_MULII2_LIMIT;
+long Flx_HALFGCD_MULII_LIMIT = __Flx_HALFGCD_MULII_LIMIT;
long Flx_INVBARRETT_HALFMULII_LIMIT = __Flx_INVBARRETT_HALFMULII_LIMIT;
long Flx_INVBARRETT_KARATSUBA_LIMIT = __Flx_INVBARRETT_KARATSUBA_LIMIT;
long Flx_INVBARRETT_MULII2_LIMIT = __Flx_INVBARRETT_MULII2_LIMIT;
diff --git a/src/kernel/none/tune.h b/src/kernel/none/tune.h
index eadc650..315a29f 100644
--- a/src/kernel/none/tune.h
+++ b/src/kernel/none/tune.h
@@ -9,7 +9,10 @@
#define __Flx_DIVREM_BARRETT_LIMIT 2804
#define __Flx_EXTGCD_LIMIT 284
#define __Flx_GCD_LIMIT 1890
-#define __Flx_HALFGCD_LIMIT 80
+#define __Flx_HALFGCD_HALFMULII_LIMIT 60
+#define __Flx_HALFGCD_KARATSUBA_LIMIT 58
+#define __Flx_HALFGCD_MULII2_LIMIT 64
+#define __Flx_HALFGCD_MULII_LIMIT 90
#define __Flx_INVBARRETT_HALFMULII_LIMIT 424
#define __Flx_INVBARRETT_KARATSUBA_LIMIT 5120
#define __Flx_INVBARRETT_MULII2_LIMIT 36
@@ -54,7 +57,10 @@
#define __Flx_DIVREM_BARRETT_LIMIT 3942
#define __Flx_EXTGCD_LIMIT 850
#define __Flx_GCD_LIMIT 7165
-#define __Flx_HALFGCD_LIMIT 232
+#define __Flx_HALFGCD_HALFMULII_LIMIT 116
+#define __Flx_HALFGCD_KARATSUBA_LIMIT 230
+#define __Flx_HALFGCD_MULII2_LIMIT 1045
+#define __Flx_HALFGCD_MULII_LIMIT 168
#define __Flx_INVBARRETT_HALFMULII_LIMIT 898
#define __Flx_INVBARRETT_KARATSUBA_LIMIT 3471
#define __Flx_INVBARRETT_MULII2_LIMIT 3672
diff --git a/src/language/anal.h b/src/language/anal.h
index 054845b..d17f681 100644
--- a/src/language/anal.h
+++ b/src/language/anal.h
@@ -22,6 +22,7 @@ BEGINEXTERN
{ GEN z; GEN __E = code; \
push_lex(gen_0, __E); z = call; pop_lex(1); return z; }
#define EXPR_ARG __E, &gp_eval
+#define EXPR_ARGPREC __E, &gp_evalprec
#define EXPR_ARGUPTO __E, &gp_evalupto
#define EXPR_ARGBOOL __E, &gp_evalbool
diff --git a/src/language/es.c b/src/language/es.c
index 5482bb1..417107b 100644
--- a/src/language/es.c
+++ b/src/language/es.c
@@ -730,23 +730,27 @@ absrtostr(GEN x, int sp, char FORMAT, long wanted_dec)
}
/* '.', " E", exponent, trailing \0 */
- buf0 = buf = stack_malloc( ls + 1+2+MAX_EXPO_LEN+1 );
point = ls - beta; /* position of . in s; < 0 or > 0 */
if (beta <= 0 || format == 'e' || (format == 'g' && point-1 < -4))
{ /* e format */
+ buf0 = buf = stack_malloc(ls+1+2+MAX_EXPO_LEN + 1);
wr_dec(buf, s, 1); buf += ls + 1;
if (sp) *buf++ = ' ';
*buf++ = exp_char;
sprintf(buf, "%ld", point-1);
- } else { /* f format */
- if (point > 0) /* write integer_part.fractional_part */
- wr_dec(buf, s, point); /* point < ls since beta > 0 */
- else { /* point <= 0, write fractional part */
- *buf++ = '0';
- *buf++ = '.';
- buf = zeros(buf, -point);
- strcpy(buf, s);
- }
+ }
+ else if (point > 0) /* f format, write integer_part.fractional_part */
+ {
+ buf0 = buf = stack_malloc(ls+1 + 1);
+ wr_dec(buf, s, point); /* point < ls since beta > 0 */
+ }
+ else /* f format, point <= 0, write fractional part */
+ {
+ buf0 = buf = stack_malloc(2-point+ls + 1);
+ *buf++ = '0';
+ *buf++ = '.';
+ buf = zeros(buf, -point);
+ strcpy(buf, s);
}
return buf0;
}
@@ -1897,7 +1901,8 @@ str_absint(outString *S, GEN x)
#define putsigne_nosp(S, x) str_putc(S, (x>0)? '+' : '-')
#define putsigne(S, x) str_puts(S, (x>0)? " + " : " - ")
#define sp_sign_sp(T,S, x) ((T)->sp? putsigne(S,x): putsigne_nosp(S,x))
-#define comma_sp(T,S) ((T)->sp? str_puts(S, ", "): str_putc(S, ','))
+#define semicolon_sp(T,S) ((T)->sp? str_puts(S, "; "): str_putc(S, ';'))
+#define comma_sp(T,S) ((T)->sp? str_puts(S, ", "): str_putc(S, ','))
/* print e to S (more efficient than sprintf) */
static void
@@ -2058,7 +2063,7 @@ dbg(GEN x, long nb, long bl)
vsigne(x), varn(x), lg(x)-2, valp(x));
else if (tx == t_LIST)
{
- pari_printf("(lmax=%ld):", list_nmax(x));
+ pari_printf("(subtyp=%ld,lmax=%ld):", list_typ(x), list_nmax(x));
x = list_data(x); lx = x? lg(x): 1;
tx = t_VEC; /* print list_data as vec */
} else if (tx == t_CLOSURE)
@@ -2847,16 +2852,29 @@ bruti_intern(GEN g, pariout_t *T, outString *S, int addsign)
case t_VECSMALL: wr_vecsmall(T,S,g); break;
case t_LIST:
- str_puts(S, "List([");
- g = list_data(g);
- l = g? lg(g): 1;
- for (i=1; i<l; i++)
+ switch (list_typ(g))
{
- bruti(gel(g,i),T,S);
- if (i<l-1) comma_sp(T,S);
+ case t_LIST_RAW:
+ str_puts(S, "List([");
+ g = list_data(g);
+ l = g? lg(g): 1;
+ for (i=1; i<l; i++)
+ {
+ bruti(gel(g,i),T,S);
+ if (i<l-1) comma_sp(T,S);
+ }
+ str_puts(S, "])"); break;
+ case t_LIST_MAP:
+ {
+ pari_sp av;
+ str_puts(S, "Map(");
+ av = avma;
+ bruti(maptomat_shallow(g),T,S);
+ avma = av;
+ str_puts(S, ")"); break;
+ }
}
- str_puts(S, "])"); break;
-
+ break;
case t_STR:
quote_string(S, GSTR(g)); break;
case t_ERROR:
@@ -2923,7 +2941,7 @@ bruti_intern(GEN g, pariout_t *T, outString *S, int addsign)
print(gcoeff(g,i,j),T,S);
if (j<r-1) comma_sp(T,S);
}
- if (i<l-1) { str_putc(S, ';'); if (T->sp) str_putc(S, ' '); }
+ if (i<l-1) semicolon_sp(T,S);
}
str_putc(S, ']'); if (l==2) str_putc(S, ')');
break;
@@ -3114,15 +3132,26 @@ texi_sign(GEN g, pariout_t *T, outString *S, int addsign)
str_puts(S, "\\cr}\n"); break;
case t_LIST:
- str_puts(S, "\\pmatrix{ ");
- g = list_data(g);
- l = g? lg(g): 1;
- for (i=1; i<l; i++)
+ switch(list_typ(g))
{
- texi(gel(g,i),T,S); if (i < l-1) str_putc(S, '&');
+ case t_LIST_RAW:
+ str_puts(S, "\\pmatrix{ ");
+ g = list_data(g);
+ l = g? lg(g): 1;
+ for (i=1; i<l; i++)
+ {
+ texi(gel(g,i),T,S); if (i < l-1) str_putc(S, '&');
+ }
+ str_puts(S, "\\cr}\n"); break;
+ case t_LIST_MAP:
+ {
+ pari_sp av = avma;
+ texi(maptomat_shallow(g),T,S);
+ avma = av;
+ break;
+ }
}
- str_puts(S, "\\cr}\n"); break;
-
+ break;
case t_COL:
str_puts(S, "\\pmatrix{ "); l = lg(g);
for (i=1; i<l; i++)
diff --git a/src/language/eval.c b/src/language/eval.c
index 94d2481..6048453 100644
--- a/src/language/eval.c
+++ b/src/language/eval.c
@@ -283,7 +283,7 @@ GEN*
safelistel(GEN x, long l)
{
GEN d;
- if (typ(x)!=t_LIST)
+ if (typ(x)!=t_LIST || list_typ(x)!=t_LIST_RAW)
pari_err_TYPE("safelistel",x);
d = list_data(x);
check_array_index(l, lg(d));
@@ -1049,6 +1049,8 @@ closure_eval(GEN C)
case t_LIST:
{
long lx;
+ if (list_typ(p)!=t_LIST_RAW)
+ pari_err_TYPE("_[_] OCcompo1 [not a vector]", p);
p = list_data(p); lx = p? lg(p): 1;
check_array_index(c, lx);
closure_castgen(gel(p,c),operand);
@@ -1085,6 +1087,8 @@ closure_eval(GEN C)
g->x = stoi(p[c]);
break;
case t_LIST:
+ if (list_typ(p)!=t_LIST_RAW)
+ pari_err_TYPE("&_[_] OCcompo1 [not a vector]", p);
p = list_data(p); lx = p? lg(p): 1;
check_array_index(c,lx);
C->ptcell = (GEN *) p+c;
@@ -1770,6 +1774,19 @@ closure_callgen1(GEN C, GEN x)
}
GEN
+closure_callgen1prec(GEN C, GEN x, long prec)
+{
+ GEN z;
+ long i, ar = closure_arity(C);
+ gel(st,sp++) = x;
+ for(i=2; i<= ar; i++) gel(st,sp++) = NULL;
+ push_localprec(prec);
+ z = closure_returnupto(C);
+ pop_localprec();
+ return z;
+}
+
+GEN
closure_callgen2(GEN C, GEN x, GEN y)
{
long i, ar = closure_arity(C);
@@ -1793,6 +1810,16 @@ closure_callgenvec(GEN C, GEN args)
}
GEN
+closure_callgenvecprec(GEN C, GEN args, long prec)
+{
+ GEN z;
+ push_localprec(prec);
+ z = closure_callgenvec(C, args);
+ pop_localprec();
+ return z;
+}
+
+GEN
closure_callgenall(GEN C, long n, ...)
{
va_list ap;
@@ -1822,6 +1849,16 @@ gp_evalupto(void *E, GEN x)
return copyupto(gp_eval(E,x), (GEN)av);
}
+GEN
+gp_evalprec(void *E, GEN x, long prec)
+{
+ GEN z;
+ push_localprec(prec);
+ z = gp_eval(E, x);
+ pop_localprec();
+ return z;
+}
+
long
gp_evalbool(void *E, GEN x)
{
@@ -1847,6 +1884,13 @@ gp_call(void *E, GEN x)
}
GEN
+gp_callprec(void *E, GEN x, long prec)
+{
+ GEN code = (GEN)E;
+ return closure_callgen1prec(code, x, prec);
+}
+
+GEN
gp_call2(void *E, GEN x, GEN y)
{
GEN code = (GEN)E;
diff --git a/src/language/gplib.c b/src/language/gplib.c
index 82ce33c..3e8ba20 100644
--- a/src/language/gplib.c
+++ b/src/language/gplib.c
@@ -253,7 +253,7 @@ gentypes(void)
t_VEC : row vector [ code ] [ x_1 ] ... [ x_k ]\n\
t_COL : column vector [ code ] [ x_1 ] ... [ x_k ]\n\
t_MAT : matrix [ code ] [ col_1 ] ... [ col_k ]\n\
- t_LIST : list [ code ] [ n ] [ nmax ][ vec ]\n\
+ t_LIST : list [ cod1 ] [ cod2 ][ vec ]\n\
t_STR : string [ code ] [ man_1 ] ... [ man_k ]\n\
t_VECSMALL: vec. small ints [ code ] [ x_1 ] ... [ x_k ]\n\
t_CLOSURE: functions [ code ] [ arity ] [ code ] [ operand ] [ data ] [ text ]\n\
diff --git a/src/language/init.c b/src/language/init.c
index ef0d5ee..44d58b8 100644
--- a/src/language/init.c
+++ b/src/language/init.c
@@ -661,13 +661,10 @@ pari_mainstack_alloc(struct pari_mainstack *st, size_t rsize, size_t vsize)
size_t sizemax = vsize ? vsize: rsize, s = fix_size(sizemax);
for (;; s>>=1)
{
- char buf[128];
if (s < MIN_STACK) pari_err(e_MEM); /* no way out. Die */
st->vbot = (pari_sp)pari_mainstack_malloc(s);
if (st->vbot) break;
- /* must use sprintf: pari stack is currently dead */
- sprintf(buf, "not enough memory, new stack %lu", (ulong)s);
- pari_warn(warner, buf, s);
+ pari_warn(warnstack, s>>1);
}
st->vsize = vsize ? s: 0;
st->rsize = minss(rsize, s);
@@ -1040,11 +1037,11 @@ err_init(void)
}
static void
-err_init_msg(int numerr, int user)
+err_init_msg(int user)
{
const char *gp_function_name;
out_puts(pariErr, " *** ");
- if (numerr != user && (gp_function_name = closure_func_err()))
+ if (!user && (gp_function_name = closure_func_err()))
out_printf(pariErr, "%s: ", gp_function_name);
else
out_puts(pariErr, " ");
@@ -1059,7 +1056,7 @@ pari_warn(int numerr, ...)
va_start(ap,numerr);
err_init();
- err_init_msg(numerr, warnuser);
+ err_init_msg(numerr==warnuser || numerr==warnstack);
switch (numerr)
{
case warnuser:
@@ -1087,6 +1084,16 @@ pari_warn(int numerr, ...)
ch1 = va_arg(ap, char*);
out_printf(pariErr, "%s: %s", ch1, va_arg(ap, char*));
break;
+
+ case warnstack:
+ {
+ ulong s = va_arg(ap, ulong);
+ char buf[128];
+ sprintf(buf,"Warning: not enough memory, new stack %lu", (ulong)s);
+ out_puts(pariErr,buf);
+ break;
+ }
+
}
va_end(ap);
out_term_color(pariErr, c_NONE);
@@ -1100,7 +1107,7 @@ pari_sigint(const char *time_s)
BLOCK_SIGALRM_START
err_init();
closure_err(0);
- err_init_msg(e_MISC, e_USER);
+ err_init_msg(0);
out_puts(pariErr, "user interrupt after ");
out_puts(pariErr, time_s);
out_term_color(pariErr, c_NONE);
@@ -1436,7 +1443,7 @@ pari_err_display(GEN err)
{
char *s = pari_err2str(err);
closure_err(0);
- err_init_msg(numerr, e_USER);
+ err_init_msg(numerr==e_USER);
pariErr->puts(s);
if (numerr==e_NOTFUNC)
{
@@ -1617,7 +1624,7 @@ listassign(GEN x, GEN y)
long nmax = list_nmax(x);
GEN L = list_data(x);
if (!nmax && L) nmax = lg(L) + 32; /* not malloc'ed yet */
- list_nmax(y) = nmax;
+ y[1] = evaltyp(list_typ(x))|evallg(nmax);
list_data(y) = list_internal_copy(L, nmax);
}
@@ -1627,6 +1634,7 @@ listcopy(GEN x)
{
GEN y = listcreate(), L = list_data(x);
if (L) list_data(y) = gcopy(L);
+ y[1] = evaltyp(list_typ(x));
return y;
}
@@ -1777,13 +1785,14 @@ gcopy_av0_canon(GEN x, pari_sp *AVMA)
/* one more special case */
case t_LIST:
{
+ long t = list_typ(x);
GEN y = cgetlist_avma(AVMA), z = list_data(x);
if (z) {
list_data(y) = gcopy_av0_canon(z, AVMA);
- list_nmax(y) = lg(z)-1;
+ y[1] = evaltyp(t)|evallg(lg(z)-1);
} else {
list_data(y) = NULL;
- list_nmax(y) = 0;
+ y[1] = evaltyp(t);
}
return y;
}
@@ -2249,6 +2258,9 @@ void
setdebugvar(long n) { DEBUGVAR=n; }
long
+getdebugvar(void) { return DEBUGVAR; }
+
+long
getstack(void) { return pari_mainstack->top-avma; }
/*******************************************************************/
diff --git a/src/language/init.h b/src/language/init.h
index d1efd15..2d4602a 100644
--- a/src/language/init.h
+++ b/src/language/init.h
@@ -14,6 +14,7 @@ entree functions_basic[]={
{"Euler",0,(void*)mpeuler,3,"p","Euler=Euler(): Euler's constant with current precision."},
{"I",0,(void*)gen_I,3,"","I=I(): square root of -1."},
{"List",0,(void*)gtolist,2,"DG","List({x=[]}): transforms the vector or list x into a list. Empty list if x is omitted."},
+{"Map",0,(void*)gtomap,2,"DG","Map({x}): convert the matrix [a_1,b_1;a_2,b_2;...;a_n,b_n] to the map a_i->b_i"},
{"Mat",0,(void*)gtomat,2,"DG","Mat({x=[]}): transforms any GEN x into a matrix. Empty matrix if x is omitted."},
{"Mod",0,(void*)gmodulo,2,"GG","Mod(a,b): creates 'a modulo b'."},
{"O",0,(void*)ggrando,9,"","O(p^e): p-adic or power series zero with precision given by e"},
@@ -199,6 +200,7 @@ entree functions_basic[]={
{"arg",0,(void*)garg,3,"Gp","arg(x): argument of x,such that -pi<arg(x)<=pi."},
{"asin",0,(void*)gasin,3,"Gp","asin(x): arc sine of x."},
{"asinh",0,(void*)gasinh,3,"Gp","asinh(x): inverse hyperbolic sine of x."},
+{"asympnum",0,(void*)asympnum0,11,"GD0,L,DGp","asympnum(expr,{k=20},{alpha = 1}): asymptotic expansion of expr assuming it has rational coefficients with reasonable height; k and alpha are as in extnum."},
{"atan",0,(void*)gatan,3,"Gp","atan(x): arc tangent of x."},
{"atanh",0,(void*)gatanh,3,"Gp","atanh(x): inverse hyperbolic tangent of x."},
{"bernfrac",0,(void*)bernfrac,3,"L","bernfrac(x): Bernoulli number B_x, as a rational number."},
@@ -265,12 +267,15 @@ entree functions_basic[]={
{"conjvec",0,(void*)conjvec,2,"Gp","conjvec(z): conjugate vector of the algebraic number z."},
{"content",0,(void*)content,4,"G","content(x): gcd of all the components of x, when this makes sense."},
{"contfrac",0,(void*)contfrac0,4,"GDGD0,L,","contfrac(x,{b},{nmax}): continued fraction expansion of x (x rational,real or rational function). b and nmax are both optional, where b is the vector of numerators of the continued fraction, and nmax is a bound for the number of terms in the continued fraction expansion."},
+{"contfraceval",0,(void*)contfraceval,11,"GGD-1,L,","contfraceval(CF,t,{lim=-1}): Given a continued fraction CF from contfracinit, evaluate the first lim terms of the continued fraction at t (all terms if lim is negative or omitted)."},
+{"contfracinit",0,(void*)contfracinit,11,"GD-1,L,","contfracinit(M,{lim = -1}): Given M representing the power series S = sum_{n>=0} M[n+1]z^n, transform it into a continued fraction suitable for evaluation."},
{"contfracpnqn",0,(void*)contfracpnqn,4,"GD-1,L,","contfracpnqn(x, {n=-1}): [p_n,p_{n-1}; q_n,q_{n-1}] corresponding to the continued fraction x. If n >= 0 is present, returns all convergents from p_0/q_0 up to p_n/q_n."},
{"core",0,(void*)core0,4,"GD0,L,","core(n,{flag=0}): unique squarefree integer d dividing n such that n/d is a square. If (optional) flag is non-null, output the two-component row vector [d,f], where d is the unique squarefree integer dividing n such that n/d=f^2 is a square."},
{"coredisc",0,(void*)coredisc0,4,"GD0,L,","coredisc(n,{flag=0}): discriminant of the quadratic field Q(sqrt(n)). If (optional) flag is non-null, output a two-component row vector [d,f], where d is the discriminant of the quadratic field Q(sqrt(n)) and n=df^2. f may be a half integer."},
{"cos",0,(void*)gcos,3,"Gp","cos(x): cosine of x."},
{"cosh",0,(void*)gcosh,3,"Gp","cosh(x): hyperbolic cosine of x."},
{"cotan",0,(void*)gcotan,3,"Gp","cotan(x): cotangent of x."},
+{"cotanh",0,(void*)gcotanh,3,"Gp","cotanh(x): hyperbolic cotangent of x."},
{"dbg_x",0,(void*)dbgGEN,13,"vGD-1,L,","dbg_x(A{,n}): print inner structure of A, complete if n is omitted, up to level n otherwise. Intended for debugging."},
{"default",0,(void*)default0,13,"DrDs","default({key},{val}): returns the current value of the default key. If val is present, set opt to val first. If no argument is given, print a list of all defaults as well as their values."},
{"denominator",0,(void*)denom,2,"G","denominator(x): denominator of x (or lowest common denominator in case of an array)."},
@@ -286,7 +291,7 @@ entree functions_basic[]={
{"divisors",0,(void*)divisors,4,"G","divisors(x): gives a vector formed by the divisors of x in increasing order."},
{"divrem",0,(void*)divrem,1,"GGDn","divrem(x,y,{v}): euclidean division of x by y giving as a 2-dimensional column vector the quotient and the remainder, with respect to v (to main variable if v is omitted)"},
{"eint1",0,(void*)veceint1,3,"GDGp","eint1(x,{n}): exponential integral E1(x). If n is present and x > 0, computes the vector of the first n values of the exponential integral E1(n.x)"},
-{"ellL1",0,(void*)ellL1,5,"GD0,L,p","ellL1(e, {r = 0}): returns the value at s=1 of the derivative of order r of the L-function of the elliptic curve e assuming that r is at most the order of vanishing of the function at s=1."},
+{"ellL1",0,(void*)ellL1,5,"GD0,L,p","ellL1(e, {r = 0}): returns the value at s=1 of the derivative of order r of the L-function of the elliptic curve e."},
{"elladd",0,(void*)elladd,5,"GGG","elladd(E,z1,z2): sum of the points z1 and z2 on elliptic curve E."},
{"ellak",0,(void*)akell,5,"GG","ellak(E,n): computes the n-th Fourier coefficient of the L-function of the elliptic curve E (assumed E is an integral model)."},
{"ellan",0,(void*)anell,5,"GL","ellan(E,n): computes the first n Fourier coefficients of the L-function of the elliptic curve E (n<2^24 on a 32-bit machine)."},
@@ -306,6 +311,7 @@ entree functions_basic[]={
{"ellformallog",0,(void*)ellformallog,5,"GDPDn","ellformallog(E, {n = seriesprecision}, {v = 't}): E elliptic curve, returns n terms of the elliptic logarithm as a series of t =-x/y."},
{"ellformalpoint",0,(void*)ellformalpoint,5,"GDPDn","ellformalpoint(E, {n = seriesprecision}, {v = 'x}): E elliptic curve, n integer; return the coordinates [x(t), y(t)] on the elliptic curve as a formal expansion in the formal parameter t = -x/y."},
{"ellformalw",0,(void*)ellformalw,5,"GDPDn","ellformalw(E, {n = seriesprecision}, {t = 'x}): E elliptic curve, n integer; returns n terms of the formal expansion of w = -1/y in the formal parameter t = -x/y."},
+{"ellfromeqn",0,(void*)ellfromeqn,5,"G","ellfromeqn(P): Given a genus 1 plane curve, defined by the affine equation f(x,y) = 0, return the coefficients [a1,a2,a3,a4,a6] of a Weierstrass equation for its Jacobian. This allows to recover a Weierstrass model for an elliptic curve given by a general plane cubic or by a binary quartic or biquadratic model."},
{"ellfromj",0,(void*)ellfromj,5,"G","ellfromj(j): returns the coefficients [a1,a2,a3,a4,a6] of a fixed elliptic curve with j-invariant j."},
{"ellgenerators",0,(void*)ellgenerators,5,"G","ellgenerators(E): If E is an elliptic curve over the rationals, return the generators of the Mordell-Weil group associated to the curve. This relies on the curve being referenced in the elldata database. If E is an elliptic curve over a finite field Fq as output by ellinit(), return a minimal set of generators for the group E(Fq)."},
{"ellglobalred",0,(void*)ellglobalred,5,"G","ellglobalred(E): E being an elliptic curve, returns [N,[u,r,s,t],c, faN,L], where N is the conductor of E, [u,r,s,t] leads to the standard model for E, c is the product of the local Tamagawa numbers c_p, faN is factor(N) and L[i] is elllocalred(E, faN[i,1])."},
@@ -405,6 +411,9 @@ entree functions_basic[]={
{"galoissubgroups",0,(void*)galoissubgroups,7,"G","galoissubgroups(G):Output all the subgroups of G."},
{"gamma",0,(void*)ggamma,3,"Gp","gamma(s): gamma function at s, a complex or p-adic number, or a series."},
{"gammah",0,(void*)ggammah,3,"Gp","gammah(x): gamma of x+1/2 (x integer)."},
+{"gammamellininv",0,(void*)gammamellininv,3,"GGD0,L,p","gammamellininv(G,t,{m=0}): returns G(t), where G is as output by gammamellininvinit. The alternative syntax gammamellininv(A,t,m) is also available."},
+{"gammamellininvasymp",0,(void*)gammamellininvasymp,3,"GDPD0,L,","gammamellininvasymp(A,n,{m=0}): return the first n terms of the asymptotic expansion at infinity of the m-th derivative K^m(t) of the inverse Mellin transform of the function f(s)=gamma_R(s+a_1)*...*gamma_(s+a_d), where Vga is the vector [a_1,...,a_d] and gamma_R(s)=Pi^(-s/2)*gamma(s/2). The result is a vector [M[1]...M[n]] with M[1]=1, such that K^m(t) = sqrt(2^{d+1}/d)t^{1-d+a+m(2/d-1)}e^{-d pi t^{2/d}}\\sum_{n\\ge0}M[n+ [...]
+{"gammamellininvinit",0,(void*)gammamellininvinit,3,"GD0,L,p","gammamellininvinit(A,{m=0}): initialize data for the computation by gammamellininv() of the m-th derivative of the inverse Mellin transform of the function f(s) = gamma_R(s+a1)*...*gamma_R(s+ad), where A is the vector [a1,...,ad] and gamma_R(s) = Pi^(-s/2)*gamma(s/2)."},
{"gcd",0,(void*)ggcd0,4,"GDG","gcd(x,{y}): greatest common divisor of x and y."},
{"gcdext",0,(void*)gcdext0,4,"GG","gcdext(x,y): returns [u,v,d] such that d=gcd(x,y) and u*x+v*y=d."},
{"genus2red",0,(void*)genus2red,5,"GDG","genus2red(P,{p}): let P be a polynomial with integer coefficients. Determines the reduction at p > 2 of the (proper, smooth) hyperelliptic curve C/Q: y^2 = P, of genus 2. (The special fiber X_p of the minimal regular model X of C over Z.)"},
@@ -458,18 +467,12 @@ entree functions_basic[]={
{"install",0,(void*)gpinstall,13,"vrrD\"\",r,D\"\",s,","install(name,code,{gpname},{lib}): load from dynamic library 'lib' the function 'name'. Assign to it the name 'gpname' in this GP session, with prototype 'code'. If 'lib' is omitted, all symbols known to gp (includes the whole 'libpari.so' and possibly others) are available. If 'gpname' is omitted, use 'name'."},
{"intcirc",0,(void*)intcirc0,11,"V=GGEDGp","intcirc(X=a,R,expr,{tab}): numerical integration of expr on the circle |z-a|=R, divided by 2*I*Pi. tab is as in intnum."},
{"intformal",0,(void*)integ,9,"GDn","intformal(x,{v}): formal integration of x with respect to v, or to the main variable of x if v is omitted."},
-{"intfouriercos",0,(void*)intfourcos0,11,"V=GGGEDGp","intfouriercos(X=a,b,z,expr,{tab}): numerical integration from a to b of cos(2*Pi*z*X)*expr(X) from a to b, where a, b, and tab are as in intnum. This is the cosine-Fourier transform if a=-infty and b=+infty."},
-{"intfourierexp",0,(void*)intfourexp0,11,"V=GGGEDGp","intfourierexp(X=a,b,z,expr,{tab}): numerical integration from a to b of exp(-2*I*Pi*z*X)*expr(X) from a to b, where a, b, and tab are as in intnum. This is the ordinary Fourier transform if a=-infty and b=+infty. Note the minus sign."},
-{"intfouriersin",0,(void*)intfoursin0,11,"V=GGGEDGp","intfouriersin(X=a,b,z,expr,{tab}): numerical integration from a to b of sin(2*Pi*z*X)*expr(X) from a to b, where a, b, and tab are as in intnum. This is the sine-Fourier transform if a=-infty and b=+infty."},
-{"intfuncinit",0,(void*)intfuncinit0,11,"V=GGED0,L,D0,L,p","intfuncinit(X=a,b,expr,{flag=0},{m=0}): initialize tables for integrations from a to b using a weight expr(X). Essential for integral transforms such as intmellininv, intlaplaceinv and intfourier, since it avoids recomputing all the time the same quantities. Must then be used with intmellininvshort (for intmellininv) and directly with intnum and not with the corresponding integral transforms for the others. See help for intnum f [...]
-{"intlaplaceinv",0,(void*)intlaplaceinv0,11,"V=GGEDGp","intlaplaceinv(X=sig,z,expr,{tab}): numerical integration on the line real(X) = sig of expr(X)exp(zX)dz/(2*I*Pi), i.e. inverse Laplace transform of expr at z. tab is as in intnum."},
-{"intmellininv",0,(void*)intmellininv0,11,"V=GGEDGp","intmellininv(X=sig,z,expr,{tab}): numerical integration on the line real(X) = sig (or sig[1]) of expr(X)z^(-X)dX/(2*I*Pi), i.e. inverse Mellin transform of s at x. sig is coded as follows: either it is real, and then by default assume s(z) decreases like exp(-z). Or sig = [sigR, al], sigR is the abscissa of integration, and al = 0 for slowly decreasing functions, or al > 0 if s(z) decreases like exp(-al*z). tab is as in intnum. Use in [...]
-{"intmellininvshort",0,(void*)intmellininvshort,11,"GGGp","intmellininvshort(sig,z,tab): numerical integration on the line real(X) = sig (or sig[1]) of s(X)z^(-X)dX/(2*I*Pi), i.e. inverse Mellin transform of s at z. sig is coded as follows: either it is real, and then by default assume s(X) decreases like exp(-X). Or sig = [sigR, al], sigR is the abscissa of integration, and al = 0 for slowly decreasing functions, or al > 0 if s(X) decreases like exp(-al*X). Compulsory table tab has been [...]
+{"intfuncinit",0,(void*)intfuncinit0,11,"V=GGED0,L,p","intfuncinit(t=a,b,f,{m=0}): initialize tables for integrations from a to b using a weight f(t). For integral transforms such as Fourier or Mellin transforms."},
{"intnum",0,(void*)intnum0,11,"V=GGEDGp","intnum(X=a,b,expr,{tab}): numerical integration of expr from a to b with respect to X. Plus/minus infinity is coded as +oo/-oo. Finally tab is either omitted (let the program choose the integration step), a positive integer m (choose integration step 1/2^m), or data precomputed with intnuminit."},
+{"intnumgauss",0,(void*)intnumgauss0,11,"V=GGEDGp","intnumgauss(X=a,b,expr,{tab}): numerical integration of expr from a to b, a compact interval, with respect to X using Gauss-Legendre quadrature. tab is either omitted (and will be recomputed) or precomputed with intnumgaussinit."},
+{"intnumgaussinit",0,(void*)intnumgaussinit,11,"D0,L,p","intnumgaussinit({n}): initialize tables for n-point Gauss-Legendre integration on a compact interval."},
{"intnuminit",0,(void*)intnuminit,11,"GGD0,L,p","intnuminit(a,b,{m=0}): initialize tables for integrations from a to b. See help for intnum for coding of a and b. Possible types: compact interval, semi-compact (one extremity at + or - infinity) or R, and very slowly, slowly or exponentially decreasing, or sine or cosine oscillating at infinities."},
-{"intnuminitgen",0,(void*)intnuminitgen0,11,"VGGED0,L,D0,L,p","intnuminitgen(t,a,b,ph,{m=0},{flag=0}): initialize tables for integrations from a to b using abscissas ph(t) and weights ph'(t). Note that there is no equal sign after the variable name t since t always goes from -infty to +infty, but it is ph(t) which goes from a to b, and this is not checked. If flag = 1 or 2, multiply the reserved table length by 4^flag, to avoid corresponding error."},
{"intnumromb",0,(void*)intnumromb0,11,"V=GGED0,L,p","intnumromb(X=a,b,expr,{flag=0}): numerical integration of expr (smooth in ]a,b[) from a to b with respect to X. flag is optional and mean 0: default. expr can be evaluated exactly on [a,b]; 1: general function; 2: a or b can be plus or minus infinity (chosen suitably), but of same sign; 3: expr has only limits at a or b."},
-{"intnumstep",0,(void*)intnumstep,11,"lp","intnumstep(): gives the default value of m used by all intnum and sumnum routines, such that the integration step is 1/2^m."},
{"isfundamental",0,(void*)isfundamental,4,"lG","isfundamental(x): true(1) if x is a fundamental discriminant (including 1), false(0) if not."},
{"ispolygonal",0,(void*)ispolygonal,4,"lGGD&","ispolygonal(x,s,{&N}): true(1) if x is an s-gonal number, false(0) if not (s > 2). If N is given set it to n if x is the n-th s-gonal number."},
{"ispower",0,(void*)ispower,4,"lGDGD&","ispower(x,{k},{&n}): if k > 0 is given, return true (1) if x is a k-th power, false (0) if not. If k is omitted, return the maximal k >= 2 such that x = n^k is a perfect power, or 0 if no such k exist. If n is present, and the function returns a non-zero result, set n to the k-th root of x."},
@@ -491,18 +494,23 @@ entree functions_basic[]={
{"liftall",0,(void*)liftall,2,"G","liftall(x): lifts every element of Z/nZ to Z, of Qp to Q, and of K[x]/(P) to K[x]."},
{"liftint",0,(void*)liftint,2,"G","liftint(x): lifts every element of Z/nZ to Z, of Qp to Q, and of K[x]/(P) to K[x]."},
{"liftpol",0,(void*)liftpol,2,"G","liftpol(x): lifts every polmod component of x to polynomials"},
+{"limitnum",0,(void*)limitnum0,11,"GD0,L,DGp","limitnum(expr,{k = 20},{alpha=1}): numerical limit of sequence expr using Lagrange-Zagier extrapolation; k is a multiplier so that we extrapolate from expr(k*n). Assume u(n) ~ sum a_i n^(-alpha*i). flag=2, assuming that the asymptotic expansion is in powers of 1/n^2."},
{"lindep",0,(void*)lindep0,10,"GD0,L,","lindep(v,{flag=0}): integral linear dependencies between components of v. flag is optional, and can be 0: default, guess a suitable accuracy, or positive: accuracy to use for the computation, in decimal digits."},
-{"listcreate",0,(void*)listcreate,10,"D0,L,","listcreate(): creates an empty list."},
-{"listinsert",0,(void*)listinsert,10,"WGL","listinsert(L,x,n): insert x at index n in list L, shifting the remaining elements to the right."},
-{"listkill",0,(void*)listkill,10,"vG","listkill(L): obsolete, retained for backward compatibility."},
-{"listpop",0,(void*)listpop,10,"vWD0,L,","listpop(list,{n}): removes n-th element from list. If n is omitted or greater than the current list length, removes last element."},
-{"listput",0,(void*)listput,10,"WGD0,L,","listput(list,x,{n}): sets n-th element of list equal to x. If n is omitted or greater than the current list length, appends x."},
-{"listsort",0,(void*)listsort,10,"vWD0,L,","listsort(L,{flag=0}): sort the list L in place. If flag is non-zero, suppress all but one occurence of each element in list."},
+{"listcreate",0,(void*)listcreate,13,"D0,L,","listcreate(): creates an empty list."},
+{"listinsert",0,(void*)listinsert,13,"WGL","listinsert(L,x,n): insert x at index n in list L, shifting the remaining elements to the right."},
+{"listkill",0,(void*)listkill,13,"vG","listkill(L): obsolete, retained for backward compatibility."},
+{"listpop",0,(void*)listpop0,13,"vWD0,L,","listpop(list,{n}): removes n-th element from list. If n is omitted or greater than the current list length, removes last element."},
+{"listput",0,(void*)listput0,13,"WGD0,L,","listput(list,x,{n}): sets n-th element of list equal to x. If n is omitted or greater than the current list length, appends x."},
+{"listsort",0,(void*)listsort,13,"vWD0,L,","listsort(L,{flag=0}): sort the list L in place. If flag is non-zero, suppress all but one occurence of each element in list."},
{"lngamma",0,(void*)glngamma,3,"Gp","lngamma(x): logarithm of the gamma function of x."},
{"local",0,NULL,13,NULL,"local(x,...,z): declare x,...,z as (dynamically scoped) local variables."},
{"localprec",0,(void*)localprec,13,"vL","localprec(p): set the real precision to p in the dynamic scope."},
{"log",0,(void*)glog,3,"Gp","log(x): natural logarithm of x."},
{"logint",0,(void*)logint0,4,"lGGD&","logint(x,b,&z): return the largest integer e so that b^e <= x, where the parameters b > 1 and x > 0 are both integers. If the parameter z is present, set it to b^e."},
+{"mapdelete",0,(void*)mapdelete,13,"vGG","mapdelete(M,x): remove x from the domain of the map M."},
+{"mapget",0,(void*)mapget,13,"GG","mapget(M,x): return the image of x by the map M"},
+{"mapisdefined",0,(void*)mapisdefined,13,"iGGD&","mapisdefined(M,x,{&z}): true (1) if x has an image by the map M, false (0) otherwise. If z is present, set it to the image of x, if it exists."},
+{"mapput",0,(void*)mapput,13,"vWGG","mapput(M,x,y): associate x to y in the map M"},
{"matadjoint",0,(void*)matadjoint0,10,"GD0,L,","matadjoint(M,{flag=0}): adjoint matrix of M using Leverrier-Faddeev's algorithm. If flag is 1, compute the characteristic polynomial independently first."},
{"matalgtobasis",0,(void*)matalgtobasis,7,"GG","matalgtobasis(nf,x): nfalgtobasis applied to every element of the vector or matrix x."},
{"matbasistoalg",0,(void*)matbasistoalg,7,"GG","matbasistoalg(nf,x): nfbasistoalg applied to every element of the matrix or vector x."},
@@ -692,7 +700,7 @@ entree functions_basic[]={
{"qfbhclassno",0,(void*)hclassno,4,"G","qfbhclassno(x): Hurwitz-Kronecker class number of x>0."},
{"qfbil",0,(void*)qfbil,10,"GGDG","qfbil(x,y,{q}): evaluate the bilinear form q (symmetric matrix) at (x,y); if q omitted, use the standard Euclidean scalar product."},
{"qfbnucomp",0,(void*)nucomp,4,"GGG","qfbnucomp(x,y,L): composite of primitive positive definite quadratic forms x and y using nucomp and nudupl, where L=[|D/4|^(1/4)] is precomputed."},
-{"qfbnupow",0,(void*)nupow,4,"GG","qfbnupow(x,n): n-th power of primitive positive definite quadratic form x using nucomp and nudupl."},
+{"qfbnupow",0,(void*)nupow,4,"GGDG","qfbnupow(x,n,{L}): n-th power of primitive positive definite quadratic form x using nucomp and nudupl."},
{"qfbpowraw",0,(void*)qfbpowraw,4,"GL","qfbpowraw(x,n): n-th power without reduction of the binary quadratic form x."},
{"qfbprimeform",0,(void*)primeform,4,"GGp","qfbprimeform(x,p): returns the prime form of discriminant x, whose first coefficient is p."},
{"qfbred",0,(void*)qfbred0,4,"GD0,L,DGDGDG","qfbred(x,{flag=0},{d},{isd},{sd}): reduction of the binary quadratic form x. All other args. are optional. The arguments d, isd and sd, if present, supply the values of the discriminant, floor(sqrt(d)) and sqrt(d) respectively. If d<0, its value is not used and all references to Shanks's distance hereafter are meaningless. flag can be any of 0: default, uses Shanks's distance function d; 1: use d, do a single reduction step; 2: do not use d; 3 [...]
@@ -785,6 +793,7 @@ entree functions_basic[]={
{"sign",0,(void*)gsigne,1,"iG","sign(x): sign of x, of type integer, real or fraction"},
{"simplify",0,(void*)simplify,2,"G","simplify(x): simplify the object x as much as possible."},
{"sin",0,(void*)gsin,3,"Gp","sin(x): sine of x."},
+{"sinc",0,(void*)gsinc,3,"Gp","sinc(x): sinc function of x."},
{"sinh",0,(void*)gsinh,3,"Gp","sinh(x): hyperbolic sine of x."},
{"sizebyte",0,(void*)gsizebyte,2,"lG","sizebyte(x): number of bytes occupied by the complete tree of the object x."},
{"sizedigit",0,(void*)sizedigit,2,"lG","sizedigit(x): rough upper bound for the number of decimal digits of (the components of) $x$. DEPRECATED."},
@@ -807,9 +816,10 @@ entree functions_basic[]={
{"sumdivmult",0,(void*)sumdivmultexpr,11,"GVE","sumdivmult(n,d,expr): sum of multiplicative function expr, d running over the divisors of n."},
{"sumformal",0,(void*)sumformal,9,"GDn","sumformal(f,{v}): formal sum of f with respect to v, or to the main variable of f if v is omitted."},
{"suminf",0,(void*)suminf0,11,"V=GEp","suminf(X=a,expr): infinite sum (X goes from a to infinity) of real or complex expression expr."},
-{"sumnum",0,(void*)sumnum0,11,"V=GGEDGD0,L,p","sumnum(X=a,sig,expr,{tab},{flag=0}): numerical summation of expr from X = ceiling(a) to +infinity. sig is either a scalar or a two-component vector coding the function's decrease rate at infinity. It is assumed that the scalar part of sig is to the right of all poles of expr. If present, tab must be initialized by sumnuminit. If flag is nonzero, assumes that conj(expr(z)) = expr(conj(z))."},
-{"sumnumalt",0,(void*)sumnumalt0,11,"V=GGEDGD0,L,p","sumnumalt(X=a,sig,expr,{tab},{flag=0}): numerical summation of (-1)^X expr(X) from X = ceiling(a) to +infinity. Note that the (-1)^X must not be included. sig is either a scalar or a two-component vector coded as in intnum, and the scalar part is larger than all the real parts of the poles of expr. Uses intnum, hence tab is as in intnum. If flag is nonzero, assumes that the function to be summed satisfies conj(f(z))=f(conj(z)), and the [...]
-{"sumnuminit",0,(void*)sumnuminit,11,"GD0,L,D1,L,p","sumnuminit(sig, {m=0}, {sgn=1}): initialize tables for numerical summation. sgn is 1 (in fact >= 0), the default, for sumnum (ordinary sums) or -1 (in fact < 0) for sumnumalt (alternating sums). sig is as in sumnum and m is as in intnuminit."},
+{"sumnum",0,(void*)sumnum0,11,"V=GEDGp","sumnum(n=a,f,{tab}): numerical summation of f(n) from n = a to +infinity using Euler-MacLaurin summation. Assume that f corresponds to a series with positive terms and is a C^oo function; a must be an integer, and tab, if given, is the output of sumnuminit."},
+{"sumnuminit",0,(void*)sumnuminit,11,"DGp","sumnuminit({asymp}): initialize tables for Euler-MacLaurin delta summation of a series with positive terms."},
+{"sumnummonien",0,(void*)sumnummonien0,11,"V=GEDGp","sumnummonien(n=a,f,{tab}): numerical summation from n = a to +infinity using Monien summation."},
+{"sumnummonieninit",0,(void*)sumnummonieninit,11,"DGDGDGp","sumnummonieninit({asymp},{w},{n0 = 1}): initialize tables for Monien summation of a series with positive terms."},
{"sumpos",0,(void*)sumpos0,11,"V=GED0,L,p","sumpos(X=a,expr,{flag=0}): sum of positive (or negative) series expr, the formal variable X starting at a. flag is optional, and can be 0: default, or 1: uses a slightly different method using Zagier's polynomials."},
{"system",0,(void*)gpsystem,13,"vs","system(str): str being a string, execute the system command str."},
{"tan",0,(void*)gtan,3,"Gp","tan(x): tangent of x."},
@@ -851,6 +861,7 @@ entree functions_basic[]={
{"zeta",0,(void*)gzeta,3,"Gp","zeta(s): Riemann zeta function at s with s a complex or a p-adic number."},
{"zetak",0,(void*)gzetakall,7,"GGD0,L,p","zetak(nfz,x,{flag=0}): Dedekind zeta function of the number field nfz at x, where nfz is the vector computed by zetakinit (NOT by nfinit); flag is optional, and can be 0: default, compute zetak, or non-zero: compute the lambdak function, i.e. with the gamma factors."},
{"zetakinit",0,(void*)initzeta,7,"Gp","zetakinit(bnf): compute number field information necessary to use zetak. bnf may also be an irreducible polynomial."},
+{"zetamult",0,(void*)zetamult,3,"Gp","zetamult(s): multiple zeta value at integral s = [s1,...,sd]."},
{"zncoppersmith",0,(void*)zncoppersmith,4,"GGGDG","zncoppersmith(P, N, X, {B=N}): finds all integers x with |x| <= X such that gcd(N, P(x)) >= B. X should be smaller than exp((log B)^2 / (deg(P) log N))."},
{"znlog",0,(void*)znlog,4,"GGDG","znlog(x,g,{o}): return the discrete logarithm of x in (Z/nZ)* in base g. If present, o represents the multiplicative order of g. Return [] if no solution exist."},
{"znorder",0,(void*)znorder,4,"GDG","znorder(x,{o}): order of the integermod x in (Z/nZ)*. Optional o represents a multiple of the order of the element."},
diff --git a/src/language/intnum.c b/src/language/intnum.c
index 2fed8cf..3885092 100644
--- a/src/language/intnum.c
+++ b/src/language/intnum.c
@@ -14,10 +14,16 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
#include "pari.h"
#include "paripriv.h"
#include "anal.h"
+
+static const long EXTRAPREC =
+#ifdef LONG_IS_64BIT
+ 1;
+#else
+ 2;
+#endif
+
/********************************************************************/
-/** **/
/** NUMERICAL INTEGRATION (Romberg) **/
-/** **/
/********************************************************************/
typedef struct {
void *E;
@@ -174,34 +180,93 @@ rombint(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, long prec)
}
/********************************************************************/
-/** **/
-/** DOUBLE EXPONENTIAL INTEGRATION **/
-/** **/
+/** NUMERICAL INTEGRATION (Gauss-Legendre) **/
/********************************************************************/
+GEN
+intnumgaussinit(long n, long prec)
+{
+ pari_sp ltop = avma;
+ GEN L, dp1, p1, p2, R, W;
+ long bitprec = prec2nbits(prec), i, d1;
+ if (n <= 0) n = (long)(bitprec*0.2258);
+ if (odd(n)) n++;
+ if (n == 2) n = 4;
+ /* n even >= 4, p1 is even */
+ prec = nbits2prec(3*bitprec/2 + 32);
+ L = pollegendre(n, 0); /* L_n = p1(x^2) */
+ p1 = Q_remove_denom(RgX_deflate(L, 2), &dp1);
+ d1 = vali(dp1);
+ p2 = ZX_deriv(p1); /* L_n' = 2x p2(x^2) / 2^d1 */
+ R = ZX_uspensky(p1, gen_0, 1, 3*bitprec/2 + 32); /* positive roots of p1 */
+ n >>= 1;
+ W = cgetg(n+1, t_VEC);
+ for (i = 1; i <= n; ++i)
+ {
+ GEN t, r, r2 = gel(R,i);
+ if (typ(r2) != t_REAL) r2 = gtofp(r2, prec);
+ gel(R,i) = r = sqrtr_abs(r2); /* positive root of L_n */
+ /* 2 / (L'(r)^2(1-r^2)) = 2^(2d1 - 1) / (1-r2)r2 (p2(r2))^2 */
+ t = mulrr(subrr(r2, sqrr(r2)), sqrr(poleval(p2, r2)));
+ shiftr_inplace(t,1-2*d1);
+ gel(W,i) = invr(t);
+ }
+ return gerepilecopy(ltop, mkvec2(R,W));
+}
+
+GEN
+intnumgauss(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN tab, long prec)
+{
+ pari_sp ltop = avma;
+ GEN R, W, bma, bpa, S;
+ long n, i;
+ if (!tab)
+ tab = intnumgaussinit(0,prec);
+ else if (typ(tab) != t_INT)
+ {
+ if (typ(tab) != t_VEC || lg(tab) != 3)
+ pari_err_TYPE("intnumgauss",tab);
+ }
+ else
+ tab = intnumgaussinit(itos(tab),prec);
+
+ R = gel(tab,1); n = lg(R)-1;
+ W = gel(tab,2);
+ a = gprec_w(a, prec+EXTRAPREC);
+ b = gprec_w(b, prec+EXTRAPREC);
+ bma = gmul2n(gsub(b,a), -1); /* (b-a)/2 */
+ bpa = gadd(bma, a); /* (b+a)/2 */
+ S = gen_0;
+ for (i = 1; i <= n; ++i)
+ {
+ GEN r = gel(R,i);
+ GEN P = eval(E, gadd(bpa, gmul(bma, r)));
+ GEN M = eval(E, gsub(bpa, gmul(bma, r)));
+ S = gadd(S, gmul(gel(W,i), gadd(P,M)));
+ }
+ return gerepilecopy(ltop, gprec_wtrunc(gmul(bma,S), prec));
+}
-/* The init functions have the following purposes:
-* 1) They fill the value tabx0 = phi(0) and arrays of abcissas
-* tabxp[] = phi(k/2^m) (positive x) and also of tabxm[] = phi(-k/2^m)
-* (negative x) unless the phi function is odd, in which case this is useless.
-* 2) They fill the corresponding arrays of weights tabw0 = phi'(0) and
-* tabwp[] = phi'(k/2^m) (and possibly also of tabwm[] = phi'(-k/2^m)).
-* 3) They set eps to the desired accuracy (depending on the GP default).
-* 4) They compute nt which says that the weights tabwp[k] and tabwm[k] are
-* negligible with respect to eps if k > nt. In particular the tabxx[] arrays
-* are indexed from 1 to nt+1. */
+GEN
+intnumgauss0(GEN a, GEN b, GEN code, GEN tab, long prec)
+{ EXPR_WRAP(code, intnumgauss(EXPR_ARG, a, b, tab, prec)); }
+
+/********************************************************************/
+/** DOUBLE EXPONENTIAL INTEGRATION **/
+/********************************************************************/
typedef struct _intdata {
- long m; /* integration step h = 1/2^m */
long eps; /* bit accuracy of current precision */
GEN tabx0; /* abcissa phi(0) for t = 0 */
GEN tabw0; /* weight phi'(0) for t = 0 */
GEN tabxp; /* table of abcissas phi(kh) for k > 0 */
GEN tabwp; /* table of weights phi'(kh) for k > 0 */
- GEN tabxm; /* table of abcissas phi(kh) for k < 0 */
- GEN tabwm; /* table of weights phi'(kh) for k < 0 */
+ GEN tabxm; /* table of abcissas phi(kh) for k < 0, possibly empty */
+ GEN tabwm; /* table of weights phi'(kh) for k < 0, possibly empty */
+ GEN h; /* integration step */
} intdata;
-#define TABm(v) gel(v,1)
+static const long LGTAB = 8;
+#define TABh(v) gel(v,1)
#define TABx0(v) gel(v,2)
#define TABw0(v) gel(v,3)
#define TABxp(v) gel(v,4)
@@ -228,8 +293,7 @@ checktabsimp(GEN tab)
{
long L, LN, LW;
if (!tab || typ(tab) != t_VEC) return 0;
- if (lg(tab) != 8) return 0;
- if (typ(TABm(tab))!= t_INT) return 0;
+ if (lg(tab) != LGTAB) return 0;
if (typ(TABxp(tab)) != t_VEC) return 0;
if (typ(TABwp(tab)) != t_VEC) return 0;
if (typ(TABxm(tab)) != t_VEC) return 0;
@@ -245,8 +309,7 @@ checktabdoub(GEN tab)
{
long L;
if (typ(tab) != t_VEC) return 0;
- if (lg(tab) != 8) return 0;
- if (typ(TABm(tab)) != t_INT) return 0;
+ if (lg(tab) != LGTAB) return 0;
L = lg(TABxp(tab));
if (lg(TABwp(tab)) != L) return 0;
if (lg(TABxm(tab)) != L) return 0;
@@ -263,105 +326,101 @@ checktab(GEN tab)
&& checktabsimp(gel(tab,2));
}
-long
-intnumstep(long prec)
-{
- long m = 2, r = 4, p = (long)prec2nbits_mul(prec, 0.3);
- while (r < p) { m++; r <<= 1; }
- return m;
-}
-
static void
-intinit_start(intdata *D, long m, long flext, long prec)
+intinit_start(intdata *D, long m, long n, GEN h, long bitprec)
{
- long lim;
- if (m <= 0) m = intnumstep(prec);
- lim = 20L<<m;
- if (flext > 0) lim = lim << (2*flext);
- D->m = m;
- D->eps = prec2nbits(prec);
- D->tabxp = cgetg(lim+1, t_VEC);
- D->tabwp = cgetg(lim+1, t_VEC);
- D->tabxm = cgetg(lim+1, t_VEC);
- D->tabwm = cgetg(lim+1, t_VEC);
+ if (m > 0) { h = gmul2n(h,-m); n <<= m; }
+ D->h = h;
+ D->eps = bitprec;
+ D->tabxp = cgetg(n+1, t_VEC);
+ D->tabwp = cgetg(n+1, t_VEC);
+ D->tabxm = cgetg(n+1, t_VEC);
+ D->tabwm = cgetg(n+1, t_VEC);
}
static GEN
intinit_end(intdata *D, long pnt, long mnt)
{
- GEN v = cgetg(8, t_VEC);
+ GEN v = cgetg(LGTAB, t_VEC);
if (pnt < 0) pari_err_DOMAIN("intnuminit","table length","<",gen_0,stoi(pnt));
- gel(v,1) = stoi(D->m);
TABx0(v) = D->tabx0;
TABw0(v) = D->tabw0;
+ TABh(v) = D->h;
TABxp(v) = D->tabxp; setlg(D->tabxp, pnt+1);
TABwp(v) = D->tabwp; setlg(D->tabwp, pnt+1);
TABxm(v) = D->tabxm; setlg(D->tabxm, mnt+1);
TABwm(v) = D->tabwm; setlg(D->tabwm, mnt+1); return v;
}
-static const long EXTRAPREC =
-#ifdef LONG_IS_64BIT
- 1;
-#else
- 2;
-#endif
-
/* divide by 2 in place */
static GEN
divr2_ip(GEN x) { shiftr_inplace(x, -1); return x; }
-/* phi(t)=tanh((3/2)sinh(t)) : from -1 to 1, hence also from a to b compact
- * interval. */
+/* phi(t)=tanh((Pi/2)sinh(t)): from -1 to 1, hence also from a to b compact
+ * interval */
static GEN
inittanhsinh(long m, long prec)
{
- pari_sp av;
- GEN h, et, ct, st, ext, ex, xp, wp;
- long k, nt = -1, lim;
- intdata D; intinit_start(&D, m, 0, prec);
+ GEN h, et, ex, pi;
+ long n, k, nt = -1, bitprec = prec2nbits(prec);
+ double d;
+ intdata D;
+
+ pi = mppi(prec);
+ d = bitprec*LOG10_2;
+ n = (long)ceil(d*log(d)/1.86); /* heuristic */
+ h = divru(logr_abs(divrr(mulur(2*n,pi), logr_abs(utor(n,prec)))), n);
+ intinit_start(&D, m, n, h, bitprec);
- lim = lg(D.tabxp) - 1;
+ n = lg(D.tabxp) - 1;
D.tabx0 = real_0(prec);
- D.tabw0 = divr2_ip(stor(3, prec));
- h = real2n(-D.m, prec);
- et = ex = mpexp(h);
- for (k = 1; k <= lim; k++)
+ D.tabw0 = Pi2n(-1,prec);
+ et = ex = mpexp(D.h);
+ for (k = 1; k <= n; k++)
{
- gel(D.tabxp,k) = cgetr(prec+EXTRAPREC);
- gel(D.tabwp,k) = cgetr(prec+EXTRAPREC); av = avma;
- ct = divr2_ip(addrr(et, invr(et)));
- st = subrr(et, ct);
- ext = invr( addrs(mpexp(mulur(3, st)), 1) );
- shiftr_inplace(ext, 1);
- xp = subsr(1, ext);
- wp = divr2_ip(mulur(3, mulrr(ct, mulrr(ext, addsr(1, xp)))));
+ GEN xp, wp, ct, st, z;
+ pari_sp av;
+ gel(D.tabxp,k) = cgetr(prec);
+ gel(D.tabwp,k) = cgetr(prec); av = avma;
+ ct = divr2_ip(addrr(et, invr(et))); /* ch(kh) */
+ st = subrr(et, ct); /* sh(kh) */
+ z = invr( addrs(mpexp(mulrr(pi, st)), 1) );
+ shiftr_inplace(z, 1);
+ xp = subsr(1, z);
+ wp = divr2_ip(mulrr(mulrr(pi,ct), mulrr(z, subsr(2, z))));
if (expo(wp) < -D.eps) { nt = k-1; break; }
affrr(xp, gel(D.tabxp,k));
+ if (absrnz_equal1(gel(D.tabxp,k))) { nt = k-1; break; }
affrr(wp, gel(D.tabwp,k)); et = gerepileuptoleaf(av, mulrr(et, ex));
}
return intinit_end(&D, nt, 0);
}
-/* phi(t)=sinh(sinh(t)) : from -\infty to \infty, slowly decreasing, at least
+/* phi(t)=sinh(sinh(t)): from -oo to oo, slowly decreasing, at least
* as 1/x^2. */
static GEN
initsinhsinh(long m, long prec)
{
pari_sp av;
- GEN h, et, ct, st, ext, exu, ex, xp, wp;
- long k, nt = -1, lim;
- intdata D; intinit_start(&D, m, 0, prec);
+ GEN h, et, ct, st, ex, pi;
+ long k, n, nt = -1, bitprec = prec2nbits(prec);
+ intdata D;
+ double d;
+
+ pi = mppi(prec);
+ d = bitprec*LOG10_2*1.5;
+ n = (long)ceil(d*log(d)); /* heuristic */
+ h = divru(logr_abs(divrr(mulur(2*n,pi), logr_abs(utor(n,prec)))), n);
+ intinit_start(&D, m, n, h, bitprec);
- lim = lg(D.tabxp) - 1;
D.tabx0 = real_0(prec);
D.tabw0 = real_1(prec);
- h = real2n(-D.m, prec);
- et = ex = mpexp(h);
- for (k = 1; k <= lim; k++)
+ et = ex = mpexp(D.h);
+ for (k = 1; k <= n; k++)
{
- gel(D.tabxp,k) = cgetr(prec+EXTRAPREC);
- gel(D.tabwp,k) = cgetr(prec+EXTRAPREC); av = avma;
+ GEN xp, wp, ext, exu;
+ gel(D.tabxp,k) = cgetr(prec);
+ gel(D.tabwp,k) = cgetr(prec); av = avma;
ct = divr2_ip(addrr(et, invr(et)));
st = subrr(et, ct);
ext = mpexp(st);
@@ -375,25 +434,30 @@ initsinhsinh(long m, long prec)
return intinit_end(&D, nt, 0);
}
-/* phi(t)=2sinh(t) : from -\infty to \infty, exponentially decreasing as
- * exp(-x). */
+/* phi(t)=2sinh(t): from -oo to oo, exponentially decreasing as exp(-x) */
static GEN
initsinh(long m, long prec)
{
pari_sp av;
- GEN h, et, ex, eti, xp, wp;
- long k, nt = -1, lim;
- intdata D; intinit_start(&D, m, 0, prec);
-
- lim = lg(D.tabxp) - 1;
+ GEN h, et, ex, eti, xp, wp, pi;
+ long k, n, nt = -1, bitprec = prec2nbits(prec);
+ double d;
+ intdata D;
+
+ pi = mppi(prec);
+ d = bitprec*LOG10_2;
+ n = (long)ceil(d*log(d)); /* heuristic */
+ h = divru(logr_abs(divrr(mulur(2*n, pi), logr_abs(utor(n,prec)))), n);
+ intinit_start(&D, m, n, h, bitprec);
+
+ n = lg(D.tabxp) - 1;
D.tabx0 = real_0(prec);
D.tabw0 = real2n(1, prec);
- h = real2n(-D.m, prec);
- et = ex = mpexp(h);
- for (k = 1; k <= lim; k++)
+ et = ex = mpexp(D.h);
+ for (k = 1; k <= n; k++)
{
- gel(D.tabxp,k) = cgetr(prec+EXTRAPREC);
- gel(D.tabwp,k) = cgetr(prec+EXTRAPREC); av = avma;
+ gel(D.tabxp,k) = cgetr(prec);
+ gel(D.tabwp,k) = cgetr(prec); av = avma;
eti = invr(et);
xp = subrr(et, eti);
wp = addrr(et, eti);
@@ -404,24 +468,29 @@ initsinh(long m, long prec)
return intinit_end(&D, nt, 0);
}
-/* phi(t)=exp(2sinh(t)) : from 0 to \infty, slowly decreasing at least as
- * 1/x^2. */
+/* phi(t)=exp(2sinh(t)): from 0 to oo, slowly decreasing at least as 1/x^2 */
static GEN
initexpsinh(long m, long prec)
{
- GEN h, et, eti, ex, xp;
- long k, nt = -1, lim;
- intdata D; intinit_start(&D, m, 0, prec);
+ GEN h, et, ex, pi;
+ long k, n, nt = -1, bitprec = prec2nbits(prec);
+ double d;
+ intdata D;
- lim = lg(D.tabxp) - 1;
+ pi = mppi(prec);
+ d = bitprec*LOG10_2/1.05;
+ n = (long)ceil(d*log(d)); /* heuristic */
+ h = divru(logr_abs(divrr(mulur(2*n, pi), logr_abs(utor(n,prec)))), n);
+ intinit_start(&D, m, n, h, bitprec);
+
+ n = lg(D.tabxp) - 1;
D.tabx0 = real_1(prec);
D.tabw0 = real2n(1, prec);
- h = real2n(-D.m, prec);
- ex = mpexp(h);
+ ex = mpexp(D.h);
et = real_1(prec);
- for (k = 1; k <= lim; k++)
+ for (k = 1; k <= n; k++)
{
- GEN t;
+ GEN t, eti, xp;
et = mulrr(et, ex);
eti = invr(et); t = addrr(et, eti);
xp = mpexp(subrr(et, eti));
@@ -439,22 +508,29 @@ static GEN
initexpexp(long m, long prec)
{
pari_sp av;
- GEN kh, h, et, eti, ex, xp, xm, wp, wm;
- long k, nt = -1, lim;
- intdata D; intinit_start(&D, m, 0, prec);
-
- lim = lg(D.tabxp) - 1;
+ GEN h, et, ex, pi;
+ long k, n, nt = -1, bitprec = prec2nbits(prec);
+ double d;
+ intdata D;
+
+ pi = mppi(prec);
+ d = bitprec*LOG10_2;
+ n = (long)ceil(d*log(d)/1.76); /* heuristic */
+ h = divru(logr_abs(divrr(mulur(2*n, pi), logr_abs(utor(n,prec)))), n);
+ intinit_start(&D, m, n, h, bitprec);
+
+ n = lg(D.tabxp) - 1;
D.tabx0 = mpexp(real_m1(prec));
D.tabw0 = gmul2n(D.tabx0, 1);
- h = real2n(-D.m, prec);
- et = ex = mpexp(negr(h));
- for (k = 1; k <= lim; k++)
+ et = ex = mpexp(negr(D.h));
+ for (k = 1; k <= n; k++)
{
- gel(D.tabxp,k) = cgetr(prec+EXTRAPREC);
- gel(D.tabwp,k) = cgetr(prec+EXTRAPREC);
- gel(D.tabxm,k) = cgetr(prec+EXTRAPREC);
- gel(D.tabwm,k) = cgetr(prec+EXTRAPREC); av = avma;
- eti = invr(et); kh = mulur(k,h);
+ GEN xp, xm, wp, wm, eti, kh;
+ gel(D.tabxp,k) = cgetr(prec);
+ gel(D.tabwp,k) = cgetr(prec);
+ gel(D.tabxm,k) = cgetr(prec);
+ gel(D.tabwm,k) = cgetr(prec); av = avma;
+ eti = invr(et); kh = mulur(k,D.h);
xp = mpexp(subrr(kh, et));
xm = mpexp(negr(addrr(kh, eti)));
wp = mulrr(xp, addsr(1, et));
@@ -468,41 +544,52 @@ initexpexp(long m, long prec)
return intinit_end(&D, nt, nt);
}
-/* phi(t)=(Pi/h)t/(1-exp(-sinh(t))) : from 0 to \infty, sine oscillation. */
+/* phi(t)=(Pi/h)*t/(1-exp(-sinh(t))) from 0 to oo, sine oscillation */
static GEN
initnumsine(long m, long prec)
{
pari_sp av;
- GEN h, et, eti, ex, st, ct, extp, extm, extp1, extm1, extp2, extm2, kpi, kct;
- GEN xp, xm, wp, wm, pi = mppi(prec);
- long k, nt = -1, lim;
- intdata D; intinit_start(&D, m, 0, prec);
-
- lim = lg(D.tabxp) - 1;
- D.tabx0 = gmul2n(pi, D.m);
- D.tabw0 = gmul2n(pi, D.m - 1);
- h = real2n(-D.m, prec);
- et = ex = mpexp(h);
- for (k = 1; k <= lim; k++)
+ GEN invh, h, et, eti, ex, pi;
+ long k, n, nt = -1, bitprec = prec2nbits(prec), exh;
+ intdata D;
+ double d;
+
+ pi = mppi(prec);
+ d = bitprec*LOG10_2;
+ n = (long)ceil(1.5*d*log(d)); /* heuristic */
+ /* nh ~ log(2npi/log(n)) */
+ h = divru(logr_abs(divrr(mulur(2*n, pi), logr_abs(utor(n,prec)))), n);
+ intinit_start(&D, m, n, h, bitprec);
+
+ n = lg(D.tabxp) - 1;
+ invh = invr(D.h);
+ D.tabx0 = mulrr(pi, invh);
+ D.tabw0 = gmul2n(D.tabx0,-1);
+ exh = expo(invh); /* expo(1/h) */
+ et = ex = mpexp(D.h);
+ for (k = 1; k <= n; k++)
{
- gel(D.tabxp,k) = cgetr(prec+EXTRAPREC);
- gel(D.tabwp,k) = cgetr(prec+EXTRAPREC);
- gel(D.tabxm,k) = cgetr(prec+EXTRAPREC);
- gel(D.tabwm,k) = cgetr(prec+EXTRAPREC); av = avma;
+ GEN xp,xm, wp,wm, ct,st, extp,extp1,extp2, extm,extm1,extm2, kct, kpi;
+ gel(D.tabxp,k) = cgetr(prec);
+ gel(D.tabwp,k) = cgetr(prec);
+ gel(D.tabxm,k) = cgetr(prec);
+ gel(D.tabwm,k) = cgetr(prec); av = avma;
eti = invr(et); /* exp(-kh) */
- ct = divr2_ip(addrr(et, eti));
- st = divr2_ip(subrr(et, eti));
- extp = mpexp(st); extp1 = subsr(1, extp); extp2 = invr(extp1);
- extm = invr(extp); extm1 = subsr(1, extm); extm2 = invr(extm1);
+ ct = divr2_ip(addrr(et, eti)); /* ch(kh) */
+ st = divr2_ip(subrr(et, eti)); /* sh(kh) */
+ extp = mpexp(st); extp1 = subsr(1, extp);
+ extp2 = invr(extp1); /* 1/(1-exp(sh(kh))) */
+ extm = invr(extp); extm1 = subsr(1, extm);
+ extm2 = invr(extm1);/* 1/(1-exp(sh(-kh))) */
kpi = mulur(k, pi);
kct = mulur(k, ct);
- shiftr_inplace(extm1, D.m);
- shiftr_inplace(extp1, D.m);
- xp = mulrr(kpi, extm2);
+ extm1 = mulrr(extm1, invh);
+ extp1 = mulrr(extp1, invh);
+ xp = mulrr(kpi, extm2); /* phi(kh) */
wp = mulrr(subrr(extm1, mulrr(kct, extm)), mulrr(pi, sqrr(extm2)));
- xm = mulrr(negr(kpi), extp2);
+ xm = mulrr(negr(kpi), extp2); /* phi(-kh) */
wm = mulrr(addrr(extp1, mulrr(kct, extp)), mulrr(pi, sqrr(extp2)));
- if (expo(wm) < -D.eps && expo(extm) + D.m + expu(10 * k) < -D.eps) { nt = k-1; break; }
+ if (expo(wm) < -D.eps && expo(extm) + exh + expu(10 * k) < -D.eps) { nt = k-1; break; }
affrr(xp, gel(D.tabxp,k));
affrr(wp, gel(D.tabwp,k));
affrr(xm, gel(D.tabxm,k));
@@ -511,277 +598,198 @@ initnumsine(long m, long prec)
return intinit_end(&D, nt, nt);
}
-static GEN
-suminit_start(GEN sig)
-{
- GEN sig2;
-
- if (typ(sig) == t_VEC)
- {
- if (lg(sig) != 3) pari_err_TYPE("sumnum",sig);
- sig2 = gel(sig,2);
- sig = gel(sig,1);
- if (!isinR(sig2)) pari_err_TYPE("sumnum",sig2);
- if (gsigne(sig2) > 0) sig2 = mulcxmI(sig2);
- }
- else sig2 = gen_0;
- if (!isinR(sig)) pari_err_TYPE("sumnum",sig);
- return mkvec2(mkoo(), sig2);
-}
-
-/* phi(t) depending on sig[2] as in intnum, with weights phi'(t)tanh(Pi*phi(t))
- * (sgn >= 0) or phi'(t)/cosh(Pi*phi(t)) (otherwise), for use in sumnumall.
- * integrations are done from 0 to +infty (flii is set to 0), except if slowly
- decreasing, from -infty to +infty (flii is set to 1). */
-GEN
-sumnuminit(GEN sig, long m, long sgn, long prec)
-{
- pari_sp ltop = avma;
- GEN b, t, tab, tabxp, tabwp, tabxm, tabwm, pi = mppi(prec);
- long L, k, eps, flii;
-
- b = suminit_start(sig);
- flii = gequal0(gel(b,2));
- if (flii)
- tab = intnuminit(mkmoo(), mkoo(), m, prec);
- else
- tab = intnuminit(gen_0, b, m, prec);
- eps = prec2nbits(prec);
- t = gmul(pi, TABx0(tab));
- if (sgn < 0) TABw0(tab) = gdiv(TABw0(tab), gcosh(t, prec));
- else TABw0(tab) = gmul(TABw0(tab), gtanh(t, prec));
- tabxp = TABxp(tab); L = lg(tabxp);
- tabwp = TABwp(tab);
- tabxm = TABxm(tab);
- tabwm = TABwm(tab);
- for (k = 1; k < L; k++)
- {
- if (cmprs(gel(tabxp,k), eps) < 0)
- {
- t = mulrr(pi, gel(tabxp,k));
- gel(tabwp,k) = (sgn < 0)? divrr(gel(tabwp,k), gcosh(t, prec))
- : mulrr(gel(tabwp,k), gtanh(t, prec));
- }
- else
- if (sgn < 0) gel(tabwp,k) = real_0_bit(-eps);
- if (!flii)
- {
- t = mulrr(pi, gel(tabxm,k));
- gel(tabwm,k) = (sgn < 0)? divrr(gel(tabwm,k), gcosh(t, prec))
- : mulrr(gel(tabwm,k), gtanh(t, prec));
- }
- }
- return gerepilecopy(ltop, tab);
-}
-
/* End of initialization functions. These functions can be executed once
- * and for all for a given accuracy, type of integral ([a,b], [a,\infty[ or
- * ]-\infty,a], ]-\infty,\infty[) and of integrand in the noncompact case
- * (slowly decreasing, exponentially decreasing, oscillating with a fixed
- * oscillating factor such as sin(x)). */
-
-/* In the following integration functions the parameters are as follows:
-* 1) The parameter denoted by m is the most crucial and difficult to
-* determine in advance: h = 1/2^m is the integration step size. Usually
-* m = floor(log(D)/log(2)), where D is the number of decimal digits of accuracy
-* is plenty for very regulat functions, for instance m = 6 for 100D, and m = 9
-* for 1000D, but values of m 1 or 2 less are often sufficient, while for
-* singular functions, 1 or 2 more may be necessary. The best test is to take 2
-* or 3 consecutive values of m and look. Note that the number of function
-* evaluations, hence the time doubles when m increases by 1. */
+ * and for all for a given accuracy and type of integral ([a,b], [a,oo[ or
+ * ]-oo,a], ]-oo,oo[) */
+
+/* The numbers below can be changed, but NOT the ordering */
+enum {
+ f_REG = 0, /* regular function */
+ f_SING = 1, /* algebraic singularity */
+ f_YSLOW = 2, /* +\infty, slowly decreasing, at least x^(-2) */
+ f_YVSLO = 3, /* +\infty, very slowly decreasing, worse than x^(-2) */
+ f_YFAST = 4, /* +\infty, exponentially decreasing */
+ f_YOSCS = 5, /* +\infty, sine oscillating */
+ f_YOSCC = 6 /* +\infty, cosine oscillating */
+};
+/* is finite ? */
+static int
+is_fin_f(long c) { return c == f_REG || c == f_SING; }
+/* is oscillatory ? */
+static int
+is_osc(long c) { long a = labs(c); return a == f_YOSCC|| a == f_YOSCS; }
/* All inner functions such as intn, etc... must be called with a
* valid 'tab' table. The wrapper intnum provides a higher level interface */
-/* compute $\int_a^b f(t)dt$ with [a,b] compact and f nonsingular. */
+/* compute \int_a^b f(t)dt with [a,b] compact and f nonsingular. */
static GEN
intn(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN tab)
{
GEN tabx0, tabw0, tabxp, tabwp;
- GEN bpa, bma, bmb, S, SP, SM;
- long m, k, L, i;
+ GEN bpa, bma, bmb, S;
+ long i;
pari_sp ltop = avma, av;
if (!checktabsimp(tab)) pari_err_TYPE("intnum",tab);
- if (!isinC(a)) pari_err_TYPE("intnum",a);
- if (!isinC(b)) pari_err_TYPE("intnum",b);
- m = itos(TABm(tab));
tabx0 = TABx0(tab); tabw0 = TABw0(tab);
- tabxp = TABxp(tab); tabwp = TABwp(tab); L = lg(tabxp);
+ tabxp = TABxp(tab); tabwp = TABwp(tab);
bpa = gmul2n(gadd(b, a), -1); /* (b+a)/2 */
bma = gsub(bpa, a); /* (b-a)/2 */
- bmb = gmul(bma, tabx0); /* (b-a)/2 phi(0) */
av = avma;
+ bmb = gmul(bma, tabx0); /* (b-a)/2 phi(0) */
/* phi'(0) f( (b+a)/2 + (b-a)/2 * phi(0) ) */
S = gmul(tabw0, eval(E, gadd(bpa, bmb)));
- for (k = 1; k <= m; k++)
+ for (i = lg(tabxp)-1; i > 0; i--)
{
- long pas = 1L<<(m-k);
- for (i = pas; i < L; i += pas)
- if (i & pas || k == 1)
- {
- bmb = gmul(bma, gel(tabxp,i));
- SP = eval(E, gsub(bpa, bmb));
- SM = eval(E, gadd(bpa, bmb));
- S = gadd(S, gmul(gel(tabwp,i), gadd(SP, SM)));
- if ((i & 0x7f) == 1) S = gerepileupto(av, S);
- }
+ GEN SP, SM;
+ bmb = gmul(bma, gel(tabxp,i));
+ SP = eval(E, gsub(bpa, bmb));
+ SM = eval(E, gadd(bpa, bmb));
+ S = gadd(S, gmul(gel(tabwp,i), gadd(SP, SM)));
+ if ((i & 0x7f) == 1) S = gerepileupto(av, S);
}
- return gerepileupto(ltop, gmul(S, gmul2n(bma, -m)));
+ return gerepileupto(ltop, gmul(S, gmul(bma, TABh(tab))));
}
-/* compute $\int_{a[1]}^{b} f(t)dt$ with [a,b] compact, possible
- * singularity with exponent a[2] at lower extremity, b regular.
- * Use tanh(sinh(t)). */
+/* compute \int_a^b f(t)dt with [a,b] compact, possible singularity with
+ * exponent a[2] at lower extremity, b regular. Use tanh(sinh(t)). */
static GEN
intnsing(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN tab, long prec)
{
- GEN tabx0, tabw0, tabxp, tabwp, ea, ba, bm, bp, S, tra, SP, SM;
- long m, k, L, i;
+ GEN tabx0, tabw0, tabxp, tabwp, ea, ba, S;
+ long i;
pari_sp ltop = avma, av;
if (!checktabsimp(tab)) pari_err_TYPE("intnum",tab);
- m = itos(TABm(tab));
tabx0 = TABx0(tab); tabw0 = TABw0(tab);
- tabxp = TABxp(tab); tabwp = TABwp(tab); L = lg(tabxp);
- tra = gel(a,1);
+ tabxp = TABxp(tab); tabwp = TABwp(tab);
ea = ginv(gaddsg(1, gel(a,2)));
- ba = gdiv(gsub(b, tra), gpow(gen_2, ea, prec));
+ a = gel(a,1);
+ ba = gdiv(gsub(b, a), gpow(gen_2, ea, prec));
av = avma;
- S = gmul(gmul(tabw0, ba), eval(E, gadd(gmul(ba, gaddsg(1, tabx0)), tra)));
- for (k = 1; k <= m; k++)
+ S = gmul(gmul(tabw0, ba), eval(E, gadd(gmul(ba, addsr(1, tabx0)), a)));
+ for (i = lg(tabxp)-1; i > 0; i--)
{
- long pas = 1L<<(m-k);
- for (i = pas; i < L; i += pas)
- if (i & pas || k == 1) /* i = odd multiple of pas = 2^(m-k) */
- {
- GEN p = addsr(1, gel(tabxp,i));
- GEN m = subsr(1, gel(tabxp,i));
- bp = gmul(ba, gpow(p, ea, prec));
- bm = gmul(ba, gpow(m, ea, prec));
- SP = gmul(gdiv(bp, p), eval(E, gadd(bp, tra)));
- SM = gmul(gdiv(bm, m), eval(E, gadd(bm, tra)));
- S = gadd(S, gmul(gel(tabwp,i), gadd(SP, SM)));
- if ((i & 0x7f) == 1) S = gerepileupto(av, S);
- }
+ GEN p = addsr(1, gel(tabxp,i));
+ GEN m = subsr(1, gel(tabxp,i));
+ GEN bp = gmul(ba, gpow(p, ea, prec));
+ GEN bm = gmul(ba, gpow(m, ea, prec));
+ GEN SP = gmul(gdiv(bp, p), eval(E, gadd(bp, a)));
+ GEN SM = gmul(gdiv(bm, m), eval(E, gadd(bm, a)));
+ S = gadd(S, gmul(gel(tabwp,i), gadd(SP, SM)));
+ if ((i & 0x7f) == 1) S = gerepileupto(av, S);
}
- return gerepileupto(ltop, gmul(gmul2n(S, -m), ea));
+ return gerepileupto(ltop, gmul(gmul(S, TABh(tab)), ea));
}
-/* compute $\int_a^\infty f(t)dt$ if $si=1$ or $\int_{-\infty}^a f(t)dt$
- if $si=-1$. Use exp(2sinh(t)) for slowly decreasing functions,
- exp(1+t-exp(-t)) for exponentially decreasing functions, and
- (pi/h)t/(1-exp(-sinh(t))) for oscillating functions. */
+static GEN id(GEN x) { return x; }
+/* compute \int_a^oo f(t)dt if si>0 or \int_{-oo}^a f(t)dt if si<0$.
+ * Use exp(2sinh(t)) for slowly decreasing functions, exp(1+t-exp(-t)) for
+ * exponentially decreasing functions, and (pi/h)t/(1-exp(-sinh(t))) for
+ * oscillating functions. */
static GEN
-intninfpm(void *E, GEN (*eval)(void*, GEN), GEN a, long si, GEN tab)
+intninfpm(void *E, GEN (*eval)(void*, GEN), GEN a, long sb, GEN tab)
{
GEN tabx0, tabw0, tabxp, tabwp, tabxm, tabwm;
- GEN S, SP, SM;
- long m, L, k, h = 0, pas, i;
- pari_sp ltop = avma, av;
+ GEN S;
+ long L, i;
+ pari_sp av = avma;
if (!checktabdoub(tab)) pari_err_TYPE("intnum",tab);
- m = itos(TABm(tab));
tabx0 = TABx0(tab); tabw0 = TABw0(tab);
tabxp = TABxp(tab); tabwp = TABwp(tab); L = lg(tabxp);
tabxm = TABxm(tab); tabwm = TABwm(tab);
- if (si < 0) { tabxp = gneg(tabxp); tabxm = gneg(tabxm); }
- av = avma;
- S = gmul(tabw0, eval(E, gadd(a, gmulsg(si, tabx0))));
- for (k = 1; k <= m; k++)
+ if (gequal0(a))
{
- h++; pas = 1L<<(m-k);
- for (i = pas; i < L; i += pas)
- if (i & pas || k == 1)
- {
- SP = eval(E, gadd(a, gel(tabxp,i)));
- SM = eval(E, gadd(a, gel(tabxm,i)));
- S = gadd(S, gadd(gmul(gel(tabwp,i), SP), gmul(gel(tabwm,i), SM)));
- if ((i & 0x7f) == 1) S = gerepileupto(av, S);
- }
+ GEN (*NEG)(GEN) = sb > 0? id: gneg;
+ S = gmul(tabw0, eval(E, NEG(tabx0)));
+ for (i = 1; i < L; i++)
+ {
+ GEN SP = eval(E, NEG(gel(tabxp,i)));
+ GEN SM = eval(E, NEG(gel(tabxm,i)));
+ S = gadd(S, gadd(gmul(gel(tabwp,i), SP), gmul(gel(tabwm,i), SM)));
+ if ((i & 0x7f) == 1) S = gerepileupto(av, S);
+ }
}
- return gerepileupto(ltop, gmul2n(S, -h));
+ else if (gexpo(a) <= 0 || is_osc(sb))
+ { /* a small */
+ GEN (*ADD)(GEN,GEN) = sb > 0? gadd: gsub;
+ S = gmul(tabw0, eval(E, ADD(a, tabx0)));
+ for (i = 1; i < L; i++)
+ {
+ GEN SP = eval(E, ADD(a, gel(tabxp,i)));
+ GEN SM = eval(E, ADD(a, gel(tabxm,i)));
+ S = gadd(S, gadd(gmul(gel(tabwp,i), SP), gmul(gel(tabwm,i), SM)));
+ if ((i & 0x7f) == 1) S = gerepileupto(av, S);
+ }
+ }
+ else
+ { /* a large, |a|*\int_sgn(a)^{oo} f(|a|*x)dx (sb > 0)*/
+ GEN (*ADD)(long,GEN) = sb > 0? addsr: subsr;
+ long sa = gsigne(a);
+ GEN A = sa > 0? a: gneg(a);
+ pari_sp av2 = avma;
+ S = gmul(tabw0, eval(E, gmul(A, ADD(sa, tabx0))));
+ for (i = 1; i < L; i++)
+ {
+ GEN SP = eval(E, gmul(A, ADD(sa, gel(tabxp,i))));
+ GEN SM = eval(E, gmul(A, ADD(sa, gel(tabxm,i))));
+ S = gadd(S, gadd(gmul(gel(tabwp,i), SP), gmul(gel(tabwm,i), SM)));
+ if ((i & 0x7f) == 1) S = gerepileupto(av2, S);
+ }
+ S = gmul(S,A);
+ }
+ return gerepileupto(av, gmul(S, TABh(tab)));
}
-/* compute $\int_{-\infty}^\infty f(t)dt$
+/* Compute \int_{-oo}^oo f(t)dt
* use sinh(sinh(t)) for slowly decreasing functions and sinh(t) for
* exponentially decreasing functions.
* HACK: in case TABwm(tab) contains something, assume function to be integrated
* satisfies f(-x) = conj(f(x)).
- * Usually flag < 0, but flag > 0 is used in sumnumall. */
+ */
static GEN
-intninfinfintern(void *E, GEN (*eval)(void*, GEN), GEN tab, long flag)
+intninfinf(void *E, GEN (*eval)(void*, GEN), GEN tab)
{
GEN tabx0, tabw0, tabxp, tabwp, tabwm;
- GEN S, SP, SM;
- long m, L, k, i, spf;
+ GEN S;
+ long L, i, spf;
pari_sp ltop = avma;
if (!checktabsimp(tab)) pari_err_TYPE("intnum",tab);
- m = itos(TABm(tab));
tabx0 = TABx0(tab); tabw0 = TABw0(tab);
tabxp = TABxp(tab); tabwp = TABwp(tab); L = lg(tabxp);
tabwm = TABwm(tab);
spf = (lg(tabwm) == lg(tabwp));
- S = flag > 0 ? gen_0 : gmul(tabw0, eval(E, tabx0));
+ S = gmul(tabw0, eval(E, tabx0));
if (spf) S = gmul2n(real_i(S), -1);
- for (k = 1; k <= m; k++)
+ for (i = L-1; i > 0; i--)
{
- long pas = 1L<<(m-k);
- for (i = pas; i < L; i += pas)
- if (i & pas || k == 1)
- {
- SP = eval(E, gel(tabxp,i));
- if (spf) S = gadd(S, real_i(gmul(gel(tabwp,i), SP)));
- else
- {
- SM = eval(E, negr(gel(tabxp,i)));
- if (flag > 0) SM = gneg(SM);
- S = gadd(S, gmul(gel(tabwp,i), gadd(SP, SM)));
- }
- if ((i & 0x7f) == 1) S = gerepileupto(ltop, S);
- }
+ GEN SP = eval(E, gel(tabxp,i));
+ if (spf)
+ S = gadd(S, real_i(gmul(gel(tabwp,i), SP)));
+ else
+ {
+ GEN SM = eval(E, negr(gel(tabxp,i)));
+ S = gadd(S, gmul(gel(tabwp,i), gadd(SP,SM)));
+ }
+ if ((i & 0x7f) == 1) S = gerepileupto(ltop, S);
}
- if (spf) m--;
- return gerepileupto(ltop, gmul2n(S, -m));
-}
-
-static GEN
-intninfinf(void *E, GEN (*eval)(void*, GEN), GEN tab)
-{
- return intninfinfintern(E, eval, tab, -1);
+ if (spf) S = gmul2n(S,1);
+ return gerepileupto(ltop, gmul(S, TABh(tab)));
}
/* general num integration routine int_a^b f(t)dt, where a and b are as follows:
- (1) a scalar : the scalar, no singularity worse than logarithmic at a.
- (2) [a, e] : the scalar a, singularity exponent -1 < e <= 0.
- (3) oo, -oo : +\infty, -\infty, slowly decreasing function.
- (4) [[+-oo], a], a nonnegative real : +-\infty, function behaving like
- exp(-a|t|) at +-\infty.
- (5) [[+-oo], e], e < -1 : +-\infty, function behaving like t^e
- at +-\infty.
- (5) [[+-oo], a*I], a real : +-\infty, function behaving like cos(at) if a>0
- and like sin(at) if a < 0 at +-\infty.
-*/
-
-/* FIXME: The numbers below can be changed, but NOT the ordering */
-enum {
- f_REG = 0, /* regular function */
- f_SING = 1, /* algebraic singularity */
- f_YSLOW = 2, /* +\infty, slowly decreasing, at least x^(-2) */
- f_YVSLO = 3, /* +\infty, very slowly decreasing, worse than x^(-2) */
- f_YFAST = 4, /* +\infty, exponentially decreasing */
- f_YOSCS = 5, /* +\infty, sine oscillating */
- f_YOSCC = 6 /* +\infty, cosine oscillating */
-};
-/* is c finite */
-static int
-is_fin_f(long c) { return c == f_REG || c == f_SING; }
-/* oscillating case: valid for +oo (c > 0) or -oo (c < 0) */
-static int
-is_osc_f(long c) { c = labs(c); return c == f_YOSCS || c == f_YOSCC; }
-
+ - a scalar : the scalar, no singularity worse than logarithmic at a.
+ - [a, e] : the scalar a, singularity exponent -1 < e <= 0.
+ - +oo: slowly decreasing function (at least O(t^-2))
+ - [[+oo], a], a nonnegative real : +oo, function behaving like exp(-a|t|)
+ - [[+oo], e], e < -1 : +oo, function behaving like t^e
+ - [[+oo], a*I], a > 0 real : +oo, function behaving like cos(at)
+ - [[+oo], a*I], a < 0 real : +oo, function behaving like sin(at)
+ and similarly at -oo */
static GEN
f_getycplx(GEN a, long prec)
{
@@ -864,14 +872,14 @@ homtab(GEN tab, GEN k)
GEN z;
if (gequal0(k) || gequal(k, gen_1)) return tab;
if (gsigne(k) < 0) k = gneg(k);
- z = cgetg(8, t_VEC);
- TABm(z) = icopy(TABm(tab));
+ z = cgetg(LGTAB, t_VEC);
TABx0(z) = gmul(TABx0(tab), k);
TABw0(z) = gmul(TABw0(tab), k);
TABxp(z) = gmul(TABxp(tab), k);
TABwp(z) = gmul(TABwp(tab), k);
TABxm(z) = gmul(TABxm(tab), k);
- TABwm(z) = gmul(TABwm(tab), k); return z;
+ TABwm(z) = gmul(TABwm(tab), k);
+ TABh(z) = rcopy(TABh(tab)); return z;
}
static GEN
@@ -907,14 +915,14 @@ exptab(GEN tab, GEN k, long prec)
if (gcmpgs(k, -2) <= 0) return tab;
ea = ginv(gsubsg(-1, k));
- v = cgetg(8, t_VEC);
- TABm(v) = icopy(TABm(tab));
+ v = cgetg(LGTAB, t_VEC);
TABx0(v) = gpow(TABx0(tab), ea, prec);
TABw0(v) = expscalpr(TABx0(v), TABx0(tab), TABw0(tab), ea);
TABxp(v) = expvec(TABxp(tab), ea, prec);
TABwp(v) = expvecpr(TABxp(v), TABxp(tab), TABwp(tab), ea);
TABxm(v) = expvec(TABxm(tab), ea, prec);
TABwm(v) = expvecpr(TABxm(v), TABxm(tab), TABwm(tab), ea);
+ TABh(v) = rcopy(TABh(tab));
return v;
}
@@ -1023,152 +1031,6 @@ intnuminit0(GEN a, GEN b, GEN tab, long prec)
m = itos(tab);
return intnuminit(a, b, m, prec);
}
-static GEN
-sumnuminit0(GEN a, GEN tab, long sgn, long prec)
-{
- long m;
- if (!tab) m = 0;
- else if (typ(tab) != t_INT)
- {
- if (!checktab(tab)) pari_err_TYPE("sumnuminit0",tab);
- return tab;
- }
- else
- m = itos(tab);
- return sumnuminit(a, m, sgn, prec);
-}
-
-/* User-defined change of variable phi(t) = f(t), where t goes from -oo to +oo,
- * and a and b are as in intnuminit. If [a,b] compact, assume phi(t) odd. */
-static int
-condfin(long code, GEN xw, long eps, long m, long k)
-{
- GEN x, w;
- eps -= 8; /* for safety. Lose 8 bits, but took 1 whole word extra. */
- x = gel(xw,1);
- w = gel(xw,2);
- switch(labs(code))
- {
- case f_REG: case f_SING:
- return gexpo(w) < -eps;
- case f_YSLOW: case f_YVSLO:
- return gexpo(w) - 2*gexpo(x) < -eps;
- case f_YFAST:
- return cmprs(x, (long)(LOG2 * (gexpo(w) + eps) + 1)) > 0;
- case f_YOSCS: case f_YOSCC:
- return gexpo(x) + m + expu(10 * k) < - eps;
- default: return 0;
- }
-}
-
-/* eps = 2^(-k). Return f'(a) ~ (f(a+eps) - f(a-eps)) / 2eps*/
-static GEN
-myderiv_num(void *E, GEN (*eval)(void*, GEN), GEN a, GEN eps, long k, long prec)
-{
- GEN d = gmul2n(gsub(eval(E, gadd(a,eps)), eval(E, gsub(a,eps))), k-1);
- return gprec_w(d, prec);
-}
-/* zp = z to a higher accuracy (enough to evaluate numerical derivative) */
-static GEN
-ffprime(void *E, GEN (*eval)(void*, GEN), GEN z, GEN zp, GEN eps, long h, long precl)
-{
- GEN f = eval(E, z), fp = myderiv_num(E, eval, zp, eps, h, precl);
- return mkvec2(f, fp);
-}
-/* v = [f(z), f'(z)]. Return h := z/(1-f(z)), h + h^2 zf'(z) */
-static GEN
-ffmodify(GEN v, GEN z)
-{
- GEN f = gel(v,1), fp = gel(v,2), h = ginv(gsubsg(1, f));
- return mkvec2(gmul(z, h), gadd(h, gmul(gsqr(h), gmul(z,fp))));
-}
-GEN
-intnuminitgen(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, long m,
- long flext, long prec)
-{
- enum {
- f_COMP, /* [a,b] */
- f_SEMI, /* [a,+-oo[, no oscillation */
- f_OSC1, /* [a,+-oo[, oscillation */
- f_INF , /* ]-oo,+oo[, no oscillation */
- f_OSC2 /* ]-oo,+oo[, oscillation */
- };
- pari_sp ltop = avma;
- GEN hnpr, eps, v;
- long k, h, newprec, lim, precl = prec+EXTRAPREC;
- long flag, codea = transcode(a, "a"), codeb = transcode(b, "b");
- int NOT_OSC, NOT_ODD;
- intdata D; intinit_start(&D, m, flext, precl);
-
- flag = f_SEMI;
- if (is_osc_f(codea) || is_osc_f(codeb)) flag = f_OSC1;
- if (is_fin_f(codea) && is_fin_f(codeb)) flag = f_COMP;
- else if (!is_fin_f(codea) && !is_fin_f(codeb))
- {
- if (codea * codeb > 0) return gen_0;
- if (codea != -codeb)
- pari_err_TYPE("intnuminitgen [infinities of different types]",
- mkvec2(a,b));
- flag = (flag == f_SEMI) ? f_INF : f_OSC2;
- }
- NOT_OSC = (flag == f_COMP || flag == f_SEMI || flag == f_INF);
- NOT_ODD = (flag == f_SEMI || flag == f_OSC1);
-
- newprec = (3*precl - 1)>>1;
- h = prec2nbits(precl)/2;
- eps = real2n(-h, newprec);
-
- if (NOT_OSC || !gequal1(eval(E, gen_0)))
- {
- GEN a0 = real_0(precl), a0n = real_0(newprec), xw, xwmod;
- xw = ffprime(E, eval, a0, a0n, eps, h, precl);
- xwmod = NOT_OSC? xw: ffmodify(xw, a0);
- D.tabx0 = gel(xwmod,1);
- D.tabw0 = gel(xwmod,2);
- }
- else
- {
- GEN xw = gdiv(pol_x(0), gsubsg(1, eval(E, gadd(pol_x(0), zeroser(0, 4)))));
- D.tabx0 = gprec_w(polcoeff0(xw, 0, 0), precl);
- D.tabw0 = gprec_w(polcoeff0(xw, 1, 0), precl);
- }
- /* precl <= newprec */
- hnpr = real2n(-D.m, newprec);
- lim = lg(D.tabxp) - 1;
- for (k = 1; k <= lim; k++)
- {
- GEN akn = mulur(k, hnpr), ak = rtor(akn, precl), xw, xwmod;
- int finb;
- xw = ffprime(E, eval, ak, akn, eps, h, precl);
- xwmod = NOT_OSC? xw: ffmodify(xw, ak);
- gel(D.tabxp,k) = gel(xwmod,1);
- gel(D.tabwp,k) = gel(xwmod,2);
- finb = condfin(codeb, is_osc_f(codeb)? xw: xwmod, D.eps, D.m, k);
- if (NOT_ODD)
- {
- ak = negr(ak); akn = negr(akn);
- xw = ffprime(E, eval, ak, akn, eps, h, precl);
- xwmod = NOT_OSC? xw: ffmodify(xw, ak);
- gel(D.tabxm,k) = gel(xwmod,1);
- gel(D.tabwm,k) = gel(xwmod,2);
- if (finb && condfin(codea, is_osc_f(codeb)? xw: xwmod, D.eps, D.m, k))
- break;
- }
- else if (finb) break;
- }
- v = intinit_end(&D, k-1, NOT_ODD? k-1: 0);
- if (!NOT_OSC)
- {
- GEN C = Pi2n(D.m, precl);
- TABx0(v) = gmul(TABx0(v), C);
- TABw0(v) = gmul(TABw0(v), C);
- TABxp(v) = RgV_Rg_mul(TABxp(v), C);
- TABwp(v) = RgV_Rg_mul(TABwp(v), C);
- TABxm(v) = RgV_Rg_mul(TABxm(v), C);
- TABwm(v) = RgV_Rg_mul(TABwm(v), C);
- }
- return gerepilecopy(ltop, v);
-}
/* Assigns the values of the function weighted by w[k] at quadrature points x[k]
* [replacing the weights]. Return the index of the last non-zero coeff */
@@ -1183,25 +1045,22 @@ weight(void *E, GEN (*eval)(void *, GEN), GEN x, GEN w)
/* compute the necessary tabs, weights multiplied by f(t).
* If flag set, assumes that f(-t) = conj(f(t)). */
static GEN
-intfuncinitintern(void *E, GEN (*eval)(void*, GEN), GEN tab, long flag)
+intfuncinit_i(void *E, GEN (*eval)(void*, GEN), GEN tab)
{
GEN tabxp = TABxp(tab), tabwp = TABwp(tab);
GEN tabxm = TABxm(tab), tabwm = TABwm(tab);
long L = weight(E, eval, tabxp, tabwp), L0 = lg(tabxp);
TABw0(tab) = gmul(TABw0(tab), eval(E, TABx0(tab)));
- if (lg(tabxm) > 1) (void)weight(E, eval, tabxm, tabwm);
+ if (lg(tabxm) > 1)
+ (void)weight(E, eval, tabxm, tabwm);
else
{
+ long L2;
tabxm = gneg(tabxp);
- if (flag) tabwm = gconj(tabwp);
- else
- {
- long L2;
- tabwm = leafcopy(tabwp);
- L2 = weight(E, eval, tabxm, tabwm);
- if (L > L2) L = L2;
- }
+ tabwm = leafcopy(tabwp);
+ L2 = weight(E, eval, tabxm, tabwm);
+ if (L > L2) L = L2;
TABxm(tab) = tabxm;
TABwm(tab) = tabwm;
}
@@ -1215,18 +1074,17 @@ intfuncinitintern(void *E, GEN (*eval)(void*, GEN), GEN tab, long flag)
}
GEN
-intfuncinit(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, long m, long flag, long prec)
+intfuncinit(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, long m, long prec)
{
pari_sp ltop = avma;
- GEN T, tab = intnuminit(a, b, m, prec);
-
- if (lg(tab) != 3) T = intfuncinitintern(E, eval, tab, flag);
- else
- {
- T = cgetg(3, t_VEC);
- gel(T,1) = intfuncinitintern(E, eval, gel(tab,1), flag);
- gel(T,2) = intfuncinitintern(E, eval, gel(tab,2), flag);
- }
+ GEN T, tab = intnuminit_i(a, b, m, prec);
+
+ if (lg(tab) == 3)
+ pari_err_IMPL("intfuncinit with hard endpoint behaviour");
+ if (is_fin_f(transcode(a,"intfuncinit")) ||
+ is_fin_f(transcode(b,"intfuncinit")))
+ pari_err_IMPL("intfuncinit with finite endpoints");
+ T = intfuncinit_i(E, eval, tab);
return gerepilecopy(ltop, T);
}
@@ -1248,18 +1106,19 @@ intnum_i(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN tab, long prec)
else
{
GEN c = gmul2n(gadd(gel(a,1), gel(b,1)), -1);
- res1 = intnsing(E, eval, a, c, tab, prec);
- res2 = intnsing(E, eval, b, c, tab, prec);
+ res1 = intnsing(E, eval, a, c, gel(tab,1), prec);
+ res2 = intnsing(E, eval, b, c, gel(tab,2), prec);
S = gsub(res1, res2);
}
return (sgns < 0) ? gneg(S) : S;
}
/* now b is infinite */
sb = codeb > 0 ? 1 : -1;
- if (codea == f_REG && labs(codeb) != f_YOSCC
- && (labs(codeb) != f_YOSCS || gequal0(a)))
+ codeb = labs(codeb);
+ if (codea == f_REG && codeb != f_YOSCC
+ && (codeb != f_YOSCS || gequal0(a)))
{
- S = intninfpm(E, eval, a, sb, tab);
+ S = intninfpm(E, eval, a, sb*codeb, tab);
return sgns*sb < 0 ? gneg(S) : S;
}
if (is_fin_f(codea))
@@ -1269,7 +1128,6 @@ intnum_i(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN tab, long prec)
GEN pi2p = gmul(Pi2n(1,prec), f_getycplx(b, prec));
GEN pis2p = gmul2n(pi2p, -2);
c = real_i(codea == f_SING ? gel(a,1) : a);
- codeb = labs(codeb);
switch(codeb)
{
case f_YOSCC: case f_YOSCS:
@@ -1287,21 +1145,22 @@ intnum_i(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN tab, long prec)
}
res1 = codea==f_SING? intnsing(E, eval, a, c, gel(tab,1), prec)
: intn (E, eval, a, c, gel(tab,1));
- res2 = intninfpm(E, eval, c, sb,gel(tab,2));
+ res2 = intninfpm(E, eval, c, sb*codeb,gel(tab,2));
if (sb < 0) res2 = gneg(res2);
res1 = gadd(res1, res2);
return sgns < 0 ? gneg(res1) : res1;
}
/* now a and b are infinite */
- if (codea * codeb > 0)
+ if (codea * sb > 0)
{
if (codea > 0) pari_warn(warner, "integral from oo to oo");
if (codea < 0) pari_warn(warner, "integral from -oo to -oo");
return gen_0;
}
if (sb < 0) sgns = -sgns;
- kma = f_getycplx(a, prec); codea = labs(codea);
- kmb = f_getycplx(b, prec); codeb = labs(codeb);
+ codea = labs(codea);
+ kma = f_getycplx(a, prec);
+ kmb = f_getycplx(b, prec);
if ((codea == f_YSLOW && codeb == f_YSLOW)
|| (codea == f_YFAST && codeb == f_YFAST && gequal(kma, kmb)))
S = intninfinf(E, eval, tab);
@@ -1311,20 +1170,17 @@ intnum_i(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN tab, long prec)
GEN ca = (codea == f_YOSCC)? gmul(pis2, kma): gen_0;
GEN cb = (codeb == f_YOSCC)? gmul(pis2, kmb): gen_0;
GEN c = codea == f_YOSCC ? ca : cb;
- GEN SP, SN = intninfpm(E, eval, c, -sb, gel(tab,1)); /* signe(a) = -sb */
+ GEN SP, SN = intninfpm(E, eval, c, -sb*codea, gel(tab,1)); /*signe(a)=-sb*/
if (codea != f_YOSCC)
- SP = intninfpm(E, eval, cb, sb, gel(tab,2));
+ SP = intninfpm(E, eval, cb, sb*codeb, gel(tab,2));
+ /* codea = codeb = f_YOSCC */
+ else if (gequal(kma, kmb))
+ SP = intninfpm(E, eval, cb, sb*codeb, gel(tab,2));
else
{
- if (codeb != f_YOSCC) pari_err_BUG("code error in intnum");
- if (gequal(kma, kmb))
- SP = intninfpm(E, eval, cb, sb, gel(tab,2));
- else
- {
- tab = gel(tab,2);
- SP = intninfpm(E, eval, cb, sb, gel(tab,2));
- SP = gadd(SP, intn(E, eval, ca, cb, gel(tab,1)));
- }
+ tab = gel(tab,2);
+ SP = intninfpm(E, eval, cb, sb*codeb, gel(tab,2));
+ SP = gadd(SP, intn(E, eval, ca, cb, gel(tab,1)));
}
S = gadd(SN, SP);
}
@@ -1340,7 +1196,7 @@ intnum(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN tab, long prec)
GEN S;
tab = intnuminit0(a, b, tab, prec);
- S = intnum_i(E, eval, gprec_w(a, l), gprec_w(b, l), tab, l);
+ S = intnum_i(E, eval, gprec_w(a, l), gprec_w(b, l), tab, prec);
return gerepilecopy(ltop, gprec_wtrunc(S, prec));
}
@@ -1376,188 +1232,6 @@ intcirc(void *E, GEN (*eval)(void*, GEN), GEN a, GEN R, GEN tab, long prec)
return gmul2n(gmul(R, z), -1);
}
-static void
-getinf(GEN x, GEN *P, GEN *N)
-{
- *P = mkvec2(mkoo(), x);
- *N = mkvec2(mkmoo(),x);
-}
-
-/* w(Rt) f(a+it) */
-static GEN
-auxinv(void *E, GEN t)
-{
- auxint_t *D = (auxint_t*) E;
- GEN tmp = D->w(gmul(D->R, t), D->prec);
- return gmul(tmp, D->f(D->E, gadd(D->a, mulcxI(t))));
-}
-static GEN
-intinvintern(void *E, GEN (*eval)(void*, GEN), GEN sig, GEN x, GEN tab, long prec)
-{
- auxint_t D;
- GEN z, zR, zI, P, N;
-
- if (lg(sig) != 3 || !isinR(gel(sig,1)) || !isinR(gel(sig,2)))
- pari_err_TYPE("integral transform",sig);
- if (gsigne(gel(sig,2)) < 0)
- pari_err_OVERFLOW("integral transform [exponential increase]");
- D.a = gel(sig,1);
- D.prec = prec;
- D.f = eval;
- D.E = E;
- if (gequal0(gel(sig,2)))
- {
- GEN c = mulcxI(gabs(x, prec));
- D.R = x;
- getinf(c, &P, &N);
- tab = intnuminit0(N, P, tab, prec);
- D.w = gcos;
- zR = intnum_i(&D, &auxinv, N, P, tab, prec);
-
- getinf(gneg(c), &P, &N);
- D.w = gsin;
- zI = intnum_i(&D, &auxinv, N, P, tab, prec);
- z = gadd(zR, mulcxI(zI));
- }
- else
- {
- D.R = mulcxI(x);
- getinf(gel(sig,2), &P, &N);
- D.w = gexp;
- z = intnum(&D, &auxinv, N, P, tab, prec);
- }
- return gdiv(gmul(gexp(gmul(gel(sig,1), x), prec), z), Pi2n(1, prec));
-}
-
-/* If sig = [sigR, e]: if e = 0, slowly decreasing, if e > 0, exponentially
- * decreasing like exp(-e*t). If sig is real, identical to [sig, 1]. */
-GEN
-intmellininv(void *E, GEN (*eval)(void*, GEN), GEN sig, GEN x, GEN tab, long prec)
-{
- if (typ(sig) != t_VEC) sig = mkvec2(sig, gen_1);
- return intinvintern(E, eval, sig, gneg(glog(x, prec)), tab, prec);
-}
-
-/* If sig = [sigR, e]: if e = 0, slowly decreasing, if e > 0, exponentially
- * decreasing like exp(-e*t). If sig is real, identical to [sig, 0]. */
-GEN
-intlaplaceinv(void *E, GEN (*eval)(void*, GEN), GEN sig, GEN x, GEN tab, long prec)
-{
- if (typ(sig) != t_VEC) sig = mkvec2(sig, gen_0);
- return intinvintern(E, eval, sig, x, tab, prec);
-}
-
-/* assume tab computed with additional weights f(sig + I*T) */
-typedef struct auxmel_s {
- GEN L;
- long prec;
-} auxmel_t;
-
-static GEN
-auxmelshort(void *E, GEN t)
-{
- auxmel_t *D = (auxmel_t*) E;
- return gexp(gmul(D->L, t), D->prec);
-}
-
-GEN
-intmellininvshort(GEN sig, GEN x, GEN tab, long prec)
-{
- auxmel_t D;
- GEN z, P,N, LX = gneg(glog(x, prec));
-
- if (typ(sig) != t_VEC) sig = mkvec2(sig, gen_1);
- if (lg(sig) != 3 || !isinR(gel(sig,1)) || !isinR(gel(sig,2)))
- pari_err_TYPE("intmellininvshort",sig);
- if (gsigne(gel(sig,2)) <= 0)
- pari_err_OVERFLOW("intinvmellinshort [need exponential decrease]");
- D.L = mulcxI(LX);
- D.prec = prec;
- getinf(gel(sig,2), &P,&N);
- z = intnum_i(&D, &auxmelshort, N, P, tab, prec);
- return gdiv(gmul(gexp(gmul(gel(sig,1), LX), prec), z), Pi2n(1, prec));
-}
-
-/* a as in intnum. flag = 0 for sin, flag = 1 for cos. */
-static GEN
-mytra(GEN a, GEN x, long flag, const char *name)
-{
- GEN b, xa;
- long s, codea = transcode(a, name);
-
- switch (labs(codea))
- {
- case f_REG: case f_SING: case f_YFAST: return a;
- case f_YSLOW: case f_YVSLO:
- xa = real_i(x); s = gsigne(xa);
- if (!s) pari_err_DOMAIN("Fourier transform","Re(x)","=",gen_0,x);
- if (s < 0) xa = gneg(xa);
- b = cgetg(3, t_VEC);
- gel(b,1) = codea > 0? mkoo(): mkmoo();
- gel(b,2) = flag? mulcxI(xa): mulcxmI(xa);
- return b;
- case f_YOSCS: case f_YOSCC:
- pari_err_IMPL("Fourier transform of oscillating functions");
- }
- return NULL;
-}
-
-/* w(ta) f(t) */
-static GEN
-auxfour(void *E, GEN t)
-{
- auxint_t *D = (auxint_t*) E;
- return gmul(D->w(gmul(t, D->a), D->prec), D->f(D->E, t));
-}
-
-GEN
-intfouriersin(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN x, GEN tab, long prec)
-{
- auxint_t D;
- GEN tmp;
-
- if (gequal0(x)) return gcopy(x);
- tmp = gmul(x, Pi2n(1, prec));
- D.a = tmp;
- D.R = NULL;
- D.prec = prec;
- D.f = eval;
- D.E = E;
- a = mytra(a,tmp,0,"a");
- b = mytra(b,tmp,0,"b");
- D.w = gsin;
- return intnum(&D, &auxfour, a, b, tab, prec);
-}
-
-GEN
-intfouriercos(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN x, GEN tab, long prec)
-{
- auxint_t D;
- GEN tmp;
-
- if (gequal0(x)) return intnum(E, eval, a, b, tab, prec);
- tmp = gmul(x, Pi2n(1, prec));
- D.a = tmp;
- D.R = NULL;
- D.prec = prec;
- D.f = eval;
- D.E = E;
- a = mytra(a,tmp,1,"a");
- b = mytra(b,tmp,1,"b");
- D.w = gcos;
- return intnum(&D, &auxfour, a, b, tab, prec);
-}
-
-GEN
-intfourierexp(void *E, GEN (*eval)(void*, GEN), GEN a, GEN b, GEN x, GEN tab,
- long prec)
-{
- pari_sp ltop = avma;
- GEN R = intfouriercos(E, eval, a, b, x, tab, prec);
- GEN I = intfouriersin(E, eval, a, b, x, tab, prec);
- return gerepileupto(ltop, gadd(R, mulcxmI(I)));
-}
-
GEN
intnumromb(void *E, GEN (*eval)(void *, GEN), GEN a, GEN b, long flag, long prec)
{
@@ -1584,30 +1258,11 @@ intnum0(GEN a, GEN b, GEN code, GEN tab, long prec)
GEN
intcirc0(GEN a, GEN R, GEN code, GEN tab, long prec)
{ EXPR_WRAP(code, intcirc(EXPR_ARG, a, R, tab, prec)); }
-GEN
-intmellininv0(GEN sig, GEN x, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(code, intmellininv(EXPR_ARG, sig, x, tab, prec)); }
-GEN
-intlaplaceinv0(GEN sig, GEN x, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(code, intlaplaceinv(EXPR_ARG, sig, x, tab, prec)); }
-GEN
-intfourcos0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(code, intfouriercos(EXPR_ARG, a, b, x, tab, prec)); }
-GEN
-intfoursin0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(code, intfouriersin(EXPR_ARG, a, b, x, tab, prec)); }
-GEN
-intfourexp0(GEN a, GEN b, GEN x, GEN code, GEN tab, long prec)
-{ EXPR_WRAP(code, intfourierexp(EXPR_ARG, a, b, x, tab, prec)); }
-
-GEN
-intnuminitgen0(GEN a, GEN b, GEN code, long m, long flag, long prec)
-{ EXPR_WRAP(code, intnuminitgen(EXPR_ARG, a, b, m, flag, prec)); }
/* m and flag reversed on purpose */
GEN
-intfuncinit0(GEN a, GEN b, GEN code, long flag, long m, long prec)
-{ EXPR_WRAP(code, intfuncinit(EXPR_ARG, a, b, m, flag? 1: 0, prec)); }
+intfuncinit0(GEN a, GEN b, GEN code, long m, long prec)
+{ EXPR_WRAP(code, intfuncinit(EXPR_ARG, a, b, m, prec)); }
#if 0
/* Two variable integration */
@@ -1682,106 +1337,524 @@ intnumdoub0(GEN a, GEN b, int nc, int nd, int nf, GEN tabext, GEN tabint, long p
}
#endif
-/* Numerical summation routine assuming f holomorphic for Re(s) >= sig.
- * Computes sum_{n>=a} f(n) if sgn >= 0,
- * sum_{n>=a} (-1)^n f(n) otherwise, where a is real.
- * Variant of Abel-Plana. */
+/* The quotient-difference algorithm. Given a vector M, convert the series
+ * S = \sum_{n >= 0} M[n+1]z^n into a continued fraction.
+ * Compute the c[n] such that
+ * S = c[1] / (1 + c[2]z / (1+c[3]z/(1+...c[lim]z))),
+ * Compute A[n] and B[n] such that
+ * S = M[1]/ (1+A[1]*z+B[1]*z^2 / (1+A[2]*z+B[2]*z^2/ (1+...1/(1+A[lim\2]*z)))),
+ * Assume lim <= #M.
+ * Does not work for certain M. */
+
+/* Given a continued fraction CF output by the quodif program,
+convert it into an Euler continued fraction A(n), B(n), where
+$1/(1+c[2]z/(1+c[3]z/(1+..c[lim]z)))
+=1/(1+A[1]*z+B[1]*z^2/(1+A[2]*z+B[2]*z^2/(1+...1/(1+A[lim\2]*z)))). */
static GEN
-auxsum(void *E, GEN t)
+contfrac_Euler(GEN CF)
{
- auxint_t *D = (auxint_t*) E;
- GEN z = mkcomplex(D->a, t);
- return D->f(D->E, z);
+ long lima, limb, i, lim = lg(CF)-1;
+ GEN A, B;
+ lima = lim/2;
+ limb = (lim - 1)/2;
+ A = cgetg(lima+1, t_VEC);
+ B = cgetg(limb+1, t_VEC);
+ gel (A, 1) = gel(CF, 2);
+ for (i=2; i <= lima; ++i) gel(A,i) = gadd(gel(CF, 2*i), gel(CF, 2*i-1));
+ for (i=1; i <= limb; ++i) gel(B,i) = gneg(gmul(gel(CF, 2*i+1), gel(CF, 2*i)));
+ return mkvec2(A, B);
}
-/* assume that conj(f(z)) = f(conj(z)) */
+
static GEN
-auxsumintern1(void *E, GEN t, long sgn)
+contfracinit_i(GEN M, long lim)
{
- auxint_t *D = (auxint_t*) E;
- GEN z = mkcomplex(D->a, t), u = D->f(D->E, z);
- return sgn > 0 ? imag_i(u): real_i(u);
+ pari_sp av;
+ GEN e, q, c;
+ long lim2;
+ long j, k;
+ e = zerovec(lim);
+ c = zerovec(lim+1); gel(c, 1) = gel(M, 1);
+ q = cgetg(lim+1, t_VEC);
+ for (k = 1; k <= lim; ++k) gel(q, k) = gdiv(gel(M, k+1), gel(M, k));
+ lim2 = lim/2; av = avma;
+ for (j = 1; j <= lim2; ++j)
+ {
+ long l = lim - 2*j;
+ gel(c, 2*j) = gneg(gel(q, 1));
+ for (k = 0; k <= l; ++k)
+ gel(e, k+1) = gsub(gadd(gel(e, k+2), gel(q, k+2)), gel(q, k+1));
+ for (k = 0; k < l; ++k)
+ gel(q, k+1) = gdiv(gmul(gel(q, k+2), gel(e, k+2)), gel(e, k+1));
+ gel(c, 2*j+1) = gneg(gel(e, 1));
+ if (gc_needed(av, 3))
+ {
+ if (DEBUGMEM>1) pari_warn(warnmem,"contfracinit, %ld/%ld",j,lim2);
+ gerepileall(av, 3, &e, &c, &q);
+ }
+ }
+ if (odd(lim)) gel(c, lim+1) = gneg(gel(q, 1));
+ return c;
+}
+
+GEN
+contfracinit(GEN M, long lim)
+{
+ pari_sp ltop = avma;
+ GEN c;
+ switch(typ(M))
+ {
+ case t_RFRAC:
+ if (lim < 0) pari_err_TYPE("contfracinit",M);
+ M = gadd(M, zeroser(gvar(M), lim + 2)); /*fall through*/
+ case t_SER: M = gtovec(M); break;
+ case t_POL: M = gtovecrev(M); break;
+ case t_VEC: case t_COL: break;
+ default: pari_err_TYPE("contfracinit", M);
+ }
+ if (lim < 0)
+ lim = lg(M)-2;
+ else if (lg(M)-1 <= lim)
+ pari_err_COMPONENT("contfracinit", "<", stoi(lg(M)-1), stoi(lim));
+ if (lim < 0) retmkvec2(cgetg(1,t_VEC),cgetg(1,t_VEC));
+ c = contfracinit_i(M, lim);
+ return gerepilecopy(ltop, contfrac_Euler(c));
+}
+
+/* Evaluate at t the nlim first terms of the continued fraction output by
+ * contfracinit. */
+GEN
+contfraceval(GEN CF, GEN t, long nlim)
+{
+ pari_sp ltop = avma, btop;
+ long j;
+ GEN S = gen_0, S1, S2, A, B, tinv = ginv(t);
+ if (typ(CF) != t_VEC || lg(CF) != 3) pari_err_TYPE("contfraceval", CF);
+ A = gel(CF, 1); if (typ(A) != t_VEC) pari_err_TYPE("contfraceval", CF);
+ B = gel(CF, 2); if (typ(B) != t_VEC) pari_err_TYPE("contfraceval", CF);
+ if (nlim < 0)
+ nlim = lg(A)-1;
+ else if (lg(A) <= nlim)
+ pari_err_COMPONENT("contfraceval", ">", stoi(lg(A)-1), stoi(nlim));
+ if (lg(B)+1 <= nlim)
+ pari_err_COMPONENT("contfraceval", ">", stoi(lg(B)), stoi(nlim));
+ btop = avma;
+ if (nlim <= 1) return gerepileupto(ltop, gdiv(tinv, gadd(gel(A, 1), tinv)));
+ switch(nlim % 3)
+ {
+ case 2:
+ S = gdiv(gel(B, nlim-1), gadd(gel(A, nlim), tinv));
+ nlim--; break;
+
+ case 0:
+ S1 = gadd(gel(A, nlim), tinv);
+ S2 = gadd(gmul(gadd(gel(A, nlim-1), tinv), S1), gel(B, nlim-1));
+ S = gdiv(gmul(gel(B, nlim-2), S1), S2);
+ nlim -= 2; break;
+ }
+ /* nlim = 1 (mod 3) */
+ for (j = nlim; j >= 4; j -= 3)
+ {
+ GEN S3;
+ S1 = gadd(gadd(gel(A, j), tinv), S);
+ S2 = gadd(gmul(gadd(gel(A, j-1), tinv), S1), gel(B, j-1));
+ S3 = gadd(gmul(gadd(gel(A, j-2), tinv), S2), gmul(gel(B, j-2), S1));
+ S = gdiv(gmul(gel(B, j-3), S2), S3);
+ if (gc_needed(btop, 3)) S = gerepilecopy(btop, S);
+ }
+ S = gdiv(tinv, gadd(gadd(gel(A, 1), tinv), S));
+ return gerepileupto(ltop, S);
}
-/* no assumption */
+
+/* MONIEN SUMMATION */
+
+/* basic Newton, find x ~ z such that Q(x) = 0 */
static GEN
-auxsumintern(void *E, GEN t, long sgn)
+monrefine(GEN Q, GEN QP, GEN z, long prec)
{
- auxint_t *D = (auxint_t*) E;
- GEN u,v, z = mkcomplex(D->a, t);
- u = D->f(D->E, z); gel(z,2) = gneg(t);
- v = D->f(D->E, z); return sgn > 0 ? gsub(u, v) : gadd(u, v);
+ pari_sp av = avma;
+ GEN pr = poleval(Q, z);
+ for(;;)
+ {
+ GEN prnew;
+ z = gsub(z, gdiv(pr, poleval(QP, z)));
+ prnew = poleval(Q, z);
+ if (gcmp(gabs(prnew, prec), gabs(pr, prec)) >= 0) break;
+ pr = prnew;
+ }
+ z = gprec_w(z, 2*prec-2);
+ z = gsub(z, gdiv(poleval(Q, z), poleval(QP, z)));
+ return gerepileupto(av, z);
}
+/* (real) roots of Q, assuming QP = Q' and that half the roots are close to
+ * k+1, ..., k+m, m = deg(Q)/2-1. N.B. All roots are real and >= 1 */
static GEN
-auxsum0(void *E, GEN t) { return auxsumintern(E, t, 1); }
+monroots(GEN Q, GEN QP, long k, long prec)
+{
+ long j, n = degpol(Q), m = n/2 - 1;
+ GEN v2, v1 = cgetg(m+1, t_VEC);
+ for (j = 1; j <= m; ++j) gel(v1, j) = monrefine(Q, QP, stoi(k+j), prec);
+ Q = gdivent(Q, roots_to_pol(v1, varn(Q)));
+ v2 = real_i(roots(Q, prec)); settyp(v2, t_VEC);
+ return shallowconcat(v1, v2);
+}
+
+static void
+Pade(GEN M, GEN *pP, GEN *pQ)
+{
+ pari_sp av = avma;
+ long n = lg(M)-2, i;
+ GEN v = contfracinit_i(M, n), P = pol_0(0), Q = pol_1(0);
+ /* evaluate continued fraction => Pade approximants */
+ for (i = n-1; i >= 1; i--)
+ { /* S = P/Q: S -> v[i]*x / (1+S) */
+ GEN R = RgX_shift_shallow(RgX_Rg_mul(Q,gel(v,i)), 1);
+ Q = RgX_add(P,Q); P = R;
+ if (gc_needed(av, 3))
+ {
+ if (DEBUGMEM>1) pari_warn(warnmem,"Pade, %ld/%ld",i,n-1);
+ gerepileall(av, 3, &P, &Q, &v);
+ }
+ }
+ /* S -> 1+S */
+ *pP = RgX_add(P,Q);
+ *pQ = Q;
+}
+
static GEN
-auxsum1(void *E, GEN t) { return auxsumintern1(E, t, 1); }
+_zeta(void *E, GEN x, long prec)
+{ (void)E; return gzeta(x, prec); }
+/* compute zeta'(s) numerically. FIXME: replace by lfun variant */
static GEN
-auxsumalt0(void *E, GEN t) { return auxsumintern(E, t, -1); }
+gzetaprime(GEN s, long prec)
+{ return derivnum(NULL, _zeta, gtofp(s,prec), prec); }
+
+/* f(n) ~ \sum_{i > 0} f_i log(n)^k / n^(a*i + b); a > 0, a+b > 1 */
static GEN
-auxsumalt1(void *E, GEN t) { return auxsumintern1(E, t, -1); }
+sumnummonieninit0(GEN a, GEN b, long k, long prec)
+{
+ GEN c, M, vr, P, Q, Qp, R, vabs, vwt;
+ long bitprec = prec2nbits(prec), m, j, n;
+ double D = bitprec*LOG2/gtodouble(a);
+
+ n = (long)ceil(D/(log(D)-1));
+ prec = maxss(2*prec-2, nbits2prec((long)ceil((2*n+1)/LOG10_2)));
+ if (k && k != 1) pari_err_IMPL("log power > 1 in sumnummonieninit");
+ a = gprec_w(a, 2*prec-2);
+ b = gprec_w(b, 2*prec-2);
+ if (k == 0)
+ M = RgV_neg(veczeta(a, gadd(a,b), 2*n+2, prec));
+ else
+ {
+ M = cgetg(2*n+3, t_VEC);
+ for (m = 1; m <= 2*n+2; m++)
+ gel(M,m) = gzetaprime(gadd(gmulsg(m,a), b), prec);
+ }
+ Pade(M, &P,&Q);
+ Qp = RgX_deriv(Q);
+ if (gequal1(a))
+ {
+ vabs = vr = monroots(Q, Qp, k, prec);
+ c = b;
+ }
+ else
+ {
+ GEN ai = ginv(a);
+ vr = real_i(roots(Q, prec));
+ vabs = cgetg(n+1, t_VEC);
+ for (j = 1; j <= n; ++j) gel(vabs,j) = gpow(gel(vr,j), ai, prec);
+ c = gdiv(b,a);
+ }
+ c = gsubgs(c,1); if (gequal0(c)) c = NULL;
+ R = gdiv(P, Qp);
+ vwt = cgetg(n+1, t_VEC);
+ for (j = 1; j <= n; ++j)
+ {
+ GEN r = gel(vr,j), t = poleval(R,r);
+ if (c) t = gmul(t, gpow(r, c, prec));
+ gel(vwt,j) = t;
+ }
+ return mkvec2(vabs,vwt);
+}
+
+struct mon_w {
+ GEN w, a, b;
+ long n, j, prec;
+};
+/* w(x) / x^(a*(j+k)+b), k >= 1 */
+static GEN
+wrapmonw(void* E, GEN x)
+{
+ struct mon_w *W = (struct mon_w*)E;
+ long k, j = W->j, n = W->n, prec = W->prec, l = 2*n+4-j;
+ GEN wx = closure_callgen1prec(W->w, x, prec);
+ GEN v = cgetg(l, t_VEC);
+ GEN xa = gpow(x, gneg(W->a), prec), w = gmul(wx, gpowgs(xa, j));
+ w = gdiv(w, gpow(x,W->b,prec));
+ for (k = 1; k < l; k++) { gel(v,k) = w; w = gmul(w, xa); }
+ return v;
+}
+/* w(x) / x^(a*j+b) */
static GEN
-sumnumall(void *E, GEN (*eval)(void*, GEN), GEN a, GEN sig, GEN tab, long flag, long sgn, long prec)
+wrapmonw2(void* E, GEN x)
{
- GEN SI, S, nsig, b, signew;
- long si = 1, flii;
- pari_sp ltop = avma;
- auxint_t D;
-
- b = suminit_start(sig);
- flii = gequal0(gel(b,2));
- if (!is_scalar_t(typ(a))) pari_err_TYPE("sumnum",a);
- tab = sumnuminit0(sig, tab, sgn, prec);
+ struct mon_w *W = (struct mon_w*)E;
+ GEN wnx = closure_callgen1prec(W->w, x, W->prec);
+ return gdiv(wnx, gpow(x, gadd(gmulgs(W->a, W->j), W->b), W->prec));
+}
- signew = (typ(sig) == t_VEC) ? gel(sig,1) : sig;
- a = gceil(a); nsig = gmax(subis(a, 1), gceil(gsub(signew, ghalf)));
- if (sgn < 0) {
- if (mpodd(nsig)) nsig = addsi(1, nsig);
- si = mpodd(a) ? -1 : 1;
+static GEN
+sumnummonieninit_w(GEN w, GEN wfast, GEN a, GEN b, GEN n0, long prec)
+{
+ GEN c, M, P, Q, vr, vabs, vwt, R;
+ long bitprec = prec2nbits(prec), j, n;
+ double D = bitprec*LOG2/gtodouble(a);
+ struct mon_w S;
+
+ n = (long)ceil(D/(log(D)-1));
+ prec = maxss(2*prec-2, nbits2prec((long)ceil((2*n+1)/LOG10_2)));
+ S.w = w;
+ S.a = a = gprec_w(a, 2*prec-2);
+ S.b = b = gprec_w(b, 2*prec-2);
+ S.n = n;
+ S.prec = prec;
+ /* M[j] = sum(n >= n0, w(n) / n^(a*(j+n)+b) */
+ if (typ(wfast) == t_INFINITY)
+ {
+ GEN tab = sumnuminit(gen_1, prec);
+ S.j = 1;
+ M = sumnum((void*)&S, wrapmonw, n0, tab, prec);
}
- SI = real_0(prec);
- while (cmpii(a, nsig) <= 0)
+ else
+ {
+ GEN faj = gsub(wfast, b);
+ long j;
+ M = cgetg(2*n+3, t_VEC);
+ for (j = 1; j <= 2*n+2; j++)
+ {
+ faj = gsub(faj, a);
+ if (gcmpgs(faj, -2) <= 0)
+ {
+ S.j = j; setlg(M,j);
+ M = shallowconcat(M, sumnum((void*)&S, wrapmonw, n0, NULL, prec));
+ break;
+ }
+ S.j = j;
+ gel(M,j) = sumnum((void*)&S, wrapmonw2, mkvec2(n0,faj), NULL, prec);
+ }
+ }
+ Pade(M, &P,&Q);
+ vr = real_i(roots(Q, prec)); settyp(vr, t_VEC);
+ if (gequal1(a))
{
- SI = (si < 0) ? gsub(SI, eval(E, a)) : gadd(SI, eval(E, a));
- a = addsi(1, a); if (sgn < 0) si = -si;
+ vabs = vr;
+ c = b;
}
- D.a = gadd(nsig, ghalf);
- D.R = gen_0;
- D.f = eval;
- D.E = E;
- D.prec = prec;
- if (!flii)
- S = intnum_i(&D, sgn > 0? (flag ? &auxsum1 : &auxsum0)
- : (flag ? &auxsumalt1 : &auxsumalt0),
- gen_0, b, tab, prec);
else
{
- if (flag)
+ GEN ai = ginv(a);
+ vabs = cgetg(n+1, t_VEC);
+ for (j = 1; j <= n; ++j) gel(vabs,j) = gpow(gel(vr,j), ai, prec);
+ c = gdiv(b,a);
+ }
+ c = gsubgs(c,1); if (gequal0(c)) c = NULL;
+ R = gneg(gdiv(P, RgX_deriv(Q)));
+ vwt = cgetg(n+1, t_VEC);
+ for (j = 1; j <= n; j++)
+ gel(vwt,j) = poleval(R, gel(vr,j));
+ return mkvec3(vabs, vwt, n0);
+}
+
+static GEN
+sumnummonieninit_i(GEN asymp, GEN w, GEN n0, long prec)
+{
+ const char *fun = "sumnummonieninit";
+ GEN a, b, wfast = gen_0;
+ if (!w)
+ {
+ if (!asymp) return sumnummonieninit0(gen_1,gen_1,0,prec);
+ w = gen_0;
+ }
+ if (asymp)
+ {
+ if (typ(asymp) == t_VEC)
{
- GEN emp = leafcopy(tab); TABwm(emp) = TABwp(emp);
- S = gmul2n(intninfinf(&D, sgn > 0? &auxsum1: &auxsumalt1, emp),-1);
+ if (lg(asymp) != 3) pari_err_TYPE(fun, asymp);
+ a = gel(asymp,1);
+ b = gel(asymp,2);
}
else
- S = intninfinfintern(&D, &auxsum, tab, sgn);
+ b = a = asymp;
+ if (gsigne(a) <= 0)
+ pari_err_DOMAIN(fun, "a", "<=", gen_0, a);
+ if (gcmpgs(gadd(a,b), 1) <= 0)
+ pari_err_DOMAIN(fun, "a+b", "<=", gen_m1, mkvec2(a,b));
}
- if (flag) S = gneg(S);
- else
+ else a = b = gen_1;
+ if (!n0) n0 = gen_1;
+ if (typ(n0) != t_INT) pari_err_TYPE(fun, n0);
+ switch(typ(w))
{
- S = gmul2n(S, -1);
- S = (sgn < 0) ? gneg(S): mulcxI(S);
+ case t_INT:
+ if (cmpiu(n0, 2) <= 0)
+ {
+ GEN tab = sumnummonieninit0(a, b, itos(w), prec);
+ return shallowconcat(tab,n0);
+ }
+ w = strtofunction("log");
+ break;
+ case t_VEC:
+ if (lg(w) != 3) pari_err_TYPE(fun, w);
+ wfast = gel(w,2);
+ w = gel(w,1);
+ if (typ(w) != t_CLOSURE) pari_err_TYPE(fun, w);
+ case t_CLOSURE:
+ break;
+ default: pari_err_TYPE(fun, w);
}
- return gerepileupto(ltop, gadd(SI, S));
+ return sumnummonieninit_w(w, wfast, a, b, n0, prec);
}
GEN
-sumnum(void *E, GEN (*f)(void *, GEN), GEN a,GEN sig,GEN tab,long flag,long prec)
-{ return sumnumall(E,f,a,sig,tab,flag,1,prec); }
+sumnummonieninit(GEN asymp, GEN w, GEN n0, long prec)
+{
+ pari_sp av = avma;
+ return gerepilecopy(av, sumnummonieninit_i(asymp,w,n0,prec));
+}
+
+/* add 'a' to all components of v */
+static GEN
+RgV_Rg_addall(GEN v, GEN a)
+{
+ long i, l;
+ GEN w = cgetg_copy(v,&l);
+ for (i = 1; i < l; i++) gel(w,i) = gadd(gel(v,i), a);
+ return w;
+}
+
GEN
-sumnumalt(void *E, GEN (*f)(void *, GEN),GEN a,GEN s,GEN tab,long flag,long prec)
-{ return sumnumall(E,f,a,s,tab,flag,-1,prec); }
+sumnummonien(void *E, GEN (*eval)(void*,GEN), GEN n0, GEN tab, long prec)
+{
+ pari_sp av = avma;
+ GEN vabs, vwt, S;
+ long l, i;
+ if (typ(n0) != t_INT) pari_err_TYPE("sumnummonien", n0);
+ if (!tab)
+ tab = sumnummonieninit0(gen_1,gen_1,0,prec);
+ else switch(lg(tab))
+ {
+ case 4:
+ if (!equalii(n0, gel(tab,3)))
+ pari_err(e_MISC, "incompatible initial value %Ps != %Ps", gel(tab,3),n0);
+ case 3:
+ if (typ(tab) == t_VEC) break;
+ default: pari_err_TYPE("sumnummonien", tab);
+ }
+ vabs= gel(tab,1); l = lg(vabs);
+ vwt = gel(tab,2);
+ if (typ(vabs) != t_VEC || typ(vwt) != t_VEC || lg(vwt) != l)
+ pari_err_TYPE("sumnummonien", tab);
+ if (!isint1(n0)) vabs = RgV_Rg_addall(vabs, subis(n0,1));
+ S = gen_0;
+ for (i = 1; i < l; i++) S = gadd(S, gmul(gel(vwt,i), eval(E, gel(vabs,i))));
+ return gerepileupto(av, gprec_w(S, prec));
+}
+
+static GEN
+get_oo(GEN fast) { return mkvec2(mkoo(), fast); }
+
+GEN
+sumnuminit(GEN fast, long prec)
+{
+ pari_sp av;
+ GEN s, v, d, C, D, res = cgetg(6, t_VEC);
+ long bitprec = prec2nbits(prec), N, k, k2, m;
+ double w;
+
+ d = mkfrac(gen_1, utoipos(4)); /* 1/4 */
+ gel(res, 1) = d;
+ av = avma;
+ w = gtodouble(glambertW(ginv(d), LOWDEFAULTPREC));
+ N = (long)ceil(LOG2*bitprec/(w*(1+w))+5);
+ k = (long)ceil(N*w); if (k&1) k--;
+
+ prec += EXTRAPRECWORD;
+ s = RgX_to_ser(monomial(d,1,0), k+3);
+ s = gdiv(gasinh(s, prec), d); /* asinh(dx)/d */
+ s = gsub(ginv(gsubgs(gexp(s,prec), 1)), ginv(s));
+ k2 = k/2;
+ C = matpascal(k-1);
+ D = gpowers(ginv(gmul2n(d,1)), k-1);
+ v = cgetg(k2+1, t_VEC);
+ for (m = 1; m <= k2; m++)
+ {
+ pari_sp av = avma;
+ GEN S = real_0(prec);
+ long j;
+ for (j = m; j <= k2; j++)
+ { /* s[X^(2j-1)] * binomial(2*j-1, j-m) / (2d)^(2j-1) */
+ GEN t = gmul(gmul(gel(s,2*j+1), gcoeff(C, 2*j,j-m+1)), gel(D, 2*j));
+ S = odd(j)? gsub(S,t): gadd(S,t);
+ }
+ if (odd(m)) S = gneg(S);
+ gel(v,m) = gerepileupto(av, S);
+ }
+ v = RgC_gtofp(v,prec); settyp(v, t_VEC);
+ gel(res, 4) = gerepileupto(av, v);
+ gel(res, 2) = utoi(N);
+ gel(res, 3) = utoi(k);
+ if (!fast) fast = get_oo(gen_0);
+ gel(res, 5) = intnuminit(gel(res,2), fast, 0, prec);
+ return res;
+}
+
+static int
+checksumtab(GEN T)
+{
+ if (typ(T) != t_VEC || lg(T) != 6) return 0;
+ return typ(gel(T,2))==t_INT && typ(gel(T,3))==t_INT && typ(gel(T,4))==t_VEC;
+}
+GEN
+sumnum(void *E, GEN (*eval)(void*, GEN), GEN a, GEN tab, long prec)
+{
+ pari_sp av = avma;
+ GEN v, tabint, S, d, fast;
+ long as, N, k, m, prec2;
+ if (!a) { a = gen_1; fast = get_oo(gen_0); }
+ else switch(typ(a))
+ {
+ case t_VEC:
+ if (lg(a) != 3) pari_err_TYPE("sumnum", a);
+ fast = get_oo(gel(a,2));
+ a = gel(a,1); break;
+ default:
+ fast = get_oo(gen_0);
+ }
+ if (typ(a) != t_INT) pari_err_TYPE("sumnum", a);
+ if (!tab) tab = sumnuminit(fast, prec);
+ else if (!checksumtab(tab)) pari_err_TYPE("sumnum",tab);
+ as = itos(a);
+ d = gel(tab,1);
+ N = maxss(as, itos(gel(tab,2)));
+ k = itos(gel(tab,3));
+ v = gel(tab,4);
+ tabint = gel(tab,5);
+ prec2 = prec+EXTRAPRECWORD;
+ S = gmul(eval(E, stoi(N)), real2n(-1,prec2));
+ for (m = as; m < N; m++) S = gadd(S, eval(E, stoi(m)));
+ for (m = 1; m <= k/2; m++)
+ {
+ GEN t = gmulsg(2*m-1, d);
+ GEN s = gsub(eval(E, gsubsg(N,t)), eval(E, gaddsg(N,t)));
+ S = gadd(S, gmul(gel(v,m), s));
+ }
+ S = gadd(S, intnum(E, eval,stoi(N), fast, tabint, prec2));
+ return gerepilecopy(av, gprec_w(S, prec));
+}
GEN
-sumnum0(GEN a, GEN sig, GEN code, GEN tab, long flag, long prec)
-{ EXPR_WRAP(code, sumnum(EXPR_ARG, a, sig, tab, flag, prec)); }
+sumnummonien0(GEN a, GEN code, GEN tab, long prec)
+{ EXPR_WRAP(code, sumnummonien(EXPR_ARG, a, tab, prec)); }
GEN
-sumnumalt0(GEN a, GEN sig, GEN code, GEN tab, long flag, long prec)
-{ EXPR_WRAP(code, sumnumalt(EXPR_ARG, a, sig, tab, flag, prec)); }
+sumnum0(GEN a, GEN code, GEN tab, long prec)
+{ EXPR_WRAP(code, sumnum(EXPR_ARG, a, tab, prec)); }
diff --git a/src/language/sumiter.c b/src/language/sumiter.c
index 0b39f9d..bb3aaaa 100644
--- a/src/language/sumiter.c
+++ b/src/language/sumiter.c
@@ -1216,7 +1216,10 @@ vecexpr0(GEN vec, GEN code, GEN pred)
{
case t_LIST:
{
- vec = list_data(vec);
+ if (list_typ(vec)==t_LIST_MAP)
+ vec = mapdomain_shallow(vec);
+ else
+ vec = list_data(vec);
if (!vec) return cgetg(1, t_VEC);
break;
}
@@ -1666,9 +1669,7 @@ zbrent0(GEN a, GEN b, GEN code, long prec)
* return D.res; */
/********************************************************************/
-/** **/
-/** Numerical derivation **/
-/** **/
+/** Numerical derivation **/
/********************************************************************/
struct deriv_data
@@ -1677,11 +1678,11 @@ struct deriv_data
GEN args;
};
-static GEN deriv_eval(void *E, GEN x)
+static GEN deriv_eval(void *E, GEN x, long prec)
{
struct deriv_data *data=(struct deriv_data *)E;
gel(data->args,1)=x;
- return closure_callgenvec(data->code, data->args);
+ return closure_callgenvecprec(data->code, data->args, prec);
}
/* Rationale: (f(2^-e) - f(-2^-e) + O(2^-pr)) / (2 * 2^-e) = f'(0) + O(2^-2e)
@@ -1692,7 +1693,7 @@ static GEN deriv_eval(void *E, GEN x)
* For f'(x), x far from 0: prec(LHS) = pr - e - expo(x)
* --> pr = 3/2 fpr + expo(x) */
GEN
-derivnum(void *E, GEN (*eval)(void *, GEN), GEN x, long prec)
+derivnum(void *E, GEN (*eval)(void *, GEN, long), GEN x, long prec)
{
GEN eps,a,b, y;
long pr, l, e, ex, newprec;
@@ -1713,16 +1714,14 @@ derivnum(void *E, GEN (*eval)(void *, GEN), GEN x, long prec)
e = fpr/2; /* 1/2 required prec (in sig. bits) */
eps = real2n(-e, l);
- if (eval==gp_eval || eval==deriv_eval) push_localprec(newprec);
- a = eval(E, gsub(x, eps));
- b = eval(E, gadd(x, eps));
- if (eval==gp_eval || eval==deriv_eval) pop_localprec();
+ a = eval(E, gsub(x, eps), newprec);
+ b = eval(E, gadd(x, eps), newprec);
y = gmul2n(gsub(b,a), e-1);
return gerepileupto(av, gprec_w(y, nbits2prec(fpr)));
}
GEN
-derivfun(void *E, GEN (*eval)(void *, GEN), GEN x, long prec)
+derivfun(void *E, GEN (*eval)(void *, GEN, long), GEN x, long prec)
{
pari_sp av = avma;
long vx;
@@ -1734,7 +1733,7 @@ derivfun(void *E, GEN (*eval)(void *, GEN), GEN x, long prec)
x = RgX_to_ser(x, precdl+2+1); /* +1 because deriv reduce the precision by 1 */
case t_SER: /* FALL THROUGH */
vx = varn(x);
- return gerepileupto(av, gdiv(deriv(eval(E, x),vx), deriv(x,vx)));
+ return gerepileupto(av, gdiv(deriv(eval(E, x, prec),vx), deriv(x,vx)));
default: pari_err_TYPE("formal derivation",x);
return NULL; /*NOT REACHED*/
}
@@ -1743,7 +1742,7 @@ derivfun(void *E, GEN (*eval)(void *, GEN), GEN x, long prec)
GEN
derivnum0(GEN a, GEN code, long prec)
{
- EXPR_WRAP(code, derivfun (EXPR_ARG,a,prec));
+ EXPR_WRAP(code, derivfun (EXPR_ARGPREC,a,prec));
}
GEN
@@ -1753,3 +1752,178 @@ derivfun0(GEN code, GEN args, long prec)
E.code=code; E.args=args;
return derivfun((void*)&E, deriv_eval, gel(args,1), prec);
}
+
+/********************************************************************/
+/** Numerical extrapolation **/
+/********************************************************************/
+
+static double
+extgetmf(long muli)
+{
+ double mulfact[] = {0.5,0.5,0.48,0.43,0.41,0.39,0.38,0.37,0.36,0.36,0.35};
+ if (muli > 100) return 0.35*LOG10_2;
+ return mulfact[muli/10]*LOG10_2;
+}
+
+/* [u(n*muli), u <= N], muli = 1 unless f!=NULL */
+static GEN
+get_u(void *E, GEN (*f)(void *, GEN, long), long N, long muli, long prec)
+{
+ long n;
+ GEN u;
+ if (f)
+ {
+ u = cgetg(N+1, t_VEC);
+ for (n = 1; n <= N; n++) gel(u,n) = f(E, stoi(muli*n), prec);
+ }
+ else
+ {
+ u = (GEN)E;
+ n = lg(u)-1;
+ if (n < N) pari_err_COMPONENT("limitnum","<",stoi(N), stoi(n));
+ u = vecslice(u, 1, N);
+ }
+ for (n = 1; n <= N; n++)
+ {
+ GEN un = gel(u,n);
+ if (is_rational_t(typ(un))) gel(u,n) = gtofp(un, prec);
+ }
+ return u;
+}
+
+struct limit
+{
+ long prec0; /* target accuracy */
+ long prec; /* working accuracy */
+ long N; /* number of terms */
+ GEN u; /* sequence to extrapolate */
+ GEN na; /* [n^alpha, n <= N] */
+ GEN nma; /* [n^-alpha, n <= N] or NULL (alpha = 1) */
+ GEN coef; /* or NULL (alpha != 1) */
+};
+
+static void
+limit_init(struct limit *L, void *E, GEN (*f)(void*,GEN,long),
+ long muli, GEN alpha, long prec)
+{
+ long bitprec = prec2nbits(prec), N;
+ GEN na;
+ long n;
+
+ if (muli <= 0) muli = 20;
+ if (!f) muli = 1;
+ L->N = N = (long)ceil(extgetmf(muli)*bitprec);
+ L->prec = nbits2prec((long)ceil(1.25*bitprec) + 32);
+ L->prec0 = prec;
+ L->u = get_u(E, f, N, muli, L->prec);
+ if (alpha && gcmp1(alpha)) alpha = NULL;
+ L->na = na = cgetg(N+1, t_VEC);
+ for (n = 1; n <= N; n++)
+ {
+ GEN c = utoipos(n*muli);
+ if (alpha) c = gpow(c, alpha, L->prec);
+ gel(na,n) = c;
+ }
+ if (alpha)
+ {
+ GEN nma, malpha = gneg(alpha);
+ L->coef = NULL;
+ L->nma= nma = cgetg(N+1, t_VEC);
+ for (n = 1; n <= N; n++)
+ {
+ GEN c = gpow(utoipos(n),malpha,L->prec);
+ if (typ(c) != t_REAL) c = gtofp(c, L->prec);
+ gel(nma, n) = c;
+ }
+ }
+ else
+ {
+ GEN coef, C = vecbinome(N);
+ L->coef = coef = cgetg(N+1, t_VEC);
+ L->nma = NULL;
+ for (n = 1; n <= N; n++)
+ {
+ GEN c = mulii(gel(C,n+1), powuu(n, N));
+ if (odd(N-n)) togglesign_safe(&c);
+ gel(coef, n) = c;
+ }
+ }
+}
+
+/* Zagier/Lagrange extrapolation */
+static GEN
+limitnum_i(struct limit *L)
+{
+ pari_sp av = avma;
+ GEN S;
+ if (L->nma)
+ S = polint(L->nma, L->u,gen_0,NULL);
+ else
+ S = gdiv(RgV_dotproduct(L->u,L->coef), mpfact(L->N));
+ return gerepilecopy(av, gprec_w(S, L->prec0));
+}
+GEN
+limitnum(void *E, GEN (*f)(void *, GEN, long), long muli, GEN alpha, long prec)
+{
+ struct limit L;
+ limit_init(&L, E,f, muli, alpha, prec);
+ return limitnum_i(&L);
+}
+GEN
+limitnum0(GEN u, long muli, GEN alpha, long prec)
+{
+ void *E = (void*)u;
+ GEN (*f)(void*,GEN,long) = NULL;
+ switch(typ(u))
+ {
+ case t_COL:
+ case t_VEC: break;
+ case t_CLOSURE: f = gp_callprec; break;
+ default: pari_err_TYPE("limitnum", u);
+ }
+ return limitnum(E,f, muli,alpha, prec);
+}
+
+GEN
+asympnum(void *E, GEN (*f)(void *, GEN, long), long muli, GEN alpha, long prec)
+{
+ const long MAX = 100;
+ pari_sp av = avma;
+ GEN u, vres = vectrunc_init(MAX);
+ long i;
+ struct limit L;
+ limit_init(&L, E,f, muli, alpha, prec);
+ u = L.u;
+ for(i = 1; i <= MAX; i++)
+ {
+ GEN a, s, v, p, q;
+ long n;
+ s = limitnum_i(&L);
+ /* NOT bestappr: lindep will "properly" ignore the lower bits */
+ v = lindep(mkvec2(gen_1, s));
+ p = negi(gel(v,1));
+ q = gel(v,2);
+ if (!signe(q)) break;
+ a = gdiv(p,q);
+ s = gsub(s, a);
+ /* |s|q^2 > eps */
+ if (!gcmp0(s) && gexpo(s) + 2*expi(q) > -17) break;
+ vectrunc_append(vres, a);
+ for (n = 1; n <= L.N; n++) gel(u,n) = gmul(gsub(gel(u,n), a), gel(L.na,n));
+ }
+ return gerepilecopy(av, vres);
+}
+GEN
+asympnum0(GEN u, long muli, GEN alpha, long prec)
+{
+ void *E = (void*)u;
+ GEN (*f)(void*,GEN,long) = NULL;
+ switch(typ(u))
+ {
+ case t_COL:
+ case t_VEC: break;
+ case t_CLOSURE: f = gp_callprec; break;
+ default: pari_err_TYPE("asympnum", u);
+ }
+ return asympnum(E,f, muli,alpha, prec);
+}
diff --git a/src/modules/ellfromeqn.c b/src/modules/ellfromeqn.c
new file mode 100644
index 0000000..bfdadd0
--- /dev/null
+++ b/src/modules/ellfromeqn.c
@@ -0,0 +1,165 @@
+/* Copyright (C) 2015 The PARI group.
+
+This file is part of the PARI/GP package.
+
+PARI/GP is free software; you can redistribute it and/or modify it under the
+terms of the GNU General Public License as published by the Free Software
+Foundation. It is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY WHATSOEVER.
+
+Check the License for details. You should have received a copy of it, along
+with the package; see the file 'COPYING'. If not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+#include "pari.h"
+#include "paripriv.h"
+
+/* This file is a C version by Bill Allombert of a GP script by
+ Fernando Rodriguez-Villegas */
+
+/* --------------- GP code --------------------------------------- */
+/* http://www.ma.utexas.edu/users/villegas/cnt/jacobians.gp */
+/* */
+/* Description: Compute long Weierstrass equation for genus 1 curve */
+/* given by a plane curve */
+/* */
+/* Original Author: Fernando Rodriguez-Villegas */
+/* villegas at math.utexas.edu */
+/* University of Texas at Austin */
+/* */
+/* Created: Tue Jun 7 2005 */
+/* */
+/*----------------------------------------------------------------- */
+
+/* The mathematic behind this is described in
+On the Jacobians of plane cubics,
+Artin, Michael and Rodriguez-Villegas, Fernando and Tate, John,
+Advances in Mathematics, 198, 2005, 1, 366--382
+DOI: 10.1016/j.aim.2005.06.004
+URL: http://dx.doi.org/10.1016/j.aim.2005.06.004
+PDF: http://www.sciencedirect.com/science/article/pii/S0001870805001775
+*/
+
+/* Input: coefficients of a cubic */
+/*t0*y^3+(s1+s0*x)*y^2 +(r2+r1*x+r0*x^2)*y+(q3+q2*x+q1*x^2+q0*x^3)=0*/
+
+static GEN
+jac_cubic(GEN t0, GEN s0, GEN s1, GEN r0, GEN r1, GEN r2, GEN q0, GEN q1, GEN q2, GEN q3)
+{
+ GEN p1 = cgetg(6, t_VEC);
+ gel(p1, 1) = gcopy(r1);
+ gel(p1, 2) = gneg(gadd(gadd(gmul(s0, q2), gmul(s1, q1)), gmul(r0, r2)));
+ gel(p1, 3) = gadd(gmul(gsub(gmul(gmulsg(9, t0), q0), gmul(s0, r0)), q3), gadd(gmul(gsub(gmul(gneg(t0), q1), gmul(s1, r0)), q2), gsub(gmul(gmul(gneg(s0), r2), q1), gmul(gmul(s1, r2), q0))));
+ gel(p1, 4) = gadd(gmul(gadd(gmul(gadd(gmul(gmulsg(-3, t0), r0), gsqr(s0)), q1), gadd(gmul(gmul(gmulsg(-3, s1), s0), q0), gmul(s1, gsqr(r0)))), q3), gadd(gadd(gmul(gmul(t0, r0), gsqr(q2)), gmul(gadd(gmul(gmul(s1, s0), q1), gadd(gmul(gadd(gmul(gmulsg(-3, t0), r2), gsqr(s1)), q0), gmul(gmul(s0, r0), r2))), q2)), gadd(gadd(gmul(gmul(t0, r2), gsqr(q1)), gmul(gmul(gmul(s1, r0), r2), q1)), gmul(gmul(s0, gsqr(r2)), q0))));
+ gel(p1, 5) = gadd(gadd(gmul(gsub(gadd(gmul(gmulsg(-27, gsqr(t0)), gsqr(q0)), gmul(gsub(gmul(gmul(gmulsg(9, t0), s0), r0), gpowgs(s0, 3)), q0)), gmul(t0, gpowgs(r0, 3))), gsqr(q3)), gmul(gadd(gmul(gadd(gmul(gsub(gmul(gmulsg(9, gsqr(t0)), q0), gmul(gmul(t0, s0), r0)), q1), gadd(gmul(gadd(gmul(gmul(gmulsg(-3, t0), s0), r1), gadd(gmul(gmul(gmulsg(3, t0), s1), r0), gmul(gmulsg(2, s1), gsqr(s0)))), q0), gsub(gmul(gmul(t0, gsqr(r0)), r1), gmul(gmul(s1, s0), gsqr(r0))))), q2), gadd(gadd(gadd(g [...]
+ return p1;
+}
+
+/* Input: coefficients of an equation */
+/* t0*y^2+(s0*x^2+s1*x+s2)*y+(r0*x^4+r1*x^3+r2*x^2+r3*x+r4)=0 */
+
+static GEN
+jac_quart(GEN t0, GEN s0, GEN s1, GEN s2, GEN r0, GEN r1, GEN r2, GEN r3, GEN r4)
+{
+ GEN p1 = cgetg(6, t_VEC);
+ gel(p1, 1) = gcopy(s1);
+ gel(p1, 2) = gsub(gmul(gneg(t0), r2), gmul(s0, s2));
+ gel(p1, 3) = gsub(gmul(gmul(gneg(t0), s2), r1), gmul(gmul(t0, s0), r3));
+ gel(p1, 4) = gadd(gadd(gadd(gmul(gneg(gsub(gmul(gmulsg(4, gsqr(t0)), r4), gmul(t0, gsqr(s2)))), r0), gmul(gmul(gsqr(t0), r1), r3)), gmul(gmul(gmul(t0, s0), s2), r2)), gmul(gmul(t0, gsqr(s0)), r4));
+ gel(p1, 5) = gsub(gsub(gsub(gmul(gneg(gadd(gsub(gadd(gmul(gneg(gsub(gmul(gmulsg(4, gpowgs(t0, 3)), r4), gmul(gsqr(t0), gsqr(s2)))), r2), gmul(gpowgs(t0, 3), gsqr(r3))), gmul(gmul(gmul(gsqr(t0), s1), s2), r3)), gmul(gmul(gsqr(t0), gsqr(s1)), r4))), r0), gmul(gmul(gpowgs(t0, 3), gsqr(r1)), r4)), gmul(gsub(gmul(gmul(gmul(gsqr(t0), s0), s2), r3), gmul(gmul(gmul(gsqr(t0), s0), s1), r4)), r1)), gmul(gmul(gmul(gsqr(t0), gsqr(s0)), r2), r4));
+ return p1;
+}
+
+/* Input: coefficients of an equation */
+/* (t0*x^2+t1*x+t2)*y^2+(r0*x^2+r1*x+r2)*y+(s0*x^2+s1*x+s2)=0 */
+
+static GEN
+jac_biquadr(GEN t0, GEN t1, GEN t2, GEN r0, GEN r1, GEN r2,
+ GEN s0, GEN s1, GEN s2)
+{
+ GEN p1 = cgetg(6, t_VEC);
+ gel(p1, 1) = gcopy(r1);
+ gel(p1, 2) = gneg(gadd(gadd(gadd(gmul(s2, t0), gmul(t2, s0)), gmul(t1, s1)), gmul(r2, r0)));
+ gel(p1, 3) = gadd(gmul(gmul(gneg(r2), s1), t0), gadd(gmul(gmul(gneg(t1), r2), s0), gsub(gmul(gmul(gneg(t2), r0), s1), gmul(gmul(t1, r0), s2))));
+ gel(p1, 4) = gadd(gmul(gadd(gmul(gadd(gmul(gmulsg(-4, t2), s2), gsqr(r2)), s0), gadd(gadd(gmul(t2, gsqr(s1)), gmul(gmul(t1, s2), s1)), gmul(gmul(r2, r0), s2))), t0), gadd(gmul(gadd(gmul(gmul(t2, t1), s1), gadd(gmul(gsqr(t1), s2), gmul(gmul(t2, r2), r0))), s0), gadd(gmul(gmul(gmul(t1, r2), r0), s1), gmul(gmul(t2, gsqr(r0)), s2))));
+ gel(p1, 5) = gadd(gadd(gmul(gsub(gmul(gsub(gmul(gmulsg(4, t2), gsqr(s2)), gmul(gsqr(r2), s2)), s0), gmul(gmul(t2, s2), gsqr(s1))), gsqr(t0)), gmul(gadd(gadd(gmul(gsub(gmul(gmulsg(4, gsqr(t2)), s2), gmul(t2, gsqr(r2))), gsqr(s0)), gmul(gadd(gadd(gmul(gneg(gsqr(t2)), gsqr(s1)), gmul(gsub(gmul(gmul(t2, r2), r1), gmul(t1, gsqr(r2))), s1)), gadd(gmul(gneg(gsqr(t1)), gsqr(s2)), gmul(gadd(gmul(gneg(t2), gsqr(r1)), gmul(gmul(t1, r2), r1)), s2))), s0)), gsub(gadd(gmul(gmul(gmul(gneg(t2), r2), r [...]
+ return p1;
+}
+
+
+INLINE long
+dg(GEN P, long v)
+{
+ if (typ(P)!=t_POL || varn(P)!=v || !signe(P))
+ return -1;
+ return degpol(P);
+}
+
+INLINE GEN
+co(GEN P, long i, long v)
+{
+ if (typ(P)!=t_POL || varn(P)!=v)
+ return i==0 ? P: gen_0;
+ if (i>degpol(P)) return gen_0;
+ return gel(P, i+2);
+}
+
+GEN
+ellfromeqn(GEN P)
+{
+ pari_sp av = avma;
+ long vx, vy, dx, dy, dm;
+ GEN r = gen_0;
+ if (typ(P)!=t_POL) pari_err_TYPE("ellfromeqn",P);
+ vx = varn(P); vy = gvar2(P);
+ if (vy==NO_VARIABLE) pari_err_TYPE("ellfromeqn",P);
+ dx = poldegree(P, vx);
+ dy = poldegree(P, vy);
+ dm = maxss(dx, dy);
+ if (dm == 2)
+ {
+ GEN p_0 = co(P, 0, vx), p_1 = co(P, 1, vx), p_2 = co(P, 2, vx);
+ r = jac_biquadr(co(p_2, 2, vy), co(p_2, 1, vy), co(p_2, 0, vy),
+ co(p_1, 2, vy), co(p_1, 1, vy), co(p_1, 0, vy),
+ co(p_0, 2, vy), co(p_0, 1, vy), co(p_0, 0, vy));
+ }
+ else if (dm == 3)
+ {
+ GEN p_0 = co(P, 0, vx), p_1 = co(P, 1, vx),
+ p_2 = co(P, 2, vx), p_3 = co(P, 3, vx);
+ if (dg(p_3, vy) > 0 || dg(p_2, vy) > 1 || dg(p_1, vy) > 2)
+ r = gen_0; /* genus > 1 */
+ else
+ r = jac_cubic( co(p_3, 0, vy),
+ co(p_2, 1, vy), co(p_2, 0, vy),
+ co(p_1, 2, vy), co(p_1, 1, vy), co(p_1, 0, vy),
+ co(p_0, 3, vy), co(p_0, 2, vy), co(p_0, 1, vy), co(p_0, 0, vy));
+ }
+ else if (dm == 4 && dx == 2)
+ {
+ GEN p_0 = co(P, 0, vx), p_1 = co(P, 1, vx), p_2 = co(P, 2, vx);
+ if (dg(p_2, vy) > 0 || dg(p_1, vy) > 2)
+ r = gen_0; /* genus > 1 */
+ else
+ r = jac_quart( co(p_2, 0, vy),
+ co(p_1, 2, vy), co(p_1, 1, vy), co(p_1, 0, vy),
+ co(p_0, 4, vy), co(p_0, 3, vy), co(p_0, 2, vy), co(p_0, 1, vy),
+ co(p_0, 0, vy));
+ }
+ else if (dm == 4 && dx == 4)
+ {
+ GEN p_0 = co(P, 0, vx), p_1 = co(P, 1, vx), p_2 = co(P, 2, vx),
+ p_3 = co(P, 3, vx), p_4 = co(P, 4, vx);
+ if (dg(p_4, vy) > 0 || dg(p_3, vy) > 0
+ || dg(p_2, vy) > 1 || dg(p_1, vy) > 1 || dg(p_0, vy) > 2)
+ r = gen_0; /* genus > 1 */
+ else
+ r = jac_quart(co(p_0, 2, vy),
+ co(p_2, 1, vy), co(p_1, 1, vy), co(p_0, 1, vy),
+ co(p_4, 0, vy), co(p_3, 0, vy), co(p_2, 0, vy),
+ co(p_1, 0, vy), co(p_0, 0, vy));
+ }
+ if (r==gen_0)
+ pari_err_DOMAIN("ellfromeqn", "genus", "!=", gen_1,P);
+ return gerepileupto(av, r);
+}
diff --git a/src/modules/kummer.c b/src/modules/kummer.c
index f2196fe..ed354da 100644
--- a/src/modules/kummer.c
+++ b/src/modules/kummer.c
@@ -141,27 +141,6 @@ idealsqrtn(GEN nf, GEN x, GEN gn, int strict)
return q? q: gen_1;
}
-/* Assume B an LLL-reduced basis, t a vector. Apply Babai's nearest plane
- * algorithm to (B,t) */
-static GEN
-Babai(GEN B, GEN t)
-{
- GEN C, N, G = gram_schmidt(B, &N), b = t;
- long j, n = lg(B)-1;
-
- C = cgetg(n+1,t_COL);
- for (j = n; j > 0; j--)
- {
- GEN c = gdiv( RgV_dotproduct(b, gel(G,j)), gel(N,j) );
- long e;
- c = grndtoi(c,&e);
- if (e >= 0) return NULL;
- if (signe(c)) b = RgC_sub(b, RgC_Rg_mul(gel(G,j), c));
- gel(C,j) = c;
- }
- return C;
-}
-
static GEN
reducebeta(GEN bnfz, GEN be, GEN ell)
{
@@ -188,7 +167,7 @@ reducebeta(GEN bnfz, GEN be, GEN ell)
GEN emb, z = get_arch_real(nf, be, &emb, prec);
if (z)
{
- GEN ex = Babai(elllogfu, z);
+ GEN ex = RgM_Babai(elllogfu, z);
if (ex)
{
be = nfdiv(nf, be, nffactorback(nf, fu, RgC_Rg_mul(ex,ell)));
@@ -573,7 +552,7 @@ fix_kernel(GEN K, GEN M, GEN vecMsup, long lW, long ell)
GEN Msup = gel(vecMsup,i);
ulong dotprod;
if (lgcols(Msup) != 2) continue;
- Msup = row_zm(Msup, 1);
+ Msup = zm_row(Msup, 1);
for (j=ffree; --j > 0; )
{
dotprod = Flv_dotproduct(Msup, gel(K,j), ell);
diff --git a/src/modules/stark.c b/src/modules/stark.c
index 323e655..daba549 100644
--- a/src/modules/stark.c
+++ b/src/modules/stark.c
@@ -272,7 +272,7 @@ GetPrimChar(GEN chi, GEN bnr, GEN bnrc, long prec)
M = bnrsurjection(bnr, bnrc);
(void)ZM_hnfall(shallowconcat(M, Mrc), &U, 1);
l = lg(M);
- U = rowslice(vecslice(U, l, lg(U)-1), 1, l-1);
+ U = matslice(U,1,l-1, l,lg(U)-1);
return gerepilecopy(av, get_Char(chi, initc, U, prec));
}
@@ -325,8 +325,7 @@ ComputeKernel0(GEN P, GEN cycA, GEN cycB)
GEN U, DB = diagonal_shallow(cycB);
rk = nbA + lg(cycB) - lg(ZM_hnfall(shallowconcat(P, DB), &U, 1));
- U = vecslice(U, 1,rk);
- U = rowslice(U, 1,nbA);
+ U = matslice(U, 1,nbA, 1,rk);
return gerepileupto(av, ZM_hnfmodid(U, cycA));
}
diff --git a/src/modules/thue.c b/src/modules/thue.c
index a011aae..8c878ad 100644
--- a/src/modules/thue.c
+++ b/src/modules/thue.c
@@ -135,7 +135,7 @@ T_A_Matrices(GEN MatFU, long r, GEN *eps5, long prec)
GEN A, p1, m1, IntM, nia, eps3, eps2;
long e = prec2nbits(prec);
- m1 = rowslice(vecslice(MatFU, 1,r), 1,r); /* minor order r */
+ m1 = matslice(MatFU, 1,r, 1,r); /* minor order r */
m1 = glog(gabs(m1, prec), prec); /* HIGH accuracy */
A = RgM_inv(m1); if (!A) pari_err_PREC("thue");
IntM = RgM_Rg_add(RgM_mul(A,m1), gen_m1);
diff --git a/src/test/32/asymp b/src/test/32/asymp
new file mode 100644
index 0000000..ac2de00
--- /dev/null
+++ b/src/test/32/asymp
@@ -0,0 +1,26 @@
+ *** Warning: new stack size = 20000000 (19.073 Mbytes).
+ realprecision = 115 significant digits
+-oo
+-85
+-oo
+-oo
+-oo
+[1, 1/12, 1/288, -139/51840, -571/2488320, 163879/209018880, 5246819/7524679
+6800, -534703531/902961561600, -4483131259/86684309913600, 432261921612371/5
+14904800886784000, 6232523202521089/86504006548979712000, -25834629665134204
+969/13494625021640835072000, -1579029138854919086429/97161300155814012518400
+00, 746590869962651602203151/116593560186976815022080000, 151151360102809790
+3631961/2798245444487443560529920000, -8849272268392873147705987190261/29969
+2087104605205332754432000000]
+[0, 1, -1/2, 1/3, -1/4, 1/5, -1/6, 1/7, -1/8, 1/9, -1/10, 1/11, -1/12, 1/13,
+ -1/14, 1/15, -1/16]
+[0, 1, -1/2, 1/3, -1/4, 1/5, -1/6, 1/7, -1/8, 1/9, -1/10, 1/11, -1/12, 1/13,
+ -1/14, 1/15, -1/16]
+[1, 0, -1/6, 0, 1/120, 0, -1/5040, 0, 1/362880, 0, -1/39916800, 0, 1/6227020
+800, 0, -1/1307674368000, 0]
+ realprecision = 38 significant digits
+1.0000000000000000000000000000000000000
+-27
+[0, -5/48, -7/64, -81/5120]
+[0, 1/12, 0, -1/360, 0, 1/1260, 0, -1/1680, 0, 1/1188, 0]
+Total time spent: 284
diff --git a/src/test/32/bessel b/src/test/32/bessel
index 9851bff..45742fe 100644
--- a/src/test/32/bessel
+++ b/src/test/32/bessel
@@ -22,7 +22,7 @@ besselh1
36876789097604882*I
[4, 1]: (1 - I) + (-1/6 + 1/2*I)*x^2 + (1/120 - 1/24*I)*x^4 + (-1/5040 + 1/7
20*I)*x^6 + O(x^7)
-[4, 2]: 0.67139670714180309041636401204046708055 - 0.43109886801837607952052
+[4, 2]: 0.67139670714180309041636401204046708054 - 0.43109886801837607952052
096729853340009*I
[4, 3]: 0.54097378993452809133091313466411641349 - 0.99024588024340488002335
195542348755756*I
@@ -72,7 +72,7 @@ besselh2
5711483489108*I
[4, 1]: (1 + I) + (-1/6 - 1/2*I)*x^2 + (1/120 + 1/24*I)*x^4 + (-1/5040 - 1/7
20*I)*x^6 + O(x^7)
-[4, 2]: 0.67139670714180309041636401204046708055 + 0.43109886801837607952052
+[4, 2]: 0.67139670714180309041636401204046708054 + 0.43109886801837607952052
096729853340009*I
[4, 3]: 0.54097378993452809133091313466411641349 + 0.99024588024340488002335
195542348755756*I
@@ -156,7 +156,7 @@ besselj
[3, 4]: 0.61416033492290361016921965837550234589 + 0.36502802882708778851335
190162868643100*I
[4, 1]: 1 - 1/6*x^2 + 1/120*x^4 - 1/5040*x^6 + O(x^7)
-[4, 2]: 0.67139670714180309041636401204046708055
+[4, 2]: 0.67139670714180309041636401204046708054
[4, 3]: 0.54097378993452809133091313466411641349
[4, 4]: 0.96790128289013061188438215640495233496 + 0.06020460621428170101212
6630105291248378*I
@@ -336,4 +336,4 @@ Mat(-0.78121282130028871654715000004796482055)
5.7412378153505365740198971395908944617 E-10
2.0105123109834969409015328783614871604 E-436 + 0.E-475*I
11.628856980944362293418444710423341176
-Total time spent: 32
+Total time spent: 24
diff --git a/src/test/32/compat b/src/test/32/compat
index 8351496..f9b770a 100644
--- a/src/test/32/compat
+++ b/src/test/32/compat
@@ -2854,8 +2854,8 @@ A function with that name existed in GP-1.39.15. Please update your script.
New syntax: nupow(x,n) ===> qfbnupow(x,n)
-qfbnupow(x,n): n-th power of primitive positive definite quadratic form x using
-nucomp and nudupl.
+qfbnupow(x,n,{L}): n-th power of primitive positive definite quadratic form x
+using nucomp and nudupl.
*** at top-level: o()
@@ -4574,4 +4574,4 @@ New syntax: texprint(x) ===> printtex(x)
printtex({str}*): outputs its string arguments in TeX format.
-Total time spent: 23
+Total time spent: 8
diff --git a/src/test/32/contfrac b/src/test/32/contfrac
index 4966d87..3a8fbff 100644
--- a/src/test/32/contfrac
+++ b/src/test/32/contfrac
@@ -66,4 +66,20 @@
[1 5 33]
+[[], []]
+[[-1], []]
+[[-1], [1/2]]
+[[-1, 1/3, 1/15, 1/35, 1/63, 1/99, 1/143, 1/195], [1/2, 1/36, 1/100, 1/196,
+1/324, 1/484, 1/676, 1/900]]
+ *** at top-level: contfraceval(e,1,10)
+ *** ^--------------------
+ *** contfraceval: non-existent component in contfraceval: index > 8
+410105312/150869313
+517656/190435
+410105312/150869313
+[[-2], [1]]
+[[], []]
+ *** at top-level: contfracinit(1)
+ *** ^---------------
+ *** contfracinit: incorrect type in contfracinit (t_INT).
Total time spent: 0
diff --git a/src/test/32/ell b/src/test/32/ell
index 0e9fb1b..0b8434a 100644
--- a/src/test/32/ell
+++ b/src/test/32/ell
@@ -74,6 +74,10 @@ Mod(1, 2)*j
Mod(1, 3)*j
a
a
+[5, -66, 148, 665, -15802]
+[3, -15, -40, 40, -181]
+[3, -15, -40, 40, -181]
+[5, -70, -300, 1956, -28305]
8*x^9 + 54*x^8 + 393*x^7 + 2373*x^6 + 6993*x^5 + 15267*x^4 + 19998*x^3 + 473
4*x^2 - 25880*x - 30932
[0, 0]
@@ -163,6 +167,9 @@ error("incorrect type in obj_check (t_VEC).")
^8 + 2^9 + O(2^11))), 2^3 + 2^4 + O(2^8), [2^-3 + 2^2 + 2^4 + 2^7 + 2^10 + O
(2^11), 2^-3 + 2^2 + 2^5 + 2^6 + 2^10 + O(2^13)]]
x^-2 + 31/15*x^2 + 2501/756*x^4 + 961/675*x^6 + 77531/41580*x^8 + O(x^9)
+[5.0000000000000000000000000000000000000, 4.99999999999999999999999999999999
+99998]
+[0]
[-1, -2*w]
[-1, 1/2*I]
[[-1, 1/2*I], [0.59200051084078635056480901325155142952, -6.5791855625999796
@@ -463,4 +470,4 @@ t + 1/3*t^3 - 1/2*t^4 + 14/15*t^5 + O(t^6)
*** ellformalw: domain error in ellformalw: precision <= 0
242.47010035195076100129810400142304776
0
-Total time spent: 476
+Total time spent: 436
diff --git a/src/test/32/ellanal b/src/test/32/ellanal
index 82445c8..ea773c2 100644
--- a/src/test/32/ellanal
+++ b/src/test/32/ellanal
@@ -2,23 +2,23 @@
[1, 0.30599977383405230182048368332167647445]
[2, 1.5186330005768535404603852157894440381]
[3, 10.391099400715804138751850510360917070]
-[5, 9997.0334671722554999496820788093288480]
+[5, 9997.0334671722554999496820788093288461]
[-339/16, 691/64]
[-3, 12]
[69648970982596494254458225/166136231668185267540804, 5389624350896046150780
04307258785218335/67716816556077455999228495435742408]
[553/17424, 25469/2299968]
-35
+30
[1317254400, 19916886528000]
0
2.8053554406276820682921020105298729343
--11.896004833586082242416037296368976713
+98.900778292211279593460469548777701093
1.5186330005768535404603852157894440381
0
2.80535544062768206829210201052987293427393419289431401051573873877896370606
9444052334712747100820315923332165307854
--11.896004833586082242416037296368976714435763715221464992944563773201706595
-82985109754671351911693790517073338635203
+98.9007782922112795934604695487777010937256627866976192105130347193178645983
+4656024843050255154457301289878660746149
1.51863300057685354046038521578944403815619503298984870317161018509598214549
5561104880431870004657718333754298413640
-Total time spent: 2188
+Total time spent: 1552
diff --git a/src/test/32/extract b/src/test/32/extract
index dd8d7bd..faaed15 100644
--- a/src/test/32/extract
+++ b/src/test/32/extract
@@ -59,6 +59,7 @@
[0, 0]
[0, 0]
[0, 0]
+Vec
[1]
[1, 0]
[1/x]
@@ -71,6 +72,7 @@
["a", "b"]
[[1, 3]~, [2, 4]~, [3, 5]~]
["e_INV", "gdiv", 0]
+(x)->my(f=Vec);f(x,4)
[1, 0, 0, 0]
[1, 0, 0, 0]
[1/x, 0, 0, 0]
@@ -83,6 +85,7 @@
error("incorrect type in gtovec (t_STR).")
error("incorrect type in gtovec (t_MAT).")
error("incorrect type in gtovec (t_ERROR).")
+(x)->my(f=Vec);f(x,-4)
[0, 0, 0, 1]
[0, 0, 1, 0]
[0, 0, 0, 1/x]
@@ -95,6 +98,7 @@ error("incorrect type in gtovec (t_ERROR).")
error("incorrect type in gtovec (t_STR).")
error("incorrect type in gtovec (t_MAT).")
error("incorrect type in gtovec (t_ERROR).")
+Vecrev
[1]
[0, 1]
[1/x]
@@ -107,18 +111,7 @@ error("incorrect type in gtovec (t_ERROR).")
["b", "a"]
[[3, 5]~, [2, 4]~, [1, 3]~]
[0, "gdiv", "e_INV"]
-[0, 0, 0, 1]
-[0, 0, 0, 1]
-[0, 0, 0, 1/x]
-[2, 3, 4, 5]
-[0, 0, 2, 1]
-[0, 0, 2, 1]
-[0, 0, 2, 1]
-[0, 3, 2, 1]
-[4, 3, 2, 1]
-error("incorrect type in gtovec (t_STR).")
-error("incorrect type in gtovec (t_MAT).")
-error("incorrect type in gtovec (t_ERROR).")
+(x)->my(f=Vecrev);f(x,4)
[1, 0, 0, 0]
[0, 1, 0, 0]
[1/x, 0, 0, 0]
@@ -131,6 +124,20 @@ error("incorrect type in gtovec (t_ERROR).")
error("incorrect type in gtovec (t_STR).")
error("incorrect type in gtovec (t_MAT).")
error("incorrect type in gtovec (t_ERROR).")
+(x)->my(f=Vecrev);f(x,-4)
+[0, 0, 0, 1]
+[0, 0, 0, 1]
+[0, 0, 0, 1/x]
+[2, 3, 4, 5]
+[0, 0, 2, 1]
+[0, 0, 2, 1]
+[0, 0, 2, 1]
+[0, 3, 2, 1]
+[4, 3, 2, 1]
+error("incorrect type in gtovec (t_STR).")
+error("incorrect type in gtovec (t_MAT).")
+error("incorrect type in gtovec (t_ERROR).")
+Col
[1]~
[1, 0]~
[1/x]~
@@ -143,6 +150,7 @@ error("incorrect type in gtovec (t_ERROR).")
["a", "b"]~
[[1, 2, 3], [3, 4, 5]]~
["e_INV", "gdiv", 0]~
+(x)->my(f=Col);f(x,4)
[1, 0, 0, 0]~
[1, 0, 0, 0]~
[1/x, 0, 0, 0]~
@@ -155,6 +163,7 @@ error("incorrect type in gtovec (t_ERROR).")
error("incorrect type in gtovec (t_STR).")
error("incorrect type in gtovec (t_MAT).")
error("incorrect type in gtovec (t_ERROR).")
+(x)->my(f=Col);f(x,-4)
[0, 0, 0, 1]~
[0, 0, 1, 0]~
[0, 0, 0, 1/x]~
@@ -167,6 +176,7 @@ error("incorrect type in gtovec (t_ERROR).")
error("incorrect type in gtovec (t_STR).")
error("incorrect type in gtovec (t_MAT).")
error("incorrect type in gtovec (t_ERROR).")
+Colrev
[1]~
[0, 1]~
[1/x]~
@@ -179,18 +189,7 @@ error("incorrect type in gtovec (t_ERROR).")
["b", "a"]~
[[3, 4, 5], [1, 2, 3]]~
[0, "gdiv", "e_INV"]~
-[0, 0, 0, 1]~
-[0, 0, 0, 1]~
-[0, 0, 0, 1/x]~
-[2, 3, 4, 5]~
-[0, 0, 2, 1]~
-[0, 0, 2, 1]~
-[0, 0, 2, 1]~
-[0, 3, 2, 1]~
-[4, 3, 2, 1]~
-error("incorrect type in gtovec (t_STR).")
-error("incorrect type in gtovec (t_MAT).")
-error("incorrect type in gtovec (t_ERROR).")
+(x)->my(f=Colrev);f(x,4)
[1, 0, 0, 0]~
[0, 1, 0, 0]~
[1/x, 0, 0, 0]~
@@ -203,6 +202,20 @@ error("incorrect type in gtovec (t_ERROR).")
error("incorrect type in gtovec (t_STR).")
error("incorrect type in gtovec (t_MAT).")
error("incorrect type in gtovec (t_ERROR).")
+(x)->my(f=Colrev);f(x,-4)
+[0, 0, 0, 1]~
+[0, 0, 0, 1]~
+[0, 0, 0, 1/x]~
+[2, 3, 4, 5]~
+[0, 0, 2, 1]~
+[0, 0, 2, 1]~
+[0, 0, 2, 1]~
+[0, 3, 2, 1]~
+[4, 3, 2, 1]~
+error("incorrect type in gtovec (t_STR).")
+error("incorrect type in gtovec (t_MAT).")
+error("incorrect type in gtovec (t_ERROR).")
+Vecsmall
Vecsmall([1])
Vecsmall([1, 0])
error("incorrect type in vectosmall (t_RFRAC).")
@@ -215,6 +228,7 @@ Vecsmall([1, 2, 3, 4, 5])
Vecsmall([97, 98])
error("incorrect type in vectosmall (t_MAT).")
error("incorrect type in vectosmall (t_ERROR).")
+(x)->my(f=Vecsmall);f(x,4)
Vecsmall([1, 0, 0, 0])
Vecsmall([1, 0, 0, 0])
error("incorrect type in gtovecsmall (t_RFRAC).")
@@ -227,6 +241,7 @@ Vecsmall([1, 2, 3, 4])
error("incorrect type in gtovecsmall (t_STR).")
error("incorrect type in gtovecsmall (t_MAT).")
error("incorrect type in gtovecsmall (t_ERROR).")
+(x)->my(f=Vecsmall);f(x,-4)
Vecsmall([0, 0, 0, 1])
Vecsmall([0, 0, 1, 0])
error("incorrect type in gtovecsmall (t_RFRAC).")
@@ -239,6 +254,7 @@ Vecsmall([1, 2, 3, 4])
error("incorrect type in gtovecsmall (t_STR).")
error("incorrect type in gtovecsmall (t_MAT).")
error("incorrect type in gtovecsmall (t_ERROR).")
+(x)->component(x,2)
error("incorrect type in component [leaf] (t_INT).")
1
x
@@ -251,6 +267,7 @@ x
error("incorrect type in component [leaf] (t_STR).")
[2, 4]~
0
+(x)->component(x,10)
error("incorrect type in component [leaf] (t_INT).")
0
error("non-existent component: index > 2")
@@ -263,6 +280,7 @@ error("non-existent component: index > 5")
error("incorrect type in component [leaf] (t_STR).")
error("non-existent component: index > 3")
error("non-existent component: index > 3")
+(x)->polcoeff(x,-1)
0
0
1
@@ -275,6 +293,7 @@ error("incorrect type in polcoeff (t_LIST).")
error("incorrect type in polcoeff (t_STR).")
error("non-existent component in polcoeff: index < 1")
error("incorrect type in polcoeff (t_ERROR).")
+(x)->polcoeff(x,2)
0
0
0
@@ -287,6 +306,7 @@ error("incorrect type in polcoeff (t_LIST).")
error("incorrect type in polcoeff (t_STR).")
[2, 4]~
error("incorrect type in polcoeff (t_ERROR).")
+(x)->polcoeff(x,10)
0
0
0
@@ -335,4 +355,4 @@ Vecsmall([4, 5, 3])
*** at top-level: [1..1/2]
*** ^------
*** [_.._]: incorrect type in [_.._] (t_FRAC).
-Total time spent: 4
+Total time spent: 0
diff --git a/src/test/32/fflog b/src/test/32/fflog
index c910d4f..97eed47 100644
--- a/src/test/32/fflog
+++ b/src/test/32/fflog
@@ -17,10 +17,11 @@
1
1
1
+1
error("incorrect type in generic discrete logarithm (order factorization) (t
_COMPLEX).")
error("incorrect type in generic discrete logarithm (order factorization) (t
_INT).")
error("incorrect type in factorback [not a factorization] (t_MAT).")
error("incorrect type in factorback [not an exponent vector] (t_COL).")
-Total time spent: 3068
+Total time spent: 4464
diff --git a/src/test/32/gamma b/src/test/32/gamma
index d8e27bf..69f6380 100644
--- a/src/test/32/gamma
+++ b/src/test/32/gamma
@@ -87,4 +87,7 @@ x^-1 - 0.57721566490153286060651209008240243104 + 0.989055995327972555395395
432 + 417274.602697087076269173737117822293981451080884873662980649365715022
9604257562187947297228515985952270200052467287642139293693997776338197086953
142287383*I
+0.99999999999999999999999999999942278433509846713939348790991858662495316863
+6615471796845732492343995375856774526593328777198552545340369146294559716293
+3800
Total time spent: 20
diff --git a/src/test/32/gammamellininv b/src/test/32/gammamellininv
new file mode 100644
index 0000000..633aaa7
--- /dev/null
+++ b/src/test/32/gammamellininv
@@ -0,0 +1,8 @@
+2.9297691204814688720898602967358433790 E-19976
+2.41 e-35
+3.68 e-40
+[1]
+[1, -3/64, 105/8192, -3465/524288, 675675/134217728, -43648605/8589934592, 7
+027425405/1099511627776, -677644592625/70368744177664, 609202488769875/36028
+797018963968, -78180986058800625/2305843009213693952]
+Total time spent: 3352
diff --git a/src/test/32/help b/src/test/32/help
index 118e565..d9cb229 100644
--- a/src/test/32/help
+++ b/src/test/32/help
@@ -147,7 +147,7 @@ List of the PARI types:
t_VEC : row vector [ code ] [ x_1 ] ... [ x_k ]
t_COL : column vector [ code ] [ x_1 ] ... [ x_k ]
t_MAT : matrix [ code ] [ col_1 ] ... [ col_k ]
- t_LIST : list [ code ] [ n ] [ nmax ][ vec ]
+ t_LIST : list [ cod1 ] [ cod2 ][ vec ]
t_STR : string [ code ] [ man_1 ] ... [ man_k ]
t_VECSMALL: vec. small ints [ code ] [ x_1 ] ... [ x_k ]
t_CLOSURE: functions [ code ] [ arity ] [ code ] [ operand ] [ data ] [ te
@@ -161,4 +161,4 @@ f =
g =
()->0
-Total time spent: 0
+Total time spent: 4
diff --git a/src/test/32/hyperell b/src/test/32/hyperell
index 9226f3b..32ef057 100644
--- a/src/test/32/hyperell
+++ b/src/test/32/hyperell
@@ -78,6 +78,7 @@
x^2 + 3*x
x^2 - 5
x^2 + x - 5
+x^4 + 3*x^3 - 3*x^2 - 9*x
x^4 - 20*x^2 - 10*x + 50
x^4 + 4*x^3 - 14*x^2 - 42*x + 14
x^4 + 3*x^3 - 27*x^2 - 26*x + 47
@@ -92,10 +93,11 @@ x^2 + 42*x - 2356
x^3 + 4*x^2 - 164*x - 180
x^3 - 10*x^2 - 154*x + 1508
x^2 + 9*x - 135
+x + 6
*** at top-level: hyperellcharpoly((25
*** ^--------------------
*** hyperellcharpoly: domain error in hyperellpadicfrobenius: H is singular at 5
*** at top-level: hyperellcharpoly((25
*** ^--------------------
*** hyperellcharpoly: domain error in hyperellpadicfrobenius: H is singular at 5
-Total time spent: 3264
+Total time spent: 3316
diff --git a/src/test/32/intnum b/src/test/32/intnum
index cfce8c1..cd95d0b 100644
--- a/src/test/32/intnum
+++ b/src/test/32/intnum
@@ -4,20 +4,21 @@
? \p96
realprecision = 96 significant digits
? check(intcirc(s=1,0.5,zeta(s)),1)
--93
-? check(intlaplaceinv(x=2,1,1/x),1)
--53
-? m=intnumstep();
-? check(intlaplaceinv(x=2,1,1/x,m+1),1)
--94
-? check(intlaplaceinv(x=5,1,1/x),1)
--83
-? check(intlaplaceinv(x=100,1,1/x),1)
--52
-? A=intmellininv(s=2,4,gamma(s)^3);
-? tab=intfuncinit(t=[-oo,4.5],[oo,4.5],gamma(2+I*t)^3,1);
-? check(intmellininvshort(2,4,tab),A)
--94
+-84
+? f(s)=gamma(s)^3;
+? c=2;
+? A=[-oo,3*Pi/2];
+? B=[+oo,3*Pi/2];
+? F(z)=my(a=-log(z));intnum(t=A,B,exp(a*I*t),T)*exp(a*c)/(2*Pi);
+? T=intfuncinit(t=A,B,f(c+I*t));
+? ref=F(4);
+? \p38
+ realprecision = 38 significant digits
+? T=intfuncinit(t=A,B,f(c+I*t));
+? check(F(4),ref)
+-37
+? \p96
+ realprecision = 96 significant digits
? f(x)=1/(exp(x)-1)-exp(-x)/x;
? F=truncate(f(t+O(t^7)));
? g(x)=if(x>1e-18,f(x),subst(F,t,x));
@@ -26,94 +27,98 @@
? check(intnum(x=0,[oo,1],g(x)),Euler)
-oo
? check(intnum(x=0,1,1/sqrt(x)),2)
--59
+-58
? check(intnum(x=[0,-1/2],1,1/sqrt(x)),2)
-oo
+? check(intnum(x=100000,oo,1/(1+x^2)),atan(1/100000))
+-oo
? check(intnum(x=[0,-1/2],[oo,-3/2],1/(sqrt(x)+x^(3/2))),Pi)
-oo
? check(intnum(x=[-oo,-3/2],[oo,-3/2],1/(1+abs(x)^(3/2))),8*Pi/sqrt(27))
-oo
+? check(intnum(x=-oo,oo,1/(1+x^2)),Pi)
+-oo
? f(x)=if(x<0,1/(1+(-x)^(3/2)),1/(1+x^(5/2)));
? a=4*Pi/sqrt(27)+2*(Pi/5)/sin(2*Pi/5);
? check(intnum(x=[-oo,-3/2],[oo,-5/2],f(x)),a)
-oo
? f(x)=if(x<0,1/(1+(-x)^(3/2)),exp(-x));
-? check(intnum(x=[-oo,-3/2],[oo,1],f(x)),1+4*Pi/sqrt(27))
+? check(intnum(x=[-oo,-3/2],[oo,1],f(x)),4*Pi/sqrt(27)+1)
+-oo
+? f(x)=if(x<0,1/(1+(-x)^(3/2)),sinc(x));
+? check(intnum(x=[-oo,-3/2],[oo,-I],f(x)),4*Pi/sqrt(27)+Pi/2)
+-oo
+? f(x)=if(x<0,exp(2*x),1/(1+x^(3/2)));
+? check(intnum(x=[-oo,2],[oo,-3/2],f(x)),1/2+4*Pi/sqrt(27))
+-oo
+? f(x)=if(x<0,exp(2*x),1/(1+x^(5/2)));
+? check(intnum(x=[-oo,2],[oo,-5/2],f(x)),1/2+2*(Pi/5)/sin(2*Pi/5))
+-oo
+? f(x)=if(x<0,exp(2*x),exp(-x));
+? check(intnum(x=[-oo,2],[oo,1],f(x)),3/2)
+-oo
+? f(x)=if(x<0,exp(2*x),sinc(x));
+? check(intnum(x=[-oo,2],[oo,-I],f(x)),1/2+Pi/2)
-oo
-? check(intnum(x=0,[oo,1],sin(x)/x),Pi/2)
+? f(x)=if(x<0,2*sinc(2*x),1/(1+x^(3/2)));
+? check(intnum(x=[-oo,-2*I],[oo,-3/2],f(x)),Pi/2+4*Pi/sqrt(27))
+-oo
+? f(x)=if(x<0,2*sinc(2*x),1/(1+x^(5/2)));
+? check(intnum(x=[-oo,-2*I],[oo,-5/2],f(x)),Pi/2+2*(Pi/5)/sin(2*Pi/5))
+-96
+? f(x)=if(x<0,2*sinc(2*x),exp(-x));
+? check(intnum(x=[-oo,-2*I],[oo,1],f(x)),Pi/2+1)
+-oo
+? f(x)=if(x<0,2*sinc(2*x),sinc(x));
+? check(intnum(x=[-oo,-2*I],[oo,-I],f(x)),Pi)
+-oo
+? f(x)=cos((3+tanh(x))*x)/sqrt(1+x^2);
+? a=intnum(x=[-oo,2*I],[oo,4*I],f(x),1);
+? check(intnum(x=[-oo,2*I],[oo,4*I],f(x)),a)
+-51
+? check(intnum(x=[0,-1/2],[1,-1/3],x^(-1/2)+(1-x)^(-1/3)),7/2)
+-95
+? T=intnuminit([0,-1/2],[1,-1/3]);
+? check(intnum(x=[0,-1/2],[1,-1/3],x^(-1/2)+(1-x)^(-1/3),T),7/2)
+-95
+? check(intnum(x=0,[oo,1],sinc(x)),Pi/2)
-2
-? check(intnum(x=0,[oo,-I],sin(x)/x),Pi/2)
+? check(intnum(x=0,[oo,-I],sinc(x)),Pi/2)
-oo
-? check(intnum(x=0,[oo,-2*I],sin(2*x)/x),Pi/2)
+? check(intnum(x=0,[oo,-2*I],2*sinc(2*x)),Pi/2)
-oo
-? A=intnum(x=0,1,(1-cos(x))/x^2)+intnum(x=1,oo,1/x^2)-intnum(x=1,[oo,I],cos(x)/x^2);
+? A=intnum(x=0,1,sinc(x/2)^2/2)+intnum(x=1,oo,1/x^2)-intnum(x=1,[oo,I],cos(x)/x^2);
? check(A,Pi/2)
-96
? check(intnum(x=0,[oo,1],sin(x)^3*exp(-x)),3/10)
--96
+-47
? check(intnum(x=0,[oo,-I],sin(x)^3*exp(-x)),3/10)
--88
-? tab=intnuminit(0,[oo,-I],m+1);
+-85
+? tab=intnuminit(0,[oo,-I],1);
? check(intnum(x=0,oo,sin(x)^3*exp(-x),tab),3/10)
-96
? check(intnum(x=0,[oo,-I],x^2*sin(x)),-2)
-oo
? tab=intnuminit(-1,1);
? check(intnum(x=-1,1,intnum(y=-sqrt(1-x^2),sqrt(1-x^2),x^2+y^2,tab),tab),Pi/2)
--93
-? \p308
- realprecision = 308 significant digits
-? a=sumpos(n=1,1/(n^3+n+1));
-? b=sumpos(n=1,1/(n^3+n+1),1);
-? check(a,b)
--307
-? tab=sumnuminit(2);
-? b=sumnum(n=1,2,1/(n^3+n+1),tab);
-? check(a,b)
--306
-? check(sumnum(n=1,2,1/(n^3+n+1),tab,1),a)
--306
-? a=sumpos(n=1,1/(n^2+1));
-? b=sumpos(n=1,1/(n^2+1),1);
-? check(a,b)
--307
-? b=sumnum(n=1,2,1/(n^2+1),tab,1);
-? check(a,b)
--305
-? check(sumnum(n=1,2,n^(-4/3),,1),zeta(4/3))
--110
-? tab=sumnuminit([2,-3/2]);
-? check(sumnum(n=1,[2,-3/2],1/(n*sqrt(n)),tab,1),zeta(3/2))
--305
-? check(suminf(n=1,2^(-n)),1)
--307
-? check(sumpos(n=1,2^(-n)),1)
--307
-? check(sumnum(n=1,[2,log(2)],2^(-n),intnumstep()+1,1),1)
--304
-? tab=sumnuminit(2,,-1);
-? a=sumnumalt(n=1,2,1/(n^3+n+1),tab,1);
-? b=sumalt(n=1,(-1)^n/(n^3+n+1));
-? check(a,b)
--307
+-95
? \p96
- realprecision = 96 significant digits
-? T=intnuminitgen(t,0,[1],exp(2*sinh(t)));
-? check(intnum(x=0,[1],1/(1+x^2),T),Pi/2)
--oo
-? T=intnuminitgen(t,0,[[1],1],exp(t-exp(-t)));
-? check(intnum(x=0,[[1],1],exp(-x),T),1)
--oo
-? intfourierexp(t=0,[[1],1],1/2,exp(-t^2))
-0.07515645001618094506724269142337819200573257288846457257682421833136020654
-01315089580450881170413 - 0.408148557374490719018171389392074027664154880556
-033855962874575972355801042051564345987971241498*I
-? intfouriercos(t=0,[[1],1],1/2,exp(-t^2))
-0.07515645001618094506724269142337819200573257288846457257682421833136020654
-01315089580450881170413
-? intfouriersin(t=0,[[1],1],1/2,exp(-t^2))
-0.40814855737449071901817138939207402766415488055603385596287457597235580104
-2051564345987971241498
+? check(intnumgauss(x=0,1,sin(x)),1-cos(1))
+-96
+? T=intnumgaussinit();
+? check(intnumgauss(x=0,1,1/(x+1),T),log(2))
+-oo
+? check(intnumgauss(x=0,1,1/(x+1)^(4/3),T),3-3/2^(1/3))
+-95
+? check(intnumgauss(x=2,1,x,T),-3/2)
+-oo
+? check(intnumgauss(x=-1,1,1/(1+x^2),20),Pi/2)
+-15
+? T=intnumgaussinit(100);
+? check(intnumgauss(x=-2,2,1/(1+x^2),T),2*atan(2))
+-41
+? check(intnumgauss(t=1,2,t,1),3/2)
+-oo
? \p38
realprecision = 38 significant digits
? intnumromb(x=0,1,sin(x))
@@ -122,17 +127,10 @@
0.45969769413186028259906339255702338970
? intnumromb(x=1,100,exp(-x^2),2)
0.13940279264033098824961630553871957887
-? intnumromb(x=0,1,sin(x)/x,3)
+? intnumromb(x=0,1,sinc(x),3)
0.94608307036718301494135331382317964743
? intnumromb(x=2,1,x,1)
-1.4999999999999999999999999999999999999
-? f(x)=-log(cos(x));
-? F=truncate(f(t+O(t^16)));
-? g(x)=if(x>1e-2,f(x),subst(F,t,x));
-? sumpos(n=1,g(1/n))
-0.94536905472633293526609521540827019813
-? sumpos(n=0,0)
-0.E-37
? intnuminit([oo,1+I],[oo,""])
*** intnuminit: Warning: real(z)*imag(z)!=0 in endpoint code, real(z) ignored.
*** at top-level: intnuminit([oo,1+I],
@@ -145,4 +143,4 @@
*** Warning: integral from -oo to -oo.
0
? print("Total time spent: ",gettime);
-Total time spent: 8489
+Total time spent: 2044
diff --git a/src/test/32/log b/src/test/32/log
index ecdd7b8..aa8424d 100644
--- a/src/test/32/log
+++ b/src/test/32/log
@@ -1,4 +1,5 @@
9.9999999999999999999999999999950000000 E-31
-5.7721566490153286060651209008157996401 E-31
+69.077552789821370520539743640530349012
error("not a prime number in p-adic log: 33.")
Total time spent: 0
diff --git a/src/test/32/map b/src/test/32/map
new file mode 100644
index 0000000..36fa2c5
--- /dev/null
+++ b/src/test/32/map
@@ -0,0 +1,14 @@
+Map([1, 2; 3, 4; 5, 6])
+[1, 3, 5]
+
+[1 2]
+
+[3 4]
+
+[5 6]
+
+Map([1, 4; 3, 16; 5, 36])
+Map([1, -2; 3, -4; 5, -6])
+[1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1]
+[1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1]
+Total time spent: 16
diff --git a/src/test/32/padic b/src/test/32/padic
index dec846c..0345e17 100644
--- a/src/test/32/padic
+++ b/src/test/32/padic
@@ -82,6 +82,8 @@
O(x)
3 + O(3^5)
O(x)
+3^-1 + O(3^3)
+O(x)
1 + 2*3 + 2*3^2 + 2*3^3 + 2*3^4 + O(3^5)
18446744073709551627 + 18446744073709551628*18446744073709551629 + O(1844674
4073709551629^2)
diff --git a/src/test/32/pol b/src/test/32/pol
index f9a2bdf..274b42a 100644
--- a/src/test/32/pol
+++ b/src/test/32/pol
@@ -38,4 +38,6 @@ x^2 + 1
2*x^2 + x + 1
6*x^3 + 2*x^2
"t_INT"
+ *** polroots: Warning: normalizing a polynomial with 0 leading term.
+[0.E-38 + 0.E-38*I]~
Total time spent: 0
diff --git a/src/test/32/printf b/src/test/32/printf
index c045293..91eade1 100644
--- a/src/test/32/printf
+++ b/src/test/32/printf
@@ -187,4 +187,5 @@ a
*** at top-level: printf("%c",'x)
*** ^---------------
*** printf: incorrect type in gtolong (t_POL).
-Total time spent: 0
+-0.0000000000000000000000000000000000000029387
+Total time spent: 4
diff --git a/src/test/32/qf b/src/test/32/qf
index 29371c2..efaf619 100644
--- a/src/test/32/qf
+++ b/src/test/32/qf
@@ -16,6 +16,9 @@ Vecsmall([0, 0, 0, 133, 165, 638, 396, 4268])
[]
[]
[0, 0, [;]]
+[0, 0, [;]]
+[]
+[0, 0, [;]]
*** at top-level: qfminim(L~*L,10^16)[
*** ^--------------------
*** qfminim: precision too low in qfminim.
@@ -66,4 +69,4 @@ Vecsmall([0, 0, 0, 133, 165, 638, 396, 4268])
*** at top-level: qfbil([1,2],[1,2],Ma
*** ^--------------------
*** qfbil: inconsistent operation 'RgV_RgM_mul' t_VEC (2 elts) , t_MAT (1x2).
-Total time spent: 16
+Total time spent: 12
diff --git a/src/test/32/qfb b/src/test/32/qfb
index 0d8775d..1971b27 100644
--- a/src/test/32/qfb
+++ b/src/test/32/qfb
@@ -10,6 +10,7 @@ Qfb(8, 13, 6)
Qfb(1, 1, 6)
Qfb(1009, 60, 99108027750247771)
Qfb(1, 0, 100000000000000000039)
+Qfb(1, 0, 100000000000000000039)
Qfb(1, 1, 6)
[Qfb(1, 1, 6), [22479, 76177; -39508, -133885]]
[Qfb(4, 3, -3, 0.E-38), [127327, -416128; -148995, 486943]]
@@ -22,4 +23,4 @@ Qfb(1, 1, 6)
*** qfbredsl2: incorrect type in qfbredsl2 (t_VEC).
Qfb(18446744073709551629, 4741036151112220792, 304625896260305173)
Qfb(18446744073709551629, 7562574061564804959, 775103267656920011, 0.E-38)
-Total time spent: 4
+Total time spent: 0
diff --git a/src/test/32/qfbclassno b/src/test/32/qfbclassno
index a0effb2..40e63a4 100644
--- a/src/test/32/qfbclassno
+++ b/src/test/32/qfbclassno
@@ -13,4 +13,5 @@
7688
8112
32448
-Total time spent: 8
+641278838681600
+Total time spent: 856
diff --git a/src/test/32/quad b/src/test/32/quad
index ec7bdb1..7306587 100644
--- a/src/test/32/quad
+++ b/src/test/32/quad
@@ -9,4 +9,20 @@
*** norml2: incorrect type in gnorml2 (t_QUAD).
1
2
+0
+0
+0
+0
+1
+1
+0
+ *** at top-level: quadgen(-8)<1
+ *** ^--
+ *** _<_: incorrect type in gsigne (t_QUAD).
+(a)->[sign(z)|z<-[a,a-1,a-2,1-a,2-a]]
+[1, 1, -1, -1, 1]
+[0, 1, -1, -1, 1]
+ *** at top-level: sign(quadgen(-8))
+ *** ^-----------------
+ *** sign: incorrect type in gsigne (t_QUAD).
Total time spent: 4
diff --git a/src/test/32/rnf b/src/test/32/rnf
index 85a89a6..08099aa 100644
--- a/src/test/32/rnf
+++ b/src/test/32/rnf
@@ -45,6 +45,10 @@
1
1
1
+ *** rnfisabelian: Warning: non-monic polynomial. Result of the form [nf,c].
+0
+ *** rnfisabelian: Warning: non-monic polynomial. Result of the form [nf,c].
+1
[x, 1]
[(-78/43*y^2 - 14/43*y + 173/43)*x^2 + (60/43*y^2 + 24/43*y - 143/43)*x + (-
23/43*y^2 - 35/43*y + 110/43), 1]
@@ -798,4 +802,4 @@ error("inconsistent operation 'RgV_RgC_mul' t_VEC (3 elts) , t_COL (2 elts).
*** at top-level: rnfidealtwoelt(L,[[1
*** ^--------------------
*** rnfidealtwoelt: incorrect type in idealtyp [non-square t_MAT] (t_MAT).
-Total time spent: 356
+Total time spent: 380
diff --git a/src/test/32/rnfkummer b/src/test/32/rnfkummer
index afd6bb0..1a000df 100644
--- a/src/test/32/rnfkummer
+++ b/src/test/32/rnfkummer
@@ -1,10 +1,9 @@
*** Warning: new stack size = 20000000 (19.073 Mbytes).
1
-x^3 + (-309809053782*y^3 - 3888997223751*y^2 - 6797301518349*y - 84052574654
-07)*x + (2110598365387467792592554352717526002539781865920923249*y^3 + 21641
-216011110540424109369276995877123124719593450117617*y^2 - 112415300673959930
-84134917692441162658808857634880256897*y - 756749747169262373129861936919845
-290814942520335331064)
+x^3 + (76444126945687692063*y^3 + 95851038938815977768*y^2 + 116634231131091
+141384*y - 106704642703262169792)*x + (6952769785407333647049967168852088370
+36*y^3 + 1295719319620829728106935660641332757336*y^2 - 63164151046984158739
+666320128496887188752*y + 34408889837655961514790658273160305237139)
2
x^3 + (-1547417164685*y^3 + 31806432693392*y^2 - 139471604300434*y - 1773556
14250444)*x + (17339620993155536027731830465024620*y^3 - 2221469729970792828
@@ -37,8 +36,8 @@ x^5 + 1497313810*x^3 + 153069990594216277067332440*x^2 - 9993317827227414657
08504771613701347765415*x - 421302153697978557238622899127897637801303537233
83633556328
6
-x^3 + (72*y^5 - 180*y^4 + 306*y^3 - 156*y^2 + 156*y + 132)*x + (144*y^5 - 36
-0*y^4 + 610*y^3 - 312*y^2 + 318*y + 250)
+x^3 + (6*y^4 - 6*y^3 + 6*y^2 - 6*y - 6)*x + (18*y^5 + 22*y^3 + 16*y^2 + 6*y
++ 2)
7
x^5 + (677308732982301944730030845266716201702837696162187325328/5*y^3 + 481
271319660811460139352501916644558975058261230836596652/5*y^2 - 3487807973304
@@ -132,4 +131,4 @@ x^3 - 3*x - 1
[]
21
x^5 - 10*x^3 + 5*x^2 + 10*x + 1
-Total time spent: 8644
+Total time spent: 17368
diff --git a/src/test/32/round4 b/src/test/32/round4
index 4c53871..1213dda 100644
--- a/src/test/32/round4
+++ b/src/test/32/round4
@@ -458,4 +458,10 @@
[1, 1/23737807549715*x + 1/23737807549715], -84
[1, 1/23737807549715*x + 1/23737807549715], -84
[1, x], -47332614610453741984512822900
-Total time spent: 2560
+1600000000000000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000854400000000000000002528000000000000000000000000000000
+0000000000000000000000000000000000000000000114062400000000000001349952000000
+0000000009985600000000000000000000000000000000000000000000000000000000000000
+0000000001802185920000000000005332310400000000000000000000000000000000000000
+00000000000000000000000000000000000000000000000000007118634384
+Total time spent: 2636
diff --git a/src/test/32/ser b/src/test/32/ser
index e650956..1b11509 100644
--- a/src/test/32/ser
+++ b/src/test/32/ser
@@ -18,6 +18,9 @@ O(x^5)
x + x^2 - 1/3*x^3 - x^4 + O(x^5)
O(x^5)
[0.76159415595576488811945828260479359041 + O(x^16)]
+x^-1 - 1 + 4/3*x - 2/3*x^2 + O(x^3)
+O(x^5)
+[1.3130352854993313036361612469308478329 + O(x^16)]
1.5707963267948966192313216916397514421*I - 1.000000000000000000000000000000
0000000*I*x - 1.0000000000000000000000000000000000000*I*x^2 - 0.166666666666
66666666666666666666666667*I*x^3 - 0.50000000000000000000000000000000000000*
@@ -79,4 +82,4 @@ x^-1 + O(x)
[0, 1, 1]
[0, 1, 1]
[0, 1, 1]
-Total time spent: 0
+Total time spent: 4
diff --git a/src/test/32/sumnum b/src/test/32/sumnum
new file mode 100644
index 0000000..6b14123
--- /dev/null
+++ b/src/test/32/sumnum
@@ -0,0 +1,42 @@
+ *** Warning: new stack size = 20000000 (19.073 Mbytes).
++oo
++oo
+-38
+ *** at top-level: sumnummonien(n=3,1/n^2,tab)
+ *** ^----------
+ *** incompatible initial value 1 != 3.
+(n)->1/(n^2+1)
+-38
+-38
+(n)->log(1+1/n)/n
+-36
+-38
+(n)->lngamma(1+1/n)/n
+-37
++oo
+(n)->sin(1/sqrt(n))/n^(3/2)
+-36
++oo
+2.3979771206715998375659850036324914714
+-37
+-38
++oo
++oo
+-36
+ realprecision = 308 significant digits
+-307
+-307
+-307
+-307
+-305
+-305
+-307
+-307
++oo
+ realprecision = 38 significant digits
+0.94536905472633293526609521540827019813
+0.E-37
+ *** at top-level: sumnum(n=1,1/n^2,"bug")
+ *** ^------------
+ *** incorrect type in sumnum (t_STR).
+Total time spent: 4372
diff --git a/src/test/32/trans2 b/src/test/32/trans2
index 78f4f2d..59f0ad5 100644
--- a/src/test/32/trans2
+++ b/src/test/32/trans2
@@ -86,5 +86,20 @@ O(x)
8866770*I
2.2048475583142180027021126820970067173 - 1.02440088160844588172486045441088
66770*I
+1.0000000000000000000000000000000000000
+0.95885107720840600054657587043114277616
+1101.3232874703393377236524554846364403
+0.96671074810035670154056228439966270092 - 0.3317468333156205932854800814081
+5291940*I
+1 + O(3^2)
+1 + 3 + 3^2 + O(3^3)
+ *** at top-level: sinc(2+O(3^2))
+ *** ^--------------
+ *** sinc: domain error in gsinc(t_PADIC): argument out of range
+1 - 1/6*x^2 + 1/120*x^4 - 1/5040*x^6 + 1/362880*x^8 - 1/39916800*x^10 + 1/62
+27020800*x^12 - 1/1307674368000*x^14 + O(x^16)
+ *** at top-level: sinc(1/x)
+ *** ^---------
+ *** sinc: domain error in sinc: valuation < 0
0.E-2003
-Total time spent: 4
+Total time spent: 12
diff --git a/src/test/32/version b/src/test/32/version
new file mode 100644
index 0000000..5b71dcb
--- /dev/null
+++ b/src/test/32/version
@@ -0,0 +1,2 @@
+[2, 8, 0]
+Total time spent: 0
diff --git a/src/test/32/zetamult b/src/test/32/zetamult
new file mode 100644
index 0000000..6c7c7a7
--- /dev/null
+++ b/src/test/32/zetamult
@@ -0,0 +1,27 @@
+-38
+-38
+-38
+-38
+ *** at top-level: zetamult("a")
+ *** ^-------------
+ *** zetamult: incorrect type in zetamult (t_STR).
+1.6449340668482264364724151666460251892
+1
+ *** at top-level: zetamult([1,2])
+ *** ^---------------
+ *** zetamult: domain error in zetamult: s[1] = 1
+360.000000000000000000000000000000000000000000000000000000
+1814400.00000000000000000000000000000000000000000000000000
+43589145600.0000000000000000000000000000000000000000000000
+3201186852864000.00000000000000000000000000000000000000000
+562000363888803840000.000000000000000000000000000000000000
+201645730563302817792000000.000000000000000000000000000000
+132626429906095529318154240000000.000000000000000000000000
+147616399519802070423809304821760000000.000000000000000000
+261511308733300555880003612050037145600000000.000000000000
+702503058876439949271571303122255784968192000000000.000000
+[3360, 46830, -6615, 210, -2]~
+[48, 2667, -299, 3, 0]~
+[480, -13650, 1455, -8, 0]~
+[5040, -201915, 25200, -504, 2]~
+Total time spent: 44
diff --git a/src/test/in/asymp b/src/test/in/asymp
new file mode 100644
index 0000000..bd6eac5
--- /dev/null
+++ b/src/test/in/asymp
@@ -0,0 +1,32 @@
+default(parisize, 20M);
+check(a,b) = my(t = abs((a-b)/b)); if (t, ceil(log(t)/log(10)), -oo);
+
+default(realprecision, 211);
+pi=Pi;
+
+\p115
+v = vector(1120,n,n*sin(1/n));
+check(limitnum(n -> n*sin(1/n)), 1)
+check(limitnum(v), 1)
+check(limitnum(n -> n^2*sin(1/n^2),,2), 1)
+check(limitnum(n -> n^2*sin(1/n^2),10,2), 1)
+check(limitnum(n -> (1+1/n)^n), exp(1))
+
+f(n) = n! / (n^n*exp(-n)*sqrt(2*Pi*n));
+asympnum(f)
+asympnum(n->log(1+1/n^2),,2)[1..17]
+
+\p115
+asympnum(n->log(1+1/n^pi),,pi)[1..17]
+asympnum(v)
+
+\p38
+log(limitnum(n->(1+1/n)^n))
+
+h(n)=my(a=1,A=1,B=1.); vector(n, i, a=B/i;A+=a;B+=A; a);
+H=h(160000);
+b(n)=log(H[n])-(2*sqrt(n)-3/4*log(n));
+C=-1/2-log(2*sqrt(Pi));
+check(limitnum(n->b(n^2)), C)
+asympnum(n->b(n^2)-C)
+asympnum(n->lngamma(n+1)-(n+1/2)*log(n)+n-1/2*log(2*Pi))
diff --git a/src/test/in/contfrac b/src/test/in/contfrac
index 9457154..fcdccaf 100644
--- a/src/test/in/contfrac
+++ b/src/test/in/contfrac
@@ -16,3 +16,16 @@ contfracpnqn(v)
contfracpnqn(v,0)
contfracpnqn(v,1)
contfracpnqn(v,2)
+
+s=exp(x);
+contfracinit(s,0)
+contfracinit(s,1)
+contfracinit(s,2)
+e=contfracinit(s)
+contfraceval(e,1,10)
+contfraceval(e,1, 8)
+contfraceval(e,1, 6)
+contfraceval(e,1)
+contfracinit([1,2,3])
+contfracinit(Pol(0))
+contfracinit(1);
diff --git a/src/test/in/ell b/src/test/in/ell
index b0f302f..783df21 100644
--- a/src/test/in/ell
+++ b/src/test/in/ell
@@ -60,6 +60,12 @@ ellinit(ellfromj(Mod(0,3))).j
ellinit(ellfromj(j*Mod(1,3))).j
a=ffgen(2^5,'a);ellinit(ellfromj(a)).j
a=ffgen(3^5,'a);ellinit(ellfromj(a)).j
+
+ellfromeqn(y^3+(3+2*x)*y^2 +(6+5*x+4*x^2)*y+(10+9*x+8*x^2+7*x^3))
+ellfromeqn(y^2+(2*x^2+3*x+4)*y+(5*x^4+6*x^3+7*x^2+8*x+9))
+ellfromeqn(x^2+(2*y^2+3*y+4)*x+(5*y^4+6*y^3+7*y^2+8*y+9))
+ellfromeqn((x^2+2*x+3)*y^2+(4*x^2+5*x+6)*y+(7*x^2+8*x+9))
+
e = ellinit([1,2,3,5,7]);
elldivpol(e,4)
ellxn(e,0)
@@ -123,8 +129,17 @@ iferr(ellztopoint(e,3),E,E)
e = ellinit(ellfromj(11/8), O(2^5));
e.tate
+e = ellinit([0,-1,1,-10,-20]);
\\#1185
-ellwp(ellinit([0,-1,1,-10,-20]),x+O(x^12))
+ellwp(e,x+O(x^12))
+\\#1683
+ellztopoint(e,3*e.omega[1]/5)
+
+\\#1683
+e = ellinit([1,1,0,-1740,22184]);
+z=-3.0059315873096303229151114945365166621 + 0.E-36*I/2;
+ellztopoint(e,z)
+
\\#1186
ellmul(ellinit([3,0]), [1,2], -quadgen(-4))
diff --git a/src/test/in/extract b/src/test/in/extract
index 4eefef7..4987bee 100644
--- a/src/test/in/extract
+++ b/src/test/in/extract
@@ -20,7 +20,7 @@ matsize(vecextract(matid(6), 3, 0))
fun = [Vec,Vecrev,Col,Colrev,Vecsmall];
obj = [1, 'x, 1/x, Pol([5,4,3,2,1]), x+2*x^2+O(x^3),[1,2], Vecsmall([1,2]), List([1,2,3]), List([1,2,3,4,5]), "ab", [1,2,3;3,4,5], iferr(1/0,E,E)];
-test(f)= [ print(iferr(f(p),E,E)) | p<-obj ];
+test(f)= print(f);[ print(iferr(f(p),E,E)) | p<-obj ];
[if(1,test(f); test(x->f(x,4)); test(x->f(x,-4))) | f <- fun];
test(x->component(x,2));
test(x->component(x,10));
diff --git a/src/test/in/fflog b/src/test/in/fflog
index b075a8f..1c442f1 100644
--- a/src/test/in/fflog
+++ b/src/test/in/fflog
@@ -16,13 +16,13 @@ t = ffprimroot(ffgen(3^23)); fflog(t^12345678910,t)
t = ffprimroot(ffgen(5^23)); fflog(t^1234567891012345,t)
t = ffprimroot(ffgen(5^17)); fflog(t^123456789101,t)
-test(P,p)=
+test(P,p,ord)=
{
my(a,b,u,l);
a=ffgen(P*Mod(1,p),'a);
b=ffprimroot(a);
u=random(a);
- l=fflog(u,b);
+ l=if(ord,fflog(u,b,ord),fflog(u,b));
b^l==u;
}
test(x^2+1,1073742623)
@@ -30,6 +30,7 @@ test(x^2+1,1152921504606849707)
test(x^4+699*x^2+107,1129)
test(polcyclo(5),1073749723)
test(polcyclo(7),1073741833)
+test(ffinit(5,24),5,5^24-1)
p=2^64+13; g=ffprimroot(ffgen(p^2), &o); a=2*g^0;
g^fflog(a,g,o) == a
diff --git a/src/test/in/gamma b/src/test/in/gamma
index 968bee9..759cf09 100644
--- a/src/test/in/gamma
+++ b/src/test/in/gamma
@@ -31,3 +31,5 @@ lngamma(2^301 + 2*I)
lngamma(2^301 + 200*I)
default(realprecision,154);
lngamma(2^301 + 2000*I)
+
+gamma(1+10^-30)
diff --git a/src/test/in/gammamellininv b/src/test/in/gammamellininv
new file mode 100644
index 0000000..36126a1
--- /dev/null
+++ b/src/test/in/gammamellininv
@@ -0,0 +1,72 @@
+default(realprecision,38);
+f(t)=4*besselk(0,2*Pi*t);
+G = gammamellininvinit([0,0]);
+g(t)=gammamellininv(G,t);
+{
+ for(a=1,30,
+ for(b=-5,5,
+ my(z = a/12+I*b/6, eps = abs(f(z)-g(z)));
+ if(eps > 10^-30, error(z,":",eps))
+ )
+ )
+}
+
+GR(s)=Pi^-(s/2)*gamma(s/2);
+
+gmellininv(Vga)=
+{
+ my(c,A,B,T);
+ localprec(precision(1.)+19);
+ my(f(s) = prod(i=1,#Vga,GR(s+Vga[i])));
+ c = 1;
+ A = [-oo,Pi/2];
+ B = [+oo,Pi/2];
+ T = intfuncinit(t=A,B, f(c + I*t));
+ z->my(a=-log(z));intnum(t=A,B, exp(a*I*t), T)*exp(a*c) / (2*Pi);
+}
+
+chk(Vga,f,t) = abs(f(t)-gammamellininv(Vga,t));
+L=[[0],[1],[1/2],[3/2],[0,0],[0,1/2],[0,1],[0,2],[0,3],[0,0,0],[0,0,1/2],[0,0,1],[0,1,1],[0,1,2],[0,1,3/2],[0,0,0,0,0]];
+M=apply(gmellininv,L);
+S=[1/2,3/2,2,3,4];
+S2=concat(S,apply(x->I+x,S));
+{
+ for(i=1,#L,
+ my(G = gammamellininvinit(L[i]));
+ for(j=1,#S,
+ my(eps = chk(G,M[i],S2[j]));
+ if(eps > 10^-29, error([1,i,j],":",eps))
+ )
+ );
+}
+
+chkd(v0,v1,t) = abs(derivnum(s=t,gammamellininv(v0,s)) - gammamellininv(v1,t));
+
+{
+ for(i=1,#L,
+ my(v0); if(1, localprec(86); v0 = gammamellininvinit(L[i]));
+ my(v1= gammamellininvinit(L[i], 1));
+ for(j=1,#S2,
+ if(j<=#S || denominator(L[i])==1,
+ my(eps = chkd(v0,v1,S2[j]));
+ if(eps > 10^-29, error([2,i,j], ":", eps))
+ )
+ )
+ );
+}
+
+{
+ my(d = abs(gammamellininv([0,1/2,1,3/2],5)-2^(3/2)*exp(-4*Pi*sqrt(5))));
+ if (d > 1E-49, error([0,1/2,1,3/2],":",5,":",d));
+}
+
+gammamellininv([0],121.)
+
+G = gammamellininvinit([1], 2);
+a(z) = 4*Pi*z*exp(-Pi*z^2)*(2*Pi*z^2-3);
+f(z) = printf("%.3g\n", abs(a(z) - gammamellininv(G,z)));
+f(I)
+f(2+I)
+
+gammamellininvasymp([0],10)
+gammamellininvasymp([0,1/2],10)
diff --git a/src/test/in/hyperell b/src/test/in/hyperell
index 37db19c..4a55703 100644
--- a/src/test/in/hyperell
+++ b/src/test/in/hyperell
@@ -22,7 +22,7 @@ checkfeq(P,q)=
forprime(p=3,7,
H=hyperellcharpoly((x^6+x+1)*Mod(1,p));
print(checkfeq(H,p)));
- forprime(p=5,11,
+ forprime(p=3,11,
H=hyperellcharpoly((x^10+x+1)*Mod(1,p));
print(checkfeq(H,p)));
forprime(p=3,7,
@@ -40,6 +40,7 @@ P=hyperellcharpoly(g*(x^6+g*x^3+2*x+5));checkfeq(P,79^2)
P=hyperellcharpoly((x^7+x^3+2*x+5)*Mod(1,79));checkfeq(P,79)
P=hyperellcharpoly((x^8+x^3+2*x+5)*Mod(1,79));checkfeq(P,79)
P=hyperellcharpoly([x^5+x+1,x]*Mod(1,79));checkfeq(P,79)
+P=hyperellcharpoly((x^3+x+1)*ffgen(3^2)^0);checkfeq(P,9)
hyperellcharpoly((256*a^5+5)*Mod(1,5))
hyperellcharpoly((256*a^5+5)*ffgen(5^2))
diff --git a/src/test/in/intnum b/src/test/in/intnum
index 26e17c7..7cf69d4 100644
--- a/src/test/in/intnum
+++ b/src/test/in/intnum
@@ -3,14 +3,22 @@ allocatemem(20 * 10^6);
check(a,b) = my(t = abs((a-b)/b)); if (t, ceil(log(t)/log(10)), -oo);
\p96
check(intcirc(s=1, 0.5, zeta(s)), 1)
-check(intlaplaceinv(x=2, 1, 1/x), 1)
-m = intnumstep();
-check(intlaplaceinv(x=2, 1, 1/x, m+1), 1)
-check(intlaplaceinv(x=5, 1, 1/x), 1)
-check(intlaplaceinv(x=100, 1, 1/x), 1)
-A = intmellininv(s=2,4, gamma(s)^3);
-tab = intfuncinit(t=[-oo, 4.5],[oo, 4.5], gamma(2+I*t)^3, 1);
-check(intmellininvshort(2,4,tab), A)
+
+f(s) = gamma(s)^3; \\ f(c+it) decrease as exp(-3Pi|t|/2)
+c = 2; \\ arbitrary
+A = [-oo,3*Pi/2];
+B = [+oo,3*Pi/2];
+F(z) =
+{ my (a = -log(z));
+ intnum(t=A,B, exp(a*I*t), T)*exp(a*c) / (2*Pi);
+}
+T = intfuncinit(t=A,B, f(c + I*t));
+ref=F(4);
+\p38
+T = intfuncinit(t=A,B, f(c + I*t));
+check(F(4), ref)
+
+\p96
f(x) = 1/(exp(x)-1) - exp(-x)/x;
F = truncate( f(t + O(t^7)) );
g(x) = if (x > 1e-18, f(x), subst(F,t,x));
@@ -18,80 +26,79 @@ check(intnum(x = 0, [oo,1], f(x)), Euler)
check(intnum(x = 0, [oo,1], g(x)), Euler)
check(intnum(x = 0, 1, 1/sqrt(x)), 2)
check(intnum(x = [0,-1/2], 1, 1/sqrt(x)), 2)
+check(intnum(x = 100000, oo, 1/(1+x^2)), atan(1/100000))
check(intnum(x = [0,-1/2], [oo,-3/2], 1/(sqrt(x)+x^(3/2))), Pi)
check(intnum(x = [-oo,-3/2], [oo,-3/2], 1/(1+abs(x)^(3/2))), 8*Pi/sqrt(27))
+check(intnum(x = -oo, oo, 1/(1+x^2)), Pi)
f(x)=if (x<0,1/(1+(-x)^(3/2)), 1/(1+x^(5/2)));
a=4*Pi/sqrt(27) + 2*(Pi/5)/sin(2*Pi/5);
check(intnum(x = [-oo,-3/2], [oo,-5/2], f(x)),a)
f(x)=if (x<0,1/(1+(-x)^(3/2)), exp(-x));
-check(intnum(x = [-oo,-3/2], [oo,1], f(x)), 1+4*Pi/sqrt(27))
+check(intnum(x = [-oo,-3/2], [oo,1], f(x)), 4*Pi/sqrt(27)+1)
+f(x)=if (x<0,1/(1+(-x)^(3/2)), sinc(x));
+check(intnum(x = [-oo,-3/2], [oo,-I], f(x)), 4*Pi/sqrt(27)+Pi/2)
+
+f(x)=if (x<0,exp(2*x), 1/(1+x^(3/2)));
+check(intnum(x = [-oo,2], [oo,-3/2], f(x)), 1/2+4*Pi/sqrt(27))
+f(x)=if (x<0,exp(2*x), 1/(1+x^(5/2)));
+check(intnum(x = [-oo,2], [oo,-5/2], f(x)), 1/2+2*(Pi/5)/sin(2*Pi/5))
+f(x)=if (x<0,exp(2*x), exp(-x));
+check(intnum(x = [-oo,2], [oo,1], f(x)), 3/2)
+f(x)=if (x<0,exp(2*x), sinc(x));
+check(intnum(x = [-oo,2], [oo,-I], f(x)), 1/2+Pi/2)
-check(intnum(x = 0, [oo,1], sin(x)/x), Pi/2)
-check(intnum(x = 0, [oo,-I], sin(x)/x), Pi/2)
-check(intnum(x = 0, [oo,-2*I], sin(2*x)/x), Pi/2)
-A=intnum(x=0,1,(1-cos(x))/x^2)+intnum(x=1,oo,1/x^2)-intnum(x=1,[oo,I],cos(x)/x^2);
+f(x)=if (x<0,2*sinc(2*x), 1/(1+x^(3/2)));
+check(intnum(x = [-oo,-2*I], [oo,-3/2], f(x)), Pi/2+4*Pi/sqrt(27))
+f(x)=if (x<0,2*sinc(2*x), 1/(1+x^(5/2)));
+check(intnum(x = [-oo,-2*I], [oo,-5/2], f(x)), Pi/2+2*(Pi/5)/sin(2*Pi/5))
+f(x)=if (x<0,2*sinc(2*x), exp(-x));
+check(intnum(x = [-oo,-2*I], [oo,1], f(x)), Pi/2+1)
+f(x)=if (x<0,2*sinc(2*x), sinc(x));
+check(intnum(x = [-oo,-2*I], [oo,-I], f(x)), Pi)
+
+f(x)=cos((3+tanh(x))*x)/sqrt(1+x^2);
+a = intnum(x = [-oo,2*I], [oo,4*I], f(x), 1);
+check(intnum(x = [-oo,2*I], [oo,4*I], f(x)), a)
+
+check(intnum(x=[0,-1/2],[1,-1/3], x^(-1/2) + (1-x)^(-1/3)), 7/2)
+T=intnuminit([0,-1/2],[1,-1/3]);
+check(intnum(x=[0,-1/2],[1,-1/3], x^(-1/2) + (1-x)^(-1/3), T), 7/2)
+
+check(intnum(x = 0, [oo,1], sinc(x)), Pi/2)
+check(intnum(x = 0, [oo,-I], sinc(x)), Pi/2)
+check(intnum(x = 0, [oo,-2*I], 2*sinc(2*x)), Pi/2)
+A=intnum(x=0,1,sinc(x/2)^2/2)+intnum(x=1,oo,1/x^2)-intnum(x=1,[oo,I],cos(x)/x^2);
check(A, Pi/2)
check(intnum(x = 0, [oo, 1], sin(x)^3*exp(-x)), 3/10)
check(intnum(x = 0, [oo,-I], sin(x)^3*exp(-x)), 3/10)
-tab = intnuminit(0,[oo,-I], m+1);
+tab = intnuminit(0,[oo,-I], 1);
check(intnum(x = 0, oo, sin(x)^3*exp(-x), tab), 3/10)
check(intnum(x = 0, [oo, -I], x^2*sin(x)), -2)
tab = intnuminit(-1,1);
check(intnum(x=-1,1, intnum(y=-sqrt(1-x^2),sqrt(1-x^2),x^2+y^2,tab),tab), Pi/2)
-\\
-\p 308
-a = sumpos(n=1, 1/(n^3+n+1));
-b = sumpos(n=1, 1/(n^3+n+1), 1);
-check(a, b)
-tab = sumnuminit(2);
-b = sumnum(n=1,2, 1/(n^3+n+1), tab);
-check(a, b)
-check(sumnum(n=1,2, 1/(n^3+n+1), tab, 1), a)
-a = sumpos(n=1,1/(n^2+1));
-b = sumpos(n=1,1/(n^2+1), 1);
-check(a, b)
-b = sumnum(n=1,2,1/(n^2+1),tab,1);
-check(a, b)
-check(sumnum(n=1,2,n^(-4/3),,1), zeta(4/3))
-tab = sumnuminit([2,-3/2]);
-check(sumnum(n=1,[2,-3/2],1/(n*sqrt(n)),tab,1), zeta(3/2))
-\\
-check(suminf(n=1, 2^(-n)), 1)
-check(sumpos(n=1, 2^(-n)), 1)
-check(sumnum(n=1,[2,log(2)],2^(-n), intnumstep()+1, 1), 1)
-\\
-tab = sumnuminit(2,,-1);
-a = sumnumalt(n=1,2,1/(n^3+n+1),tab,1);
-b = sumalt(n=1,(-1)^n/(n^3+n+1));
-check(a, b)
-
\p96
-T=intnuminitgen(t,0,[1],exp(2*sinh(t)));
-check(intnum(x=0,[1],1/(1+x^2),T), Pi/2)
-T=intnuminitgen(t,0,[[1],1],exp(t-exp(-t)));
-check(intnum(x=0,[[1],1],exp(-x),T), 1)
-intfourierexp(t=0,[[1],1], 1/2, exp(-t^2))
-intfouriercos(t=0,[[1],1], 1/2, exp(-t^2))
-intfouriersin(t=0,[[1],1], 1/2, exp(-t^2))
+check(intnumgauss(x=0,1,sin(x)), 1-cos(1))
+T=intnumgaussinit();
+check(intnumgauss(x=0,1,1/(x+1),T), log(2))
+check(intnumgauss(x=0,1,1/(x+1)^(4/3),T), 3-3/2^(1/3))
+check(intnumgauss(x=2,1,x,T),-3/2)
+check(intnumgauss(x=-1,1,1/(1+x^2), 20), Pi/2)
+T=intnumgaussinit(100);
+check(intnumgauss(x=-2,2,1/(1+x^2), T), 2*atan(2))
+check(intnumgauss(t=1,2,t,1),3/2)
\p38
intnumromb(x=0,1,sin(x))
intnumromb(x=0,1,sin(x), 1)
intnumromb(x=1,100,exp(-x^2), 2)
-intnumromb(x=0,1,sin(x)/x, 3)
+intnumromb(x=0,1,sinc(x), 3)
\\ sloooow
\\intnumromb(x=0,110,x, 1)
\\intnumromb(x=-110,90,x, 1)
intnumromb(x=2,1,x, 1)
-f(x) = -log(cos(x));
-F = truncate( f(t + O(t^16)) );
-g(x) = if (x > 1e-2, f(x), subst(F,t,x));
-sumpos(n=1,g(1/n))
-sumpos(n=0,0)
-
intnuminit([oo,1+I],[oo,""])
intnum(x=oo,oo,1)
intnum(x=-oo,-oo,1)
diff --git a/src/test/in/log b/src/test/in/log
index 5339f1f..fc0c54f 100644
--- a/src/test/in/log
+++ b/src/test/in/log
@@ -1,4 +1,5 @@
default(realprecision,38);
log(1+10^-30)
lngamma(1+10^-30)
+lngamma(10^-30)
iferr(log(2+O(33)),E,E)
diff --git a/src/test/in/map b/src/test/in/map
new file mode 100644
index 0000000..9342c14
--- /dev/null
+++ b/src/test/in/map
@@ -0,0 +1,54 @@
+shankslog(a,g,card)=
+{
+ my(M=Map());
+ my(h=a,B=sqrtint(card)+1);
+ for(i=0,B-1,
+ mapput(M,h,i);
+ h*=g);
+ g2=h*a^-1;
+ h=1;
+ for(i=0,B,my(j);
+ if(mapisdefined(M,h,&j),
+ return(i*B-j));
+ h*=g2);
+ error("shankslog: not found");
+}
+if(Mod(2,1000003)^shankslog(Mod(3,1000003),Mod(2,1000003),1000002)!=3, error("shankslog"));
+
+tablelog(g,card)=
+{
+ my(M=Map());
+ my(h=1);
+ for(i=0,card-1,
+ mapput(M,h,i);h*=g);
+ M;
+}
+tablelogdel(g,card)=
+{
+ my(M=Map());
+ my(h=1);
+ for(i=0,card-1,
+ mapput(M,h,i);h*=g);
+ h=1;
+ for(i=0,card-1,
+ mapdelete(M,h);h*=g);
+ #M;
+}
+a=ffgen(5^5,'a); g=ffprimroot(a); T=tablelog(g,5^5-1);
+if(g^mapget(T,a^2+a+1)!=a^2+a+1,error("shankslog"));
+if(tablelogdel(g,5^5-1),error("mapdelete"));
+
+M=Map([1,2;3,4;5,6])
+Vec(M)
+Mat(M)
+apply(sqr,M)
+for(i=0,2,mapput(M, 2*i+1, -mapget(M,2*i+1)));M
+
+M0=Map(matrix(10,2,i,j,i));
+M1=Map(matrix(10,2,i,j,if(j==1,i,i*x^0)));
+M2=Map(matrix(10,2,i,j,11-i));
+M3=Map(matrix(10,2,i,j,12-i));
+M4=Map(matrix(10,2,i,j,i*x^0));
+MV=[M0,M1,M2,M3,M4];
+[a==b|a<-MV;b<-MV]
+[a===b|a<-MV;b<-MV]
diff --git a/src/test/in/nfields b/src/test/in/nfields
index 6e3fd91..fac77aa 100644
--- a/src/test/in/nfields
+++ b/src/test/in/nfields
@@ -1,4 +1,4 @@
-HEAP=[213, if(precision(1.)==38,91496,101423)];
+HEAP=[213, if(precision(1.)==38,91502,101429)];
default(realprecision,154); Pi; default(realprecision,38);
dobnf(T,flag=0,tech=[])= setrand(1); my(K = bnfinit(T,flag,tech)); [K.cyc,K.fu];
\e
diff --git a/src/test/in/padic b/src/test/in/padic
index f0bf0d2..9a95c5c 100644
--- a/src/test/in/padic
+++ b/src/test/in/padic
@@ -24,7 +24,7 @@ lift(1/2 + O(2))
s=3+3^2+O(3^5)
t=2+2^2+O(2^5)
-f=[cosh,sinh,tanh];
+f=[cosh,sinh,tanh,cotanh];
{
for (i=1,#f,
print(f[i](s));
diff --git a/src/test/in/pol b/src/test/in/pol
index 02fcf93..6626bdd 100644
--- a/src/test/in/pol
+++ b/src/test/in/pol
@@ -28,3 +28,8 @@ serlaplace(x^2+x^3)
\\#1651
f1=(x-1)/(x*x-x);
type(subst(1/f1,x,1))
+
+\\#1690
+default(realprecision,38);
+P(x,y)=(x+1)*y^2+(x^2-x+1)*y+(x^2+x);
+polroots(P(exp(I*Pi),y))
diff --git a/src/test/in/printf b/src/test/in/printf
index a9931b0..8f46ec2 100644
--- a/src/test/in/printf
+++ b/src/test/in/printf
@@ -74,3 +74,6 @@ printf("%c",97 + 0.*I)
printf("%c",97 +0*quadgen(5))
printf("%1.2f",Mat([1.,2.]))
printf("%c",'x)
+
+default(format,"f.5")
+-0.00000000000000000000000000000000000000293873587705572
diff --git a/src/test/in/qf b/src/test/in/qf
index cabbe63..723e065 100644
--- a/src/test/in/qf
+++ b/src/test/in/qf
@@ -12,6 +12,11 @@ qfminim(Q,8,,1)
qfminim(Q,4,,1)
qfminim([;],4,,1)
qfminim([;],4,,2)
+qfminim(matid(2),0,1,2)
+qfminim(matid(2),0,1,1)
+qfminim(matid(2),0,1,0)
+
+
L=[360815,2283021;-316840,2566404];
qfminim(L~*L,10^16)[2]
diff --git a/src/test/in/qfb b/src/test/in/qfb
index eaf0769..9b10684 100644
--- a/src/test/in/qfb
+++ b/src/test/in/qfb
@@ -14,6 +14,8 @@ qfbpowraw(q,3)
qfbred(q3,1)
q=Qfb(1009, 60, 99108027750247771)
qfbnupow(q, 8839368315)
+L = sqrtnint(abs(poldisc(q)), 4);
+qfbnupow(q, 8839368315,L)
q=Qfb(22000957029,25035917443,7122385192);
qfbred(q)
qfbredsl2(q)
diff --git a/src/test/in/qfbclassno b/src/test/in/qfbclassno
index c034362..7976b7b 100644
--- a/src/test/in/qfbclassno
+++ b/src/test/in/qfbclassno
@@ -13,4 +13,4 @@ qfbclassno(-1788799151)
qfbclassno(-1850979435)
qfbclassno(-4386842803)
qfbclassno(-5082406399)
-
+qfbclassno(1-2^100)
diff --git a/src/test/in/quad b/src/test/in/quad
index ee70640..1d56d91 100644
--- a/src/test/in/quad
+++ b/src/test/in/quad
@@ -9,3 +9,17 @@ norm(w)
norml2(w)
trace(w)
trace(1+0*w)
+
+w < 1
+w < 1.
+w < 3/2
+w < w
+w <= w
+w <= +oo
+w <= -oo
+quadgen(-8) < 1
+
+test(a)=[sign(z) | z<-[a,a-1,a-2,1-a,2-a]]
+test(w)
+test(quadgen(8))
+sign(quadgen(-8))
diff --git a/src/test/in/rnf b/src/test/in/rnf
index b7f6fda..49627c1 100644
--- a/src/test/in/rnf
+++ b/src/test/in/rnf
@@ -31,6 +31,8 @@ rnfisabelian(y^2+23,x^3+x^2-1)
T = polcyclo(7, x+Mod(y, nf.pol));
rnfisabelian(nf.pol, T)
rnfisabelian(nf, T)
+rnfisabelian(a^2+1,5*x^3+2)
+rnfisabelian(4*a^2+1, 9*x^2 + (12*a+3)*x + 2*a)
pol = y^3+y^2-2*y-1;
bnf = bnfinit(pol);
diff --git a/src/test/in/round4 b/src/test/in/round4
index 3057246..6121a24 100644
--- a/src/test/in/round4
+++ b/src/test/in/round4
@@ -466,3 +466,9 @@ valuation(nfdisc([f, [2]]), 2)
T = (x+1)^2 + 3*5^2*7^31;
P = [[7], [5,7], factor(poldisc(T)), 7, 2];
for (i=1,#P, print(nfbasis([T,P[i]]), ", ", nfdisc([T,P[i]])));
+
+
+p=10^100+267; q=10^120+79;
+T=polcompositum(x^2-p,x^2-q,2);
+nfdisc([T,[2,p,q]])
+
diff --git a/src/test/in/ser b/src/test/in/ser
index 9f99c7c..d2fae3a 100644
--- a/src/test/in/ser
+++ b/src/test/in/ser
@@ -1,6 +1,6 @@
default(realprecision,38);
s=x+x^2+O(x^5)
-f=[atan,asin,acos,cosh,sinh,tanh,acosh,asinh,atanh];
+f=[atan,asin,acos,cosh,sinh,tanh,cotanh,acosh,asinh,atanh];
{
for (i=1,#f,
print(f[i](s));
diff --git a/src/test/in/sumiter b/src/test/in/sumiter
index 362f38e..e23192d 100644
--- a/src/test/in/sumiter
+++ b/src/test/in/sumiter
@@ -1,4 +1,4 @@
-HEAP=[23, if(precision(1.)==38,200,230)];
+HEAP=[23, if(precision(1.)==38,198,226)];
\p 19
\e
intnum(x=0,Pi,sin(x))
diff --git a/src/test/in/sumnum b/src/test/in/sumnum
new file mode 100644
index 0000000..3312e24
--- /dev/null
+++ b/src/test/in/sumnum
@@ -0,0 +1,71 @@
+default(realprecision,38);
+allocatemem(20 * 10^6);
+check(a,b)=my(c=abs(a-b)); if(!c,oo, ceil(log(c)/log(10)));
+check(sumnummonien(n=1,1/n^2), Pi^2/6)
+check(sumnummonien(n=1,log(1+1/n)/n), sumpos(n=1,log(1+1/n)/n))
+tab=sumnummonieninit(,1);
+check(sumnummonien(n=1, 1/n^2, tab), -zeta'(2))
+sumnummonien(n=3, 1/n^2, tab)
+
+TEST=[n->1/(n^2+1), n->log(1+1/n)/n, n->lngamma(1+1/n)/n, n->sin(1/sqrt(n))/n^(3/2)];
+FUN=[f->sumnum(n=1,f(n)), f->sumnummonien(n=1,f(n))];
+
+localprec(57); V=[sumnummonien(n=1,f(n)) | f<-TEST];
+
+{
+ for (i = 1, #TEST,
+ my (f = TEST[i]);
+ print(f);
+ for (j = 1, #FUN,
+ my (SUM = FUN[j]);
+ my (t = check(SUM(f), V[i]));
+ print(t);
+ )
+ )
+}
+
+sumnum(n = [1, -3/2], sin(1/sqrt(n))/n)
+
+tab=sumnummonieninit(,n->log(n)^2);
+check(sumnummonien(n=1, 1/n^2, tab), zeta''(2))
+
+tab=sumnummonieninit([1,2]);
+check(sumnummonien(n=1, 1/n^3, tab), zeta(3))
+
+tab=sumnummonieninit([1,1/2]);
+check(sumnummonien(n=1, 1/n^(3/2), tab), zeta(3/2))
+
+localprec(57); V = sumnum(n=[1,-3/2], sin(1/sqrt(n))/n);
+
+tmon=sumnummonieninit([1/2,1]);
+check(sumnummonien(n=1, sin(1/sqrt(n))/n, tmon), V)
+check(sumnum(n=[1,-3/2], sin(1/sqrt(n))/n), V)
+
+\p 308
+a = sumpos(n=1, 1/(n^3+n+1));
+b = sumpos(n=1, 1/(n^3+n+1), 1);
+check(a, b)
+tab = sumnuminit();
+b = sumnum(n=1, 1/(n^3+n+1), tab);
+check(a, b)
+a = sumpos(n=1,1/(n^2+1));
+b = sumpos(n=1,1/(n^2+1), 1);
+check(a, b)
+b = sumnum(n=1,1/(n^2+1));
+check(a, b)
+check(sumnum(n=[1,-4/3],n^(-4/3)), zeta(4/3))
+tab = sumnuminit([+oo,-3/2]);
+check(sumnum(n=1,1/(n*sqrt(n)),tab), zeta(3/2))
+\\
+check(suminf(n=1, 2^(-n)), 1)
+check(sumpos(n=1, 2^(-n)), 1)
+check(sumnum(n=[1, 1],2^(-n)), 1)
+
+\p38
+f(x) = -log(cos(x));
+F = truncate( f(t + O(t^16)) );
+g(x) = if (x > 1e-2, f(x), subst(F,t,x));
+sumpos(n=1,g(1/n))
+sumpos(n=0,0)
+
+sumnum(n=1,1/n^2,"bug");
diff --git a/src/test/in/trans2 b/src/test/in/trans2
index e08429f..7ab8b9a 100644
--- a/src/test/in/trans2
+++ b/src/test/in/trans2
@@ -49,5 +49,16 @@ for (i=0,7, z=1e-20+i*w; test(z))
for (i=0,7, z=1e-20+i*w+I; test(z))
erfc(1/2+I)
erfc(-1/2+I)
+
+sinc(0)
+sinc(1/2)
+sinc(10*I)
+sinc(1+I)
+sinc(O(3^2))
+sinc(3+O(3^4))
+sinc(2+O(3^2))
+sinc(x)
+sinc(1/x)
+
default(realprecision,2003);
log(exp(1.5)) - 1.5
diff --git a/src/test/in/version b/src/test/in/version
new file mode 100644
index 0000000..3045246
--- /dev/null
+++ b/src/test/in/version
@@ -0,0 +1 @@
+version()[1..3]
diff --git a/src/test/in/zetamult b/src/test/in/zetamult
new file mode 100644
index 0000000..3a416c7
--- /dev/null
+++ b/src/test/in/zetamult
@@ -0,0 +1,23 @@
+default(realprecision,38);
+test(a,b)= if(a==b,oo, ceil(log(abs(a-b))/log(10)));
+test(zetamult([2,1]), zeta(3))
+test(zetamult([4,2]), (zeta(3)^2 - 4*zeta(6)/3))
+test(zetamult([4,4]), (zeta(4)^2 - zeta(8))/2)
+test(zetamult([2,2,2]), zeta(2)^3/6 + zeta(6)/3 - zeta(2)*zeta(4)/2)
+zetamult("a")
+zetamult(2)
+zetamult([])
+zetamult([1,2])
+
+default(realprecision,57);
+for(k=1,10, print(Pi^(4*k) / zetamult(vector(2*k, j, 1+2*(j%2)))));
+
+v = [zeta(9),Pi^2*zeta(7),Pi^4*zeta(5),Pi^6*zeta(3)];
+LD=[2,2,2,2];
+{
+ for(i=1,4,
+ LE=LD; LE[i]=3;
+ z = lindep(concat(zetamult(LE),v));
+ if (z[1] < 0, z = -z); print(z);
+ );
+}
diff --git a/src/test/tune.c b/src/test/tune.c
index 4d759dc..a9554ff 100644
--- a/src/test/tune.c
+++ b/src/test/tune.c
@@ -264,7 +264,6 @@ static double speed_Flx_rem(speed_param *s) {
static double speed_Flxq_red(speed_param *s) {
GEN x = rand_NFlx((degpol(s->x)-1)*2, s->l);
GEN q = Flx_get_red(s->x, s->l);
- if(typ(q)==t_VECSMALL) err_printf("."); else err_printf("+");
TIME_FUN(Flx_rem(x, q, s->l));
}
@@ -362,7 +361,14 @@ static tune_param param[] = {
speed_Flxq_red,0,0,NULL,&Flx_MUL_MULII_LIMIT},
{0, var(Flx_BARRETT_MULII2_LIMIT),t_NFl2x,5,0,
speed_Flxq_red,0,0,NULL,&Flx_MUL_MULII2_LIMIT},
-{0, var(Flx_HALFGCD_LIMIT), t_Flx,10,0, speed_Flx_halfgcd},
+{0, var(Flx_HALFGCD_KARATSUBA_LIMIT), t_Flx,10,0,
+ speed_Flx_halfgcd,0,0,&Fmod_MUL_MULII_LIMIT,&Flx_MUL_KARATSUBA_LIMIT},
+{0, var(Flx_HALFGCD_HALFMULII_LIMIT), t_Fhx,10,0,
+ speed_Flx_halfgcd,0,0,NULL,&Flx_MUL_HALFMULII_LIMIT},
+{0, var(Flx_HALFGCD_MULII_LIMIT), t_Fl1x,10,0,
+ speed_Flx_halfgcd,0,0,NULL,&Flx_MUL_MULII_LIMIT},
+{0, var(Flx_HALFGCD_MULII2_LIMIT),t_Fl2x,10,0,
+ speed_Flx_halfgcd,0,0,NULL,&Flx_MUL_MULII2_LIMIT},
{0, var(Flx_GCD_LIMIT), t_Flx,10,0, speed_Flx_gcd,0.1},
{0, var(Flx_EXTGCD_LIMIT), t_Flx,10,0, speed_Flx_extgcd},
{0, var(FpX_INVBARRETT_LIMIT), t_NFpX,10,0, speed_FpX_inv,0.05},
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/pari-sage.git
More information about the debian-science-commits
mailing list