;;; calc-math.el --- mathematical functions for Calc
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
-;; Maintainer: Jay Belanger <belanger@truman.edu>
+;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
;; This file is part of GNU Emacs.
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(require 'calc-ext)
(require 'calc-macs)
+
+;;; Find out how many 9s in 9.9999... will give distinct Emacs floats,
+;;; then back off by one.
+
+(defvar math-emacs-precision
+ (let* ((n 1)
+ (x 9)
+ (xx (+ x (* 9 (expt 10 (- n))))))
+ (while (/= x xx)
+ (progn
+ (setq n (1+ n))
+ (setq x xx)
+ (setq xx (+ x (* 9 (expt 10 (- n)))))))
+ (1- n))
+ "The number of digits in an Emacs float.")
+
+;;; Find the largest power of 10 which is an Emacs float,
+;;; then back off by one so that any float d.dddd...eN
+;;; is an Emacs float, for acceptable d.dddd....
+
+(defvar math-largest-emacs-expt
+ (let ((x 1)
+ (pow 1e2))
+ ;; The following loop is for efficiency; it should stop when
+ ;; 10^(2x) is too large. This could be indicated by a range
+ ;; error when computing 10^(2x) or an infinite value for 10^(2x).
+ (while (and
+ pow
+ (< pow 1.0e+INF))
+ (setq x (* 2 x))
+ (setq pow (condition-case nil
+ (expt 10.0 (* 2 x))
+ (error nil))))
+ ;; The following loop should stop when 10^(x+1) is too large.
+ (setq pow (condition-case nil
+ (expt 10.0 (1+ x))
+ (error nil)))
+ (while (and
+ pow
+ (< pow 1.0e+INF))
+ (setq x (1+ x))
+ (setq pow (condition-case nil
+ (expt 10.0 (1+ x))
+ (error nil))))
+ (1- x))
+ "The largest exponent which Calc will convert to an Emacs float.")
+
+(defvar math-smallest-emacs-expt
+ (let ((x -1))
+ (while (condition-case nil
+ (> (expt 10.0 x) 0.0)
+ (error nil))
+ (setq x (* 2 x)))
+ (setq x (/ x 2))
+ (while (condition-case nil
+ (> (expt 10.0 x) 0.0)
+ (error nil))
+ (setq x (1- x)))
+ (+ x 2))
+ "The smallest exponent which Calc will convert to an Emacs float.")
+
+(defun math-use-emacs-fn (fn x)
+ "Use the native Emacs function FN to evaluate the Calc number X.
+If this can't be done, return NIL."
+ (and
+ (<= calc-internal-prec math-emacs-precision)
+ (math-realp x)
+ (let* ((fx (math-float x))
+ (xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x))))))
+ (and (<= math-smallest-emacs-expt xpon)
+ (<= xpon math-largest-emacs-expt)
+ (condition-case nil
+ (math-read-number
+ (number-to-string
+ (funcall fn
+ (string-to-number (math-format-number (math-float x))))))
+ (error nil))))))
+
(defun calc-sqrt (arg)
(interactive "P")
(calc-slow-wrapper
(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
(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
(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-coth (arg)
+ (interactive "P")
+ (calc-hyperbolic-func)
+ (calc-cot arg))
+
(defun calc-arctan2 ()
(interactive)
(calc-slow-wrapper
(calc-slow-wrapper
(calc-pop-push-record 1 "i*" (math-imaginary (calc-top-n 1)))))
-
-
(defun calc-to-degrees (arg)
(interactive "P")
(calc-wrapper
(let* ((top (nthcdr (- len 2) a)))
(math-isqrt-bignum-iter
a
- (math-scale-bignum-3
+ (math-scale-bignum-digit-size
(math-bignum-big
(1+ (math-isqrt-small
- (+ (* (nth 1 top) 1000) (car top)))))
+ (+ (* (nth 1 top) math-bignum-digit-size) (car top)))))
(1- (/ len 2)))))
(let* ((top (nth (1- len) a)))
(math-isqrt-bignum-iter
a
- (math-scale-bignum-3
+ (math-scale-bignum-digit-size
(list (1+ (math-isqrt-small top)))
(/ len 2)))))))
(while (eq (car (setq a (cdr a))) 0))
(null a))))
-(defun math-scale-bignum-3 (a n) ; [L L S]
+(defun math-scale-bignum-digit-size (a n) ; [L L S]
(while (> n 0)
(setq a (cons 0 a)
n (1- n)))
a)
(defun math-isqrt-small (a) ; A > 0. [S S]
- (let ((g (cond ((>= a 10000) 1000)
+ (let ((g (cond ((>= a 1000000) 10000)
+ ((>= a 10000) 1000)
((>= a 100) 100)
(t 10)))
g2)
(defun math-sqrt-raw (a &optional guess) ; [F F F]
(if (not (Math-posp a))
(math-sqrt a)
- (if (null guess)
- (let ((ldiff (- (math-numdigs (nth 1 a)) 6)))
- (or (= (% (+ (nth 2 a) ldiff) 2) 0) (setq ldiff (1+ ldiff)))
- (setq guess (math-make-float (math-isqrt-small
- (math-scale-int (nth 1 a) (- ldiff)))
- (/ (+ (nth 2 a) ldiff) 2)))))
- (math-sqrt-float-iter a guess)))
+ (cond
+ ((math-use-emacs-fn 'sqrt a))
+ (t
+ (if (null guess)
+ (let ((ldiff (- (math-numdigs (nth 1 a)) 6)))
+ (or (= (% (+ (nth 2 a) ldiff) 2) 0) (setq ldiff (1+ ldiff)))
+ (setq guess (math-make-float (math-isqrt-small
+ (math-scale-int (nth 1 a) (- ldiff)))
+ (/ (+ (nth 2 a) ldiff) 2)))))
+ (math-sqrt-float-iter a guess)))))
(defun math-sqrt-float-iter (a guess) ; [F F F]
(math-working "sqrt" guess)
(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)))
(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-csc-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.
((math-lessp-float x (math-neg (math-pi-over-4)))
(math-neg (math-cos-raw-2 (math-add (math-pi-over-2) x) orgx)))
((math-nearly-zerop-float x orgx) '(float 0 0))
+ ((math-use-emacs-fn 'sin x))
(calc-symbolic-mode (signal 'inexact-result nil))
(t (math-sin-series x 6 4 x (math-neg-float (math-sqr-float x)))))))
(defun math-cos-raw-2 (x orgx) ; [F F]
(cond ((math-nearly-zerop-float x orgx) '(float 1 0))
+ ((math-use-emacs-fn 'cos x))
(calc-symbolic-mode (signal 'inexact-result nil))
(t (let ((xnegsqr (math-neg-float (math-sqr-float x))))
(math-sin-series
((Math-integer-negp (nth 1 x))
(math-neg-float (math-arctan-raw (math-neg-float x))))
((math-zerop x) x)
+ ((math-use-emacs-fn 'atan x))
(calc-symbolic-mode (signal 'inexact-result nil))
((math-equal-int x 1) (math-pi-over-4))
((math-equal-int x -1) (math-neg (math-pi-over-4)))
(list 'polar
(math-exp-raw (nth 1 xc))
(math-from-radians (nth 2 xc)))))
+ ((math-use-emacs-fn 'exp x))
((or (math-lessp-float '(float 5 -1) x)
(math-lessp-float x '(float -5 -1)))
(if (math-lessp-float '(float 921035 1) x)
'(float 0 0))
(calc-symbolic-mode (signal 'inexact-result nil))
((math-posp (nth 1 x)) ; positive and real
- (let ((xdigs (1- (math-numdigs (nth 1 x)))))
- (math-add-float (math-ln-raw-2 (list 'float (nth 1 x) (- xdigs)))
- (math-mul-float (math-float (+ (nth 2 x) xdigs))
- (math-ln-10)))))
+ (cond
+ ((math-use-emacs-fn 'log x))
+ (t
+ (let ((xdigs (1- (math-numdigs (nth 1 x)))))
+ (math-add-float (math-ln-raw-2 (list 'float (nth 1 x) (- xdigs)))
+ (math-mul-float (math-float (+ (nth 2 x) xdigs))
+ (math-ln-10)))))))
((math-zerop x)
(math-reject-arg x "*Logarithm of zero"))
((eq calc-complex-mode 'polar) ; negative and real
sum
(math-lnp1-series nextsum (1+ n) nextx x))))
-(math-defcache math-ln-10 (float (bigpos 018 684 045 994 092 585 302 2) -21)
+(defconst math-approx-ln-10
+ (math-read-number-simple "2.302585092994045684018")
+ "An approximation for ln(10).")
+
+(math-defcache math-ln-10 math-approx-ln-10
(math-ln-raw-2 '(float 1 1)))
-(math-defcache math-ln-2 (float (bigpos 417 309 945 559 180 147 693) -21)
+(defconst math-approx-ln-2
+ (math-read-number-simple "0.693147180559945309417")
+ "An approximation for ln(2).")
+
+(math-defcache math-ln-2 math-approx-ln-2
(math-ln-raw-3 (math-float '(frac 1 3))))
(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