|
From: willisbl <wil...@us...> - 2025-10-13 19:18:52
|
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 eb00d13582520edbf58aed89d2d4d7aeb9217236 (commit)
from 50a7d7ca816b6547b873db940f34a9ced2dced43 (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 eb00d13582520edbf58aed89d2d4d7aeb9217236
Author: Barton Willis <wi...@un...>
Date: Mon Oct 13 14:18:39 2025 -0500
Fix #4614: correct atan2 reflection rule
- Fixed reflection rule conditional for atan2 in comm2.lisp
- Added new function atan2-to-atan in tlimit.lisp to convert atan2 expressions to atan expressions
- Incorporated tests from the bug report into rtest_atan2.mac
- Added additional bug report tests to rtest_limit_extra.mac
- Updated and corrected tests in rtest_trig.mac and rtest_abs_integrate.mac
Tested with SBCL 2.4.7 and Clozure CL 1.13; no unexpected failures in core or share test suites.
diff --git a/share/contrib/integration/rtest_abs_integrate.mac b/share/contrib/integration/rtest_abs_integrate.mac
index 9f79fcd7e..520d3dee4 100644
--- a/share/contrib/integration/rtest_abs_integrate.mac
+++ b/share/contrib/integration/rtest_abs_integrate.mac
@@ -551,9 +551,12 @@ radcan(subst(x=5,i) - subst(x=0,i) - integrate(sqrt(5),x,0,5));
/* abs_integrate causes stack overflow - ID: 3533723 */
integrate(log(sin(x)),x);
-x*log(sin(x)) -(x*log(sin(x)^2+cos(x)^2+2*cos(x)+1)+x*log(sin(x)^2+cos(x)^2
- -2*cos(x)+1)+2*%i*x*atan2(sin(x),cos(x)+1) -2*%i*x*atan2(sin(x),1 -cos(x))
- -2*%i*li[2](%e^(%i*x)) -2*%i*li[2]( -%e^(%i*x)) -%i*x^2)/(2)$
+x*log(sin(x))-(x*log(sin(x)^2+cos(x)^2+2*cos(x)+1)
+ +x*log(sin(x)^2+cos(x)^2-2*cos(x)+1)
+ +2*%i*x*atan2(sin(x),cos(x)+1)
+ +2*%i*x*atan2(-sin(x),1-cos(x))-%i*x^2
+ -2*%i*li[2](%e^(%i*x))-2*%i*li[2](-%e^(%i*x)))
+ /2$
/* SF bug #2557: "abs_integrate leaks assumptions into enclosing context" */
@@ -596,8 +599,12 @@ expand(integrate(x*ceiling(x)*floor(x),x));
/* see SF bug 2853*/
integrate(log(abs(sin(x))),x);
- x*log(abs(sin(x)))-(x*log(sin(x)^2+cos(x)^2+2*cos(x)+1) +x*log(sin(x)^2+cos(x)^2-2*cos(x)+1)
- +2*%i*x*atan2(sin(x),cos(x)+1) -2*%i*x*atan2(sin(x),1-cos(x))-2*%i*li[2](%e^(%i*x))-2*%i*li[2](-%e^(%i*x))-%i*x^2)/2$
+x*log(abs(sin(x)))-(x*log(sin(x)^2+cos(x)^2+2*cos(x)+1)
+ +x*log(sin(x)^2+cos(x)^2-2*cos(x)+1)
+ +2*%i*x*atan2(sin(x),cos(x)+1)
+ +2*%i*x*atan2(-sin(x),1-cos(x))-%i*x^2
+ -2*%i*li[2](%e^(%i*x))-2*%i*li[2](-%e^(%i*x)))
+ /2$
block([ans : integrate(log(abs(sin(x))),x,0,%pi/2)], [ans, expand(ans)]);
[-((6*%pi*log(2)-%i*%pi^2)/12)-(%i*%pi^2)/12,-((%pi*log(2))/2)]$
diff --git a/src/comm2.lisp b/src/comm2.lisp
index 2af9828f3..88550c7de 100644
--- a/src/comm2.lisp
+++ b/src/comm2.lisp
@@ -681,12 +681,10 @@ the hashtable.")
($logarc
(logarc '%atan2 (list ($logarc y) ($logarc x))))
;; atan2(-y,x) = -atan2(y,x) provided (a) trigsign is true, (b) (great (neg y) y), and
- ;; (c) (x,y) is off the negative real axis. The test for (x,y) off the negative
- ;; real axis should be (or (eq t (mnqp y 0)) (eq t (mgrp x 0))), but that causes
- ;; one testsuite failure, so we'll test using (or (not (eql y 0)) (eq signx '$pos)))
+ ;; (c) (x,y) is off the negative real axis.
((and $trigsign
(eq t (mminusp y))
- (or (not (eql y 0)) (eq signx '$pos)))
+ (or (eq t (mnqp y 0)) (eq t (mgrp x 0))))
(neg (ftake '%atan2 (neg y) x)))
((eq signx '$pos)
;; atan2(y,x) = atan(y/x) when x is positive.
diff --git a/src/tlimit.lisp b/src/tlimit.lisp
index ede8e7627..1c5bf916c 100644
--- a/src/tlimit.lisp
+++ b/src/tlimit.lisp
@@ -61,6 +61,23 @@
(logarc '%atan2 (list (logarc-atan2 (second e)) (logarc-atan2 (third e)))))
(t (recur-apply #'logarc-atan2 e))))
+(defun atan2-to-atan (e)
+ "In the expression `e`, replace all subexpressions of the form atan2(y,x), where y is not explicitly equal to
+ zero, by 2*atan((sqrt(x^2+y^2) - x)/y). The input `e` should be simplified--that way, the general simplifier
+ handles the error case of atan2(0,0) and many other cases as well. "
+ (cond (($mapatom e) e)
+ ((and (consp e) (eq '%atan2 (caar e)))
+ (let ((y (second e)) (x (third e)))
+ (if (zerop1 y)
+ e
+ (mul 2 (ftake '%atan (div (sub (ftake 'mexpt (add (mul x x) (mul y y)) (div 1 2)) x) y))))))
+ (($subvarp (mop e)) ;subscripted function
+ (subfunmake
+ (subfunname e)
+ (subfunsubs e) ;don't map fun onto the operator subscripts
+ (mapcar #'atan2-to-atan (subfunargs e)))) ; map onto the arguments
+ (t (fapply (caar e) (mapcar #'atan2-to-atan (cdr e))))))
+
;; Dispatch Taylor, but recurse on the order until either the recursion
;; depth reaches 15 or the Taylor polynomial is nonzero. If Taylor
;; fails to find a nonzero Taylor polynomial or the recursion depth
@@ -96,12 +113,12 @@
($taylordepth 8)
($radexpand nil)
($taylor_logexpand t)
- ($logexpand t))
+ ($logexpand nil))
(cond
((eq pt '$infinity) nil)
(t
- (setq e (logarc-atan2 e))
+ (setq e (atan2-to-atan e))
(setq ee (catch 'taylor-catch ($totaldisrep ($taylor e x pt n))))
(cond
((and ee (not (eql ee 0))) ee)
diff --git a/tests/rtest_atan2.mac b/tests/rtest_atan2.mac
index d03ed4332..e7a1cb197 100644
--- a/tests/rtest_atan2.mac
+++ b/tests/rtest_atan2.mac
@@ -244,9 +244,20 @@ integrate(sin(t)*atan2(2*sin(t),1-2*cos(t)),t,0,%pi);
integrate(atan2(sin(x), cos(x)), x, 0, 9*%pi);
%pi^2/2$
-(kill(values),0);
+/*\#4614 atan2 reflection rule*/
+block([trigsign : true], subst([x=-1,y=0], atan2(-y,x) + atan2(y,x)));
+2*%pi$
+
+block([trigsign : true,ans],
+ assume(notequal(y,0)),
+ ans : 0,
+ forget(notequal(y,0)),
+ ans);
0$
+(kill(values),0);
+0$
+
facts();
[]$
diff --git a/tests/rtest_limit_extra.mac b/tests/rtest_limit_extra.mac
index ef74f8c33..56c32a3d0 100644
--- a/tests/rtest_limit_extra.mac
+++ b/tests/rtest_limit_extra.mac
@@ -1422,11 +1422,12 @@ log(tan(x)^2+1)+2*%i*li[2](-((%i*((%i+1)*tan(x)+%i-1))/2))+2*%i*li[2](%i*tan(x)+
-2*%i*li[2](-((%i*((%i-1)*tan(x)+%i+1))/2))-4*x*log(tan(x)))/4, 0);
0$
-limit(xxx,x,%pi/4,'minus);
- (4*%i*log(2)*log(sqrt(2)*%i+sqrt(2))-4*%i*log(2)^2+%pi*log(2)+8*%catalan)/8$
+/* see \#4614 atan2 reflection rule*/
+[trigsimp(block([trigsign : false], limit(xxx,x,%pi/4,'minus))), block([trigsign : true], limit(xxx,x,%pi/4,'minus))];
+[%catalan,%catalan]$
-limit(xxx,x,%pi/4,'plus);
--((4*%i*log(2)*log(sqrt(2)*%i-sqrt(2))-4*%i*log(2)^2-%pi*log(2)-2*%i*%pi^2-8*%catalan)/8)$
+[block([trigsign : false], limit(xxx,x,%pi/4,'plus)), block([trigsign : true], limit(xxx,x,%pi/4,'plus))];
+[-((-(4*%pi*log(2))-2*%i*%pi^2-8*%catalan)/8), -((-(4*%pi*log(2))-2*%i*%pi^2-8*%catalan)/8)]$
(remvalue(xxx),0);
0$
diff --git a/tests/rtest_trig.mac b/tests/rtest_trig.mac
index f32ebb373..29ce548f6 100644
--- a/tests/rtest_trig.mac
+++ b/tests/rtest_trig.mac
@@ -615,14 +615,19 @@ done;
acoth (x);
/* SF bug #2620: "atan2(y,x)+atan2(-y,x) doesn't always return 0 " */
+block([ans,trigsign : true],
+ kill(x,y),
+ assume(notequal(y,0)),
+ ans : atan2(y,x)+atan2(-y,x),
+ forget(notequal(y,0)),
+ ans);
+0$
-(kill (x, y), atan2(y,x)+atan2(-y,x));
-0;
-(assume (y > 0), atan2(y,x)+atan2(-y,x));
+(assume (y > 0), block([trigsign : true], atan2(y,x)+atan2(-y,x)));
0;
-(kill (n, p, r), forget (y > 0), assume(n<0,p>0), atan2 (- x, r));
+(kill (n, p, r), forget (y > 0), assume(n<0,p>0, notequal(x,0)), atan2 (- x, r));
- atan2 (x, r);
atan2 (-n, r);
@@ -631,8 +636,8 @@ atan2 (-n, r);
atan2 (-p, r);
- atan2 (p, r);
-forget (n < 0, p > 0);
-[n < 0, p > 0];
+forget (n < 0, p > 0,notequal(x,0));
+[n < 0, p > 0,notequal(x,0)];
/* mailing list 2017-11-27: "trigsimp fails with pderivop" */
-----------------------------------------------------------------------
Summary of changes:
share/contrib/integration/rtest_abs_integrate.mac | 17 ++++++++++++-----
src/comm2.lisp | 6 ++----
src/tlimit.lisp | 21 +++++++++++++++++++--
tests/rtest_atan2.mac | 13 ++++++++++++-
tests/rtest_limit_extra.mac | 9 +++++----
tests/rtest_trig.mac | 17 +++++++++++------
6 files changed, 61 insertions(+), 22 deletions(-)
hooks/post-receive
--
Maxima CAS
|