(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)

(calcFunc-sec, calcFunc-csc, calcFunc-cot, calcFunc-sech)
(calcFunc-csch, calcFunc-coth, math-sec-raw, math-csc-raw)
(math-cot-raw): New functions.

1 files changed, 387 insertions, 2 deletions

diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 02c65ac22ea..2cfe81fdd65 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -144,6 +144,18 @@
   (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,6 +183,18 @@
   (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,6 +229,29 @@
   (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,8 +267,6 @@
   (calc-slow-wrapper
    (calc-pop-push-record 1 "i*" (math-imaginary (calc-top-n 1)))))
 
-
-
 (defun calc-to-degrees (arg)
   (interactive "P")
   (calc-wrapper
@@ -794,6 +839,169 @@
         (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,6 +1027,85 @@
       (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,6 +1824,104 @@
            (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