[Emacs-diffs] Changes to emacs/lisp/calc/calc-math.el

[Jay Belanger]

Index: emacs/lisp/calc/calc-math.el
diff -c emacs/lisp/calc/calc-math.el:1.10 emacs/lisp/calc/calc-math.el:1.11
*** emacs/lisp/calc/calc-math.el:1.10   Tue Nov 30 17:16:50 2004
--- emacs/lisp/calc/calc-math.el        Tue Feb 15 19:25:20 2005
***************
*** 144,149 ****
--- 144,161 ----
    (calc-hyperbolic-func)
    (calc-sin arg))
  
+ (defun calc-sec (arg)
+   (interactive "P")
+   (calc-slow-wrapper
+    (if (calc-is-hyperbolic)
+        (calc-unary-op "sech" 'calcFunc-sech arg)
+      (calc-unary-op "sec" 'calcFunc-sec arg))))
+ 
+ (defun calc-sech (arg)
+   (interactive "P")
+   (calc-hyperbolic-func)
+   (calc-sec arg))
+ 
  (defun calc-cos (arg)
    (interactive "P")
    (calc-slow-wrapper
***************
*** 171,176 ****
--- 183,200 ----
    (calc-hyperbolic-func)
    (calc-cos arg))
  
+ (defun calc-csc (arg)
+   (interactive "P")
+   (calc-slow-wrapper
+    (if (calc-is-hyperbolic)
+        (calc-unary-op "csch" 'calcFunc-csch arg)
+      (calc-unary-op "csc" 'calcFunc-csc arg))))
+ 
+ (defun calc-csch (arg)
+   (interactive "P")
+   (calc-hyperbolic-func)
+   (calc-csc arg))
+ 
  (defun calc-sincos ()
    (interactive)
    (calc-slow-wrapper
***************
*** 205,210 ****
--- 229,257 ----
    (calc-hyperbolic-func)
    (calc-tan arg))
  
+ (defun calc-cot (arg)
+   (interactive "P")
+   (calc-slow-wrapper
+    (if (calc-is-hyperbolic)
+        (calc-unary-op "coth" 'calcFunc-coth arg)
+      (calc-unary-op "cot" 'calcFunc-cot arg))))
+ 
+ (defun calc-arctan (arg)
+   (interactive "P")
+   (calc-invert-func)
+   (calc-tan arg))
+ 
+ (defun calc-tanh (arg)
+   (interactive "P")
+   (calc-hyperbolic-func)
+   (calc-tan arg))
+ 
+ (defun calc-arctanh (arg)
+   (interactive "P")
+   (calc-invert-func)
+   (calc-hyperbolic-func)
+   (calc-tan arg))
+ 
  (defun calc-arctan2 ()
    (interactive)
    (calc-slow-wrapper
***************
*** 220,227 ****
    (calc-slow-wrapper
     (calc-pop-push-record 1 "i*" (math-imaginary (calc-top-n 1)))))
  
- 
- 
  (defun calc-to-degrees (arg)
    (interactive "P")
    (calc-wrapper
--- 267,272 ----
***************
*** 794,799 ****
--- 839,1007 ----
        (t (calc-record-why 'scalarp x)
           (list 'calcFunc-tan x))))
  
+ (defun calcFunc-sec (x)
+   (cond ((and (integerp x)
+               (eq calc-angle-mode 'deg)
+               (= (% x 180) 0))
+          (if (= (% x 360) 0)
+              1
+            -1))
+         ((and (integerp x)
+               (eq calc-angle-mode 'rad)
+               (= x 0))
+          1)
+         ((Math-scalarp x)
+          (math-with-extra-prec 2
+            (math-sec-raw (math-to-radians (math-float x)))))
+         ((eq (car x) 'sdev)
+          (if (math-constp x)
+              (math-with-extra-prec 2
+                (let* ((xx (math-to-radians (math-float (nth 1 x))))
+                       (xs (math-to-radians (math-float (nth 2 x))))
+                       (sc (math-sin-cos-raw xx)))
+                  (if (and (math-zerop (cdr sc))
+                           (not calc-infinite-mode))
+                      (progn
+                        (calc-record-why "*Division by zero")
+                        (list 'calcFunc-sec x))
+                    (math-make-sdev (math-div-float '(float 1 0) (cdr sc))
+                                    (math-div-float
+                                     (math-mul xs (car sc))
+                                     (math-sqr (cdr sc)))))))
+            (math-make-sdev (calcFunc-sec (nth 1 x))
+                            (math-div 
+                             (math-mul (nth 2 x)
+                                       (calcFunc-sin (nth 1 x)))
+                             (math-sqr (calcFunc-cos (nth 1 x)))))))
+         ((and (eq (car x) 'intv)
+               (math-intv-constp x))
+          (math-with-extra-prec 2
+            (let* ((xx (math-to-radians (math-float x)))
+                   (na (math-floor (math-div (math-sub (nth 2 xx)
+                                                       (math-pi-over-2))
+                                             (math-pi))))
+                   (nb (math-floor (math-div (math-sub (nth 3 xx)
+                                                       (math-pi-over-2))
+                                             (math-pi))))
+                   (naa (math-floor (math-div (nth 2 xx) (math-pi-over-2))))
+                   (nbb (math-floor (math-div (nth 3 xx) (math-pi-over-2))))
+                   (span (math-sub nbb naa)))
+              (if (not (equal na nb))
+                  '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
+                (let ((int (math-sort-intv (nth 1 x)
+                                           (math-sec-raw (nth 2 xx))
+                                           (math-sec-raw (nth 3 xx)))))
+                  (if (eq span 1)
+                      (if (math-evenp (math-div (math-add naa 1) 2))
+                          (math-make-intv (logior (nth 1 int) 2)
+                                          1
+                                          (nth 3 int))
+                        (math-make-intv (logior (nth 1 int) 1)
+                                        (nth 2 int)
+                                        -1))
+                    int))))))
+         ((equal x '(var nan var-nan))
+          x)
+         (t (calc-record-why 'scalarp x)
+            (list 'calcFunc-sec x))))
+ 
+ (defun calcFunc-csc (x)
+   (cond ((and (integerp x)
+               (eq calc-angle-mode 'deg)
+               (= (% (- x 90) 180) 0))
+          (if (= (% (- x 90) 360) 0)
+              1
+            -1))
+         ((Math-scalarp x)
+          (math-with-extra-prec 2
+            (math-csc-raw (math-to-radians (math-float x)))))
+         ((eq (car x) 'sdev)
+          (if (math-constp x)
+              (math-with-extra-prec 2
+                (let* ((xx (math-to-radians (math-float (nth 1 x))))
+                       (xs (math-to-radians (math-float (nth 2 x))))
+                       (sc (math-sin-cos-raw xx)))
+                  (if (and (math-zerop (car sc))
+                           (not calc-infinite-mode))
+                      (progn
+                        (calc-record-why "*Division by zero")
+                        (list 'calcFunc-csc x))
+                    (math-make-sdev (math-div-float '(float 1 0) (car sc))
+                                    (math-div-float
+                                     (math-mul xs (cdr sc))
+                                     (math-sqr (car sc)))))))
+            (math-make-sdev (calcFunc-csc (nth 1 x))
+                            (math-div 
+                             (math-mul (nth 2 x)
+                                       (calcFunc-cos (nth 1 x)))
+                             (math-sqr (calcFunc-sin (nth 1 x)))))))
+         ((and (eq (car x) 'intv)
+               (math-intv-constp x))
+          (math-with-extra-prec 2
+            (let* ((xx (math-to-radians (math-float x)))
+                   (na (math-floor (math-div (nth 2 xx) (math-pi))))
+                   (nb (math-floor (math-div (nth 3 xx) (math-pi))))
+                   (naa (math-floor (math-div (nth 2 xx) (math-pi-over-2))))
+                   (nbb (math-floor (math-div (nth 3 xx) (math-pi-over-2))))
+                   (span (math-sub nbb naa)))
+              (if (not (equal na nb))
+                  '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
+                (let ((int (math-sort-intv (nth 1 x)
+                                           (math-csc-raw (nth 2 xx))
+                                           (math-csc-raw (nth 3 xx)))))
+                  (if (eq span 1)
+                      (if (math-evenp (math-div naa 2))
+                          (math-make-intv (logior (nth 1 int) 2)
+                                          1
+                                          (nth 3 int))
+                        (math-make-intv (logior (nth 1 int) 1)
+                                        (nth 2 int)
+                                        -1))
+                    int))))))
+         ((equal x '(var nan var-nan))
+          x)
+         (t (calc-record-why 'scalarp x)
+            (list 'calcFunc-csc x))))
+ 
+ (defun calcFunc-cot (x)   ; [N N] [Public]
+   (cond ((and (integerp x)
+             (if (eq calc-angle-mode 'deg)
+                 (= (% (- x 90) 180) 0)
+               (= x 0)))
+        0)
+       ((Math-scalarp x)
+        (math-with-extra-prec 2
+          (math-cot-raw (math-to-radians (math-float x)))))
+       ((eq (car x) 'sdev)
+        (if (math-constp x)
+            (math-with-extra-prec 2
+              (let* ((xx (math-to-radians (math-float (nth 1 x))))
+                     (xs (math-to-radians (math-float (nth 2 x))))
+                     (sc (math-sin-cos-raw xx)))
+                (if (and (math-zerop (car sc)) (not calc-infinite-mode))
+                    (progn
+                      (calc-record-why "*Division by zero")
+                      (list 'calcFunc-cot x))
+                  (math-make-sdev (math-div-float (cdr sc) (car sc))
+                                  (math-div-float xs (math-sqr (car sc)))))))
+          (math-make-sdev (calcFunc-cot (nth 1 x))
+                          (math-div (nth 2 x)
+                                    (math-sqr (calcFunc-sin (nth 1 x)))))))
+       ((and (eq (car x) 'intv) (math-intv-constp x))
+        (or (math-with-extra-prec 2
+              (let* ((xx (math-to-radians (math-float x)))
+                     (na (math-floor (math-div (nth 2 xx) (math-pi))))
+                     (nb (math-floor (math-div (nth 3 xx) (math-pi))))
+                (and (equal na nb)
+                     (math-sort-intv (nth 1 x)
+                                     (math-cot-raw (nth 2 xx))
+                                     (math-cot-raw (nth 3 xx)))))))
+            '(intv 3 (neg (var inf var-inf)) (var inf var-inf))))
+       ((equal x '(var nan var-nan))
+        x)
+       (t (calc-record-why 'scalarp x)
+          (list 'calcFunc-cot x))))
+ 
  (defun math-sin-raw (x)   ; [N N]
    (cond ((eq (car x) 'cplx)
         (let* ((expx (math-exp-raw (nth 2 x)))
***************
*** 819,824 ****
--- 1027,1111 ----
        (math-polar (math-cos-raw (math-complex x)))
      (math-sin-raw (math-sub (math-pi-over-2) x))))
  
+ (defun math-sec-raw (x)   ; [N N]
+   (cond ((eq (car x) 'cplx)
+        (let* ((x (math-mul x '(float 1 0)))
+                 (expx (math-exp-raw (nth 2 x)))
+               (expmx (math-div-float '(float 1 0) expx))
+                 (sh (math-mul-float (math-sub-float expx expmx) '(float 5 
-1)))
+                 (ch (math-mul-float (math-add-float expx expmx) '(float 5 
-1)))
+               (sc (math-sin-cos-raw (nth 1 x)))
+               (d (math-add-float 
+                     (math-mul-float (math-sqr (car sc))
+                                     (math-sqr sh))
+                     (math-mul-float (math-sqr (cdr sc))
+                                     (math-sqr ch)))))
+          (and (not (eq (nth 1 d) 0))
+               (list 'cplx
+                     (math-div-float (math-mul-float (cdr sc) ch) d)
+                     (math-div-float (math-mul-float (car sc) sh) d)))))
+       ((eq (car x) 'polar)
+        (math-polar (math-sec-raw (math-complex x))))
+       (t
+        (let ((cs (math-cos-raw x)))
+            (if (eq cs 0)
+                (math-div 1 0)
+            (math-div-float '(float 1 0) cs))))))
+ 
+ (defun math-csc-raw (x)   ; [N N]
+   (cond ((eq (car x) 'cplx)
+        (let* ((x (math-mul x '(float 1 0)))
+                 (expx (math-exp-raw (nth 2 x)))
+               (expmx (math-div-float '(float 1 0) expx))
+                 (sh (math-mul-float (math-sub-float expx expmx) '(float 5 
-1)))
+                 (ch (math-mul-float (math-add-float expx expmx) '(float 5 
-1)))
+               (sc (math-sin-cos-raw (nth 1 x)))
+               (d (math-add-float 
+                     (math-mul-float (math-sqr (car sc))
+                                     (math-sqr ch))
+                     (math-mul-float (math-sqr (cdr sc))
+                                     (math-sqr sh)))))
+          (and (not (eq (nth 1 d) 0))
+               (list 'cplx
+                     (math-div-float (math-mul-float (car sc) ch) d)
+                     (math-div-float (math-mul-float (cdr sc) sh) d)))))
+       ((eq (car x) 'polar)
+        (math-polar (math-sec-raw (math-complex x))))
+       (t
+        (let ((sn (math-sin-raw x)))
+            (if (eq sn 0)
+                (math-div 1 0)
+            (math-div-float '(float 1 0) sn))))))
+ 
+ (defun math-cot-raw (x)   ; [N N]
+   (cond ((eq (car x) 'cplx)
+        (let* ((x (math-mul x '(float 1 0)))
+                 (expx (math-exp-raw (nth 2 x)))
+               (expmx (math-div-float '(float 1 0) expx))
+                 (sh (math-mul-float (math-sub-float expx expmx) '(float 5 
-1)))
+                 (ch (math-mul-float (math-add-float expx expmx) '(float 5 
-1)))
+               (sc (math-sin-cos-raw (nth 1 x)))
+               (d (math-add-float 
+                     (math-sqr (car sc))
+                     (math-sqr sh))))
+          (and (not (eq (nth 1 d) 0))
+               (list 'cplx
+                     (math-div-float 
+                        (math-mul-float (car sc) (cdr sc))
+                        d)
+                       (math-neg
+                        (math-div-float 
+                         (math-mul-float sh ch) 
+                         d))))))
+       ((eq (car x) 'polar)
+        (math-polar (math-cot-raw (math-complex x))))
+       (t
+        (let ((sc (math-sin-cos-raw x)))
+          (if (eq (nth 1 (car sc)) 0)
+              (math-div (cdr sc) 0)
+            (math-div-float (cdr sc) (car sc)))))))
+ 
+ 
  ;;; This could use a smarter method:  Reduce x as in math-sin-raw, then
  ;;;   compute either sin(x) or cos(x), whichever is smaller, and compute
  ;;;   the other using the identity sin(x)^2 + cos(x)^2 = 1.
***************
*** 1537,1542 ****
--- 1824,1927 ----
           (list 'calcFunc-tanh x))))
  (put 'calcFunc-tanh 'math-expandable t)
  
+ (defun calcFunc-sech (x)   ; [N N] [Public]
+   (cond ((eq x 0) 1)
+       (math-expand-formulas
+        (math-normalize
+         (list '/ 2 (list '+ (list 'calcFunc-exp x)
+                            (list 'calcFunc-exp (list 'neg x))))))
+       ((Math-numberp x)
+        (if calc-symbolic-mode (signal 'inexact-result nil))
+        (math-with-extra-prec 2
+          (let ((expx (math-exp-raw (math-float x))))
+            (math-div '(float 2 0) (math-add expx (math-div 1 expx))))))
+       ((eq (car-safe x) 'sdev)
+        (math-make-sdev (calcFunc-sech (nth 1 x))
+                        (math-mul (nth 2 x)
+                                    (math-mul (calcFunc-sech (nth 1 x))
+                                              (calcFunc-tanh (nth 1 x))))))
+       ((and (eq (car x) 'intv) (math-intv-constp x))
+        (setq x (math-abs x))
+        (math-sort-intv (nth 1 x)
+                        (calcFunc-sech (nth 2 x))
+                        (calcFunc-sech (nth 3 x))))
+       ((or (equal x '(var inf var-inf))
+            (equal x '(neg (var inf var-inf))))
+          0)
+         ((equal x '(var nan var-nan))
+          x)
+       (t (calc-record-why 'numberp x)
+          (list 'calcFunc-sech x))))
+ (put 'calcFunc-sech 'math-expandable t)
+ 
+ (defun calcFunc-csch (x)   ; [N N] [Public]
+   (cond ((eq x 0) (math-div 1 0))
+       (math-expand-formulas
+        (math-normalize
+         (list '/ 2 (list '- (list 'calcFunc-exp x)
+                            (list 'calcFunc-exp (list 'neg x))))))
+       ((Math-numberp x)
+        (if calc-symbolic-mode (signal 'inexact-result nil))
+        (math-with-extra-prec 2
+          (let ((expx (math-exp-raw (math-float x))))
+            (math-div '(float 2 0) (math-add expx (math-div -1 expx))))))
+       ((eq (car-safe x) 'sdev)
+        (math-make-sdev (calcFunc-csch (nth 1 x))
+                        (math-mul (nth 2 x) 
+                                    (math-mul (calcFunc-csch (nth 1 x))
+                                              (calcFunc-coth (nth 1 x))))))
+       ((eq (car x) 'intv)
+          (if (and (Math-negp (nth 2 x))
+                   (Math-posp (nth 3 x)))
+              '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
+            (math-sort-intv (nth 1 x)
+                            (calcFunc-csch (nth 2 x))
+                            (calcFunc-csch (nth 3 x)))))
+       ((or (equal x '(var inf var-inf))
+            (equal x '(neg (var inf var-inf))))
+          0)
+         ((equal x '(var nan var-nan))
+          x)
+       (t (calc-record-why 'numberp x)
+          (list 'calcFunc-csch x))))
+ (put 'calcFunc-csch 'math-expandable t)
+ 
+ (defun calcFunc-coth (x)   ; [N N] [Public]
+   (cond ((eq x 0) (math-div 1 0))
+       (math-expand-formulas
+        (math-normalize
+         (let ((expx (list 'calcFunc-exp x))
+               (expmx (list 'calcFunc-exp (list 'neg x))))
+           (math-normalize
+            (list '/ (list '+ expx expmx) (list '- expx expmx))))))
+       ((Math-numberp x)
+        (if calc-symbolic-mode (signal 'inexact-result nil))
+        (math-with-extra-prec 2
+          (let* ((expx (calcFunc-exp (math-float x)))
+                 (expmx (math-div 1 expx)))
+            (math-div (math-add expx expmx)
+                      (math-sub expx expmx)))))
+       ((eq (car-safe x) 'sdev)
+        (math-make-sdev (calcFunc-coth (nth 1 x))
+                        (math-div (nth 2 x)
+                                  (math-sqr (calcFunc-sinh (nth 1 x))))))
+       ((eq (car x) 'intv)
+          (if (and (Math-negp (nth 2 x))
+                   (Math-posp (nth 3 x)))
+              '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
+            (math-sort-intv (nth 1 x)
+                            (calcFunc-coth (nth 2 x))
+                            (calcFunc-coth (nth 3 x)))))
+       ((equal x '(var inf var-inf))
+        1)
+       ((equal x '(neg (var inf var-inf)))
+        -1)
+       ((equal x '(var nan var-nan))
+        x)
+       (t (calc-record-why 'numberp x)
+          (list 'calcFunc-coth x))))
+ (put 'calcFunc-coth 'math-expandable t)
+ 
  (defun calcFunc-arcsinh (x)   ; [N N] [Public]
    (cond ((eq x 0) 0)
        (math-expand-formulas