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
(6) |
Oct
|
Nov
|
Dec
|
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 |
From: peterpall <pet...@us...> - 2024-08-18 14:09: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 d9602d40bdc2f7acf3c38279a316759178886086 (commit) from 2f19f6683dd203689067d302391022d846997c6f (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 d9602d40bdc2f7acf3c38279a316759178886086 Author: Gunter Königsmann <gu...@pe...> Date: Sun Aug 18 16:09:03 2024 +0200 Windows installer: Updated wxMaxima diff --git a/crosscompile-windows/wxmaxima/CMakeLists.txt b/crosscompile-windows/wxmaxima/CMakeLists.txt index 873bebf7e..03b699af6 100644 --- a/crosscompile-windows/wxmaxima/CMakeLists.txt +++ b/crosscompile-windows/wxmaxima/CMakeLists.txt @@ -10,9 +10,9 @@ # If no further patches are needed, you should get a # updated setup-file automatically. -set(WXMAXIMAVERSION "24.05.0") +set(WXMAXIMAVERSION "24.08.0") -set(WXMAXIMA_MD5 "79d2e675f41b55ad4f18044c65fd94b2") +set(WXMAXIMA_MD5 "45e11dcc01a204863b0f48c63f067f5d") set(WXMAXIMA_URL "https://github.com/wxMaxima-developers/wxmaxima/archive/refs/tags/Version-${WXMAXIMAVERSION}.tar.gz") ----------------------------------------------------------------------- Summary of changes: crosscompile-windows/wxmaxima/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-08-16 13:44:32
|
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-html-support-external-docs has been updated via 241b20f89d94eda9f335c50bbe445f368eb7592d (commit) via f3e651523aa4b66b9d71ed2bfe49cc3ef7b713bc (commit) from 9c6339dacb15a82fb6576868d3459e59bcc74379 (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 241b20f89d94eda9f335c50bbe445f368eb7592d Author: Raymond Toy <toy...@gm...> Date: Fri Aug 16 06:43:15 2024 -0700 More documentation and comment out debugging print. diff --git a/doc/info/build-html-index.lisp b/doc/info/build-html-index.lisp index 25f8db0e5..a30e2ce0c 100644 --- a/doc/info/build-html-index.lisp +++ b/doc/info/build-html-index.lisp @@ -84,10 +84,13 @@ (defun process-line (line matcher path &key replace-dash-p (prefix "Add:") truenamep) "Process the LINE using the function MATCHER to determine if this line contains something interesting to add to the index. REPLACE-DASH-P - and PREFIX are passed to ADD-ENTRY." + and PREFIX are passed to ADD-ENTRY. If TRUENAMEP is non-NIL, the + entry is the full path to the file specified in the line based on + the value of PATH." (multiple-value-bind (item item-id file line) (funcall matcher line) (when item + #+nil (format t "process-line: file, path = ~A ~A~%" file path) (when truenamep (setf file (truename (merge-pathnames file path)))) commit f3e651523aa4b66b9d71ed2bfe49cc3ef7b713bc Author: Raymond Toy <toy...@gm...> Date: Fri Aug 16 06:39:09 2024 -0700 Update docs to match implementation of $build_and_dump_html_index diff --git a/doc/info/build-html-index.lisp b/doc/info/build-html-index.lisp index 1a1a18d37..25f8db0e5 100644 --- a/doc/info/build-html-index.lisp +++ b/doc/info/build-html-index.lisp @@ -348,15 +348,35 @@ (handle-special-cases))))) ;; Run this to build a hash table from the topic to the HTML file -;; containing the documentation. The single argument DIR should be a -;; directory that contains the html files to be searched for the -;; topics. For example it can be "<maxima-dir>/doc/info/*.html". The -;; LANG arg specifies the language to use. For English, either leave -;; the argument out, or use "". +;; containing the documentation. It is written to the file given by +;; OUTPUT_FILE. The output can then subsequently be read back in to +;; update Maxima's database of available HTML documentation. However, +;; fot this to work Maxima must have also have the updated index to +;; the info files for the documentation. (defmfun $build_and_dump_html_index (dir &key (output_file "maxima-index-html.lisp") (lang "") (truenamep nil)) + "Creates a file that contains data that maxima can use to produce + HTML documentation. The parameters are: + + DIR + Pathname to where the html files are. This is usually a wildcard + pathname of the form \"<path>/*.html\". + :OUTPUT-FILE + Specifies the name of the file where the data is written. + Defaults to \"maxima-index-html.lisp\". + :LANG + Specifies the language to use. Defaults to \"\" for English. + This is used primarly when building Maxima's user manual to + determine the name of file containing the function and variable + index. + :TRUENAMEP + If non-NIL, the data will use the full pathname to the html + files. Defaults to NIL. Otherwise, the data will be a relative + path. This MUST be set to NIL when building Maxima's user + manual. +" (build-html-index dir lang truenamep) (let (entries) (maphash #'(lambda (k v) ----------------------------------------------------------------------- Summary of changes: doc/info/build-html-index.lisp | 35 +++++++++++++++++++++++++++++------ 1 file changed, 29 insertions(+), 6 deletions(-) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-08-15 22:56:32
|
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-html-support-external-docs has been updated via 9c6339dacb15a82fb6576868d3459e59bcc74379 (commit) from e5da56547d03e9831540d909c68dcad3d6491052 (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 9c6339dacb15a82fb6576868d3459e59bcc74379 Author: Raymond Toy <toy...@gm...> Date: Thu Aug 15 15:55:47 2024 -0700 Fix typo in display-html-help Had an extra closing paren in the wrong place which messed up everything. diff --git a/src/macdes.lisp b/src/macdes.lisp index b0c35d9e6..420432baa 100644 --- a/src/macdes.lisp +++ b/src/macdes.lisp @@ -160,14 +160,17 @@ (when found-it (destructuring-bind (base-name . id) found-it - (let ((url (if (pathname-directory base-name) - base-name - (concatenate 'string - $url_base + (let ((url (concatenate 'string + ;; If BASE-NAME is an absolute path, + ;; use "FILE://" as the protocol. + ;; Otherwise use $URL_BASE. + (if (eq :absolute (car (pathname-directory base-name))) + "file://" + $url_base) "/" (namestring base-name) "#" - id))) + id)) command) (when *debug-display-html-help* (format *debug-io* "URL: ~S~%" url)) ----------------------------------------------------------------------- Summary of changes: src/macdes.lisp | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-08-15 21:54:32
|
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-html-support-external-docs has been updated via e5da56547d03e9831540d909c68dcad3d6491052 (commit) from ff87bb55033822237d044d2e9f1ca1524e16a6fd (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 e5da56547d03e9831540d909c68dcad3d6491052 Author: Raymond Toy <toy...@gm...> Date: Thu Aug 15 14:53:34 2024 -0700 Fix typo in display-html-help "base-basename" -> base-name diff --git a/src/macdes.lisp b/src/macdes.lisp index 46b07c6ee..b0c35d9e6 100644 --- a/src/macdes.lisp +++ b/src/macdes.lisp @@ -160,7 +160,7 @@ (when found-it (destructuring-bind (base-name . id) found-it - (let ((url (if (pathname-directory base-basename) + (let ((url (if (pathname-directory base-name) base-name (concatenate 'string $url_base ----------------------------------------------------------------------- Summary of changes: src/macdes.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) hooks/post-receive -- Maxima CAS |
From: willisbl <wil...@us...> - 2024-08-15 16:06:57
|
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 2f19f6683dd203689067d302391022d846997c6f (commit) from 145a3377eb9dd03effe8121a136e4100767e8823 (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 2f19f6683dd203689067d302391022d846997c6f Author: Barton Willis <wi...@un...> Date: Thu Aug 15 11:06:09 2024 -0500 Fix source code comment. Thanks to Stavros who found this error diff --git a/src/maxmin.lisp b/src/maxmin.lisp index 417c3f7d0..bdb0acc92 100644 --- a/src/maxmin.lisp +++ b/src/maxmin.lisp @@ -67,7 +67,7 @@ ;; factor-if-small. We could locally set the value of factor_max_degree, but let's not. ;; Removing factor from (csign ($factor (mul (sub x pk) (sub qk x))) causes max -;; to miss the simplification max(x^2,x^4,x^6) --> max(x^2, x^4). Arguably, csign +;; to miss the simplification max(x^2,x^4,x^6) --> max(x^2, x^6). Arguably, csign ;; should be more semantically neutral--until it is, let's keep factor in here. (defun betweenp (x p) ----------------------------------------------------------------------- Summary of changes: src/maxmin.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) hooks/post-receive -- Maxima CAS |
From: willisbl <wil...@us...> - 2024-08-15 15:51:48
|
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 145a3377eb9dd03effe8121a136e4100767e8823 (commit) from 9d62035b221d710296586201b1b45ba52b5c155f (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 145a3377eb9dd03effe8121a136e4100767e8823 Author: Barton Willis <wi...@un...> Date: Thu Aug 15 10:51:28 2024 -0500 Minor update to tests/README.how-to diff --git a/tests/README.how-to b/tests/README.how-to index d43f20ed1..b43b9e884 100644 --- a/tests/README.how-to +++ b/tests/README.how-to @@ -1,4 +1,4 @@ -Suggestions and tips for writing test files +Suggestions and tips for writing and running test files Barton Willis (1) A test file contains pairs of expressions. The first @@ -12,7 +12,7 @@ x - x; 0$ You may terminate each line with either a semicolon or a dollar -sign. To keep the file somewhat organized, terminate the input line +sign. To keep the file organized, terminate the input line with a semicolon and the expected output with a dollar sign. It's helpful to separate each input / expected output pair with a blank line. @@ -21,7 +21,7 @@ For example, "rtest_abs.mac" is a good name for tests for the absolute value function. (3) If the input is something that doesn't need to be checked, make a -compound statement with the last statement being 0. Thus +compound statement with the last statement being 0. For example, (assume(x > 0), 0); 0$ @@ -30,7 +30,7 @@ abs(x); x$ (4) If a test needs to use a non-default value for an option variable, try to -make the change local instead of global. For example +make the change local instead of global. For example, is (x < 1), prederror : false; unknown$ @@ -68,8 +68,13 @@ include this data into testsuite.lisp. To illustrate, the tests are known bugs, append ((mlist) "rtest_abs" 42 43) to the file list in testsuite.lisp. -Finally, build Maxima and run the test suite. If all goes -well, commit the new test file. +Finally, build Maxima and run the test suite. If a test triggers an `asksign`, +unfortunately, Maxima doesn't print the 'asksign` question and it might appear +to stall while waiting for input. When Maxima appears to be stalled, enter a +bogus expression such as `[;`. Doing so will allow you discover the test that +triggers the 'asksign.' + +Once your test file runs to completion, commit it. (9) Other: @@ -77,17 +82,16 @@ well, commit the new test file. appending a new test to Maxima's test suite, make sure that run_testsuite() runs multiple times without error. -(b) Always test the simple cases: abs(0), abs(0.0), abs(0.0b0), ... Also, +(b) Always test the simple cases: abs(0), abs(0.0), abs(0.0b0), and ... Also, check that functions work correctly for CRE expressions, arguments that -contain '%i', empty lists, empty matrices, ... Thus always test +contain '%i', empty lists, empty matrices, and ... Thus always test the 'boundary' cases; these are things like max(), min(), apply("*",[]), .... -(c) Check the sourceforge bug list for all reported bugs for the functions(s) +(c) Check the Maxima bug list for all reported bugs for the functions(s) you are testing. Include tests for these bugs; also put a comment in your test file that references the bug report: -/* See SF Bug # 771061 */ - +/* #358 expand dot expr; fatal error/FIX */ expand((vt . a^^(-1) . u+1)^^(-2)); ((vt.a^^(-1).u)^^2+2*(vt.a^^(-1).u)+1)^^(-1)$ @@ -121,7 +125,7 @@ or makelist(sin(k * %pi),k,1,5); [0,0,0,0,0]$ -To get a test to pass,you may need to insert a few parenthesis in the +To get a test to pass, you may need to insert a few parenthesis in the expected output; for example -a/2; @@ -132,6 +136,9 @@ Another way to handle such things is to use explicit calls to ratsimp: ratsimp(-a/2); ''(ratsimp(-a/2))$ -To test a function such as factor, you do not want to apply ratsimp. - +Of course, to test a function such as factor, you do not want to apply ratsimp. +(g) When the expected result is messy, I suggest that you *not* routinely use additional +simplifications (ratsimp, factor, radcan, ...) to make the expected result +nicer. Such simplifications can hide changes that might be useful for a developer to +know about. Of course, the simplification functions need their own testing. \ No newline at end of file ----------------------------------------------------------------------- Summary of changes: tests/README.how-to | 35 +++++++++++++++++++++-------------- 1 file changed, 21 insertions(+), 14 deletions(-) hooks/post-receive -- Maxima CAS |
From: willisbl <wil...@us...> - 2024-08-15 15:47:19
|
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 9d62035b221d710296586201b1b45ba52b5c155f (commit) from 2ff01b0b1a7466f932a99c963873c688fb7b82dd (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 9d62035b221d710296586201b1b45ba52b5c155f Author: Barton Willis <wi...@un...> Date: Thu Aug 15 10:46:54 2024 -0500 Changes to resolve #4321 limits of Newton quotients for some inverse trig logarc.lisp - New function partial-logarc. tlimit.lisp In tlimit-taylor - Set $radexpand to nil. - Set $logexpand to nil. - Call partial-logarc before calling taylor. limit.lisp In calculate-series - Locally set $radexpand to nil and $logexpand to nil. Also, change value of $taylor_simplifier; set a few more option values to match those in tlimit-taylor. tlimit-taylor. - Call partial-logarc before calling taylor. testsuite.lisp - Remove rtest_limit_extra test 102 as a known failure. rtest_limit_extra - Non-semantic change of expected value for two tests. - Append tests for #4321 limits of Newton quotients for some inverse trig. Tested with SBCL 2.4.7 & Clozure CL 1.12.2 (v1.12.2). For SBCL, tests 384 & 390 (floating point accuracy of gamma) fail (but not by much), but no other unexpected failures. For Clozure CL, no expected failures. diff --git a/src/limit.lisp b/src/limit.lisp index d29b89ac9..ff5cf1b51 100644 --- a/src/limit.lisp +++ b/src/limit.lisp @@ -3918,17 +3918,38 @@ ignoring dummy variables and array indices." exp) exp)))) +;; When $domain is $real, substitute the rectangular form for log(+/- %i) in +;; the expression e; when $domain is not $real, return the expression e unchanged. + +;; Maxima's general simplifier does not simplify log(+/- %i) to a rectangular form. +;; This is due to Maxima's guideline of perserving multivalueness of log-like +;; expressions. Especially when $domain is true, I don't think users want to see +;; results such as limit(atan(x),x,inf) = -%i*log(%i). +(defun log-simp-plus-or-minus-i (e) + (if (eq '$real $domain) + (maxima-substitute + (div (mul '$%i '$%pi) -2) + (ftake '%log (mul -1 '$%i)) + (maxima-substitute (div (mul '$%i '$%pi) 2) (ftake '%log '$%i) e)) + e)) + ;; Generate $lhospitallim terms of taylor expansion. ;; Ideally we would use a lazy series representation that generates ;; more terms as higher order terms cancel. (defun calculate-series (exp var) - (let ((cntx ($supcontext)) ($taylor_simplifier #'extra-simp)) - ($activate cntx) + (let ((cntx ($supcontext)) + (silent-taylor-flag t) + ($taylordepth 8) + ($radexpand nil) + ($logexpand nil) + ($taylor_simplifier #'(lambda (q) (sratsimp (extra-simp q))))) + ($activate cntx) (unwind-protect (progn - (mfuncall '$assume (ftake 'mgreaterp var 0)) + (assume (ftake 'mgreaterp var 0)) (putprop var t 'internal); keep var from appearing in questions to user - ($taylor exp var 0 $lhospitallim)) + (setq exp (partial-logarc exp (list '%atan))) + (log-simp-plus-or-minus-i (catch 'taylor-catch ($taylor exp var 0 $lhospitallim)))) (remprop var 'internal) ($killcontext cntx)))) diff --git a/src/logarc.lisp b/src/logarc.lisp index a6eceb853..c9c175a4f 100644 --- a/src/logarc.lisp +++ b/src/logarc.lisp @@ -53,6 +53,19 @@ (logarc (zl-get (zl-get (get f '$inverse) 'recip) '$inverse) (inv x))) (t (merror "LOGARC: unrecognized argument: ~M" f)))) +;; Conditionally apply a logarc transformation to operators that either have the +;; arcp property or that are %atan2 expressions but are *not* members of the list `l`. +;; We could blend this functionality into $logarc, but I'm not sure there is much +;; demand for it. +(defun partial-logarc (e l) + (cond ((atom e) e) + ((and (arcp (caar e)) (not (member (caar e) l))) + (logarc (caar e) (partial-logarc (cadr e) l))) + ((eq (caar e) '%atan2) + (logarc '%atan2 (list (partial-logarc (second e) l) + (partial-logarc (third e) l)))) + (t (recur-apply #'(lambda (q) (partial-logarc q l)) e)))) + (defun halfangle (f a) (and (mtimesp a) (ratnump (cadr a)) diff --git a/src/testsuite.lisp b/src/testsuite.lisp index d35a40271..41b81da5e 100644 --- a/src/testsuite.lisp +++ b/src/testsuite.lisp @@ -138,7 +138,7 @@ "rtest_polynomialp" ((mlist simp) "rtest_limit_extra" ((mlist simp) 42 59 61 82 83 84 89 - 94 96 102 104 111 + 94 96 104 111 124 125 126 127 132 133 135 136 137 224 238 239 240 241 242 243 244 245 246 249 diff --git a/src/tlimit.lisp b/src/tlimit.lisp index 797559041..d628942a9 100644 --- a/src/tlimit.lisp +++ b/src/tlimit.lisp @@ -51,10 +51,9 @@ ;; This recursion on the order attempts to handle limits such as ;; tlimit(2^n/n^5, n, inf) correctly. -;; We set up a reasonable environment for calling taylor. Arguably, setting -;; these option variables is overly removes the users ability to adjust these -;; option variables. When $taylor_logexpand is true, taylor does some -;; principal branch violating transformations, so we set it to nil. +;; We set up a reasonable environment for calling taylor. When $taylor_logexpand +;; is true, taylor does some principal branch violating transformations, so we set +;; it to nil. ;; I know of no compelling reason for defaulting the taylor order to ;; lhospitallim, but this is documented in the user documentation). @@ -63,9 +62,12 @@ (let ((ee 0) (silent-taylor-flag t) ($taylordepth 8) + ($radexpand nil) + ($logexpand nil) ($taylor_logexpand nil) - ($taylor_simplifier #'sratsimp)) - (setq ee (ratdisrep (catch 'taylor-catch ($taylor e x pt n)))) + ($taylor_simplifier #'(lambda (q) (sratsimp (extra-simp q))))) + (setq e (partial-logarc e (list '%atan))) + (setq ee (catch 'taylor-catch (let (($logexpand t)) (ratdisrep ($taylor e x pt n))))) (cond ((and ee (not (alike1 ee 0))) ee) ;; When taylor returns zero and the depth d is less than 16, ;; declare a do-over; otherwise return nil. diff --git a/tests/rtest16.mac b/tests/rtest16.mac index 8e9ed02e6..0ed1e9907 100644 --- a/tests/rtest16.mac +++ b/tests/rtest16.mac @@ -2045,9 +2045,12 @@ integrate(x[1]*exp(x[1]), x[1]); exp(x[1])*(x[1]-1)$ /* #2726: Integrate produces wrong answer for Gaussian Moments */ -(declare(m2726, even), - block([tmp: integrate(exp(-x^2/2)/sqrt(2*%pi) * x^m2726, x, -1/4, 1/4)], - sign (subst(m2726 = 4, tmp)))); +block([tmp, m2726], + assume(m2726+1 > 0), + tmp : integrate(exp(-x^2/2)/sqrt(2*%pi) * x^m2726, x, -1/4, 1/4), + tmp : sign(subst(m2726 = 4, tmp)), + forget(m2726+1 > 0), + tmp); pos$ /* # 2697: Inconsistent handling of Greek symbols */ diff --git a/tests/rtest_limit_extra.mac b/tests/rtest_limit_extra.mac index 183a245d0..7a0cab3f4 100644 --- a/tests/rtest_limit_extra.mac +++ b/tests/rtest_limit_extra.mac @@ -403,8 +403,9 @@ block([domain : 'complex],limit(2/5*((3/4)^m - 1)*(a - 10) + 1/5*(3*(3/4)^m + 2) 27/26$ /* #2953 limit loops endlessly */ - limit((a/x^b + (1-a)/y^b)^(-1/b),b,0); - x^a*y^(1-a)$ + block([ans : limit((a/x^b + (1-a)/y^b)^(-1/b),b,0)], + [ans, ratsimp(ans)]); + [(x^(a-1)*%e^((log(x)/log(y)+1)*log(y)))/y^a,x^a*y^(1-a)]$ /* #2899 Limit that once worked is broken */ limit((1+sqrt(n+1))^(-n-1)/(1+sqrt(n))^(-n),n,inf); @@ -704,8 +705,9 @@ log(sqrt(2)+1)-log(1-sqrt(2))-sqrt(2)$ 0$ /* #2953 limit loops endlessly */ -limit((a/x^b + (1-a)/y^b)^(-1/b),b,0); -x^a*y^(1-a)$ +block([ans : limit((a/x^b + (1-a)/y^b)^(-1/b),b,0)], + [ans, ratsimp(ans)]); + [(x^(a-1)*%e^((log(x)/log(y)+1)*log(y)))/y^a,x^a*y^(1-a)]$ /* #2706 Limit runs forever, never returning (simplified bug) */ block([ans1,ans2, ans3], @@ -1183,6 +1185,29 @@ und$ limit(erfi(sin(x)),x,inf); ind$ +/* #4321 limits of Newton quotients for some inverse trig */ + +limit((cos(3+h)-cos(3))/h,h,0); +-sin(3)$ + + limit((acos(3+h)-acos(3))/h,h,0); + %i/2^(3/2)$ + + limit((asin(3+h)-asin(3))/h,h,0); + -%i/2^(3/2)$ + +limit((acos(x+h) - acos(x))/h,h,0); +sqrt(1-x^2)/(x^2-1)$ + +tlimit((acos(x+h) - acos(x))/h,h,0); +sqrt(1-x^2)/(x^2-1)$ + +limit((asin(x+h)-asin(x))/h,h,0); +-sqrt(1-x^2)/(x^2-1)$ + +tlimit((asin(x+h)-asin(x))/h,h,0); +-sqrt(1-x^2)/(x^2-1)$ + /* clean up*/ (kill(values),0); 0$ ----------------------------------------------------------------------- Summary of changes: src/limit.lisp | 29 +++++++++++++++++++++++++---- src/logarc.lisp | 13 +++++++++++++ src/testsuite.lisp | 2 +- src/tlimit.lisp | 14 ++++++++------ tests/rtest16.mac | 9 ++++++--- tests/rtest_limit_extra.mac | 33 +++++++++++++++++++++++++++++---- 6 files changed, 82 insertions(+), 18 deletions(-) hooks/post-receive -- Maxima CAS |
From: rtoy <rt...@us...> - 2024-08-15 14:39:01
|
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-html-support-external-docs has been created at ff87bb55033822237d044d2e9f1ca1524e16a6fd (commit) - Log ----------------------------------------------------------------- commit ff87bb55033822237d044d2e9f1ca1524e16a6fd Author: Raymond Toy <toy...@gm...> Date: Thu Aug 15 07:32:16 2024 -0700 Add support for external html docs WIP. First, use keyword args for `$build_and_dump_html_index`. Then add new keywords: * output_file: specifies where the output index is to be written. Defaults to "maxima-index-html.lisp", as before * truenamep: When set to T, the html index file will include the full path to the file. Defaults to NIL. This is intended to be used when adding external docs for display. To make this work, pass the `truenamep` parameter to `process-line` which will either just use the filename or use the truename of the file. In `display-html-help`, if the path contains a directory, just use it as is; otherwise, we prefix the path with `$url_base`, as before. diff --git a/doc/info/build-html-index.lisp b/doc/info/build-html-index.lisp index c65d2b208..1a1a18d37 100644 --- a/doc/info/build-html-index.lisp +++ b/doc/info/build-html-index.lisp @@ -81,18 +81,23 @@ (setf (gethash item *html-index*) (cons file item-id))) -(defun process-line (line matcher &key replace-dash-p (prefix "Add:")) +(defun process-line (line matcher path &key replace-dash-p (prefix "Add:") truenamep) "Process the LINE using the function MATCHER to determine if this line contains something interesting to add to the index. REPLACE-DASH-P and PREFIX are passed to ADD-ENTRY." (multiple-value-bind (item item-id file line) (funcall matcher line) (when item - (add-entry item item-id file line + (format t "process-line: file, path = ~A ~A~%" file path) + (when truenamep + (setf file (truename (merge-pathnames file path)))) + (add-entry item item-id + file + line :replace-dash-p replace-dash-p :prefix prefix)))) -(defun process-one-html-file (file matcher replace-dash-p prefix) +(defun process-one-html-file (file matcher replace-dash-p prefix truenamep) "Process one html file named FILE using MATCHER to determine matches. REPLACE-DASH-P and PREFIX are passed to PROCESS-LINE which will handle these." @@ -102,8 +107,10 @@ while line do (process-line line matcher + file :replace-dash-p replace-dash-p - :prefix prefix)))) + :prefix prefix + :truenamep truenamep)))) (defun handle-special-cases () "These HTML topics need special handling because we didn't quite @@ -325,7 +332,7 @@ (when (probe-file toc-path) (return-from find-toc-file toc-path))))) -(defun build-html-index (dir lang) +(defun build-html-index (dir lang truenamep) (clrhash *html-index*) (let ((index-file (find-index-file dir lang))) (unless index-file @@ -336,8 +343,8 @@ (let ((toc-path (find-toc-file dir))) (get-texinfo-version toc-path) (format t "Texinfo Version ~A: ~D~%" *texinfo-version-string* *texinfo-version*) - (process-one-html-file index-file #'match-entries t "Add") - (process-one-html-file toc-path #'match-toc nil "TOC") + (process-one-html-file index-file #'match-entries t "Add" truenamep) + (process-one-html-file toc-path #'match-toc nil "TOC" truenamep) (handle-special-cases))))) ;; Run this to build a hash table from the topic to the HTML file @@ -346,13 +353,16 @@ ;; topics. For example it can be "<maxima-dir>/doc/info/*.html". The ;; LANG arg specifies the language to use. For English, either leave ;; the argument out, or use "". -(defmfun $build_and_dump_html_index (dir &optional (lang "")) - (build-html-index dir lang) +(defmfun $build_and_dump_html_index (dir &key + (output_file "maxima-index-html.lisp") + (lang "") + (truenamep nil)) + (build-html-index dir lang truenamep) (let (entries) (maphash #'(lambda (k v) (push (list k (namestring (car v)) (cdr v)) entries)) *html-index*) - (with-open-file (s "maxima-index-html.lisp" + (with-open-file (s output_file :direction :output :if-exists :supersede) (with-standard-io-syntax diff --git a/src/macdes.lisp b/src/macdes.lisp index 7818fb03a..46b07c6ee 100644 --- a/src/macdes.lisp +++ b/src/macdes.lisp @@ -160,12 +160,14 @@ (when found-it (destructuring-bind (base-name . id) found-it - (let ((url (concatenate 'string + (let ((url (if (pathname-directory base-basename) + base-name + (concatenate 'string $url_base "/" (namestring base-name) "#" - id)) + id))) command) (when *debug-display-html-help* (format *debug-io* "URL: ~S~%" url)) ----------------------------------------------------------------------- hooks/post-receive -- Maxima CAS |