Raymond Toy pushed to branch master at cmucl / cmucl Commits: a05277c7 by Raymond Toy at 2022-10-15T20:53:20+00:00 Fix #134: Handle the case of (expt complex complex-rational) - - - - - 4dacd5ac by Raymond Toy at 2022-10-15T20:53:20+00:00 Merge branch 'issue-134-expt-bug' into 'master' Fix #134: Handle the case of (expt complex complex-rational) Closes #134 See merge request cmucl/cmucl!91 - - - - - 2 changed files: - src/code/irrat.lisp - tests/issues.lisp Changes: ===================================== src/code/irrat.lisp ===================================== @@ -510,12 +510,12 @@ (* base power) (exp (* power (* (log2 base 1w0) (log 2w0)))))) (((foreach fixnum (or bignum ratio) single-float) - (foreach (complex single-float))) + (foreach (complex rational) (complex single-float))) (if (and (zerop base) (plusp (realpart power))) (* base power) (exp (* power (log base))))) (((foreach (complex rational) (complex single-float)) - (foreach single-float (complex single-float))) + (foreach single-float (complex rational) (complex single-float))) (if (and (zerop base) (plusp (realpart power))) (* base power) (or (expt-xfrm (coerce base '(complex single-float)) power) @@ -537,7 +537,7 @@ (exp (* power (log (coerce base '(complex double-double-float)))))))) (((foreach (complex double-float)) (foreach single-float double-float - (complex single-float) (complex double-float))) + (complex rational) (complex single-float) (complex double-float))) (if (and (zerop base) (plusp (realpart power))) (* base power) (or (expt-xfrm base power) @@ -552,7 +552,7 @@ (exp (* power (log (coerce base '(complex double-double-float)))))))) #+double-double (((foreach (complex double-double-float)) - (foreach float (complex float))) + (foreach float (complex float) (complex rational))) (if (and (zerop base) (plusp (realpart power))) (* base power) (or (expt-xfrm base power) ===================================== tests/issues.lisp ===================================== @@ -645,3 +645,28 @@ (assert-true defaulted-new-name) (assert-equalp old-truename orig) (assert-equalp new-truename new))))) + +(define-test issue.134 + (:tag :issues) + ;; Verify that we can compute (3+4*%i)^%i (in Maxima format). This + ;; can be written analytically as + ;; %i*%e^-atan(4/3)*sin(log(5))+%e^-atan(4/3)*cos(log(5)), so use + ;; %this as the reference value. + (let ((answer (complex (* (cos (log 5w0)) + (exp (- (atan (float (/ 4 3) 0w0))))) + (* (sin (log 5w0)) + (exp (- (atan (float (/ 4 3) 0w0)))))))) + (flet ((relerr (actual true) + ;; Return the relative error between ACTUAL and TRUE + (/ (abs (- actual true)) + (abs true)))) + (dolist (test '((#c(3 4) 3.5918w-8) + (#c(3.0 4) 3.5918w-8) + (#c(3d0 4) 9.2977w-17) + (#c(3w0 4) 0w0))) + (destructuring-bind (base eps) + test + (let* ((value (expt base #c(0 1))) + (err (relerr value answer))) + (assert-true (<= err eps) base err eps))))))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e0e9f62d1f2dd64d166ac1f... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e0e9f62d1f2dd64d166ac1f... You're receiving this email because of your account on gitlab.common-lisp.net.