Mercurial > emacs

changeset 60154:71985e6ee53a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Jay Belanger <jay.p.belanger@gmail.com>
date Sat, 19 Feb 2005 05:36:21 +0000
parents 10993bad7aee
children e0ecc22c6459
files lisp/calc/calc-arith.el
diffstat 1 files changed, 132 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/calc/calc-arith.el	Sat Feb 19 05:08:49 2005 +0000
+++ b/lisp/calc/calc-arith.el	Sat Feb 19 05:36:21 2005 +0000
@@ -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