summaryrefslogtreecommitdiff
path: root/lisp/calc
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/calc')
-rw-r--r--lisp/calc/calc-alg.el128
-rw-r--r--lisp/calc/calc-arith.el8
-rw-r--r--lisp/calc/calc-ext.el15
-rw-r--r--lisp/calc/calc-math.el389
-rw-r--r--lisp/calc/calc-rules.el10
-rw-r--r--lisp/calc/calc-undo.el3
-rw-r--r--lisp/calc/calc-units.el39
-rw-r--r--lisp/calc/calcalg2.el83
-rw-r--r--lisp/calc/calccomp.el2
9 files changed, 666 insertions, 11 deletions
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 4901883d094..b722261907d 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -746,6 +746,55 @@
(list '* (list 'calcFunc-sin (list '* (1- n) a))
(list 'calcFunc-sin a))))))))
+(math-defsimplify calcFunc-sec
+ (or (and (math-looks-negp (nth 1 math-simplify-expr))
+ (list 'calcFunc-sec (math-neg (nth 1 math-simplify-expr))))
+ (and (eq calc-angle-mode 'rad)
+ (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
+ (and n
+ (math-div 1 (math-known-sin (car n) (nth 1 n) 120 300)))))
+ (and (eq calc-angle-mode 'deg)
+ (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
+ (and n
+ (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
+ (math-div
+ 1
+ (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
+ (math-div
+ 1
+ (nth 1 (nth 1 math-simplify-expr))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
+ (list 'calcFunc-sqrt
+ (math-add 1
+ (math-sqr (nth 1 (nth 1 math-simplify-expr))))))))
+
+(math-defsimplify calcFunc-csc
+ (or (and (math-looks-negp (nth 1 math-simplify-expr))
+ (math-neg (list 'calcFunc-csc (math-neg (nth 1 math-simplify-expr)))))
+ (and (eq calc-angle-mode 'rad)
+ (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
+ (and n
+ (math-div 1 (math-known-sin (car n) (nth 1 n) 120 0)))))
+ (and (eq calc-angle-mode 'deg)
+ (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
+ (and n
+ (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
+ (math-div 1 (nth 1 (nth 1 math-simplify-expr))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
+ (math-div
+ 1
+ (list 'calcFunc-sqrt (math-sub 1 (math-sqr
+ (nth 1 (nth 1 math-simplify-expr)))))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
+ (math-div (list 'calcFunc-sqrt
+ (math-add 1 (math-sqr
+ (nth 1 (nth 1 math-simplify-expr)))))
+ (nth 1 (nth 1 math-simplify-expr))))))
+
(defun math-should-expand-trig (x &optional hyperbolic)
(let ((m (math-is-multiple x)))
(and math-living-dangerously
@@ -827,6 +876,28 @@
(math-div (list 'calcFunc-sin (nth 1 math-simplify-expr))
(list 'calcFunc-cos (nth 1 math-simplify-expr))))))))
+(math-defsimplify calcFunc-cot
+ (or (and (math-looks-negp (nth 1 math-simplify-expr))
+ (math-neg (list 'calcFunc-cot (math-neg (nth 1 math-simplify-expr)))))
+ (and (eq calc-angle-mode 'rad)
+ (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
+ (and n
+ (math-div 1 (math-known-tan (car n) (nth 1 n) 120)))))
+ (and (eq calc-angle-mode 'deg)
+ (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
+ (and n
+ (math-div 1 (math-known-tan (car n) (nth 1 n) '(frac 2 3))))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
+ (math-div (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
+ (nth 1 (nth 1 math-simplify-expr))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
+ (math-div (nth 1 (nth 1 math-simplify-expr))
+ (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
+ (math-div 1 (nth 1 (nth 1 math-simplify-expr))))))
+
(defun math-known-tan (plus n mul)
(setq n (math-mul n mul))
(and (math-num-integerp n)
@@ -930,6 +1001,58 @@
(math-div (list 'calcFunc-sinh (nth 1 math-simplify-expr))
(list 'calcFunc-cosh (nth 1 math-simplify-expr))))))))
+(math-defsimplify calcFunc-sech
+ (or (and (math-looks-negp (nth 1 math-simplify-expr))
+ (list 'calcFunc-sech (math-neg (nth 1 math-simplify-expr))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
+ math-living-dangerously
+ (math-div
+ 1
+ (list 'calcFunc-sqrt
+ (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
+ math-living-dangerously
+ (math-div 1 (nth 1 (nth 1 math-simplify-expr))) 1)
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
+ math-living-dangerously
+ (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))))
+
+(math-defsimplify calcFunc-csch
+ (or (and (math-looks-negp (nth 1 math-simplify-expr))
+ (math-neg (list 'calcFunc-csch (math-neg (nth 1 math-simplify-expr)))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
+ math-living-dangerously
+ (math-div 1 (nth 1 (nth 1 math-simplify-expr))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
+ math-living-dangerously
+ (math-div
+ 1
+ (list 'calcFunc-sqrt
+ (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
+ math-living-dangerously
+ (math-div (list 'calcFunc-sqrt
+ (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
+ (nth 1 (nth 1 math-simplify-expr))))))
+
+(math-defsimplify calcFunc-coth
+ (or (and (math-looks-negp (nth 1 math-simplify-expr))
+ (math-neg (list 'calcFunc-coth (math-neg (nth 1 math-simplify-expr)))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
+ math-living-dangerously
+ (math-div (list 'calcFunc-sqrt
+ (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))
+ (nth 1 (nth 1 math-simplify-expr))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
+ math-living-dangerously
+ (math-div (nth 1 (nth 1 math-simplify-expr))
+ (list 'calcFunc-sqrt
+ (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
+ (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
+ math-living-dangerously
+ (math-div 1 (nth 1 (nth 1 math-simplify-expr))))))
+
(math-defsimplify calcFunc-arcsin
(or (and (math-looks-negp (nth 1 math-simplify-expr))
(math-neg (list 'calcFunc-arcsin (math-neg (nth 1 math-simplify-expr)))))
@@ -1043,8 +1166,13 @@
(math-equal-int (nth 2 a) 2)
(or (and (eq (car-safe (nth 1 a)) 'calcFunc-sinh)
(list 'calcFunc-cosh (nth 1 (nth 1 a))))
+ (and (eq (car-safe (nth 1 a)) 'calcFunc-csch)
+ (list 'calcFunc-coth (nth 1 (nth 1 a))))
(and (eq (car-safe (nth 1 a)) 'calcFunc-tan)
(list '/ 1 (list 'calcFunc-cos
+ (nth 1 (nth 1 a)))))
+ (and (eq (car-safe (nth 1 a)) 'calcFunc-cot)
+ (list '/ 1 (list 'calcFunc-sin
(nth 1 (nth 1 a)))))))))
(and (eq (car-safe (nth 1 math-simplify-expr)) '^)
(list '^
diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el
index 3a436cb1d36..38c10f5cc9f 100644
--- a/lisp/calc/calc-arith.el
+++ b/lisp/calc/calc-arith.el
@@ -70,9 +70,13 @@
calcFunc-max calcFunc-min))
(defvar math-real-if-arg-functions '(calcFunc-sin calcFunc-cos
- calcFunc-tan calcFunc-arctan
+ calcFunc-tan calcFunc-sec
+ calcFunc-csc calcFunc-cot
+ calcFunc-arctan
calcFunc-sinh calcFunc-cosh
- calcFunc-tanh calcFunc-exp
+ calcFunc-tanh calcFunc-sech
+ calcFunc-csch calcFunc-coth
+ calcFunc-exp
calcFunc-gamma calcFunc-fact))
(defvar math-integer-functions '(calcFunc-idiv
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 374e89ec1f1..d4d50d64658 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -801,13 +801,16 @@ math-mul-mat-vec math-mul-mats math-row-matrix)
("calc-math" calcFunc-alog calcFunc-arccos
calcFunc-arccosh calcFunc-arcsin calcFunc-arcsincos calcFunc-arcsinh
-calcFunc-arctan calcFunc-arctan2 calcFunc-arctanh calcFunc-cos
-calcFunc-cosh calcFunc-deg calcFunc-exp calcFunc-exp10 calcFunc-expm1
+calcFunc-arctan calcFunc-arctan2 calcFunc-arctanh calcFunc-csc
+calcFunc-csch calcFunc-cos calcFunc-cosh calcFunc-cot calcFunc-coth
+calcFunc-deg calcFunc-exp calcFunc-exp10 calcFunc-expm1
calcFunc-hypot calcFunc-ilog calcFunc-isqrt calcFunc-ln calcFunc-lnp1
-calcFunc-log calcFunc-log10 calcFunc-nroot calcFunc-rad calcFunc-sin
+calcFunc-log calcFunc-log10 calcFunc-nroot calcFunc-rad calcFunc-sec
+calcFunc-sech calcFunc-sin
calcFunc-sincos calcFunc-sinh calcFunc-sqr calcFunc-sqrt calcFunc-tan
calcFunc-tanh math-arccos-raw math-arcsin-raw math-arctan-raw
-math-arctan2-raw math-cos-raw math-exp-minus-1-raw math-exp-raw
+math-arctan2-raw math-cos-raw math-cot-raw math-csc-raw
+math-exp-minus-1-raw math-exp-raw
math-from-radians math-from-radians-2 math-hypot math-infinite-dir
math-isqrt-small math-ln-raw math-nearly-equal math-nearly-equal-float
math-nearly-zerop math-nearly-zerop-float math-nth-root
@@ -1008,9 +1011,11 @@ calc-map-equation calc-map-stack calc-outer-product calc-reduce)
("calc-math" calc-arccos calc-arccosh calc-arcsin calc-arcsinh
calc-arctan calc-arctan2 calc-arctanh calc-conj calc-cos calc-cosh
+calc-cot calc-coth calc-csc calc-csch
calc-degrees-mode calc-exp calc-expm1 calc-hypot calc-ilog
calc-imaginary calc-isqrt calc-ln calc-lnp1 calc-log calc-log10
-calc-pi calc-radians-mode calc-sin calc-sincos calc-sinh calc-sqrt
+calc-pi calc-radians-mode calc-sec calc-sech
+calc-sin calc-sincos calc-sinh calc-sqrt
calc-tan calc-tanh calc-to-degrees calc-to-radians)
("calc-mode" calc-alg-simplify-mode calc-algebraic-mode
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 02c65ac22ea..d2c66c34d49 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-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.
@@ -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
diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el
index 1ccbf3fffac..7a11cfa5012 100644
--- a/lisp/calc/calc-rules.el
+++ b/lisp/calc/calc-rules.el
@@ -153,10 +153,14 @@ tan(select(2 a)) := 2 tan(select(a)) / (1 - tan(a)^2),
tan(select(n a)) := (tan((n-1) select(a)) + tan(a)) /
(1 - tan((n-1) a) tan(a))
:: integer(n) :: n > 2,
+cot(select(a + b)) := (cot(select(a)) cot(b) - 1) /
+ (cot(a) + cot(b)),
sinh(select(a + b)) := sinh(select(a)) cosh(b) + cosh(a) sinh(b),
cosh(select(a + b)) := cosh(select(a)) cosh(b) + sinh(a) sinh(b),
tanh(select(a + b)) := (tanh(select(a)) + tanh(b)) /
(1 + tanh(a) tanh(b)),
+coth(select(a + b)) := (coth(select(a)) coth(b) + 1) /
+ (coth(a) + coth(b)),
x && select(a || b) := (x && select(a)) || (x && b),
select(a || b) && x := (select(a) && x) || (b && x),
! select(a && b) := (!a) || (!b),
@@ -269,12 +273,18 @@ exp(select(x)) := 1 / exp(select(-x)),
sin(select(x)) := -sin(select(-x)),
cos(select(x)) := cos(select(-x)),
tan(select(x)) := -tan(select(-x)),
+sec(select(x)) := sec(select(-x)),
+csc(select(x)) := -csc(select(-x)),
+cot(select(x)) := -cot(select(-x)),
arcsin(select(x)) := -arcsin(select(-x)),
arccos(select(x)) := 4 arctan(1) - arccos(select(-x)),
arctan(select(x)) := -arctan(select(-x)),
sinh(select(x)) := -sinh(select(-x)),
cosh(select(x)) := cosh(select(-x)),
tanh(select(x)) := -tanh(select(-x)),
+sech(select(x)) := sech(select(-x)),
+csch(select(x)) := -csch(select(-x)),
+coth(select(x)) := -coth(select(-x)),
arcsinh(select(x)) := -arcsinh(select(-x)),
arctanh(select(x)) := -arctanh(select(-x)),
select(x) = a := select(-x) = -a,
diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el
index a49c34010ab..d946a1390d3 100644
--- a/lisp/calc/calc-undo.el
+++ b/lisp/calc/calc-undo.el
@@ -77,7 +77,8 @@
(let ((v (intern (nth 1 action))))
(calc-record-undo (list 'store (nth 1 action)
(and (boundp v) (symbol-value v))))
- (if (y-or-n-p (format "Un-store variable %s? " (nth 1 action)))
+ (if (y-or-n-p (format "Un-store variable %s? "
+ (calc-var-name (nth 1 action))))
(progn
(if (nth 2 action)
(set v (nth 2 action))
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index e8a3abfe958..4b3c284ddad 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -1241,6 +1241,45 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
(eq (nth 1 (nth 2 rad)) 'rad)
(list 'calcFunc-tan (nth 1 rad))))))
+(math-defsimplify calcFunc-sec
+ (and math-simplifying-units
+ (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
+ (let ((rad (math-simplify-units
+ (math-evaluate-expr
+ (math-to-standard-units (nth 1 math-simplify-expr) nil))))
+ (calc-angle-mode 'rad))
+ (and (eq (car-safe rad) '*)
+ (math-realp (nth 1 rad))
+ (eq (car-safe (nth 2 rad)) 'var)
+ (eq (nth 1 (nth 2 rad)) 'rad)
+ (list 'calcFunc-sec (nth 1 rad))))))
+
+(math-defsimplify calcFunc-csc
+ (and math-simplifying-units
+ (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
+ (let ((rad (math-simplify-units
+ (math-evaluate-expr
+ (math-to-standard-units (nth 1 math-simplify-expr) nil))))
+ (calc-angle-mode 'rad))
+ (and (eq (car-safe rad) '*)
+ (math-realp (nth 1 rad))
+ (eq (car-safe (nth 2 rad)) 'var)
+ (eq (nth 1 (nth 2 rad)) 'rad)
+ (list 'calcFunc-csc (nth 1 rad))))))
+
+(math-defsimplify calcFunc-cot
+ (and math-simplifying-units
+ (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
+ (let ((rad (math-simplify-units
+ (math-evaluate-expr
+ (math-to-standard-units (nth 1 math-simplify-expr) nil))))
+ (calc-angle-mode 'rad))
+ (and (eq (car-safe rad) '*)
+ (math-realp (nth 1 rad))
+ (eq (car-safe (nth 2 rad)) 'var)
+ (eq (nth 1 (nth 2 rad)) 'rad)
+ (list 'calcFunc-cot (nth 1 rad))))))
+
(defun math-remove-units (expr)
(if (math-check-unit-name expr)
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index 18b6c1328d7..d5a9009c1ac 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -412,6 +412,30 @@
(math-normalize
(list 'calcFunc-cos u))))))))
+(put 'calcFunc-sec\' 'math-derivative-1
+ (function (lambda (u) (math-to-radians-2
+ (math-mul
+ (math-normalize
+ (list 'calcFunc-sec u))
+ (math-normalize
+ (list 'calcFunc-tan u)))))))
+
+(put 'calcFunc-csc\' 'math-derivative-1
+ (function (lambda (u) (math-neg
+ (math-to-radians-2
+ (math-mul
+ (math-normalize
+ (list 'calcFunc-csc u))
+ (math-normalize
+ (list 'calcFunc-cot u))))))))
+
+(put 'calcFunc-cot\' 'math-derivative-1
+ (function (lambda (u) (math-neg
+ (math-to-radians-2
+ (math-div 1 (math-sqr
+ (math-normalize
+ (list 'calcFunc-sin u)))))))))
+
(put 'calcFunc-arcsin\' 'math-derivative-1
(function (lambda (u)
(math-from-radians-2
@@ -441,6 +465,24 @@
(math-normalize
(list 'calcFunc-cosh u)))))))
+(put 'calcFunc-sech\' 'math-derivative-1
+ (function (lambda (u) (math-neg
+ (math-mul
+ (math-normalize (list 'calcFunc-sech u))
+ (math-normalize (list 'calcFunc-tanh u)))))))
+
+(put 'calcFunc-csch\' 'math-derivative-1
+ (function (lambda (u) (math-neg
+ (math-mul
+ (math-normalize (list 'calcFunc-csch u))
+ (math-normalize (list 'calcFunc-coth u)))))))
+
+(put 'calcFunc-tanh\' 'math-derivative-1
+ (function (lambda (u) (math-neg
+ (math-div 1 (math-sqr
+ (math-normalize
+ (list 'calcFunc-sinh u))))))))
+
(put 'calcFunc-arcsinh\' 'math-derivative-1
(function (lambda (u)
(math-div 1 (math-normalize
@@ -1053,7 +1095,10 @@
(while (and p
(memq (car (car p)) '(calcFunc-sin
calcFunc-cos
- calcFunc-tan))
+ calcFunc-tan
+ calcFunc-sec
+ calcFunc-csc
+ calcFunc-cot))
(equal (nth 1 (car p)) math-integ-var))
(setq p (cdr p)))
(null p))
@@ -1068,6 +1113,9 @@
(memq (car (car p)) '(calcFunc-sinh
calcFunc-cosh
calcFunc-tanh
+ calcFunc-sech
+ calcFunc-csch
+ calcFunc-coth
calcFunc-exp))
(equal (nth 1 (car p)) math-integ-var))
(setq p (cdr p)))
@@ -1619,6 +1667,27 @@
(math-neg (math-from-radians-2
(list 'calcFunc-ln (list 'calcFunc-cos u))))))
+(math-defintegral calcFunc-sec
+ (and (equal u math-integ-var)
+ (math-from-radians-2
+ (list 'calcFunc-ln
+ (math-add
+ (list 'calcFunc-sec u)
+ (list 'calcFunc-tan u))))))
+
+(math-defintegral calcFunc-csc
+ (and (equal u math-integ-var)
+ (math-from-radians-2
+ (list 'calcFunc-ln
+ (math-sub
+ (list 'calcFunc-csc u)
+ (list 'calcFunc-cot u))))))
+
+(math-defintegral calcFunc-cot
+ (and (equal u math-integ-var)
+ (math-from-radians-2
+ (list 'calcFunc-ln (list 'calcFunc-sin u)))))
+
(math-defintegral calcFunc-arcsin
(and (equal u math-integ-var)
(math-add (math-mul u (list 'calcFunc-arcsin u))
@@ -1650,6 +1719,18 @@
(and (equal u math-integ-var)
(list 'calcFunc-ln (list 'calcFunc-cosh u))))
+(math-defintegral calcFunc-sech
+ (and (equal u math-integ-var)
+ (list 'calcFunc-arctan (list 'calcFunc-sinh u))))
+
+(math-defintegral calcFunc-csch
+ (and (equal u math-integ-var)
+ (list 'calcFunc-ln (list 'calcFunc-tanh (math-div u 2)))))
+
+(math-defintegral calcFunc-coth
+ (and (equal u math-integ-var)
+ (list 'calcFunc-ln (list 'calcFunc-sinh u))))
+
(math-defintegral calcFunc-arcsinh
(and (equal u math-integ-var)
(math-sub (math-mul u (list 'calcFunc-arcsinh u))
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index eff7df2373d..305e155843e 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -35,7 +35,9 @@
'( calcFunc-log
calcFunc-ln calcFunc-exp
calcFunc-sin calcFunc-cos calcFunc-tan
+ calcFunc-sec calcFunc-csc calcFunc-cot
calcFunc-sinh calcFunc-cosh calcFunc-tanh
+ calcFunc-sech calcFunc-csch calcFunc-coth
calcFunc-arcsin calcFunc-arccos calcFunc-arctan
calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-28 10:22:08 +0000