You can subscribe to this list here.
2001 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(20) |
Dec
(17) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2002 |
Jan
(39) |
Feb
(21) |
Mar
(33) |
Apr
(135) |
May
(53) |
Jun
(88) |
Jul
(47) |
Aug
(59) |
Sep
(207) |
Oct
(40) |
Nov
(7) |
Dec
(26) |
2003 |
Jan
(49) |
Feb
(39) |
Mar
(117) |
Apr
(50) |
May
(62) |
Jun
(6) |
Jul
(19) |
Aug
(24) |
Sep
(11) |
Oct
(11) |
Nov
(49) |
Dec
(9) |
2004 |
Jan
(29) |
Feb
(123) |
Mar
(32) |
Apr
(53) |
May
(52) |
Jun
(19) |
Jul
(33) |
Aug
(10) |
Sep
(76) |
Oct
(86) |
Nov
(171) |
Dec
(163) |
2005 |
Jan
(147) |
Feb
(121) |
Mar
(120) |
Apr
(126) |
May
(120) |
Jun
(213) |
Jul
(76) |
Aug
(79) |
Sep
(140) |
Oct
(83) |
Nov
(156) |
Dec
(202) |
2006 |
Jan
(181) |
Feb
(171) |
Mar
(157) |
Apr
(98) |
May
(96) |
Jun
(97) |
Jul
(193) |
Aug
(76) |
Sep
(130) |
Oct
(63) |
Nov
(196) |
Dec
(253) |
2007 |
Jan
(256) |
Feb
(293) |
Mar
(276) |
Apr
(258) |
May
(181) |
Jun
(91) |
Jul
(108) |
Aug
(69) |
Sep
(107) |
Oct
(179) |
Nov
(137) |
Dec
(121) |
2008 |
Jan
(124) |
Feb
(129) |
Mar
(192) |
Apr
(201) |
May
(90) |
Jun
(86) |
Jul
(115) |
Aug
(142) |
Sep
(49) |
Oct
(91) |
Nov
(95) |
Dec
(218) |
2009 |
Jan
(230) |
Feb
(149) |
Mar
(118) |
Apr
(72) |
May
(77) |
Jun
(68) |
Jul
(102) |
Aug
(72) |
Sep
(89) |
Oct
(76) |
Nov
(125) |
Dec
(86) |
2010 |
Jan
(75) |
Feb
(90) |
Mar
(89) |
Apr
(121) |
May
(111) |
Jun
(66) |
Jul
(75) |
Aug
(66) |
Sep
(66) |
Oct
(166) |
Nov
(121) |
Dec
(73) |
2011 |
Jan
(74) |
Feb
|
Mar
|
Apr
(14) |
May
(22) |
Jun
(31) |
Jul
(53) |
Aug
(37) |
Sep
(23) |
Oct
(25) |
Nov
(31) |
Dec
(28) |
2012 |
Jan
(18) |
Feb
(11) |
Mar
(32) |
Apr
(17) |
May
(48) |
Jun
(37) |
Jul
(23) |
Aug
(54) |
Sep
(15) |
Oct
(11) |
Nov
(19) |
Dec
(22) |
2013 |
Jan
(11) |
Feb
(32) |
Mar
(24) |
Apr
(37) |
May
(31) |
Jun
(14) |
Jul
(26) |
Aug
(33) |
Sep
(40) |
Oct
(21) |
Nov
(36) |
Dec
(84) |
2014 |
Jan
(23) |
Feb
(20) |
Mar
(27) |
Apr
(24) |
May
(31) |
Jun
(27) |
Jul
(34) |
Aug
(26) |
Sep
(21) |
Oct
(45) |
Nov
(23) |
Dec
(73) |
2015 |
Jan
(33) |
Feb
(8) |
Mar
(24) |
Apr
(45) |
May
(27) |
Jun
(19) |
Jul
(21) |
Aug
(51) |
Sep
(43) |
Oct
(29) |
Nov
(61) |
Dec
(86) |
2016 |
Jan
(99) |
Feb
(52) |
Mar
(80) |
Apr
(61) |
May
(24) |
Jun
(23) |
Jul
(36) |
Aug
(30) |
Sep
(41) |
Oct
(43) |
Nov
(27) |
Dec
(46) |
2017 |
Jan
(57) |
Feb
(34) |
Mar
(40) |
Apr
(31) |
May
(78) |
Jun
(49) |
Jul
(72) |
Aug
(33) |
Sep
(26) |
Oct
(82) |
Nov
(69) |
Dec
(29) |
2018 |
Jan
(43) |
Feb
(9) |
Mar
|
Apr
(40) |
May
(34) |
Jun
(49) |
Jul
(45) |
Aug
(8) |
Sep
(51) |
Oct
(75) |
Nov
(103) |
Dec
(80) |
2019 |
Jan
(153) |
Feb
(78) |
Mar
(47) |
Apr
(48) |
May
(63) |
Jun
(54) |
Jul
(10) |
Aug
(7) |
Sep
(17) |
Oct
(24) |
Nov
(29) |
Dec
(17) |
2020 |
Jan
(22) |
Feb
(74) |
Mar
(47) |
Apr
(48) |
May
(12) |
Jun
(44) |
Jul
(13) |
Aug
(18) |
Sep
(26) |
Oct
(36) |
Nov
(25) |
Dec
(23) |
2021 |
Jan
(28) |
Feb
(25) |
Mar
(58) |
Apr
(76) |
May
(72) |
Jun
(70) |
Jul
(25) |
Aug
(67) |
Sep
(17) |
Oct
(24) |
Nov
(30) |
Dec
(30) |
2022 |
Jan
(51) |
Feb
(39) |
Mar
(72) |
Apr
(65) |
May
(30) |
Jun
(72) |
Jul
(129) |
Aug
(44) |
Sep
(45) |
Oct
(30) |
Nov
(48) |
Dec
(275) |
2023 |
Jan
(235) |
Feb
(232) |
Mar
(68) |
Apr
(16) |
May
(52) |
Jun
(87) |
Jul
(143) |
Aug
(32) |
Sep
(26) |
Oct
(15) |
Nov
(20) |
Dec
(74) |
2024 |
Jan
(119) |
Feb
(32) |
Mar
(64) |
Apr
(68) |
May
(30) |
Jun
(50) |
Jul
(37) |
Aug
(32) |
Sep
(10) |
Oct
(4) |
Nov
|
Dec
|
From: rtoy <rt...@us...> - 2024-10-01 21:45:25
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 82002f803288b7198c0fe4f268cf2152140ac427 (commit) from bd60a262c555650f94cf1b43c24a7184ac30b299 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 82002f803288b7198c0fe4f268cf2152140ac427 Author: Raymond Toy <toy...@gm...> Date: Tue Oct 1 14:42:12 2024 -0700 Reduce code duplication in print-directories A minor update to [bd60a2] to reduce the code duplication, ensuring we're consistent for each variable. We can just iterate over a list of all the variables that name directories. This works because the printed name is the same as the variable (without "*"). diff --git a/src/init-cl.lisp b/src/init-cl.lisp index d38d87112..8cc6e6bb1 100644 --- a/src/init-cl.lisp +++ b/src/init-cl.lisp @@ -45,22 +45,27 @@ (merror (intl:gettext "assignment: must assign a string to ~:M; found: ~M") var value)))) (defun print-directories () - (format t "~25a~a~%" "maxima-prefix:" *maxima-prefix*) - (format t "~25a~a~%" "maxima-topdir:" *maxima-topdir*) - (format t "~25a~a~%" "maxima-imagesdir:" *maxima-imagesdir*) - (format t "~25a~a~%" "maxima-sharedir:" *maxima-sharedir*) - (format t "~25a~a~%" "maxima-srcdir:" *maxima-srcdir*) - (format t "~25a~a~%" "maxima-demodir:" *maxima-demodir*) - (format t "~25a~a~%" "maxima-testsdir:" *maxima-testsdir*) - (format t "~25a~a~%" "maxima-docdir:" *maxima-docdir*) - (format t "~25a~a~%" "maxima-infodir:" *maxima-infodir*) - (format t "~25a~a~%" "maxima-htmldir:" *maxima-htmldir*) - (format t "~25a~a~%" "maxima-plotdir:" *maxima-plotdir*) - (format t "~25a~a~%" "maxima-layout-autotools:" *maxima-layout-autotools*) - (format t "~25a~a~%" "maxima-userdir:" *maxima-userdir*) - (format t "~25a~a~%" "maxima-tempdir:" *maxima-tempdir*) - (format t "~25a~a~%" "maxima-lang-subdir:" *maxima-lang-subdir*) - (format t "~25a~a~%" "maxima-objdir:" *maxima-objdir*)) + (dolist (var '(*maxima-prefix* + *maxima-topdir* + *maxima-imagesdir* + *maxima-sharedir* + *maxima-srcdir* + *maxima-demodir* + *maxima-testsdir* + *maxima-docdir* + *maxima-infodir* + *maxima-htmldir* + *maxima-plotdir* + *maxima-layout-autotools* + *maxima-userdir* + *maxima-tempdir* + *maxima-lang-subdir* + *maxima-objdir*)) + ;; Neatly print out the name of the variable (sans *) and the + ;; corresponding value. + (format t "~a:~25t~a~%" + (string-trim "*" (string-downcase var)) + (symbol-value var)))) (defvar *maxima-lispname* #+clisp "clisp" ----------------------------------------------------------------------- Summary of changes: src/init-cl.lisp | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-10-01 21:29:29
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, rtoy-defmvar-add-string-decl has been updated via ff965fe57ad2f4718b0fe491f8b256ad921192f8 (commit) via bd60a262c555650f94cf1b43c24a7184ac30b299 (commit) via b94a1f8c6eff283b26f539b9bac082d2362b38ba (commit) from 7d8490458cd4c0192a9d3f1135bb297b3557ac4d (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit ff965fe57ad2f4718b0fe491f8b256ad921192f8 Merge: 7d8490458 bd60a262c Author: Raymond Toy <toy...@gm...> Date: Tue Oct 1 14:21:51 2024 -0700 Merge branch 'master' into rtoy-defmvar-add-string-decl ----------------------------------------------------------------------- Summary of changes: share/numeric/interpol.mac | 16 ++++++++-------- src/init-cl.lisp | 32 ++++++++++++++++---------------- 2 files changed, 24 insertions(+), 24 deletions(-) hooks/post-receive -- Maxima CAS |
From: <ap...@us...> - 2024-10-01 20:46:11
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via bd60a262c555650f94cf1b43c24a7184ac30b299 (commit) from b94a1f8c6eff283b26f539b9bac082d2362b38ba (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit bd60a262c555650f94cf1b43c24a7184ac30b299 Author: Robert Dodier <rob...@so...> Date: Tue Oct 1 13:45:42 2024 -0700 In PRINT-DIRECTORIES, arrange formatting for greater legibility. Applying https://sourceforge.net/p/maxima/patches/106/ . Thanks to Richard Gobeli for this contribution. diff --git a/src/init-cl.lisp b/src/init-cl.lisp index e8f4c3241..d38d87112 100644 --- a/src/init-cl.lisp +++ b/src/init-cl.lisp @@ -45,22 +45,22 @@ (merror (intl:gettext "assignment: must assign a string to ~:M; found: ~M") var value)))) (defun print-directories () - (format t "maxima-prefix=~a~%" *maxima-prefix*) - (format t "maxima-topdir=~a~%" *maxima-topdir*) - (format t "maxima-imagesdir=~a~%" *maxima-imagesdir*) - (format t "maxima-sharedir=~a~%" *maxima-sharedir*) - (format t "maxima-srcdir=~a~%" *maxima-srcdir*) - (format t "maxima-demodir=~a~%" *maxima-demodir*) - (format t "maxima-testsdir=~a~%" *maxima-testsdir*) - (format t "maxima-docdir=~a~%" *maxima-docdir*) - (format t "maxima-infodir=~a~%" *maxima-infodir*) - (format t "maxima-htmldir=~a~%" *maxima-htmldir*) - (format t "maxima-plotdir=~a~%" *maxima-plotdir*) - (format t "maxima-layout-autotools=~a~%" *maxima-layout-autotools*) - (format t "maxima-userdir=~a~%" *maxima-userdir*) - (format t "maxima-tempdir=~a~%" *maxima-tempdir*) - (format t "maxima-lang-subdir=~a~%" *maxima-lang-subdir*) - (format t "maxima-objdir=~A~%" *maxima-objdir*)) + (format t "~25a~a~%" "maxima-prefix:" *maxima-prefix*) + (format t "~25a~a~%" "maxima-topdir:" *maxima-topdir*) + (format t "~25a~a~%" "maxima-imagesdir:" *maxima-imagesdir*) + (format t "~25a~a~%" "maxima-sharedir:" *maxima-sharedir*) + (format t "~25a~a~%" "maxima-srcdir:" *maxima-srcdir*) + (format t "~25a~a~%" "maxima-demodir:" *maxima-demodir*) + (format t "~25a~a~%" "maxima-testsdir:" *maxima-testsdir*) + (format t "~25a~a~%" "maxima-docdir:" *maxima-docdir*) + (format t "~25a~a~%" "maxima-infodir:" *maxima-infodir*) + (format t "~25a~a~%" "maxima-htmldir:" *maxima-htmldir*) + (format t "~25a~a~%" "maxima-plotdir:" *maxima-plotdir*) + (format t "~25a~a~%" "maxima-layout-autotools:" *maxima-layout-autotools*) + (format t "~25a~a~%" "maxima-userdir:" *maxima-userdir*) + (format t "~25a~a~%" "maxima-tempdir:" *maxima-tempdir*) + (format t "~25a~a~%" "maxima-lang-subdir:" *maxima-lang-subdir*) + (format t "~25a~a~%" "maxima-objdir:" *maxima-objdir*)) (defvar *maxima-lispname* #+clisp "clisp" ----------------------------------------------------------------------- Summary of changes: src/init-cl.lisp | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-10-01 12:22:50
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via b94a1f8c6eff283b26f539b9bac082d2362b38ba (commit) from 842eb746a3add7b53b23bbc21af287ab981193a8 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit b94a1f8c6eff283b26f539b9bac082d2362b38ba Author: Raymond Toy <toy...@gm...> Date: Tue Oct 1 05:12:41 2024 -0700 Rename tab to datatab in numeric/interpol.mac The variable `tab` is defined in stringproc and only allows strings to be assigned to it. interpol.mac uses `tab` as a parameter for a matrix and this conflicts with the restriction for `tab`. To resolve this, rename `tab` to `datatab` as the least disruptive way to fix this. This also fixes bug #4379. diff --git a/share/numeric/interpol.mac b/share/numeric/interpol.mac index 6cff483bc..044bd5472 100644 --- a/share/numeric/interpol.mac +++ b/share/numeric/interpol.mac @@ -78,8 +78,8 @@ interpol_check_input(data,funame):= /* explicit(f(x),x,0,9), */ /* point_size = 3, */ /* points(p)) $ */ -lagrange(tab,[select]) := block([n,sum:0,prod,options,defaults,ratprint:false,tab2], - tab2: interpol_check_input(tab,"lagrange"), +lagrange(datatab,[select]) := block([n,sum:0,prod,options,defaults,ratprint:false,tab2], + tab2: interpol_check_input(datatab,"lagrange"), options: ['varname], defaults: ['x], for i in select do( @@ -126,8 +126,8 @@ charfun2(z,l1,l2):= charfun(l1 <= z and z < l2)$ /* explicit(f(x),x,0,9), */ /* point_size = 3, */ /* points(p)) $ */ -linearinterpol(tab,[select]) := block([n,s:0,a,b,options, defaults,ratprint:false,tab2], - tab2: interpol_check_input(tab,"linearinterpol"), +linearinterpol(datatab,[select]) := block([n,s:0,a,b,options, defaults,ratprint:false,tab2], + tab2: interpol_check_input(datatab,"linearinterpol"), options: ['varname], defaults: ['x], for i in select do( @@ -189,9 +189,9 @@ linearinterpol(tab,[select]) := block([n,s:0,a,b,options, defaults,ratprint:fals /* explicit(g(x),x,0,9), */ /* point_size = 3, */ /* points(p)) $ */ -cspline(tab,[select]):= block([options, defaults, n, aux, y2, u, sig, p, +cspline(datatab,[select]):= block([options, defaults, n, aux, y2, u, sig, p, qn, un, a, b, s:0, aj, bj, cj, dj, ratprint:false,tab2], - tab2: interpol_check_input(tab,"cspline"), + tab2: interpol_check_input(datatab,"cspline"), options: ['d1, 'dn, 'varname], defaults: ['unknown, 'unknown, 'x], for i in select do( @@ -296,9 +296,9 @@ cspline(tab,[select]):= block([options, defaults, n, aux, y2, u, sig, p, /* points(p), */ /* title = concat("Degree of numerator = ",k), */ /* yrange=[0,10])$ */ -ratinterpol(tab,r,[select]) := +ratinterpol(datatab,r,[select]) := block([n,m,coef,unk,sol,lovtab,lov,options,defaults,ratprint:false,tab2], - tab2: interpol_check_input(tab,"ratinterpol"), + tab2: interpol_check_input(datatab,"ratinterpol"), options: ['varname], defaults: ['x], for i in select do( ----------------------------------------------------------------------- Summary of changes: share/numeric/interpol.mac | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-09-30 21:46:17
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, rtoy-defmvar-add-string-decl has been created at 7d8490458cd4c0192a9d3f1135bb297b3557ac4d (commit) - Log ----------------------------------------------------------------- commit 7d8490458cd4c0192a9d3f1135bb297b3557ac4d Author: Raymond Toy <toy...@gm...> Date: Mon Sep 30 14:45:17 2024 -0700 Add comments, fix docstring for defmvar We also update the docstring for BOOLEAN because we do support this declaration. diff --git a/src/globals.lisp b/src/globals.lisp index 1144a63cc..107628de4 100644 --- a/src/globals.lisp +++ b/src/globals.lisp @@ -40,8 +40,15 @@ NO-RESET - If given, the variable will not be reset. - FIXNUM, BOOLEAN, STRING, FLONUM + FIXNUM, FLONUM - The type of variable. Currently ignored. + BOOLEAN, STRING + - Declares the variable to have this type and adds a property + so that this variable can only be assigned an appropriate type. + This takes precedence over other options so :SETTING-PREDICATE, + and :SETTING-LIST cannot also be specified. In addition, + :PROPERTIES can be specified, but it cannot contain an + ASSIGN property. :PROPERTIES - A list of properties to be applied for this variable. It is a list of lists. Each sublist is a list of the property and @@ -129,6 +136,9 @@ ;; Ignore this ) (string + ;; Declares the variable to be a string and adds a predicate + ;; to verify that only strings can be assigned to the + ;; variable. (let ((assign-func `#'(lambda (var val) (unless (stringp val) @@ -256,12 +266,14 @@ (warn "Ignoring unknown defmvar option for ~S: ~S" var (car opts))))) (flet ((validate-type-predicate (type-predicate type-name) + "If TYPE-PREDICATE is non-NIL, verify that the other options like + :SETTING-PREDICATE, :SETTING-LIST, and :PROPERTIES option + has an ASSIGN property are not also given. The type + declaration takes precedence." (when type-predicate (if (or setting-predicate-p setting-list-p assign-property-p) (error "Do not use ~A option when :SETTING-PREDICATE, :SETTING-LIST, or :PROPERTIES is used." type-name) - ;; Check that boolean predicate isn't used with any other - ;; predicate. The other predicates supersede boolean. (setf maybe-predicate type-predicate))))) (validate-type-predicate maybe-boolean-predicate "BOOLEAN") (validate-type-predicate maybe-string-predicate "STRING")) commit baf1b505937a0054ff29166addbbf116def093a5 Author: Raymond Toy <toy...@gm...> Date: Mon Sep 30 14:36:23 2024 -0700 Support STRING declaration in DEFMVAR If `defmvar` includes the `string` declaration, actually declare the variable to be a string and also provide an `assign` property so that only strings can be assigned to the variable. Updated stringproc.lisp to use this string declaration instead of a `:setting-predicate`. diff --git a/share/stringproc/stringproc.lisp b/share/stringproc/stringproc.lisp index 42f0028cf..b80f67a74 100644 --- a/share/stringproc/stringproc.lisp +++ b/share/stringproc/stringproc.lisp @@ -728,21 +728,15 @@ Please use `unicode' for code points larger than 127." ))) ;; (defmvar $newline (string #\newline) "Maxima newline character" - :setting-predicate #'(lambda (x) - (values (stringp x) - "must be a string"))) + string) (defmvar $tab (string #\tab) "Maxima tab character" - :setting-predicate #'(lambda (x) - (values (stringp x) - "must be a string"))) + string) (defmvar $space (string #\space) "Maxima space character" - :setting-predicate #'(lambda (x) - (values (stringp x) - "must be a string"))) + string) (defun $tab () $tab) ;; returns Maxima tab character; can be autoloaded diff --git a/src/globals.lisp b/src/globals.lisp index f6b139c04..1144a63cc 100644 --- a/src/globals.lisp +++ b/src/globals.lisp @@ -92,6 +92,7 @@ maybe-set-props maybe-predicate maybe-boolean-predicate + maybe-string-predicate setting-predicate-p setting-list-p assign-property-p @@ -106,7 +107,7 @@ (unless deprecated-p ;; Don't reset the value (setf maybe-reset nil))) - ((fixnum string flonum) + ((fixnum flonum) ;; Don't declare the types yet. There are testsuite failures ;; with sbcl that some things declared fixnum aren't assigned ;; fixnum values. Some are clearly bugs in the code where we @@ -127,6 +128,15 @@ (in-core ;; Ignore this ) + (string + (let ((assign-func + `#'(lambda (var val) + (unless (stringp val) + (mseterr var val "must be a string"))))) + (setf maybe-declare-type + `((declaim (string ,var)))) + (setf maybe-string-predicate + `((putprop ',var ,assign-func 'assign))))) (boolean ;; Vars declared as boolean create a setting-list so that ;; only true and false can be assigned to the variable. @@ -245,13 +255,17 @@ (t (warn "Ignoring unknown defmvar option for ~S: ~S" var (car opts))))) - (when maybe-boolean-predicate - (if (or setting-predicate-p setting-list-p assign-property-p) - (error "Do not use BOOLEAN option when :SETTING-PREDICATE, :SETTING-LIST, or :PROPERTIES is used") - ;; Check that boolean predicate isn't used with any other - ;; predicate. The other predicates supersede boolean. - (setf maybe-predicate maybe-boolean-predicate))) - + (flet ((validate-type-predicate (type-predicate type-name) + (when type-predicate + (if (or setting-predicate-p setting-list-p assign-property-p) + (error "Do not use ~A option when :SETTING-PREDICATE, :SETTING-LIST, or :PROPERTIES is used." + type-name) + ;; Check that boolean predicate isn't used with any other + ;; predicate. The other predicates supersede boolean. + (setf maybe-predicate type-predicate))))) + (validate-type-predicate maybe-boolean-predicate "BOOLEAN") + (validate-type-predicate maybe-string-predicate "STRING")) + `(progn ,@maybe-reset ,@maybe-declare-type ----------------------------------------------------------------------- hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-09-30 13:36:55
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 842eb746a3add7b53b23bbc21af287ab981193a8 (commit) from cab32dcb1e108d14f3c7988f7662e12bc337b255 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 842eb746a3add7b53b23bbc21af287ab981193a8 Author: Raymond Toy <toy...@gm...> Date: Mon Sep 30 06:32:27 2024 -0700 Use :setting-predicate to assert the vars takes strings In commit [cab32dcb1e], the variables `$newline`, `$tab`, and `$space` were updated to assert that only strings could be assigned to them. This is a slight change to use the `:setting-predicate` option to `defmvar` instead of manually setting the `assign` property for these variables. I think this is easier to read and maintain. Manually tested this to verify that we throw an error when setting `$space` to a number. Also verified that a string works as expected. diff --git a/share/stringproc/stringproc.lisp b/share/stringproc/stringproc.lisp index 19f1ef704..42f0028cf 100644 --- a/share/stringproc/stringproc.lisp +++ b/share/stringproc/stringproc.lisp @@ -726,20 +726,23 @@ Please use `unicode' for code points larger than 127." ))) ;; Special Maxima characters ;; -(defmvar $newline - (string #\newline) "Maxima newline character") - -(setf (get '$newline 'assign) (lambda (x y) (when (not (stringp y)) (mseterr x y "must be a string")))) - -(defmvar $tab - (string #\tab) "Maxima tab character") - -(setf (get '$tab 'assign) (lambda (x y) (when (not (stringp y)) (mseterr x y "must be a string")))) - -(defmvar $space - (string #\space) "Maxima space character") - -(setf (get '$space 'assign) (lambda (x y) (when (not (stringp y)) (mseterr x y "must be a string")))) +(defmvar $newline (string #\newline) + "Maxima newline character" + :setting-predicate #'(lambda (x) + (values (stringp x) + "must be a string"))) + +(defmvar $tab (string #\tab) + "Maxima tab character" + :setting-predicate #'(lambda (x) + (values (stringp x) + "must be a string"))) + +(defmvar $space (string #\space) + "Maxima space character" + :setting-predicate #'(lambda (x) + (values (stringp x) + "must be a string"))) (defun $tab () $tab) ;; returns Maxima tab character; can be autoloaded ----------------------------------------------------------------------- Summary of changes: share/stringproc/stringproc.lisp | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) hooks/post-receive -- Maxima CAS |
From: <ap...@us...> - 2024-09-29 19:38:02
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via cab32dcb1e108d14f3c7988f7662e12bc337b255 (commit) from 6464edaa0c1bf180bc18a001aeb9b3943762666f (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit cab32dcb1e108d14f3c7988f7662e12bc337b255 Author: Robert Dodier <rob...@so...> Date: Sun Sep 29 12:37:40 2024 -0700 Package stringproc: set assign property for variables newline, tab, and space to require that an assigned value must be a string. This is a direct translation of the previous (nonfunctional) DEFMVAR formulation which attempted (unsuccessfully) to specify that those variables are strings. I am not convinced that those variables are needed at all, but this is a minimal change which maintains the previous concept. I think we should consider the following: making those variables not assignable; changing the names to something like string_newline, etc., to reduce the probability of collision; or removing them entirely. diff --git a/share/stringproc/stringproc.lisp b/share/stringproc/stringproc.lisp index b32fd2814..19f1ef704 100644 --- a/share/stringproc/stringproc.lisp +++ b/share/stringproc/stringproc.lisp @@ -727,14 +727,19 @@ Please use `unicode' for code points larger than 127." ))) ;; Special Maxima characters ;; (defmvar $newline - (string #\newline) "Maxima newline character" string) -;; + (string #\newline) "Maxima newline character") + +(setf (get '$newline 'assign) (lambda (x y) (when (not (stringp y)) (mseterr x y "must be a string")))) + (defmvar $tab - (string #\tab) "Maxima tab character" string) -;; + (string #\tab) "Maxima tab character") + +(setf (get '$tab 'assign) (lambda (x y) (when (not (stringp y)) (mseterr x y "must be a string")))) + (defmvar $space - (string #\space) "Maxima space character" string) + (string #\space) "Maxima space character") +(setf (get '$space 'assign) (lambda (x y) (when (not (stringp y)) (mseterr x y "must be a string")))) (defun $tab () $tab) ;; returns Maxima tab character; can be autoloaded ----------------------------------------------------------------------- Summary of changes: share/stringproc/stringproc.lisp | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) hooks/post-receive -- Maxima CAS |
From: <ap...@us...> - 2024-09-24 22:39:14
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 6464edaa0c1bf180bc18a001aeb9b3943762666f (commit) from 7c5a1555235da2b8993aa2e30a3d4ce22ffe271f (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 6464edaa0c1bf180bc18a001aeb9b3943762666f Author: Robert Dodier <rob...@so...> Date: Tue Sep 24 15:35:53 2024 -0700 In Maxima function trace, call $LOAD instead of LOAD-AND-TELL to ensure that the to-be-loaded file is located by $FILE_SEARCH1. This is the same thing that the autoloading mechanism does. Fixes bug reported to mailing list 2024-09-24: "stringp() throws deprecation warnings on first call" (Although that business about the deprecation warnings is a separate bug.) diff --git a/src/mtrace.lisp b/src/mtrace.lisp index 592689f62..e1e61147e 100644 --- a/src/mtrace.lisp +++ b/src/mtrace.lisp @@ -616,7 +616,7 @@ (let ((try (macsyma-fsymeval-sub fun))) (cond (try try) ((get fun 'autoload) - (load-and-tell (get fun 'autoload)) + ($load (get fun 'autoload)) (setq try (macsyma-fsymeval-sub fun)) (or try (mtell (intl:gettext "trace: ~@:M has no functional properties after autoloading.~%") ----------------------------------------------------------------------- Summary of changes: src/mtrace.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) hooks/post-receive -- Maxima CAS |
From: dauti <da...@us...> - 2024-09-19 19:23:25
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 7c5a1555235da2b8993aa2e30a3d4ce22ffe271f (commit) from efdce0d0ed457e22b31acfdf4714404b50ee7834 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 7c5a1555235da2b8993aa2e30a3d4ce22ffe271f Author: Wolfgang Dautermann <da...@us...> Date: Thu Sep 19 21:22:56 2024 +0200 Windows installer: Update TCL/TK. diff --git a/crosscompile-windows/tcltk/CMakeLists.txt b/crosscompile-windows/tcltk/CMakeLists.txt index 6afc306b0..888bf59d7 100644 --- a/crosscompile-windows/tcltk/CMakeLists.txt +++ b/crosscompile-windows/tcltk/CMakeLists.txt @@ -10,11 +10,11 @@ # If no further patches are needed, you should get a # updated setup-file automatically. -set(TCLVERSION "8.6.14") -set(TKVERSION "8.6.14") +set(TCLVERSION "8.6.15") +set(TKVERSION "8.6.15") -set(TCL_MD5 "c30b57c6051be28fa928d09aca82841e") -set(TK_MD5 "cf2aaac0478ef468b48e65c10e6b0d07") +set(TCL_MD5 "c13a4d5425b5ae335258342b38ba34c2") +set(TK_MD5 "6d64b6eb021062f378017d403fedcbe6") set(TCL_URL "https://prdownloads.sourceforge.net/tcl/tcl${TCLVERSION}-src.tar.gz") set(TK_URL "https://prdownloads.sourceforge.net/tcl/tk${TKVERSION}-src.tar.gz") ----------------------------------------------------------------------- Summary of changes: crosscompile-windows/tcltk/CMakeLists.txt | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) hooks/post-receive -- Maxima CAS |
From: willisbl <wil...@us...> - 2024-09-18 10:15:07
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via efdce0d0ed457e22b31acfdf4714404b50ee7834 (commit) from 4bf14b49ff36e1625497019a60a708d87a1a0366 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit efdce0d0ed457e22b31acfdf4714404b50ee7834 Author: Barton Willis <wi...@un...> Date: Wed Sep 18 05:14:48 2024 -0500 Fix typo in source code comment. diff --git a/src/hypergeometric.lisp b/src/hypergeometric.lisp index 09cef1bd9..7e07d5851 100644 --- a/src/hypergeometric.lisp +++ b/src/hypergeometric.lisp @@ -85,7 +85,7 @@ (t 'nonpolynomial)))) -;; The function simpcheck changes taylor polynomials to general form--that messes +;; The function simpcheck changes taylor polynomials to general form--that makes ;; it harder to taylorize hypergeometrics (things like hypergeometric([5],[], taylor(x,x,0,3)) --> ;; a taylor polynomial. So use tsimpcheck: if e is a taylor polynomial, simplify; otherwise, simpcheck. ----------------------------------------------------------------------- Summary of changes: src/hypergeometric.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) hooks/post-receive -- Maxima CAS |
From: willisbl <wil...@us...> - 2024-09-18 10:05:47
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 4bf14b49ff36e1625497019a60a708d87a1a0366 (commit) from c02e1b022ef5cb70dbe24d2e097260c4682971cc (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 4bf14b49ff36e1625497019a60a708d87a1a0366 Author: Barton Willis <wi...@un...> Date: Wed Sep 18 05:05:28 2024 -0500 #4373 conjugate doesn't know li[n](x) is complex in general - Revise function conjugate-li so that it replaces conjugate(li[n](z)) by li[n](conjugate(z)) when n is a positive integer and z is off the real interval [1,inf) - Add source code comment to conjugate-plog - append tests to rtest_limit_extra for #4338 limit((1+%i)^(2*a)*2^(-a),x,inf) when logexpand is true (unrelated to #4373) - append tests for #4373 to rtestconjugate.mac Tested with SBCL 2.4.7 & Clozure 1.13. For SBCL, the rtest_gamma.mac problems 384 & 390 fail for a tiny margin in numerical accuracy. And for Clozure, rtest_gamma.mac problem 330 similarly fails. But I think these failures are absent in other compiler versions. Also Clozure 1.13 fixes the failures test_engineering_format.mac problems 6, 8, 10, and 12. But I didn't mark these as fixed because Clozure 1.13 is fairly new. - diff --git a/src/conjugate.lisp b/src/conjugate.lisp index 8b5c3175a..ecb1236e2 100644 --- a/src/conjugate.lisp +++ b/src/conjugate.lisp @@ -1,4 +1,4 @@ -;; Copyright 2005, 2006, 2020, 2021 by Barton Willis +;; Copyright 2005, 2006, 2020, 2021, 2024 by Barton Willis ;; This is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License, @@ -180,7 +180,7 @@ (setq x (car x)) (cond ((off-negative-real-axisp x) (take '(%plog) (take '($conjugate) x))) - ((on-negative-real-axisp x) + ((on-negative-real-axisp x) ; simplified away--never happens (add (take '(%plog) (neg x)) (mul -1 '$%i '$%pi))) (t (list '($conjugate simp) (take '(%plog) x))))) @@ -311,13 +311,19 @@ (take '(%log_gamma) (take '($conjugate) z)) (list '($conjugate simp) (take '(%log_gamma) z)))) -;; conjugate of polylogarithm li[s](x), where z = (s,x). We have li[s](x) = x+x^2/2^s+x^3/3^s+... -;; Since for all integers k, we have conjugate(x^k/k^s) = conjugate(x)^k/k^conjugate(s), we -;; commute conjugate with li. +;; For z ∈ C \ [1,∞) and n ∈ {1,2,3,...}, replace conjugate(li[n](z)) by li[n](conjugate(z)). +;; For all other cases, return a conjugate nounform. (defun conjugate-li (z) - (let ((s (take '($conjugate) (first z))) (x (take '($conjugate) (second z)))) - (take '(mqapply) `(($li array) ,s) x))) - + (let ((n (first z)) (zz (risplit (second z)))) + (if (and ($featurep n '$integer) + (eq t (mgrp n 0)) + ;; either the imagpart(z) ≠ 0 or the realpart(z) < 1 + (or (eq t (mnqp (cdr zz) 0)) (eq t (mgrp 1 (car zz))))) + (subftake '$li (list n) (list (ftake '$conjugate (second z)))) + ;; give up and return conjugate nounform + (list (list '$conjugate 'simp) + (subftake '$li (list n) (list (second z))))))) + (defun conjugate-psi (z) (let ((s (take '($conjugate) (first z))) (x (take '($conjugate) (second z)))) (take '(mqapply) `(($psi array) ,s) x))) diff --git a/tests/rtest_limit_extra.mac b/tests/rtest_limit_extra.mac index 7a0cab3f4..5b05c86d1 100644 --- a/tests/rtest_limit_extra.mac +++ b/tests/rtest_limit_extra.mac @@ -1208,6 +1208,19 @@ limit((asin(x+h)-asin(x))/h,h,0); tlimit((asin(x+h)-asin(x))/h,h,0); -sqrt(1-x^2)/(x^2-1)$ +/* #4338 limit((1+%i)^(2*a)*2^(-a),x,inf) when logexpand is true */ +block([logexpand : true], limit((1+%i)^(2*a)*2^(-a),a,inf)); +ind$ + +block([logexpand : false], limit((1+%i)^(2*a)*2^(-a),a,inf)); +ind$ + +block([logexpand : true], tlimit((1+%i)^(2*a)*2^(-a),a,inf)); +ind$ + +block([logexpand : false], tlimit((1+%i)^(2*a)*2^(-a),a,inf)); +ind$ + /* clean up*/ (kill(values),0); 0$ diff --git a/tests/rtestconjugate.mac b/tests/rtestconjugate.mac index d83856643..5ffe4abea 100644 --- a/tests/rtestconjugate.mac +++ b/tests/rtestconjugate.mac @@ -643,8 +643,9 @@ conjugate(log_gamma(z))$ conjugate(log_gamma(1-%i)); log_gamma(1+%i)$ -conjugate(li[2](z)); -li[2](conjugate(z))$ +/* #4373 conjugate doesn't know li[n](x) is complex in general */ +block([w : conjugate(li[2](z))], [inpart(w,0), args(w)]); +[conjugate,[li[2](z)]]$ conjugate(psi[2](z)); psi[2](conjugate(z))$ @@ -803,6 +804,46 @@ conjugate$ (remove(z,complex), conjugate(z)); z$ +/* More conjugate of li; see #4373 conjugate doesn't know li[n](x) is complex in general */ +(declare(n,integer), assume(n > 0), assume(xx < 1),0); +0$ + +conjugate(li[n](2/3)); +li[n](2/3)$ + +conjugate(li[2](2/3)); +li[2](2/3)$ + +conjugate(li[n](2/3)); +li[n](2/3)$ + +conjugate(li[n](xx)); +li[n](xx)$ + +conjugate(li[n](x+%i)); +li[n](x-%i)$ + +conjugate(li[3](x+%i)); +li[3](x-%i)$ + +(declare(z,complex),0); +0$ + +tex1(conjugate(z + F(z))); +"F\\left(z\\right)^{\\ast}+z^{\\ast}"$ + +block([xxx : conjugate(sum(f(x),x,%i,inf))], [op(xxx), args(first(xxx))]); +[conjugate,[f(x),x,%i,inf]]$ + +block([xxx : conjugate(product(f(x),x,%i,inf))], [op(xxx), args(first(xxx))]); +[conjugate,[f(x),x,%i,inf]]$ + +block([xxx : conjugate(atanh(s))], [op(xxx), args(xxx)]); + [conjugate, [atanh(s)]]$ + +(forget(z,complex), forget(n,integer), forget(n > 0),forget(xx < 1),0); +0$ + (kill(all),0); 0$ @@ -812,3 +853,6 @@ values; facts(); []$ + +contexts; +[initial,global]$ ----------------------------------------------------------------------- Summary of changes: src/conjugate.lisp | 22 +++++++++++++-------- tests/rtest_limit_extra.mac | 13 ++++++++++++ tests/rtestconjugate.mac | 48 +++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 73 insertions(+), 10 deletions(-) hooks/post-receive -- Maxima CAS |
From: dgildea <dg...@us...> - 2024-09-13 08:28:40
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via c02e1b022ef5cb70dbe24d2e097260c4682971cc (commit) from 134580b7d1d354bb5923edca730e318027bb3aea (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit c02e1b022ef5cb70dbe24d2e097260c4682971cc Author: Dan Gildea <dgildea> Date: Fri Sep 13 10:27:44 2024 +0200 limit(li[2](2*exp(x*%i)), x, 0, plus) clean up previous commit signs were flipped adjust numbering of test cases diff --git a/src/limit.lisp b/src/limit.lisp index 56371ca3d..bb4102dda 100644 --- a/src/limit.lisp +++ b/src/limit.lisp @@ -3565,18 +3565,18 @@ ignoring dummy variables and array indices." ((and (not (extended-real-p elim)) (not (off-one-to-inf elim))) ;; handle branch cut along line (1, inf). - ;; if we approach from positive imaginary, - ;; result is the same as result on the line. ;; if we approach from negative imaginary, + ;; result is the same as result on the line. + ;; if we approach from positive imaginary, ;; imaginary part of result has opposite sign ;; ;; this works for limit(li[2](2*exp(x*%i)), x, 0, plus) ;; but currently does not work in general because maxima ;; thinks conjugate(li[n](x)) => li[n](x) (setq dir (behavior ($imagpart e) var val)) - (cond ((eq dir 1) + (cond ((eq dir -1) (subftake '$li (list n) (list elim))) - ((eq dir -1) + ((eq dir 1) (ftake '$conjugate (subftake '$li (list n) (list elim)))) (t (throw 'limit nil)))) diff --git a/src/testsuite.lisp b/src/testsuite.lisp index 41b81da5e..75ac93fa9 100644 --- a/src/testsuite.lisp +++ b/src/testsuite.lisp @@ -128,7 +128,7 @@ "rtestdefstruct" ;; Tested with acl 10.1 ((mlist simp) "rtest_limit" - ((mlist simp) 113 158 159 229)) + ((mlist simp) 113 158 159 231)) "rtest_powerseries" ((mlist simp) "rtest_laplace" ((mlist simp) 29 49 50 51 59 60 61 62 78 80)) diff --git a/tests/rtest_limit.mac b/tests/rtest_limit.mac index 5a5db7196..25ee48957 100644 --- a/tests/rtest_limit.mac +++ b/tests/rtest_limit.mac @@ -629,10 +629,10 @@ limit(li[3](x)/log(-x)^3,x,inf); /* #4368 incorrect limit(li[2](2*exp(x*%i)), x, 0, plus) */ limit(li[2](2*exp(x*%i)), x, 0, plus); -(-4*%i*%pi*log(2)+%pi^2)/4; +%i*%pi*log(2)+%pi^2/4; limit(li[2](2*exp(x*%i)), x, 0, minus); -(4*%i*%pi*log(2)+%pi^2)/4; +-%i*%pi*log(2)+%pi^2/4; /* The initial problem which triggers this bug */ declare(n,integer); ----------------------------------------------------------------------- Summary of changes: src/limit.lisp | 8 ++++---- src/testsuite.lisp | 2 +- tests/rtest_limit.mac | 4 ++-- 3 files changed, 7 insertions(+), 7 deletions(-) hooks/post-receive -- Maxima CAS |
From: dauti <da...@us...> - 2024-09-12 20:55:33
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 134580b7d1d354bb5923edca730e318027bb3aea (commit) from 525b90fec12d0446698a2d75a7d084a664864686 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 134580b7d1d354bb5923edca730e318027bb3aea Author: Wolfgang Dautermann <da...@us...> Date: Thu Sep 12 22:55:03 2024 +0200 Windows installer: Update wxWidgets. diff --git a/crosscompile-windows/wxwidgets/CMakeLists.txt b/crosscompile-windows/wxwidgets/CMakeLists.txt index 07ce1c6ce..ecc33d939 100644 --- a/crosscompile-windows/wxwidgets/CMakeLists.txt +++ b/crosscompile-windows/wxwidgets/CMakeLists.txt @@ -10,8 +10,8 @@ # If no further patches are needed, you should get a # updated setup-file automatically. -set(WXWIDGETSVERSION "3.2.5") -set(WXWIDGETS_MD5 "5a0ad6fb2566cebfa3271be3fea2e7fd") +set(WXWIDGETSVERSION "3.2.6") +set(WXWIDGETS_MD5 "41d54fffc953936bb92ae45d81ded60c") set(WXWIDGETS_URL "https://github.com/wxWidgets/wxWidgets/releases/download/v${WXWIDGETSVERSION}/wxWidgets-${WXWIDGETSVERSION}.tar.bz2") # Build wxWidgets static library (required for wxMaxima) ----------------------------------------------------------------------- Summary of changes: crosscompile-windows/wxwidgets/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) hooks/post-receive -- Maxima CAS |
From: dgildea <dg...@us...> - 2024-09-12 09:51:38
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 525b90fec12d0446698a2d75a7d084a664864686 (commit) from 4afc4ab91ff733bcbd2e7890309ec97d9ae8846e (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 525b90fec12d0446698a2d75a7d084a664864686 Author: Dan Gildea <dgildea> Date: Thu Sep 12 11:49:42 2024 +0200 limit(li[2](2*exp(x*%i)), x, 0, plus) Fixes #4368 handle branch cut along line (1, inf). if we approach from positive imaginary, result is the same as result on the line. if we approach from negative imaginary, imaginary part of result has opposite sign this works for limit(li[2](2*exp(x*%i)), x, 0, plus) but currently does not work in general because maxima thinks conjugate(li[n](x)) => li[n](x) diff --git a/src/limit.lisp b/src/limit.lisp index ff5cf1b51..56371ca3d 100644 --- a/src/limit.lisp +++ b/src/limit.lisp @@ -3547,18 +3547,39 @@ ignoring dummy variables and array indices." (eq t (mgrp 1 (car z))))) ; x < 1 (defun simplim%li (expr x pt) - (let ((n (car (subfunsubs expr))) (e (car (subfunargs expr)))) + (let* ((n (car (subfunsubs expr))) + (e (car (subfunargs expr))) + (elim (limit e x pt 'think)) + (dir)) (cond ((freeof x n) - (setq e (limit e x pt 'think)) - (cond ((and (eq e '$minf) (integerp n) (>= n 2)) + (cond ((and (eq elim '$minf) (integerp n) (>= n 2)) '$minf) - ((and (eq e '$inf) (integerp n) (>= n 2)) + ((and (eq elim '$inf) (integerp n) (>= n 2)) '$infinity) - ((or (eql (ridofab e) 1) (and (not (extended-real-p e)) (off-one-to-inf e))) + ((or (eql (ridofab elim) 1) (and (not (extended-real-p elim)) (off-one-to-inf elim))) ;; Limit of li[s](1) can be evaluated by just ;; substituting in 1. ;; Same for li[s](x) when x is < 1. - (subftake '$li (list n) (list e))) + (subftake '$li (list n) (list elim))) + + ((and (not (extended-real-p elim)) + (not (off-one-to-inf elim))) + ;; handle branch cut along line (1, inf). + ;; if we approach from positive imaginary, + ;; result is the same as result on the line. + ;; if we approach from negative imaginary, + ;; imaginary part of result has opposite sign + ;; + ;; this works for limit(li[2](2*exp(x*%i)), x, 0, plus) + ;; but currently does not work in general because maxima + ;; thinks conjugate(li[n](x)) => li[n](x) + (setq dir (behavior ($imagpart e) var val)) + (cond ((eq dir 1) + (subftake '$li (list n) (list elim))) + ((eq dir -1) + (ftake '$conjugate (subftake '$li (list n) (list elim)))) + (t (throw 'limit nil)))) + (t (throw 'limit nil)))) ;; Claim ignorance when order depends on limit variable. (t (throw 'limit nil))))) diff --git a/tests/rtest_limit.mac b/tests/rtest_limit.mac index d289730ea..5a5db7196 100644 --- a/tests/rtest_limit.mac +++ b/tests/rtest_limit.mac @@ -627,6 +627,13 @@ limit(-x*log(%e^x+1)-li[2](-%e^x)+x^2/2, x, inf); limit(li[3](x)/log(-x)^3,x,inf); -1/6; +/* #4368 incorrect limit(li[2](2*exp(x*%i)), x, 0, plus) */ +limit(li[2](2*exp(x*%i)), x, 0, plus); +(-4*%i*%pi*log(2)+%pi^2)/4; + +limit(li[2](2*exp(x*%i)), x, 0, minus); +(4*%i*%pi*log(2)+%pi^2)/4; + /* The initial problem which triggers this bug */ declare(n,integer); done; ----------------------------------------------------------------------- Summary of changes: src/limit.lisp | 33 +++++++++++++++++++++++++++------ tests/rtest_limit.mac | 7 +++++++ 2 files changed, 34 insertions(+), 6 deletions(-) hooks/post-receive -- Maxima CAS |
From: dauti <da...@us...> - 2024-08-31 07:50:49
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 4afc4ab91ff733bcbd2e7890309ec97d9ae8846e (commit) from a5eec06454229cb9ecc47c47a13094f92a6f3b28 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 4afc4ab91ff733bcbd2e7890309ec97d9ae8846e Author: Wolfgang Dautermann <da...@us...> Date: Sat Aug 31 09:50:19 2024 +0200 Windows installer: Update SBCL. diff --git a/crosscompile-windows/sbcl/CMakeLists.txt b/crosscompile-windows/sbcl/CMakeLists.txt index 4f9c158e3..21cdf0d51 100644 --- a/crosscompile-windows/sbcl/CMakeLists.txt +++ b/crosscompile-windows/sbcl/CMakeLists.txt @@ -11,8 +11,8 @@ # updated setup-file automatically. if(BUILD_64BIT) - set(SBCLVERSION "2.4.7") - set(SBCL_MD5 "2875cd24a59309ef4dc307eaa5c81eb6") + set(SBCLVERSION "2.4.8") + set(SBCL_MD5 "113176fd35198310c1708bde2677eb18") set(SBCL_INSTALLERNAME "sbcl-${SBCLVERSION}-x86-64-windows-binary.msi") else() set(SBCLVERSION "2.3.2") ----------------------------------------------------------------------- Summary of changes: crosscompile-windows/sbcl/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) hooks/post-receive -- Maxima CAS |
From: <ap...@us...> - 2024-08-31 01:15:00
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via a5eec06454229cb9ecc47c47a13094f92a6f3b28 (commit) from 7c9eb9ce7e785c75de555318bd35c102cc3f8f4f (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit a5eec06454229cb9ecc47c47a13094f92a6f3b28 Author: Robert Dodier <do...@oh...> Date: Fri Aug 30 17:50:41 2024 -0700 Package numericalio: functions CONSTRUCT-FLOAT-32-FROM-INTEGER and EXTRACT-SMASHED-FLOAT-32-FROM-INTEGER to mirror corresponding functions for 64 bit floats. diff --git a/share/numericalio/encode-decode-float.lisp b/share/numericalio/encode-decode-float.lisp index 60a67dff0..7176f25a8 100644 --- a/share/numericalio/encode-decode-float.lisp +++ b/share/numericalio/encode-decode-float.lisp @@ -45,6 +45,21 @@ (byte 23 0) significand))))) +(defun construct-float-32-from-integer (x) + (multiple-value-bind + (significand exponent sign) + (extract-smashed-float-32-from-integer x) + (* sign (scale-float (float significand 1f0) exponent)))) + +(defun extract-smashed-float-32-from-integer (x) + (if (eql x 0) + (values 0 0 0) + (let + ((significand (dpb x (byte 23 0) #x800000)) + (exponent (- (ldb (byte 8 23) x) 127 23)) + (sign (if (eql (ldb (byte 1 31) x) 0) 1 -1))) + (values significand exponent sign)))) + (defun smash-decoded-float-64-into-integer (significand exponent sign) (if (= significand 0) 0 ----------------------------------------------------------------------- Summary of changes: share/numericalio/encode-decode-float.lisp | 15 +++++++++++++++ 1 file changed, 15 insertions(+) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-08-27 13:25:40
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 7c9eb9ce7e785c75de555318bd35c102cc3f8f4f (commit) via c201db88b58984f01ccb2bbda841661ac7de2f1e (commit) from dafed984fa9d278101fa581789675f2b425c1650 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- ----------------------------------------------------------------------- Summary of changes: src/ellipt.lisp | 1365 +++++++++++++++++++++++++++---------------------------- 1 file changed, 681 insertions(+), 684 deletions(-) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-08-26 15:33:02
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, rtoy-ellipt-collect-bigfloat-together has been created at 7c9eb9ce7e785c75de555318bd35c102cc3f8f4f (commit) - Log ----------------------------------------------------------------- commit 7c9eb9ce7e785c75de555318bd35c102cc3f8f4f Author: Raymond Toy <toy...@gm...> Date: Mon Aug 26 08:31:02 2024 -0700 Fix up some comments. diff --git a/src/ellipt.lisp b/src/ellipt.lisp index 4ebdb913a..8e74eafe3 100644 --- a/src/ellipt.lisp +++ b/src/ellipt.lisp @@ -30,22 +30,25 @@ ;;; Note that m = k^2 and k = sin(alpha). ;;; -;; -;; Routines for computing the basic elliptic functions sn, cn, and dn. -;; -;; -;; A&S gives several methods for computing elliptic functions -;; including the AGM method (16.4) and ascending and descending Landen -;; transformations (16.12 and 16.14). The latter are actually quite -;; fast, only requiring simple arithmetic and square roots for the -;; transformation until the last step. The AGM requires evaluation of -;; several trigonometric functions at each stage. -;; -;; However, the Landen transformations appear to have some round-off -;; issues. For example, using the ascending transform to compute cn, -;; cn(100,.7) > 1e10. This is clearly not right since |cn| <= 1. -;; +;;; +;;; Routines for computing the basic elliptic functions sn, cn, and dn. +;;; +;;; +;;; A&S gives several methods for computing elliptic functions +;;; including the AGM method (16.4) and ascending and descending Landen +;;; transformations (16.12 and 16.14). The latter are actually quite +;;; fast, only requiring simple arithmetic and square roots for the +;;; transformation until the last step. The AGM requires evaluation of +;;; several trigonometric functions at each stage. +;;; +;;; However, the Landen transformations appear to have some round-off +;;; issues. For example, using the ascending transform to compute cn, +;;; cn(100,.7) > 1e10. This is clearly not right since |cn| <= 1. +;;; +;;; All the routines in the BIGFLOAT package are collected here. +;;; These functions compute numerical results for the elliptic +;;; functions and integrals. (in-package #:bigfloat) (declaim (inline descending-transform ascending-transform)) commit c201db88b58984f01ccb2bbda841661ac7de2f1e Author: Raymond Toy <toy...@gm...> Date: Mon Aug 26 08:25:18 2024 -0700 Move all code in the bigfloat package together in ellipt.lisp It's a bit confusing to have lots of `in-package` forms spread around the file. Keep track of the package is a bit of a pain. Thus, gather all the code that is in the `bigfloat` package all together in one place. Remove the extraneous `in-package` forms too. diff --git a/src/ellipt.lisp b/src/ellipt.lisp index 0713eeee5..4ebdb913a 100644 --- a/src/ellipt.lisp +++ b/src/ellipt.lisp @@ -180,115 +180,622 @@ (/ (- (* d d) root-mu1) d))))))) -(in-package :maxima) - -;; Tell maxima what the derivatives are. -;; -;; Lawden says the derivative wrt to k but that's not what we want. -;; -;; Here's the derivation we used, based on how Lawden gets his results. -;; -;; Let -;; -;; diff(sn(u,m),m) = s -;; diff(cn(u,m),m) = p -;; diff(dn(u,m),m) = q -;; -;; From the derivatives of sn, cn, dn wrt to u, we have -;; -;; diff(sn(u,m),u) = cn(u)*dn(u) -;; diff(cn(u,m),u) = -cn(u)*dn(u) -;; diff(dn(u,m),u) = -m*sn(u)*cn(u) +;; Arithmetic-Geometric Mean algorithm for real or complex numbers. +;; See https://dlmf.nist.gov/22.20.ii. ;; +;; Do not use this for computing jacobi sn. It loses some 7 digits of +;; accuracy for sn(1+%i,0.7). +(let ((an (make-array 100 :fill-pointer 0)) + (bn (make-array 100 :fill-pointer 0)) + (cn (make-array 100 :fill-pointer 0))) + ;; Instead of allocating these array anew each time, we'll reuse + ;; them and allow them to grow as needed. + (defun agm (a0 b0 c0 tol) + "Arithmetic-Geometric Mean algorithm for real or complex a0, b0, c0. + Algorithm continues until |c[n]| <= tol." -;; Differentiate these wrt to m: -;; -;; diff(s,u) = p*dn + cn*q -;; diff(p,u) = -p*dn - q*dn -;; diff(q,u) = -sn*cn - m*s*cn - m*sn*q -;; -;; Also recall that -;; -;; sn(u)^2 + cn(u)^2 = 1 -;; dn(u)^2 + m*sn(u)^2 = 1 + ;; DLMF (https://dlmf.nist.gov/22.20.ii) says for any real or + ;; complex a0 and b0, b0/a0 must not be real and negative. Let's + ;; check that. + (let ((q (/ b0 a0))) + (when (and (= (imagpart q) 0) + (minusp (realpart q))) + (error "Invalid arguments for AGM: ~A ~A~%" a0 b0))) + (let ((nd (max (* 2 (ceiling (log (- (log tol 2))))) 8))) + ;; DLMF (https://dlmf.nist.gov/22.20.ii) says that |c[n]| <= + ;; C*2^(-2^n), for some constant C. Solve C*2^(-2^n) = tol to + ;; get n = log(log(C/tol)/log(2))/log(2). Arbitrarily assume C + ;; is one to get n = log(-(log(tol)/log(2)))/log(2). Thus, the + ;; approximate number of term needed is n = + ;; 1.44*log(-(1.44*log(tol))). Round to 2*log(-log2(tol)). + (setf (fill-pointer an) 0 + (fill-pointer bn) 0 + (fill-pointer cn) 0) + (vector-push-extend a0 an) + (vector-push-extend b0 bn) + (vector-push-extend c0 cn) + + (do ((k 0 (1+ k))) + ((or (<= (abs (aref cn k)) tol) + (>= k nd)) + (if (>= k nd) + (error "Failed to converge") + (values k an bn cn))) + (vector-push-extend (/ (+ (aref an k) (aref bn k)) 2) an) + ;; DLMF (https://dlmf.nist.gov/22.20.ii) has conditions on how + ;; to choose the square root depending on the phase of a[n-1] + ;; and b[n-1]. We don't check for that here. + (vector-push-extend (sqrt (* (aref an k) (aref bn k))) bn) + (vector-push-extend (/ (- (aref an k) (aref bn k)) 2) cn))))) + +(defun jacobi-am-agm (u m tol) + "Evaluate the jacobi_am function from real u and m with |m| <= 1. This + uses the AGM method until a tolerance of TOL is reached for the + error." + (multiple-value-bind (n an bn cn) + (agm 1 (sqrt (- 1 m)) (sqrt m) tol) + (declare (ignore bn)) + ;; See DLMF (https://dlmf.nist.gov/22.20.ii) for the algorithm. + (let ((phi (* u (aref an n) (expt 2 n)))) + (loop for k from n downto 1 + do + (setf phi (/ (+ phi (asin (* (/ (aref cn k) + (aref an k)) + (sin phi)))) + 2))) + phi))) + +;; Compute Jacobi am for real or complex values of U and M. The args +;; must be floats or bigfloat::bigfloats. TOL is the tolerance used +;; by the AGM algorithm. It is ignored if the AGM algorithm is not +;; used. +(defun bf-jacobi-am (u m tol) + (cond ((and (realp u) (realp m) (<= (abs m) 1)) + ;; The case of real u and m with |m| <= 1. We can use AGM to + ;; compute the result. + (jacobi-am-agm (to u) + (to m) + tol)) + (t + ;; Otherwise, use the formula am(u,m) = asin(jacobi_sn(u,m)). + ;; (See DLMF https://dlmf.nist.gov/22.16.E1). This appears + ;; to be what functions.wolfram.com is using in this case. + (asin (sn (to u) (to m)))))) + +;; Translation of Jim FitzSimons' bigfloat implementation of elliptic +;; integrals from http://www.getnet.com/~cherry/elliptbf3.mac. ;; -;; Differentiate these wrt to m: +;; The algorithms are based on B.C. Carlson's "Numerical Computation +;; of Real or Complex Elliptic Integrals". These are updated to the +;; algorithms in Journal of Computational and Applied Mathematics 118 +;; (2000) 71-85 "Reduction Theorems for Elliptic Integrands with the +;; Square Root of two quadritic factors" ;; -;; sn*s + cn*p = 0 -;; 2*dn*q + sn^2 + 2*m*sn*s = 0 + +;; NOTE: Despite the names indicating these are for bigfloat numbers, +;; the algorithms and routines are generic and will work with floats +;; and bigfloats. + +(defun bferrtol (&rest args) + ;; Compute error tolerance as sqrt(2^(-fpprec)). Not sure this is + ;; quite right, but it makes the routines more accurate as fpprec + ;; increases. + (sqrt (reduce #'min (mapcar #'(lambda (x) + (if (rationalp (realpart x)) + maxima::+flonum-epsilon+ + (epsilon x))) + args)))) + +;; rc(x,y) = integrate(1/2*(t+x)^(-1/2)/(t+y), t, 0, inf) ;; -;; Thus, +;; log(x) = (x-1)*rc(((1+x)/2)^2, x), x > 0 +;; asin(x) = x * rc(1-x^2, 1), |x|<= 1 +;; acos(x) = sqrt(1-x^2)*rc(x^2,1), 0 <= x <=1 +;; atan(x) = x * rc(1,1+x^2) +;; asinh(x) = x * rc(1+x^2,1) +;; acosh(x) = sqrt(x^2-1) * rc(x^2,1), x >= 1 +;; atanh(x) = x * rc(1,1-x^2), |x|<=1 + +(defun bf-rc (x y) + (let ((yn y) + xn z w a an pwr4 n epslon lambda sn s) + (cond ((and (zerop (imagpart yn)) + (minusp (realpart yn))) + (setf xn (- x y)) + (setf yn (- yn)) + (setf z yn) + (setf w (sqrt (/ x xn)))) + (t + (setf xn x) + (setf z yn) + (setf w 1))) + (setf a (/ (+ xn yn yn) 3)) + (setf epslon (/ (abs (- a xn)) (bferrtol x y))) + (setf an a) + (setf pwr4 1) + (setf n 0) + (loop while (> (* epslon pwr4) (abs an)) + do + (setf pwr4 (/ pwr4 4)) + (setf lambda (+ (* 2 (sqrt xn) (sqrt yn)) yn)) + (setf an (/ (+ an lambda) 4)) + (setf xn (/ (+ xn lambda) 4)) + (setf yn (/ (+ yn lambda) 4)) + (incf n)) + ;; c2=3/10,c3=1/7,c4=3/8,c5=9/22,c6=159/208,c7=9/8 + (setf sn (/ (* pwr4 (- z a)) an)) + (setf s (* sn sn (+ 3/10 + (* sn (+ 1/7 + (* sn (+ 3/8 + (* sn (+ 9/22 + (* sn (+ 159/208 + (* sn 9/8)))))))))))) + (/ (* w (+ 1 s)) + (sqrt an)))) + + + +;; See https://dlmf.nist.gov/19.16.E5: +;; +;; rd(x,y,z) = integrate(3/2/sqrt(t+x)/sqrt(t+y)/sqrt(t+z)/(t+z), t, 0, inf) ;; -;; p = -s*sn/cn -;; q = -m*s*sn/dn - sn^2/dn/2 +;; rd(1,1,1) = 1 +;; E(K) = rf(0, 1-K^2, 1) - (K^2/3)*rd(0,1-K^2,1) ;; -;; So -;; diff(s,u) = -s*sn*dn/cn - m*s*sn*cn/dn - sn^2*cn/dn/2 +;; B = integrate(s^2/sqrt(1-s^4), s, 0 ,1) +;; = beta(3/4,1/2)/4 +;; = sqrt(%pi)*gamma(3/4)/gamma(1/4) +;; = 1/3*rd(0,2,1) + +(defun bf-rd (x y z) + (let* ((xn x) + (yn y) + (zn z) + (a (/ (+ xn yn (* 3 zn)) 5)) + (epslon (/ (max (abs (- a xn)) + (abs (- a yn)) + (abs (- a zn))) + (bferrtol x y z))) + (an a) + (sigma 0) + (power4 1) + (n 0) + xnroot ynroot znroot lam) + (loop while (> (* power4 epslon) (abs an)) + do + (setf xnroot (sqrt xn)) + (setf ynroot (sqrt yn)) + (setf znroot (sqrt zn)) + (setf lam (+ (* xnroot ynroot) + (* xnroot znroot) + (* ynroot znroot))) + (setf sigma (+ sigma (/ power4 + (* znroot (+ zn lam))))) + (setf power4 (* power4 1/4)) + (setf xn (* (+ xn lam) 1/4)) + (setf yn (* (+ yn lam) 1/4)) + (setf zn (* (+ zn lam) 1/4)) + (setf an (* (+ an lam) 1/4)) + (incf n)) + ;; c1=-3/14,c2=1/6,c3=9/88,c4=9/22,c5=-3/22,c6=-9/52,c7=3/26 + (let* ((xndev (/ (* (- a x) power4) an)) + (yndev (/ (* (- a y) power4) an)) + (zndev (- (* (+ xndev yndev) 1/3))) + (ee2 (- (* xndev yndev) (* 6 zndev zndev))) + (ee3 (* (- (* 3 xndev yndev) + (* 8 zndev zndev)) + zndev)) + (ee4 (* 3 (- (* xndev yndev) (* zndev zndev)) zndev zndev)) + (ee5 (* xndev yndev zndev zndev zndev)) + (s (+ 1 + (* -3/14 ee2) + (* 1/6 ee3) + (* 9/88 ee2 ee2) + (* -3/22 ee4) + (* -9/52 ee2 ee3) + (* 3/26 ee5) + (* -1/16 ee2 ee2 ee2) + (* 3/10 ee3 ee3) + (* 3/20 ee2 ee4) + (* 45/272 ee2 ee2 ee3) + (* -9/68 (+ (* ee2 ee5) (* ee3 ee4)))))) + (+ (* 3 sigma) + (/ (* power4 s) + (expt an 3/2)))))) + +;; See https://dlmf.nist.gov/19.16.E1 ;; -;; or +;; rf(x,y,z) = 1/2*integrate(1/(sqrt(t+x)*sqrt(t+y)*sqrt(t+z)), t, 0, inf); ;; -;; diff(s,u) + s*(sn*dn/cn + m*sn*cn/dn) = -1/2*sn^2*cn/dn -;; -;; diff(s,u) + s*sn/cn/dn*(dn^2 + m*cn^2) = -1/2*sn^2*cn/dn -;; -;; Multiply through by the integrating factor 1/cn/dn: -;; -;; diff(s/cn/dn, u) = -1/2*sn^2/dn^2 = -1/2*sd^2. -;; -;; Integrate this to get -;; -;; s/cn/dn = C + -1/2*int sd^2 -;; -;; It can be shown that C is zero. -;; -;; We know that (by differentiating this expression) -;; -;; int dn^2 = (1-m)*u+m*sn*cd + m*(1-m)*int sd^2 +;; rf(1,1,1) = 1 +(defun bf-rf (x y z) + (let* ((xn x) + (yn y) + (zn z) + (a (/ (+ xn yn zn) 3)) + (epslon (/ (max (abs (- a xn)) + (abs (- a yn)) + (abs (- a zn))) + (bferrtol x y z))) + (an a) + (power4 1) + (n 0) + xnroot ynroot znroot lam) + (loop while (> (* power4 epslon) (abs an)) + do + (setf xnroot (sqrt xn)) + (setf ynroot (sqrt yn)) + (setf znroot (sqrt zn)) + (setf lam (+ (* xnroot ynroot) + (* xnroot znroot) + (* ynroot znroot))) + (setf power4 (* power4 1/4)) + (setf xn (* (+ xn lam) 1/4)) + (setf yn (* (+ yn lam) 1/4)) + (setf zn (* (+ zn lam) 1/4)) + (setf an (* (+ an lam) 1/4)) + (incf n)) + ;; c1=-3/14,c2=1/6,c3=9/88,c4=9/22,c5=-3/22,c6=-9/52,c7=3/26 + (let* ((xndev (/ (* (- a x) power4) an)) + (yndev (/ (* (- a y) power4) an)) + (zndev (- (+ xndev yndev))) + (ee2 (- (* xndev yndev) (* 6 zndev zndev))) + (ee3 (* xndev yndev zndev)) + (s (+ 1 + (* -1/10 ee2) + (* 1/14 ee3) + (* 1/24 ee2 ee2) + (* -3/44 ee2 ee3)))) + (/ s (sqrt an))))) + +(defun bf-rj1 (x y z p) + (let* ((xn x) + (yn y) + (zn z) + (pn p) + (en (* (- pn xn) + (- pn yn) + (- pn zn))) + (sigma 0) + (power4 1) + (k 0) + (a (/ (+ xn yn zn pn pn) 5)) + (epslon (/ (max (abs (- a xn)) + (abs (- a yn)) + (abs (- a zn)) + (abs (- a pn))) + (bferrtol x y z p))) + (an a) + xnroot ynroot znroot pnroot lam dn) + (loop while (> (* power4 epslon) (abs an)) + do + (setf xnroot (sqrt xn)) + (setf ynroot (sqrt yn)) + (setf znroot (sqrt zn)) + (setf pnroot (sqrt pn)) + (setf lam (+ (* xnroot ynroot) + (* xnroot znroot) + (* ynroot znroot))) + (setf dn (* (+ pnroot xnroot) + (+ pnroot ynroot) + (+ pnroot znroot))) + (setf sigma (+ sigma + (/ (* power4 + (bf-rc 1 (+ 1 (/ en (* dn dn))))) + dn))) + (setf power4 (* power4 1/4)) + (setf en (/ en 64)) + (setf xn (* (+ xn lam) 1/4)) + (setf yn (* (+ yn lam) 1/4)) + (setf zn (* (+ zn lam) 1/4)) + (setf pn (* (+ pn lam) 1/4)) + (setf an (* (+ an lam) 1/4)) + (incf k)) + (let* ((xndev (/ (* (- a x) power4) an)) + (yndev (/ (* (- a y) power4) an)) + (zndev (/ (* (- a z) power4) an)) + (pndev (* -0.5 (+ xndev yndev zndev))) + (ee2 (+ (* xndev yndev) + (* xndev zndev) + (* yndev zndev) + (* -3 pndev pndev))) + (ee3 (+ (* xndev yndev zndev) + (* 2 ee2 pndev) + (* 4 pndev pndev pndev))) + (ee4 (* (+ (* 2 xndev yndev zndev) + (* ee2 pndev) + (* 3 pndev pndev pndev)) + pndev)) + (ee5 (* xndev yndev zndev pndev pndev)) + (s (+ 1 + (* -3/14 ee2) + (* 1/6 ee3) + (* 9/88 ee2 ee2) + (* -3/22 ee4) + (* -9/52 ee2 ee3) + (* 3/26 ee5) + (* -1/16 ee2 ee2 ee2) + (* 3/10 ee3 ee3) + (* 3/20 ee2 ee4) + (* 45/272 ee2 ee2 ee3) + (* -9/68 (+ (* ee2 ee5) (* ee3 ee4)))))) + (+ (* 6 sigma) + (/ (* power4 s) + (sqrt (* an an an))))))) + +(defun bf-rj (x y z p) + (let* ((xn x) + (yn y) + (zn z) + (qn (- p))) + (cond ((and (and (zerop (imagpart xn)) (>= (realpart xn) 0)) + (and (zerop (imagpart yn)) (>= (realpart yn) 0)) + (and (zerop (imagpart zn)) (>= (realpart zn) 0)) + (and (zerop (imagpart qn)) (> (realpart qn) 0))) + (destructuring-bind (xn yn zn) + (sort (list xn yn zn) #'<) + (let* ((pn (+ yn (* (- zn yn) (/ (- yn xn) (+ yn qn))))) + (s (- (* (- pn yn) (bf-rj1 xn yn zn pn)) + (* 3 (bf-rf xn yn zn))))) + (setf s (+ s (* 3 (sqrt (/ (* xn yn zn) + (+ (* xn zn) (* pn qn)))) + (bf-rc (+ (* xn zn) (* pn qn)) (* pn qn))))) + (/ s (+ yn qn))))) + (t + (bf-rj1 x y z p))))) + +(defun bf-rg (x y z) + (* 0.5 + (+ (* z (bf-rf x y z)) + (* (- z x) + (- y z) + (bf-rd x y z) + 1/3) + (sqrt (/ (* x y) z))))) + +;; elliptic_f(phi,m) = sin(phi)*rf(cos(phi)^2, 1-m*sin(phi)^2,1) +(defun bf-elliptic-f (phi m) + (flet ((base (phi m) + (cond ((= m 1) + ;; F(z|1) = log(tan(z/2+%pi/4)) + (log (tan (+ (/ phi 2) (/ (%pi phi) 4))))) + (t + (let ((s (sin phi)) + (c (cos phi))) + (* s (bf-rf (* c c) (- 1 (* m s s)) 1))))))) + ;; Handle periodicity (see elliptic-f) + (let* ((bfpi (%pi phi)) + (period (round (realpart phi) bfpi))) + (+ (base (- phi (* bfpi period)) m) + (if (zerop period) + 0 + (* 2 period (bf-elliptic-k m))))))) + +;; elliptic_kc(k) = rf(0, 1-k^2,1) ;; ;; or +;; elliptic_kc(m) = rf(0, 1-m,1) + +(defun bf-elliptic-k (m) + (cond ((= m 0) + (if (maxima::$bfloatp m) + (maxima::$bfloat (maxima::div 'maxima::$%pi 2)) + (float (/ pi 2) 1e0))) + ((= m 1) + (maxima::merror + (intl:gettext "elliptic_kc: elliptic_kc(1) is undefined."))) + (t + (bf-rf 0 (- 1 m) 1)))) + +;; elliptic_e(phi, k) = sin(phi)*rf(cos(phi)^2,1-k^2*sin(phi)^2,1) +;; - (k^2/3)*sin(phi)^3*rd(cos(phi)^2, 1-k^2*sin(phi)^2,1) ;; -;; int sd^2 = 1/m/(1-m)*int dn^2 - u/m - sn*cd/(1-m) ;; -;; Thus, we get +;; or +;; elliptic_e(phi, m) = sin(phi)*rf(cos(phi)^2,1-m*sin(phi)^2,1) +;; - (m/3)*sin(phi)^3*rd(cos(phi)^2, 1-m*sin(phi)^2,1) ;; -;; s/cn/dn = u/(2*m) + sn*cd/(2*(1-m)) - 1/2/m/(1-m)*int dn^2 +(defun bf-elliptic-e (phi m) + (flet ((base (phi m) + (let* ((s (sin phi)) + (c (cos phi)) + (c2 (* c c)) + (s2 (- 1 (* m s s)))) + (- (* s (bf-rf c2 s2 1)) + (* (/ m 3) (* s s s) (bf-rd c2 s2 1)))))) + ;; Elliptic E is quasi-periodic wrt to phi: + ;; + ;; E(z|m) = E(z - %pi*round(Re(z)/%pi)|m) + 2*round(Re(z)/%pi)*E(m) + (let* ((bfpi (%pi phi)) + (period (round (realpart phi) bfpi))) + (+ (base (- phi (* bfpi period)) m) + (* 2 period (bf-elliptic-ec m)))))) + + +;; elliptic_ec(k) = rf(0,1-k^2,1) - (k^2/3)*rd(0,1-k^2,1); ;; ;; or -;; -;; s = 1/(2*m)*u*cn*dn + 1/(2*(1-m))*sn*cn^2 - 1/2/(m*(1-m))*cn*dn*E(u) -;; -;; where E(u) = int dn^2 = elliptic_e(am(u)) = elliptic_e(asin(sn(u))) -;; -;; This is our desired result: -;; -;; s = 1/(2*m)*cn*dn*[u - elliptic_e(asin(sn(u)),m)/(1-m)] + sn*cn^2/2/(1-m) -;; -;; -;; Since diff(cn(u,m),m) = p = -s*sn/cn, we have -;; -;; p = -1/(2*m)*sn*dn[u - elliptic_e(asin(sn(u)),m)/(1-m)] - sn^2*cn/2/(1-m) -;; -;; diff(dn(u,m),m) = q = -m*s*sn/dn - sn^2/dn/2 -;; -;; q = -1/2*sn*cn*[u-elliptic_e(asin(sn),m)/(1-m)] - m*sn^2*cn^2/dn/2/(1-m) -;; -;; - sn^2/dn/2 -;; -;; = -1/2*sn*cn*[u-elliptic_e(asin(sn),m)/(1-m)] + dn*sn^2/2/(m-1) -;; -(defprop %jacobi_sn - ((u m) - ((mtimes) ((%jacobi_cn) u m) ((%jacobi_dn) u m)) - ((mplus simp) - ((mtimes simp) ((rat simp) 1 2) - ((mexpt simp) ((mplus simp) 1 ((mtimes simp) -1 m)) -1) - ((mexpt simp) ((%jacobi_cn simp) u m) 2) ((%jacobi_sn simp) u m)) - ((mtimes simp) ((rat simp) 1 2) ((mexpt simp) m -1) - ((%jacobi_cn simp) u m) ((%jacobi_dn simp) u m) - ((mplus simp) u - ((mtimes simp) -1 ((mexpt simp) ((mplus simp) 1 ((mtimes simp) -1 m)) -1) - ((%elliptic_e simp) ((%asin simp) ((%jacobi_sn simp) u m)) m)))))) - grad) +;; elliptic_ec(m) = rf(0,1-m,1) - (m/3)*rd(0,1-m,1); + +(defun bf-elliptic-ec (m) + (cond ((= m 0) + (if (typep m 'bigfloat) + (bigfloat (maxima::$bfloat (maxima::div 'maxima::$%pi 2))) + (float (/ pi 2) 1e0))) + ((= m 1) + (if (typep m 'bigfloat) + (bigfloat 1) + 1e0)) + (t + (let ((m1 (- 1 m))) + (- (bf-rf 0 m1 1) + (* m 1/3 (bf-rd 0 m1 1))))))) + +(defun bf-elliptic-pi-complete (n m) + (+ (bf-rf 0 (- 1 m) 1) + (* 1/3 n (bf-rj 0 (- 1 m) 1 (- 1 n))))) + +(defun bf-elliptic-pi (n phi m) + ;; Note: Carlson's DRJ has n defined as the negative of the n given + ;; in A&S. + (flet ((base (n phi m) + (let* ((nn (- n)) + (sin-phi (sin phi)) + (cos-phi (cos phi)) + (k (sqrt m)) + (k2sin (* (- 1 (* k sin-phi)) + (+ 1 (* k sin-phi))))) + (- (* sin-phi (bf-rf (expt cos-phi 2) k2sin 1.0)) + (* (/ nn 3) (expt sin-phi 3) + (bf-rj (expt cos-phi 2) k2sin 1.0 + (- 1 (* n (expt sin-phi 2))))))))) + ;; FIXME: Reducing the arg by pi has significant round-off. + ;; Consider doing something better. + (let* ((bf-pi (%pi (realpart phi))) + (cycles (round (realpart phi) bf-pi)) + (rem (- phi (* cycles bf-pi)))) + (let ((complete (bf-elliptic-pi-complete n m))) + (+ (* 2 cycles complete) + (base n rem m)))))) + +;; Compute inverse_jacobi_sn, for float or bigfloat args. +(defun bf-inverse-jacobi-sn (u m) + (* u (bf-rf (- 1 (* u u)) + (- 1 (* m u u)) + 1))) + +;; Compute inverse_jacobi_dn. We use the following identity +;; from Gradshteyn & Ryzhik, 8.153.6 +;; +;; w = dn(z|m) = cn(sqrt(m)*z, 1/m) +;; +;; Solve for z to get +;; +;; z = inverse_jacobi_dn(w,m) +;; = 1/sqrt(m) * inverse_jacobi_cn(w, 1/m) +(defun bf-inverse-jacobi-dn (w m) + (cond ((= w 1) + (float 0 w)) + ((= m 1) + ;; jacobi_dn(x,1) = sech(x) so the inverse is asech(x) + (maxima::take '(maxima::%asech) (maxima::to w))) + (t + ;; We should do something better to make sure that things + ;; that should be real are real. + (/ (to (maxima::take '(maxima::%inverse_jacobi_cn) + (maxima::to w) + (maxima::to (/ m)))) + (sqrt m))))) + +(in-package :maxima) + +;; Tell maxima what the derivatives are. +;; +;; Lawden says the derivative wrt to k but that's not what we want. +;; +;; Here's the derivation we used, based on how Lawden gets his results. +;; +;; Let +;; +;; diff(sn(u,m),m) = s +;; diff(cn(u,m),m) = p +;; diff(dn(u,m),m) = q +;; +;; From the derivatives of sn, cn, dn wrt to u, we have +;; +;; diff(sn(u,m),u) = cn(u)*dn(u) +;; diff(cn(u,m),u) = -cn(u)*dn(u) +;; diff(dn(u,m),u) = -m*sn(u)*cn(u) +;; + +;; Differentiate these wrt to m: +;; +;; diff(s,u) = p*dn + cn*q +;; diff(p,u) = -p*dn - q*dn +;; diff(q,u) = -sn*cn - m*s*cn - m*sn*q +;; +;; Also recall that +;; +;; sn(u)^2 + cn(u)^2 = 1 +;; dn(u)^2 + m*sn(u)^2 = 1 +;; +;; Differentiate these wrt to m: +;; +;; sn*s + cn*p = 0 +;; 2*dn*q + sn^2 + 2*m*sn*s = 0 +;; +;; Thus, +;; +;; p = -s*sn/cn +;; q = -m*s*sn/dn - sn^2/dn/2 +;; +;; So +;; diff(s,u) = -s*sn*dn/cn - m*s*sn*cn/dn - sn^2*cn/dn/2 +;; +;; or +;; +;; diff(s,u) + s*(sn*dn/cn + m*sn*cn/dn) = -1/2*sn^2*cn/dn +;; +;; diff(s,u) + s*sn/cn/dn*(dn^2 + m*cn^2) = -1/2*sn^2*cn/dn +;; +;; Multiply through by the integrating factor 1/cn/dn: +;; +;; diff(s/cn/dn, u) = -1/2*sn^2/dn^2 = -1/2*sd^2. +;; +;; Integrate this to get +;; +;; s/cn/dn = C + -1/2*int sd^2 +;; +;; It can be shown that C is zero. +;; +;; We know that (by differentiating this expression) +;; +;; int dn^2 = (1-m)*u+m*sn*cd + m*(1-m)*int sd^2 +;; +;; or +;; +;; int sd^2 = 1/m/(1-m)*int dn^2 - u/m - sn*cd/(1-m) +;; +;; Thus, we get +;; +;; s/cn/dn = u/(2*m) + sn*cd/(2*(1-m)) - 1/2/m/(1-m)*int dn^2 +;; +;; or +;; +;; s = 1/(2*m)*u*cn*dn + 1/(2*(1-m))*sn*cn^2 - 1/2/(m*(1-m))*cn*dn*E(u) +;; +;; where E(u) = int dn^2 = elliptic_e(am(u)) = elliptic_e(asin(sn(u))) +;; +;; This is our desired result: +;; +;; s = 1/(2*m)*cn*dn*[u - elliptic_e(asin(sn(u)),m)/(1-m)] + sn*cn^2/2/(1-m) +;; +;; +;; Since diff(cn(u,m),m) = p = -s*sn/cn, we have +;; +;; p = -1/(2*m)*sn*dn[u - elliptic_e(asin(sn(u)),m)/(1-m)] - sn^2*cn/2/(1-m) +;; +;; diff(dn(u,m),m) = q = -m*s*sn/dn - sn^2/dn/2 +;; +;; q = -1/2*sn*cn*[u-elliptic_e(asin(sn),m)/(1-m)] - m*sn^2*cn^2/dn/2/(1-m) +;; +;; - sn^2/dn/2 +;; +;; = -1/2*sn*cn*[u-elliptic_e(asin(sn),m)/(1-m)] + dn*sn^2/2/(m-1) +;; +(defprop %jacobi_sn + ((u m) + ((mtimes) ((%jacobi_cn) u m) ((%jacobi_dn) u m)) + ((mplus simp) + ((mtimes simp) ((rat simp) 1 2) + ((mexpt simp) ((mplus simp) 1 ((mtimes simp) -1 m)) -1) + ((mexpt simp) ((%jacobi_cn simp) u m) 2) ((%jacobi_sn simp) u m)) + ((mtimes simp) ((rat simp) 1 2) ((mexpt simp) m -1) + ((%jacobi_cn simp) u m) ((%jacobi_dn simp) u m) + ((mplus simp) u + ((mtimes simp) -1 ((mexpt simp) ((mplus simp) 1 ((mtimes simp) -1 m)) -1) + ((%elliptic_e simp) ((%asin simp) ((%jacobi_sn simp) u m)) m)))))) + grad) (defprop %jacobi_cn ((u m) @@ -1794,525 +2301,97 @@ first kind: ;; = integrate(-1/(sqrt(1-m*sin(u)^2)*(1-n*sin(u)^2)),u,%pi/2-w,%pi/2) ;; = I(%pi/2-w,%pi/2) ;; = I(0,%pi/2) - I(0,%pi/2-w) -;; -;; Thus, -;; -;; I(0,%pi/2+w) = 2*I(0,%pi/2) - I(0,%pi/2-w) -;; -;; This allows us to compute the general result with 0 <= z < %pi -;; -;; I(0, k*%pi + z) = 2*k*I(0,%pi/2) + I(0,z); -;; -;; If 0 <= z < %pi/2, then the we are done. If %pi/2 <= z < %pi, let -;; z = w+%pi/2. Then -;; -;; I(0,z) = 2*I(0,%pi/2) - I(0,%pi/2-w) -;; -;; Or, since w = z-%pi/2: -;; -;; I(0,z) = 2*I(0,%pi/2) - I(0,%pi-z) - -(defun elliptic-pi (n phi m) - ;; elliptic_pi(n, -phi, m) = -elliptic_pi(n, phi, m). That is, it - ;; is an odd function of phi. - (when (minusp (realpart phi)) - (return-from elliptic-pi (- (elliptic-pi n (- phi) m)))) - - ;; Note: Carlson's DRJ has n defined as the negative of the n given - ;; in A&S. - (flet ((base (n phi m) - ;; elliptic_pi(n,phi,m) = - ;; sin(phi)*Rf(cos(phi)^2, 1-m*sin(phi)^2, 1) - ;; - (-n / 3) * sin(phi)^3 - ;; * Rj(cos(phi)^2, 1-m*sin(phi)^2, 1, 1-n*sin(phi)^2) - (let* ((nn (- n)) - (sin-phi (sin phi)) - (cos-phi (cos phi)) - (k (sqrt m)) - (k2sin (* (- 1 (* k sin-phi)) - (+ 1 (* k sin-phi))))) - (- (* sin-phi (bigfloat::bf-rf (expt cos-phi 2) k2sin 1.0)) - (* (/ nn 3) (expt sin-phi 3) - (bigfloat::bf-rj (expt cos-phi 2) k2sin 1.0 - (- 1 (* n (expt sin-phi 2))))))))) - ;; FIXME: Reducing the arg by pi has significant round-off. - ;; Consider doing something better. - (let* ((cycles (round (realpart phi) pi)) - (rem (- phi (* cycles pi)))) - (let ((complete (elliptic-pi-complete n m))) - (to (+ (* 2 cycles complete) - (base n rem m))))))) - -;;; Deriviatives from functions.wolfram.com -;;; http://functions.wolfram.com/EllipticIntegrals/EllipticPi3/20/ -(defprop %elliptic_pi - ((n z m) - ;Derivative wrt first argument - ((mtimes) ((rat) 1 2) - ((mexpt) ((mplus) m ((mtimes) -1 n)) -1) - ((mexpt) ((mplus) -1 n) -1) - ((mplus) - ((mtimes) ((mexpt) n -1) - ((mplus) ((mtimes) -1 m) ((mexpt) n 2)) - ((%elliptic_pi) n z m)) - ((%elliptic_e) z m) - ((mtimes) ((mplus) m ((mtimes) -1 n)) ((mexpt) n -1) - ((%elliptic_f) z m)) - ((mtimes) ((rat) -1 2) n - ((mexpt) - ((mplus) 1 ((mtimes) -1 m ((mexpt) ((%sin) z) 2))) - ((rat) 1 2)) - ((mexpt) - ((mplus) 1 ((mtimes) -1 n ((mexpt) ((%sin) z) 2))) - -1) - ((%sin) ((mtimes) 2 z))))) - ;derivative wrt second argument - ((mtimes) - ((mexpt) - ((mplus) 1 ((mtimes) -1 m ((mexpt) ((%sin) z) 2))) - ((rat) -1 2)) - ((mexpt) - ((mplus) 1 ((mtimes) -1 n ((mexpt) ((%sin) z) 2))) -1)) - ;Derivative wrt third argument - ((mtimes) ((rat) 1 2) - ((mexpt) ((mplus) ((mtimes) -1 m) n) -1) - ((mplus) ((%elliptic_pi) n z m) - ((mtimes) ((mexpt) ((mplus) -1 m) -1) - ((%elliptic_e) z m)) - ((mtimes) ((rat) -1 2) ((mexpt) ((mplus) -1 m) -1) m - ((mexpt) - ((mplus) 1 ((mtimes) -1 m ((mexpt) ((%sin) z) 2))) - ((rat) -1 2)) - ((%sin) ((mtimes) 2 z)))))) - grad) - -(in-package #:bigfloat) -;; Translation of Jim FitzSimons' bigfloat implementation of elliptic -;; integrals from http://www.getnet.com/~cherry/elliptbf3.mac. -;; -;; The algorithms are based on B.C. Carlson's "Numerical Computation -;; of Real or Complex Elliptic Integrals". These are updated to the -;; algorithms in Journal of Computational and Applied Mathematics 118 -;; (2000) 71-85 "Reduction Theorems for Elliptic Integrands with the -;; Square Root of two quadritic factors" -;; - -;; NOTE: Despite the names indicating these are for bigfloat numbers, -;; the algorithms and routines are generic and will work with floats -;; and bigfloats. - -(defun bferrtol (&rest args) - ;; Compute error tolerance as sqrt(2^(-fpprec)). Not sure this is - ;; quite right, but it makes the routines more accurate as fpprec - ;; increases. - (sqrt (reduce #'min (mapcar #'(lambda (x) - (if (rationalp (realpart x)) - maxima::+flonum-epsilon+ - (epsilon x))) - args)))) - -;; rc(x,y) = integrate(1/2*(t+x)^(-1/2)/(t+y), t, 0, inf) -;; -;; log(x) = (x-1)*rc(((1+x)/2)^2, x), x > 0 -;; asin(x) = x * rc(1-x^2, 1), |x|<= 1 -;; acos(x) = sqrt(1-x^2)*rc(x^2,1), 0 <= x <=1 -;; atan(x) = x * rc(1,1+x^2) -;; asinh(x) = x * rc(1+x^2,1) -;; acosh(x) = sqrt(x^2-1) * rc(x^2,1), x >= 1 -;; atanh(x) = x * rc(1,1-x^2), |x|<=1 - -(defun bf-rc (x y) - (let ((yn y) - xn z w a an pwr4 n epslon lambda sn s) - (cond ((and (zerop (imagpart yn)) - (minusp (realpart yn))) - (setf xn (- x y)) - (setf yn (- yn)) - (setf z yn) - (setf w (sqrt (/ x xn)))) - (t - (setf xn x) - (setf z yn) - (setf w 1))) - (setf a (/ (+ xn yn yn) 3)) - (setf epslon (/ (abs (- a xn)) (bferrtol x y))) - (setf an a) - (setf pwr4 1) - (setf n 0) - (loop while (> (* epslon pwr4) (abs an)) - do - (setf pwr4 (/ pwr4 4)) - (setf lambda (+ (* 2 (sqrt xn) (sqrt yn)) yn)) - (setf an (/ (+ an lambda) 4)) - (setf xn (/ (+ xn lambda) 4)) - (setf yn (/ (+ yn lambda) 4)) - (incf n)) - ;; c2=3/10,c3=1/7,c4=3/8,c5=9/22,c6=159/208,c7=9/8 - (setf sn (/ (* pwr4 (- z a)) an)) - (setf s (* sn sn (+ 3/10 - (* sn (+ 1/7 - (* sn (+ 3/8 - (* sn (+ 9/22 - (* sn (+ 159/208 - (* sn 9/8)))))))))))) - (/ (* w (+ 1 s)) - (sqrt an)))) - - - -;; See https://dlmf.nist.gov/19.16.E5: -;; -;; rd(x,y,z) = integrate(3/2/sqrt(t+x)/sqrt(t+y)/sqrt(t+z)/(t+z), t, 0, inf) -;; -;; rd(1,1,1) = 1 -;; E(K) = rf(0, 1-K^2, 1) - (K^2/3)*rd(0,1-K^2,1) -;; -;; B = integrate(s^2/sqrt(1-s^4), s, 0 ,1) -;; = beta(3/4,1/2)/4 -;; = sqrt(%pi)*gamma(3/4)/gamma(1/4) -;; = 1/3*rd(0,2,1) - -(defun bf-rd (x y z) - (let* ((xn x) - (yn y) - (zn z) - (a (/ (+ xn yn (* 3 zn)) 5)) - (epslon (/ (max (abs (- a xn)) - (abs (- a yn)) - (abs (- a zn))) - (bferrtol x y z))) - (an a) - (sigma 0) - (power4 1) - (n 0) - xnroot ynroot znroot lam) - (loop while (> (* power4 epslon) (abs an)) - do - (setf xnroot (sqrt xn)) - (setf ynroot (sqrt yn)) - (setf znroot (sqrt zn)) - (setf lam (+ (* xnroot ynroot) - (* xnroot znroot) - (* ynroot znroot))) - (setf sigma (+ sigma (/ power4 - (* znroot (+ zn lam))))) - (setf power4 (* power4 1/4)) - (setf xn (* (+ xn lam) 1/4)) - (setf yn (* (+ yn lam) 1/4)) - (setf zn (* (+ zn lam) 1/4)) - (setf an (* (+ an lam) 1/4)) - (incf n)) - ;; c1=-3/14,c2=1/6,c3=9/88,c4=9/22,c5=-3/22,c6=-9/52,c7=3/26 - (let* ((xndev (/ (* (- a x) power4) an)) - (yndev (/ (* (- a y) power4) an)) - (zndev (- (* (+ xndev yndev) 1/3))) - (ee2 (- (* xndev yndev) (* 6 zndev zndev))) - (ee3 (* (- (* 3 xndev yndev) - (* 8 zndev zndev)) - zndev)) - (ee4 (* 3 (- (* xndev yndev) (* zndev zndev)) zndev zndev)) - (ee5 (* xndev yndev zndev zndev zndev)) - (s (+ 1 - (* -3/14 ee2) - (* 1/6 ee3) - (* 9/88 ee2 ee2) - (* -3/22 ee4) - (* -9/52 ee2 ee3) - (* 3/26 ee5) - (* -1/16 ee2 ee2 ee2) - (* 3/10 ee3 ee3) - (* 3/20 ee2 ee4) - (* 45/272 ee2 ee2 ee3) - (* -9/68 (+ (* ee2 ee5) (* ee3 ee4)))))) - (+ (* 3 sigma) - (/ (* power4 s) - (expt an 3/2)))))) - -;; See https://dlmf.nist.gov/19.16.E1 -;; -;; rf(x,y,z) = 1/2*integrate(1/(sqrt(t+x)*sqrt(t+y)*sqrt(t+z)), t, 0, inf); -;; -;; rf(1,1,1) = 1 -(defun bf-rf (x y z) - (let* ((xn x) - (yn y) - (zn z) - (a (/ (+ xn yn zn) 3)) - (epslon (/ (max (abs (- a xn)) - (abs (- a yn)) - (abs (- a zn))) - (bferrtol x y z))) - (an a) - (power4 1) - (n 0) - xnroot ynroot znroot lam) - (loop while (> (* power4 epslon) (abs an)) - do - (setf xnroot (sqrt xn)) - (setf ynroot (sqrt yn)) - (setf znroot (sqrt zn)) - (setf lam (+ (* xnroot ynroot) - (* xnroot znroot) - (* ynroot znroot))) - (setf power4 (* power4 1/4)) - (setf xn (* (+ xn lam) 1/4)) - (setf yn (* (+ yn lam) 1/4)) - (setf zn (* (+ zn lam) 1/4)) - (setf an (* (+ an lam) 1/4)) - (incf n)) - ;; c1=-3/14,c2=1/6,c3=9/88,c4=9/22,c5=-3/22,c6=-9/52,c7=3/26 - (let* ((xndev (/ (* (- a x) power4) an)) - (yndev (/ (* (- a y) power4) an)) - (zndev (- (+ xndev yndev))) - (ee2 (- (* xndev yndev) (* 6 zndev zndev))) - (ee3 (* xndev yndev zndev)) - (s (+ 1 - (* -1/10 ee2) - (* 1/14 ee3) - (* 1/24 ee2 ee2) - (* -3/44 ee2 ee3)))) - (/ s (sqrt an))))) - -(defun bf-rj1 (x y z p) - (let* ((xn x) - (yn y) - (zn z) - (pn p) - (en (* (- pn xn) - (- pn yn) - (- pn zn))) - (sigma 0) - (power4 1) - (k 0) - (a (/ (+ xn yn zn pn pn) 5)) - (epslon (/ (max (abs (- a xn)) - (abs (- a yn)) - (abs (- a zn)) - (abs (- a pn))) - (bferrtol x y z p))) - (an a) - xnroot ynroot znroot pnroot lam dn) - (loop while (> (* power4 epslon) (abs an)) - do - (setf xnroot (sqrt xn)) - (setf ynroot (sqrt yn)) - (setf znroot (sqrt zn)) - (setf pnroot (sqrt pn)) - (setf lam (+ (* xnroot ynroot) - (* xnroot znroot) - (* ynroot znroot))) - (setf dn (* (+ pnroot xnroot) - (+ pnroot ynroot) - (+ pnroot znroot))) - (setf sigma (+ sigma - (/ (* power4 - (bf-rc 1 (+ 1 (/ en (* dn dn))))) - dn))) - (setf power4 (* power4 1/4)) - (setf en (/ en 64)) - (setf xn (* (+ xn lam) 1/4)) - (setf yn (* (+ yn lam) 1/4)) - (setf zn (* (+ zn lam) 1/4)) - (setf pn (* (+ pn lam) 1/4)) - (setf an (* (+ an lam) 1/4)) - (incf k)) - (let* ((xndev (/ (* (- a x) power4) an)) - (yndev (/ (* (- a y) power4) an)) - (zndev (/ (* (- a z) power4) an)) - (pndev (* -0.5 (+ xndev yndev zndev))) - (ee2 (+ (* xndev yndev) - (* xndev zndev) - (* yndev zndev) - (* -3 pndev pndev))) - (ee3 (+ (* xndev yndev zndev) - (* 2 ee2 pndev) - (* 4 pndev pndev pndev))) - (ee4 (* (+ (* 2 xndev yndev zndev) - (* ee2 pndev) - (* 3 pndev pndev pndev)) - pndev)) - (ee5 (* xndev yndev zndev pndev pndev)) - (s (+ 1 - (* -3/14 ee2) - (* 1/6 ee3) - (* 9/88 ee2 ee2) - (* -3/22 ee4) - (* -9/52 ee2 ee3) - (* 3/26 ee5) - (* -1/16 ee2 ee2 ee2) - (* 3/10 ee3 ee3) - (* 3/20 ee2 ee4) - (* 45/272 ee2 ee2 ee3) - (* -9/68 (+ (* ee2 ee5) (* ee3 ee4)))))) - (+ (* 6 sigma) - (/ (* power4 s) - (sqrt (* an an an))))))) - -(defun bf-rj (x y z p) - (let* ((xn x) - (yn y) - (zn z) - (qn (- p))) - (cond ((and (and (zerop (imagpart xn)) (>= (realpart xn) 0)) - (and (zerop (imagpart yn)) (>= (realpart yn) 0)) - (and (zerop (imagpart zn)) (>= (realpart zn) 0)) - (and (zerop (imagpart qn)) (> (realpart qn) 0))) - (destructuring-bind (xn yn zn) - (sort (list xn yn zn) #'<) - (let* ((pn (+ yn (* (- zn yn) (/ (- yn xn) (+ yn qn))))) - (s (- (* (- pn yn) (bf-rj1 xn yn zn pn)) - (* 3 (bf-rf xn yn zn))))) - (setf s (+ s (* 3 (sqrt (/ (* xn yn zn) - (+ (* xn zn) (* pn qn)))) - (bf-rc (+ (* xn zn) (* pn qn)) (* pn qn))))) - (/ s (+ yn qn))))) - (t - (bf-rj1 x y z p))))) - -(defun bf-rg (x y z) - (* 0.5 - (+ (* z (bf-rf x y z)) - (* (- z x) - (- y z) - (bf-rd x y z) - 1/3) - (sqrt (/ (* x y) z))))) - -;; elliptic_f(phi,m) = sin(phi)*rf(cos(phi)^2, 1-m*sin(phi)^2,1) -(defun bf-elliptic-f (phi m) - (flet ((base (phi m) - (cond ((= m 1) - ;; F(z|1) = log(tan(z/2+%pi/4)) - (log (tan (+ (/ phi 2) (/ (%pi phi) 4))))) - (t - (let ((s (sin phi)) - (c (cos phi))) - (* s (bf-rf (* c c) (- 1 (* m s s)) 1))))))) - ;; Handle periodicity (see elliptic-f) - (let* ((bfpi (%pi phi)) - (period (round (realpart phi) bfpi))) - (+ (base (- phi (* bfpi period)) m) - (if (zerop period) - 0 - (* 2 period (bf-elliptic-k m))))))) - -;; elliptic_kc(k) = rf(0, 1-k^2,1) +;; +;; Thus, ;; -;; or -;; elliptic_kc(m) = rf(0, 1-m,1) - -(defun bf-elliptic-k (m) - (cond ((= m 0) - (if (maxima::$bfloatp m) - (maxima::$bfloat (maxima::div 'maxima::$%pi 2)) - (float (/ pi 2) 1e0))) - ((= m 1) - (maxima::merror - (intl:gettext "elliptic_kc: elliptic_kc(1) is undefined."))) - (t - (bf-rf 0 (- 1 m) 1)))) - -;; elliptic_e(phi, k) = sin(phi)*rf(cos(phi)^2,1-k^2*sin(phi)^2,1) -;; - (k^2/3)*sin(phi)^3*rd(cos(phi)^2, 1-k^2*sin(phi)^2,1) +;; I(0,%pi/2+w) = 2*I(0,%pi/2) - I(0,%pi/2-w) ;; +;; This allows us to compute the general result with 0 <= z < %pi ;; -;; or -;; elliptic_e(phi, m) = sin(phi)*rf(cos(phi)^2,1-m*sin(phi)^2,1) -;; - (m/3)*sin(phi)^3*rd(cos(phi)^2, 1-m*sin(phi)^2,1) +;; I(0, k*%pi + z) = 2*k*I(0,%pi/2) + I(0,z); ;; -(defun bf-elliptic-e (phi m) - (flet ((base (phi m) - (let* ((s (sin phi)) - (c (cos phi)) - (c2 (* c c)) - (s2 (- 1 (* m s s)))) - (- (* s (bf-rf c2 s2 1)) - (* (/ m 3) (* s s s) (bf-rd c2 s2 1)))))) - ;; Elliptic E is quasi-periodic wrt to phi: - ;; - ;; E(z|m) = E(z - %pi*round(Re(z)/%pi)|m) + 2*round(Re(z)/%pi)*E(m) - (let* ((bfpi (%pi phi)) - (period (round (realpart phi) bfpi))) - (+ (base (- phi (* bfpi period)) m) - (* 2 period (bf-elliptic-ec m)))))) - - -;; elliptic_ec(k) = rf(0,1-k^2,1) - (k^2/3)*rd(0,1-k^2,1); +;; If 0 <= z < %pi/2, then the we are done. If %pi/2 <= z < %pi, let +;; z = w+%pi/2. Then ;; -;; or -;; elliptic_ec(m) = rf(0,1-m,1) - (m/3)*rd(0,1-m,1); - -(defun bf-elliptic-ec (m) - (cond ((= m 0) - (if (typep m 'bigfloat) - (bigfloat (maxima::$bfloat (maxima::div 'maxima::$%pi 2))) - (float (/ pi 2) 1e0))) - ((= m 1) - (if (typep m 'bigfloat) - (bigfloat 1) - 1e0)) - (t - (let ((m1 (- 1 m))) - (- (bf-rf 0 m1 1) - (* m 1/3 (bf-rd 0 m1 1))))))) - -(defun bf-elliptic-pi-complete (n m) - (+ (bf-rf 0 (- 1 m) 1) - (* 1/3 n (bf-rj 0 (- 1 m) 1 (- 1 n))))) +;; I(0,z) = 2*I(0,%pi/2) - I(0,%pi/2-w) +;; +;; Or, since w = z-%pi/2: +;; +;; I(0,z) = 2*I(0,%pi/2) - I(0,%pi-z) + +(defun elliptic-pi (n phi m) + ;; elliptic_pi(n, -phi, m) = -elliptic_pi(n, phi, m). That is, it + ;; is an odd function of phi. + (when (minusp (realpart phi)) + (return-from elliptic-pi (- (elliptic-pi n (- phi) m)))) -(defun bf-elliptic-pi (n phi m) ;; Note: Carlson's DRJ has n defined as the negative of the n given ;; in A&S. (flet ((base (n phi m) + ;; elliptic_pi(n,phi,m) = + ;; sin(phi)*Rf(cos(phi)^2, 1-m*sin(phi)^2, 1) + ;; - (-n / 3) * sin(phi)^3 + ;; * Rj(cos(phi)^2, 1-m*sin(phi)^2, 1, 1-n*sin(phi)^2) (let* ((nn (- n)) (sin-phi (sin phi)) (cos-phi (cos phi)) (k (sqrt m)) (k2sin (* (- 1 (* k sin-phi)) (+ 1 (* k sin-phi))))) - (- (* sin-phi (bf-rf (expt cos-phi 2) k2sin 1.0)) - (* (/ nn 3) (expt sin-phi 3) - (bf-rj (expt cos-phi 2) k2sin 1.0 - (- 1 (* n (expt sin-phi 2))))))))) + (- (* sin-phi (bigfloat::bf-rf (expt cos-phi 2) k2sin 1.0)) + (* (/ nn 3) (expt sin-phi 3) + (bigfloat::bf-rj (expt cos-phi 2) k2sin 1.0 + (- 1 (* n (expt sin-phi 2))))))))) ;; FIXME: Reducing the arg by pi has significant round-off. ;; Consider doing something better. - (let* ((bf-pi (%pi (realpart phi))) - (cycles (round (realpart phi) bf-pi)) - (rem (- phi (* cycles bf-pi)))) - (let ((complete (bf-elliptic-pi-complete n m))) - (+ (* 2 cycles complete) - (base n rem m)))))) - -;; Compute inverse_jacobi_sn, for float or bigfloat args. -(defun bf-inverse-jacobi-sn (u m) - (* u (bf-rf (- 1 (* u u)) - (- 1 (* m u u)) - 1))) - -;; Compute inverse_jacobi_dn. We use the following identity -;; from Gradshteyn & Ryzhik, 8.153.6 -;; -;; w = dn(z|m) = cn(sqrt(m)*z, 1/m) -;; -;; Solve for z to get -;; -;; z = inverse_jacobi_dn(w,m) -;; = 1/sqrt(m) * inverse_jacobi_cn(w, 1/m) -(defun bf-inverse-jacobi-dn (w m) - (cond ((= w 1) - (float 0 w)) - ((= m 1) - ;; jacobi_dn(x,1) = sech(x) so the inverse is asech(x) - (maxima::take '(maxima::%asech) (maxima::to w))) - (t - ;; We should do something better to make sure that things - ;; that should be real are real. - (/ (to (maxima::take '(maxima::%inverse_jacobi_cn) - (maxima::to w) - (maxima::to (/ m)))) - (sqrt m))))) + (let* ((cycles (round (realpart phi) pi)) + (rem (- phi (* cycles pi)))) + (let ((complete (elliptic-pi-complete n m))) + (to (+ (* 2 cycles complete) + (base n rem m))))))) -(in-package :maxima) +;;; Deriviatives from functions.wolfram.com +;;; http://functions.wolfram.com/EllipticIntegrals/EllipticPi3/20/ +(defprop %elliptic_pi + ((n z m) + ;Derivative wrt first argument + ((mtimes) ((rat) 1 2) + ((mexpt) ((mplus) m ((mtimes) -1 n)) -1) + ((mexpt) ((mplus) -1 n) -1) + ((mplus) + ((mtimes) ((mexpt) n -1) + ((mplus) ((mtimes) -1 m) ((mexpt) n 2)) + ((%elliptic_pi) n z m)) + ((%elliptic_e) z m) + ((mtimes) ((mplus) m ((mtimes) -1 n)) ((mexpt) n -1) + ((%elliptic_f) z m)) + ((mtimes) ((rat) -1 2) n + ((mexpt) + ((mplus) 1 ((mtimes) -1 m ((mexpt) ((%sin) z) 2))) + ((rat) 1 2)) + ((mexpt) + ((mplus) 1 ((mtimes) -1 n ((mexpt) ((%sin) z) 2))) + -1) + ((%sin) ((mtimes) 2 z))))) + ;derivative wrt second argument + ((mtimes) + ((mexpt) + ((mplus) 1 ((mtimes) -1 m ((mexpt) ((%sin) z) 2))) + ((rat) -1 2)) + ((mexpt) + ((mplus) 1 ((mtimes) -1 n ((mexpt) ((%sin) z) 2))) -1)) + ;Derivative wrt third argument + ((mtimes) ((rat) 1 2) + ((mexpt) ((mplus) ((mtimes) -1 m) n) -1) + ((mplus) ((%elliptic_pi) n z m) + ((mtimes) ((mexpt) ((mplus) -1 m) -1) + ((%elliptic_e) z m)) + ((mtimes) ((rat) -1 2) ((mexpt) ((mplus) -1 m) -1) m + ((mexpt) + ((mplus) 1 ((mtimes) -1 m ((mexpt) ((%sin) z) 2))) + ((rat) -1 2)) + ((%sin) ((mtimes) 2 z)))))) + grad) ;; Define Carlson's elliptic integrals. @@ -4798,91 +4877,6 @@ first kind: ;; Jacobi amplitude function. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(in-package #:bigfloat) - -;; Arithmetic-Geometric Mean algorithm for real or complex numbers. -;; See https://dlmf.nist.gov/22.20.ii. -;; -;; Do not use this for computing jacobi sn. It loses some 7 digits of -;; accuracy for sn(1+%i,0.7). -(let ((an (make-array 100 :fill-pointer 0)) - (bn (make-array 100 :fill-pointer 0)) - (cn (make-array 100 :fill-pointer 0))) - ;; Instead of allocating these array anew each time, we'll reuse - ;; them and allow them to grow as needed. - (defun agm (a0 b0 c0 tol) - "Arithmetic-Geometric Mean algorithm for real or complex a0, b0, c0. - Algorithm continues until |c[n]| <= tol." - - ;; DLMF (https://dlmf.nist.gov/22.20.ii) says for any real or - ;; complex a0 and b0, b0/a0 must not be real and negative. Let's - ;; check that. - (let ((q (/ b0 a0))) - (when (and (= (imagpart q) 0) - (minusp (realpart q))) - (error "Invalid arguments for AGM: ~A ~A~%" a0 b0))) - (let ((nd (max (* 2 (ceiling (log (- (log tol 2))))) 8))) - ;; DLMF (https://dlmf.nist.gov/22.20.ii) says that |c[n]| <= - ;; C*2^(-2^n), for some constant C. Solve C*2^(-2^n) = tol to - ;; get n = log(log(C/tol)/log(2))/log(2). Arbitrarily assume C - ;; is one to get n = log(-(log(tol)/log(2)))/log(2). Thus, the - ;; approximate number of term needed is n = - ;; 1.44*log(-(1.44*log(tol))). Round to 2*log(-log2(tol)). - (setf (fill-pointer an) 0 - (fill-pointer bn) 0 - (fill-pointer cn) 0) - (vector-push-extend a0 an) - (vector-push-extend b0 bn) - (vector-push-extend c0 cn) - - (do ((k 0 (1+ k))) - ((or (<= (abs (aref cn k)) tol) - (>= k nd)) - (if (>= k nd) - (error "Failed to converge") - (values k an bn cn))) - (vector-push-extend (/ (+ (aref an k) (aref bn k)) 2) an) - ;; DLMF (https://dlmf.nist.gov/22.20.ii) has conditions on how - ;; to choose the square root depending on the phase of a[n-1] - ;; and b[n-1]. We don't check for that here. - (vector-push-extend (sqrt (* (aref an k) (aref bn k))) bn) - (vector-push-extend (/ (- (aref an k) (aref bn k)) 2) cn))))) - -(defun jacobi-am-agm (u m tol) - "Evaluate the jacobi_am function from real u and m with |m| <= 1. This - uses the AGM method until a tolerance of TOL is reached for the - error." - (multiple-value-bind (n an bn cn) - (agm 1 (sqrt (- 1 m)) (sqrt m) tol) - (declare (ignore bn)) - ;; See DLMF (https://dlmf.nist.gov/22.20.ii) for the algorithm. - (let ((phi (* u (aref an n) (expt 2 n)))) - (loop for k from n downto 1 - do - (setf phi (/ (+ phi (asin (* (/ (aref cn k) - (aref an k)) - (sin phi)))) - 2))) - phi))) - -;; Compute Jacobi am for real or complex values of U and M. The args -;; must be floats or bigfloat::bigfloats. TOL is the tolerance used -;; by the AGM algorithm. It is ignored if the AGM algorithm is not -;; used. -(defun bf-jacobi-am (u m tol) - (cond ((and (realp u) (realp m) (<= (abs m) 1)) - ;; The case of real u and m with |m| <= 1. We can use AGM to - ;; compute the result. - (jacobi-am-agm (to u) - (to m) - tol)) - (t - ;; Otherwise, use the formula am(u,m) = asin(jacobi_sn(u,m)). - ;; (See DLMF https://dlmf.nist.gov/22.16.E1). This appears - ;; to be what functions.wolfram.com is using in this case. - (asin (sn (to u) (to m)))))) - -(in-package :maxima) (def-simplifier jacobi_am (u m) (let (args) (cond ----------------------------------------------------------------------- hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-08-26 14:59:47
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via dafed984fa9d278101fa581789675f2b425c1650 (commit) via cd1f8874149af54efef3e19def29d227441f7b6f (commit) via 825db797b7aa8baed6f0a6f7b24ae696cfeca401 (commit) via f13c68b1c785739eb888ecf07580d0a8afe56a29 (commit) via c52b955b0259d718f75e04a2cf9af40ebdb3b34c (commit) from 23ecb057a40b96c079823ed6e66693f93e6d7e0d (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- ----------------------------------------------------------------------- Summary of changes: src/ellipt.lisp | 20 ++++++++++---------- tests/rtest_elliptic.mac | 14 ++++++++++++++ 2 files changed, 24 insertions(+), 10 deletions(-) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-08-25 13:58:23
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, bug-4352-elliptic-e-error has been updated via dafed984fa9d278101fa581789675f2b425c1650 (commit) via cd1f8874149af54efef3e19def29d227441f7b6f (commit) via 825db797b7aa8baed6f0a6f7b24ae696cfeca401 (commit) via f13c68b1c785739eb888ecf07580d0a8afe56a29 (commit) from c52b955b0259d718f75e04a2cf9af40ebdb3b34c (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit dafed984fa9d278101fa581789675f2b425c1650 Author: Raymond Toy <toy...@gm...> Date: Sun Aug 25 06:58:08 2024 -0700 Remove debugging prints diff --git a/src/ellipt.lisp b/src/ellipt.lisp index a824a2635..0713eeee5 100644 --- a/src/ellipt.lisp +++ b/src/ellipt.lisp @@ -1201,7 +1201,6 @@ first kind: ;; ;; E(z|m) = E(z - %pi*round(Re(z)/%pi)|m) + 2*round(Re(z)/%pi)*E(m) (let ((period (round (realpart phi) pi))) - (format t "period = ~A~%" period) (+ (base (- phi (* pi period)) m) (* 2 period (elliptic-ec m)))))) @@ -1216,14 +1215,6 @@ first kind: 1.0) (t (let* ((y (- 1 m))) - (format t "y = ~A~%" y) - (format t "bf-rf, bf-rd = ~A ~A~%" - (bigfloat::bf-rf 0.0 y 1.0) - (bigfloat::bf-rd 0.0 y 1.0)) - (format t "result = ~A~%" - (- (bigfloat::bf-rf 0.0 y 1.0) - (* (/ m 3) - (bigfloat::bf-rd 0.0 y 1.0)))) (- (bigfloat::bf-rf 0.0 y 1.0) (* (/ m 3) (bigfloat::bf-rd 0.0 y 1.0))))))) commit cd1f8874149af54efef3e19def29d227441f7b6f Author: Raymond Toy <toy...@gm...> Date: Sun Aug 25 06:56:35 2024 -0700 Add some tests diff --git a/tests/rtest_elliptic.mac b/tests/rtest_elliptic.mac index 4504da4d0..9b2a5e8b1 100755 --- a/tests/rtest_elliptic.mac +++ b/tests/rtest_elliptic.mac @@ -1154,7 +1154,21 @@ makelist(block([z : 2*k*%i, m : 1.75b0+%i], k, 0, 10); [true, true, true, true, true, true, true, true, true, true, true]; +/* + * #4352 elliptic_e signals an error due to elliptic_ec returning a + * Maxima complex instead of Lisp complex. + */ +closeto(elliptic_e(1,1.23) - 0.7935821331230606, 1e-15); +true; + +closeto(elliptic_e(1,2.0) - (0.09311292177217778*%i+0.5990701173677968), 1e-15); +true; + +closeto(elliptic_e(1,1.23b0)- 7.9358213312306066216147457280131b-1, 1b-32); +true; +closeto(elliptic_e(1,2b0) - (9.3112921772178507209815461615034b-2*%i+5.9907011736779610371996124614016b-1), 3.1055b-33); +true; (fpprec:oldfpprec,kill(l2,l3,test_deriv,oldfpprec),done); done; commit 825db797b7aa8baed6f0a6f7b24ae696cfeca401 Author: Raymond Toy <toy...@gm...> Date: Sun Aug 25 06:23:15 2024 -0700 Need to remove another call to TO in elliptic-e `elliptic-e` should return a Lisp number. It was returning a Maxima complex instead of Lisp complex for the general case of `m`. diff --git a/src/ellipt.lisp b/src/ellipt.lisp index d9e738cbf..a824a2635 100644 --- a/src/ellipt.lisp +++ b/src/ellipt.lisp @@ -1192,11 +1192,11 @@ first kind: (k (sqrt m)) (y (* (- 1 (* k sin-phi)) (+ 1 (* k sin-phi))))) - (to (- (* sin-phi - (bigfloat::bf-rf (* cos-phi cos-phi) y 1.0)) - (* (/ m 3) - (expt sin-phi 3) - (bigfloat::bf-rd (* cos-phi cos-phi) y 1.0))))))))) + (- (* sin-phi + (bigfloat::bf-rf (* cos-phi cos-phi) y 1.0)) + (* (/ m 3) + (expt sin-phi 3) + (bigfloat::bf-rd (* cos-phi cos-phi) y 1.0)))))))) ;; Elliptic E is quasi-periodic wrt to phi: ;; ;; E(z|m) = E(z - %pi*round(Re(z)/%pi)|m) + 2*round(Re(z)/%pi)*E(m) commit f13c68b1c785739eb888ecf07580d0a8afe56a29 Author: Raymond Toy <toy...@gm...> Date: Sat Aug 24 17:36:06 2024 -0700 Handle complex value from elliptic-ec in elliptic_ec Since `elliptic-ec` may return a Lisp complex number, we need call `complexify` to convert it to a Maxima complex before returning from `elliptic_ec`. diff --git a/src/ellipt.lisp b/src/ellipt.lisp index 0d6414717..d9e738cbf 100644 --- a/src/ellipt.lisp +++ b/src/ellipt.lisp @@ -1637,7 +1637,7 @@ first kind: (let (args) (cond ((float-numerical-eval-p m) ;; Numerically evaluate it - (elliptic-ec ($float m))) + (complexify (elliptic-ec ($float m)))) ((setf args (complex-float-numerical-eval-p m)) (destructuring-bind (m) args ----------------------------------------------------------------------- Summary of changes: src/ellipt.lisp | 21 ++++++--------------- tests/rtest_elliptic.mac | 14 ++++++++++++++ 2 files changed, 20 insertions(+), 15 deletions(-) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-08-25 00:23:10
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, bug-4352-elliptic-e-error has been created at c52b955b0259d718f75e04a2cf9af40ebdb3b34c (commit) - Log ----------------------------------------------------------------- commit c52b955b0259d718f75e04a2cf9af40ebdb3b34c Author: Raymond Toy <toy...@gm...> Date: Sat Aug 24 17:07:14 2024 -0700 Fix #4352: elliptic_e(1,1.23) signals lisp error on complex number `elliptic_e` calls `elliptic-e` to evaluate `elliptic_e(1,1.23)`. This calls `elliptic-ec` which returns a Maxima complex number because it calls `to` before returning. That's not right; it should just return a Lisp complex number and the caller needs to handle that appropriately. diff --git a/src/ellipt.lisp b/src/ellipt.lisp index 8d4b3e486..0d6414717 100644 --- a/src/ellipt.lisp +++ b/src/ellipt.lisp @@ -1201,6 +1201,7 @@ first kind: ;; ;; E(z|m) = E(z - %pi*round(Re(z)/%pi)|m) + 2*round(Re(z)/%pi)*E(m) (let ((period (round (realpart phi) pi))) + (format t "period = ~A~%" period) (+ (base (- phi (* pi period)) m) (* 2 period (elliptic-ec m)))))) @@ -1215,9 +1216,17 @@ first kind: 1.0) (t (let* ((y (- 1 m))) - (to (- (bigfloat::bf-rf 0.0 y 1.0) - (* (/ m 3) - (bigfloat::bf-rd 0.0 y 1.0)))))))) + (format t "y = ~A~%" y) + (format t "bf-rf, bf-rd = ~A ~A~%" + (bigfloat::bf-rf 0.0 y 1.0) + (bigfloat::bf-rd 0.0 y 1.0)) + (format t "result = ~A~%" + (- (bigfloat::bf-rf 0.0 y 1.0) + (* (/ m 3) + (bigfloat::bf-rd 0.0 y 1.0)))) + (- (bigfloat::bf-rf 0.0 y 1.0) + (* (/ m 3) + (bigfloat::bf-rd 0.0 y 1.0))))))) ;; Define the elliptic integrals for maxima @@ -1429,7 +1438,7 @@ first kind: (let (args) (cond ((float-numerical-eval-p phi m) ;; Numerically evaluate it - (elliptic-e ($float phi) ($float m))) + (complexify (elliptic-e ($float phi) ($float m)))) ((complex-float-numerical-eval-p phi m) (complexify (bigfloat::bf-elliptic-e (complex ($float ($realpart phi)) ($float ($imagpart phi))) (complex ($float ($realpart m)) ($float ($imagpart m)))))) ----------------------------------------------------------------------- hooks/post-receive -- Maxima CAS |
From: dauti <da...@us...> - 2024-08-23 19:08:20
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 23ecb057a40b96c079823ed6e66693f93e6d7e0d (commit) from 9a2271da7d69851a300655b0941502c6839aa5fc (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 23ecb057a40b96c079823ed6e66693f93e6d7e0d Author: Wolfgang Dautermann <da...@us...> Date: Fri Aug 23 21:07:06 2024 +0200 Windows installer: Build wxMaxima with CMAKE_BUILD_TYPE=Release. (when not compiling a wxMaxima git version) diff --git a/crosscompile-windows/wxmaxima/CMakeLists.txt b/crosscompile-windows/wxmaxima/CMakeLists.txt index 03b699af6..ec5548fd0 100644 --- a/crosscompile-windows/wxmaxima/CMakeLists.txt +++ b/crosscompile-windows/wxmaxima/CMakeLists.txt @@ -36,7 +36,7 @@ if(USE_WXMAXIMA_GIT) # had to set CMAKE_LIBRARY_PATH=/usr/${HOST}/lib - libraries for mingw are installed there, but CMake (>3.8) # tries to check all the libraries reported by wx-config, but does not check this directory... CMAKE_CACHE_ARGS "-DCMAKE_PROGRAM_PATH:PATH=${CMAKE_BINARY_DIR}/wxwidgets/wxwidgets-prefix/src/wxwidgets-build" - CMAKE_ARGS -DCMAKE_SYSTEM_NAME=${CMAKE_SYSTEM_NAME} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} -DCMAKE_CXX_COMPILER=${CMAKE_CXX_COMPILER} -DCMAKE_RC_COMPILER=${CMAKE_RC_COMPILER} -DCMAKE_LIBRARY_PATH=/usr/${HOST}/lib -DCMAKE_INSTALL_PREFIX=${WINDOWS_DRIVELETTER}:/maxima-${MAXIMAVERSION} -DCMAKE_BUILD_TYPE=DEBUG + CMAKE_ARGS -DCMAKE_SYSTEM_NAME=${CMAKE_SYSTEM_NAME} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} -DCMAKE_CXX_COMPILER=${CMAKE_CXX_COMPILER} -DCMAKE_RC_COMPILER=${CMAKE_RC_COMPILER} -DCMAKE_LIBRARY_PATH=/usr/${HOST}/lib -DCMAKE_INSTALL_PREFIX=${WINDOWS_DRIVELETTER}:/maxima-${MAXIMAVERSION} -DCMAKE_BUILD_TYPE=Debug BUILD_COMMAND $(MAKE) ) install(DIRECTORY ${CMAKE_BINARY_DIR}/wxmaxima/wxmaxima-git-prefix/src/wxmaxima-git-build/${WINDOWS_DRIVELETTER}\:/maxima-${MAXIMAVERSION}/ DESTINATION . COMPONENT wxMaxima) @@ -51,7 +51,7 @@ else() # had to set CMAKE_LIBRARY_PATH=/usr/${HOST}/lib - libraries for mingw are installed there, but CMake (>3.8) # tries to check all the libraries reported by wx-config, but does not check this directory... CMAKE_CACHE_ARGS "-DCMAKE_PROGRAM_PATH:PATH=${CMAKE_BINARY_DIR}/wxwidgets/wxwidgets-prefix/src/wxwidgets-build" - CMAKE_ARGS -DCMAKE_SYSTEM_NAME=${CMAKE_SYSTEM_NAME} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} -DCMAKE_CXX_COMPILER=${CMAKE_CXX_COMPILER} -DCMAKE_RC_COMPILER=${CMAKE_RC_COMPILER} -DCMAKE_LIBRARY_PATH=/usr/${HOST}/lib -DCMAKE_INSTALL_PREFIX=${WINDOWS_DRIVELETTER}:/maxima-${MAXIMAVERSION} + CMAKE_ARGS -DCMAKE_SYSTEM_NAME=${CMAKE_SYSTEM_NAME} -DCMAKE_C_COMPILER=${CMAKE_C_COMPILER} -DCMAKE_CXX_COMPILER=${CMAKE_CXX_COMPILER} -DCMAKE_RC_COMPILER=${CMAKE_RC_COMPILER} -DCMAKE_LIBRARY_PATH=/usr/${HOST}/lib -DCMAKE_INSTALL_PREFIX=${WINDOWS_DRIVELETTER}:/maxima-${MAXIMAVERSION} -DCMAKE_BUILD_TYPE=Release BUILD_COMMAND $(MAKE) ) install(DIRECTORY ${CMAKE_BINARY_DIR}/wxmaxima/wxmaxima-prefix/src/wxmaxima-build/${WINDOWS_DRIVELETTER}\:/maxima-${MAXIMAVERSION}/ DESTINATION . COMPONENT wxMaxima) ----------------------------------------------------------------------- Summary of changes: crosscompile-windows/wxmaxima/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) hooks/post-receive -- Maxima CAS |
From: <ap...@us...> - 2024-08-22 22:00:14
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 9a2271da7d69851a300655b0941502c6839aa5fc (commit) from d1f6d5afee73cde384489788350ada2ded52edbc (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 9a2271da7d69851a300655b0941502c6839aa5fc Author: Robert Dodier <rob...@so...> Date: Thu Aug 22 14:59:02 2024 -0700 arrayinfo: accept an array value as an argument (as supplied e.g. via apply(arrayinfo, [foo]) where foo is an array value). Fixes SF bug #4350: "arrayinfo complains \"not an array\" when supplied a Lisp array or hash table". diff --git a/src/comm2.lisp b/src/comm2.lisp index 94b96fb37..b310d2f6f 100644 --- a/src/comm2.lisp +++ b/src/comm2.lisp @@ -808,9 +808,11 @@ (cons (cons (getopr ary) '(array)) (cdr subs))) (t (cons '(mqapply array) (cons ary (cdr subs)))))) -(defmspec $arrayinfo (ary) - (setq ary (cdr ary)) - (arrayinfo-aux (car ary) (getvalue (car ary)))) +(defmspec $arrayinfo (e) + (let* + ((ary (second e)) + (ary-value (if (or (arrayp ary) (hash-table-p ary)) ary (getvalue ary)))) + (arrayinfo-aux ary ary-value))) (defun arrayinfo-aux (sym val) (prog (arra ary) diff --git a/tests/rtest2.mac b/tests/rtest2.mac index 58fcaf662..4c8e9ef97 100644 --- a/tests/rtest2.mac +++ b/tests/rtest2.mac @@ -746,12 +746,18 @@ listarray (mydeclared); arrayinfo (myvalue); [declared, 4, [1, 1, 1, 1]]; /* "declared" seems wrong here ... oh well */ +apply (arrayinfo, [myvalue]); +[declared, 4, [1, 1, 1, 1]]; /* "declared" seems wrong here ... oh well */ + listarray (myvalue); [%pi + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, %e - 1]; (arrayinfo (myfast), [%%[1], %%[2], sort (rest (%%, 2))]); [hash_table, true, [["mumble", "abc", "xy", "Z"], [foo, bar, baz], [sin(foo), 1 - baz]]]; +(apply (arrayinfo, [myfast]), [%%[1], %%[2], sort (rest (%%, 2))]); +[hash_table, true, [["mumble", "abc", "xy", "Z"], [foo, bar, baz], [sin(foo), 1 - baz]]]; + sort (listarray (myfast)); [blurf, 2*blurf, 3*blurf]; @@ -1165,3 +1171,27 @@ block ([use_fast_arrays : false, xyz); 123; +/* SF bug #4350: "arrayinfo complains 'not an array' when supplied a Lisp array or hash table" */ + +(kill (aa, bb, L), + aa: make_array (fixnum, 4), + bb: make_array (hashed, 1), + L: [aa, bb], + 0); +0; + +arrayinfo (aa); +[declared, 1, [3]]; + +arrayinfo (bb); +[hash_table, 1]; + +/* arrayinfo complains if argument is neither a symbol nor an array value -- OK */ +errcatch (arrayinfo (L[1])); +[]; + +apply (arrayinfo, [L[1]]); +[declared, 1, [3]]; + +apply (arrayinfo, [L[2]]); +[hash_table, 1]; ----------------------------------------------------------------------- Summary of changes: src/comm2.lisp | 8 +++++--- tests/rtest2.mac | 30 ++++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+), 3 deletions(-) hooks/post-receive -- Maxima CAS |
From: <ap...@us...> - 2024-08-21 01:57:03
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via d1f6d5afee73cde384489788350ada2ded52edbc (commit) from 672c0baea0442487b275a6e83740381210b878c6 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit d1f6d5afee73cde384489788350ada2ded52edbc Author: Robert Dodier <rob...@so...> Date: Tue Aug 20 14:21:38 2024 -0700 Ensure that rules (defrule, defmatch, tellsimp, tellsimpafter) distinguish array expressions from non-array. Fixes SF bug #4349: "user-defined rules apply to expressions with square brackets as well as parentheses". diff --git a/src/matcom.lisp b/src/matcom.lisp index ec888c2e0..451595edb 100644 --- a/src/matcom.lisp +++ b/src/matcom.lisp @@ -334,6 +334,13 @@ (nconc (list 'prog) (list (setq tem (cdr (reverse topreflist)))) `((declare (special ,@ tem))) + + (when (not (atom pt)) + ;; Ensure that the expression to be matched is an array expression iff the pattern is. + (if (member 'array (car pt)) + (list `(when (not (member 'array (kar ,a))) (matcherr))) + (list `(when (member 'array (kar ,a)) (matcherr))))) + program (list (list 'return (cond (boundlist (cons 'retlist @@ -400,6 +407,12 @@ (list (setq tem (nconc boundlist (cdr (reverse topreflist))))) `((declare (special ,@ tem))) + + ;; Ensure that the expression to be matched is an array expression iff the pattern is. + (if (member 'array (car pt)) + (list '(when (not (member 'array (kar x))) (matcherr))) + (list '(when (member 'array (kar x)) (matcherr)))) + program (list (list 'return (list 'values (memqargs rhs) t)))))) @@ -484,6 +497,7 @@ (list 'setq 'x (list 'simpargs1 'x 'ans 'a3))) (list 'cond + `(,my*afterflag x) (list 't (nconc (list 'prog) @@ -504,6 +518,12 @@ (list (setq tem(nconc boundlist (cdr (reverse topreflist))))) `((declare (special ,@ tem))) + + ;; Ensure that the expression to be matched is an array expression iff the pattern is. + (if (member 'array (car pt)) + (list '(when (not (member 'array (kar x))) (matcherr))) + (list '(when (member 'array (kar x)) (matcherr)))) + program (cond ($announce_rules_firing @@ -550,6 +570,13 @@ (list (setq tem (nconc boundlist (cdr (reverse topreflist))))) `((declare (special ,@ tem))) + + (when (not (atom pt)) + ;; Ensure that the expression to be matched is an array expression iff the pattern is. + (if (member 'array (car pt)) + (list `(when (not (member 'array (kar ,a))) (matcherr))) + (list `(when (member 'array (kar ,a)) (matcherr))))) + program (list (list 'return (list 'values (memqargs rhs) t))))))) diff --git a/tests/rtest_rules.mac b/tests/rtest_rules.mac index d65318594..7c9bc2f30 100644 --- a/tests/rtest_rules.mac +++ b/tests/rtest_rules.mac @@ -1042,3 +1042,126 @@ quux (29, w[3] + m[7], blurf, b + c + d); r6b (29^blurf + w[3]); quux (w[3], blurf); +/* SF bug #4349: "user-defined rules apply to expressions with square brackets as well as parentheses" */ + +/* (1) verify pattern foo(...) only matches foo(...) and not foo[...] */ + +(kill (all), + matchdeclare ([aa, bb], symbolp, [cc, dd], numberp), + tellsimpafter (glub(cc), 2*cc), + tellsimp (blart(aa, bb), aa + bb), + defrule (r1, froog(cc), 4*cc + 1), + defmatch (m1, zorg(cc, bb)), + 0); +0; + +glub(123); +246; + +glub[123]; +glub[123]; + +blart(x, y); +x + y; + +blart[x, y]; +blart[x, y]; + +apply1 (froog(222), r1); +889; + +apply1 (froog[222], r1); +froog[222]; + +m1 (zorg(3/2, y)); +[bb = y, cc = 3/2]; + +m1 (zorg[3/2, y]); +false; + +/* (2) verify pattern foo[...] only matches foo[...] and not foo(...) */ + +(kill (all), + matchdeclare ([aa, bb], symbolp, [cc, dd], numberp), + tellsimpafter (glub[cc], cc - 3), + tellsimp (blart[aa, bb], bb - aa), + defrule (r2, froog[cc], blargle(cc)), + defmatch (m2, zorg[cc, bb]), + 0); +0; + +glub(123); +glub(123); + +glub[123]; +120; + +blart(x, y); +blart(x, y); + +blart[x, y]; +y - x; + +apply1 (froog(222), r2); +froog(222); + +apply1 (froog[222], r2); +blargle(222); + +m2 (zorg(3/2, y)); +false; + +m2 (zorg[3/2, y]); +[bb = y, cc = 3/2]; + +/* (3) verify pattern foo(...) only matches foo(...), and pattern foo[...] only matches foo[...]. */ + +(kill (all), + matchdeclare ([aa, bb], symbolp, [cc, dd], numberp), + tellsimpafter (glub(cc), 2*cc), + tellsimpafter (glub[cc], cc - 3), + tellsimp (blart(aa, bb), aa + bb), + tellsimp (blart[aa, bb], bb - aa), + defrule (r1, froog(cc), 4*cc + 1), + defrule (r2, froog[cc], blargle(cc)), + defmatch (m1, zorg(cc, bb)), + defmatch (m2, zorg[cc, bb]), + 0); +0; + +glub(123); +246; + +glub[123]; +120; + +blart(x, y); +x + y; + +blart[x, y]; +y - x; + +apply1 (froog(222), r1); +889; + +apply1 (froog[222], r1); +froog[222]; + +m1 (zorg(3/2, y)); +[bb = y, cc = 3/2]; + +m1 (zorg[3/2, y]); +false; + +apply1 (froog(222), r2); +froog(222); + +apply1 (froog[222], r2); +blargle(222); + +m2 (zorg(3/2, y)); +false; + +m2 (zorg[3/2, y]); +[bb = y, cc = 3/2]; + ----------------------------------------------------------------------- Summary of changes: src/matcom.lisp | 27 +++++++++++ tests/rtest_rules.mac | 123 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 150 insertions(+) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-08-19 23:30:16
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via 672c0baea0442487b275a6e83740381210b878c6 (commit) via 241b20f89d94eda9f335c50bbe445f368eb7592d (commit) via f3e651523aa4b66b9d71ed2bfe49cc3ef7b713bc (commit) via 9c6339dacb15a82fb6576868d3459e59bcc74379 (commit) via e5da56547d03e9831540d909c68dcad3d6491052 (commit) via ff87bb55033822237d044d2e9f1ca1524e16a6fd (commit) from d9602d40bdc2f7acf3c38279a316759178886086 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 672c0baea0442487b275a6e83740381210b878c6 Merge: d9602d40b 241b20f89 Author: Raymond Toy <toy...@gm...> Date: Mon Aug 19 09:43:34 2024 -0700 Merge branch 'rtoy-html-support-external-docs' Updates `build_and_dump_html_index` to support other documents that aren't part of the Maxima user manual. ----------------------------------------------------------------------- Summary of changes: doc/info/build-html-index.lisp | 65 +++++++++++++++++++++++++++++++----------- src/macdes.lisp | 7 ++++- 2 files changed, 55 insertions(+), 17 deletions(-) hooks/post-receive -- Maxima CAS |