summaryrefslogtreecommitdiff
path: root/lisp/calc/calc-arith.el
diff options
context:
space:
mode:
authorJay Belanger <jay.p.belanger@gmail.com>2005-02-19 05:36:21 +0000
committerJay Belanger <jay.p.belanger@gmail.com>2005-02-19 05:36:21 +0000
commit7db3d0d59e2ccd113de32d6551cacaee49f674c4 (patch)
treeb9c7c70eb2267a3dc358e11e1c1f38002c72f825 /lisp/calc/calc-arith.el
parent9efdfc10ec2c6f8953421aaacf5573b038063807 (diff)
(math-trig-inverses, math-div-trig, math-div-non-trig): New variables.
(math-combine-prod-trig, math-div-new-trig, math-div-new-non-trig) (math-div-isolate-trig, math-div-isolate-trig-term): New functions. (math-combine-prod, math-div-symb-fancy): Add simplifications for trig expressions.
Diffstat (limited to 'lisp/calc/calc-arith.el')
-rw-r--r--lisp/calc/calc-arith.el132
1 files changed, 132 insertions, 0 deletions
diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el
index 38c10f5cc9..d9acc2ebc5 100644
--- a/lisp/calc/calc-arith.el
+++ b/lisp/calc/calc-arith.el
@@ -1609,6 +1609,50 @@
(math-reject-arg b "*Division by zero"))
a))))
+;; For math-div-symb-fancy
+(defvar math-trig-inverses
+ '((calcFunc-sin . calcFunc-csc)
+ (calcFunc-cos . calcFunc-sec)
+ (calcFunc-tan . calcFunc-cot)
+ (calcFunc-sec . calcFunc-cos)
+ (calcFunc-csc . calcFunc-sin)
+ (calcFunc-cot . calcFunc-tan)
+ (calcFunc-sinh . calcFunc-csch)
+ (calcFunc-cosh . calcFunc-sech)
+ (calcFunc-tanh . calcFunc-coth)
+ (calcFunc-sech . calcFunc-cosh)
+ (calcFunc-csch . calcFunc-sinh)
+ (calcFunc-coth . calcFunc-tanh)))
+
+(defvar math-div-trig)
+(defvar math-div-non-trig)
+
+(defun math-div-new-trig (tr)
+ (if math-div-trig
+ (setq math-div-trig
+ (list '* tr math-div-trig))
+ (setq math-div-trig tr)))
+
+(defun math-div-new-non-trig (ntr)
+ (if math-div-non-trig
+ (setq math-div-non-trig
+ (list '* ntr math-div-non-trig))
+ (setq math-div-non-trig ntr)))
+
+(defun math-div-isolate-trig (expr)
+ (if (eq (car-safe expr) '*)
+ (progn
+ (math-div-isolate-trig-term (nth 1 expr))
+ (math-div-isolate-trig (nth 2 expr)))
+ (math-div-isolate-trig-term expr)))
+
+(defun math-div-isolate-trig-term (term)
+ (let ((fn (assoc (car-safe term) math-trig-inverses)))
+ (if fn
+ (math-div-new-trig
+ (cons (cdr fn) (cdr term)))
+ (math-div-new-non-trig term))))
+
(defun math-div-symb-fancy (a b)
(or (and math-simplify-only
(not (equal a math-simplify-only))
@@ -1667,6 +1711,15 @@
(list 'calcFunc-idn (math-div a (nth 1 b))))
(and (math-known-matrixp a)
(math-div a (nth 1 b)))))
+ (and math-simplifying
+ (let ((math-div-trig nil)
+ (math-div-non-trig nil))
+ (math-div-isolate-trig b)
+ (if math-div-trig
+ (if math-div-non-trig
+ (math-div (math-mul a math-div-trig) math-div-non-trig)
+ (math-mul a math-div-trig))
+ nil)))
(if (and calc-matrix-mode
(or (math-known-matrixp a) (math-known-matrixp b)))
(math-combine-prod a b nil t nil)
@@ -2674,6 +2727,8 @@
invb
(math-looks-negp (nth 2 b)))
(math-mul a (math-pow (nth 1 b) (math-neg (nth 2 b)))))
+ ((and math-simplifying
+ (math-combine-prod-trig a b)))
(t (let ((apow 1) (bpow 1))
(and (consp a)
(cond ((and (eq (car a) '^)
@@ -2771,6 +2826,83 @@
(math-pow a apow)
(inexact-result (list '^ a apow)))))))))))
+(defun math-combine-prod-trig (a b)
+ (cond
+ ((and (eq (car-safe a) 'calcFunc-sin)
+ (eq (car-safe b) 'calcFunc-csc)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ 1)
+ ((and (eq (car-safe a) 'calcFunc-sin)
+ (eq (car-safe b) 'calcFunc-sec)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-tan (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-sin)
+ (eq (car-safe b) 'calcFunc-cot)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-cos (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-cos)
+ (eq (car-safe b) 'calcFunc-sec)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ 1)
+ ((and (eq (car-safe a) 'calcFunc-cos)
+ (eq (car-safe b) 'calcFunc-csc)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-cot (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-cos)
+ (eq (car-safe b) 'calcFunc-tan)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-sin (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-tan)
+ (eq (car-safe b) 'calcFunc-cot)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ 1)
+ ((and (eq (car-safe a) 'calcFunc-tan)
+ (eq (car-safe b) 'calcFunc-csc)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-sec (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-sec)
+ (eq (car-safe b) 'calcFunc-cot)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-csc (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-sinh)
+ (eq (car-safe b) 'calcFunc-csch)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ 1)
+ ((and (eq (car-safe a) 'calcFunc-sinh)
+ (eq (car-safe b) 'calcFunc-sech)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-tanh (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-sinh)
+ (eq (car-safe b) 'calcFunc-coth)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-cosh (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-cosh)
+ (eq (car-safe b) 'calcFunc-sech)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ 1)
+ ((and (eq (car-safe a) 'calcFunc-cosh)
+ (eq (car-safe b) 'calcFunc-csch)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-coth (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-cosh)
+ (eq (car-safe b) 'calcFunc-tanh)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-sinh (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-tanh)
+ (eq (car-safe b) 'calcFunc-coth)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ 1)
+ ((and (eq (car-safe a) 'calcFunc-tanh)
+ (eq (car-safe b) 'calcFunc-csch)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-sech (cdr a)))
+ ((and (eq (car-safe a) 'calcFunc-sech)
+ (eq (car-safe b) 'calcFunc-coth)
+ (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
+ (cons 'calcFunc-csch (cdr a)))
+ (t
+ nil)))
+
(defun math-mul-or-div (a b ainv binv)
(if (or (Math-vectorp a) (Math-vectorp b))
(math-normalize