(math-trig-rewrite, math-hyperbolic-trig-rewrite): New functions.

(calc-simplify): Simplify trig functions when asked.

2 files changed, 58 insertions, 2 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6d4db938378..eb11c0aaa8c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2009-08-24  Jay Belanger  <jay.p.belanger@gmail.com>
+
+        * calc/calc-alg.el (math-trig-rewrite)
+        (math-hyperbolic-trig-rewrite): New functions.
+        (calc-simplify): Simplify trig functions when asked.
+
 2009-08-24  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * diff-mode.el (diff-find-source-location): Avoid goto-line.
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 9b3083f83d3..f4be1a5e036 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -51,8 +51,17 @@
 (defun calc-simplify ()
   (interactive)
   (calc-slow-wrapper
-   (calc-with-default-simplification
-    (calc-enter-result 1 "simp" (math-simplify (calc-top-n 1))))))
+   (let ((top (calc-top-n 1)))
+     (if (calc-is-inverse)
+         (setq top 
+               (let ((calc-simplify-mode nil))
+                 (math-normalize (math-trig-rewrite top)))))
+     (if (calc-is-hyperbolic)
+         (setq top 
+               (let ((calc-simplify-mode nil))
+                 (math-normalize (math-hyperbolic-trig-rewrite top)))))
+     (calc-with-default-simplification
+      (calc-enter-result 1 "simp" (math-simplify top))))))
 
 (defun calc-simplify-extended ()
   (interactive)
@@ -303,6 +312,47 @@
 
 (defalias 'calcFunc-esimplify 'math-simplify-extended)
 
+;;; Rewrite the trig functions in a form easier to simplify.
+(defun math-trig-rewrite (fn)
+  "Rewrite trigonometric functions in terms of sines and cosines."
+  (cond
+   ((not (consp fn))
+    fn)
+   ((eq (car-safe fn) 'calcFunc-sec)
+    (list '/ 1 (cons 'calcFunc-cos (math-trig-rewrite (cdr fn)))))
+   ((eq (car-safe fn) 'calcFunc-csc)
+    (list '/ 1 (cons 'calcFunc-sin (math-trig-rewrite (cdr fn)))))
+   ((eq (car-safe fn) 'calcFunc-tan)
+    (let ((newfn (math-trig-rewrite (cdr fn))))
+      (list '/ (cons 'calcFunc-sin newfn)
+            (cons 'calcFunc-cos newfn))))
+   ((eq (car-safe fn) 'calcFunc-cot)
+    (let ((newfn (math-trig-rewrite (cdr fn))))
+      (list '/ (cons 'calcFunc-cos newfn)
+            (cons 'calcFunc-sin newfn))))
+   (t
+    (mapcar 'math-trig-rewrite fn))))
+
+(defun math-hyperbolic-trig-rewrite (fn)
+  "Rewrite hyperbolic functions in terms of sinhs and coshs."
+  (cond
+   ((not (consp fn))
+    fn)
+   ((eq (car-safe fn) 'calcFunc-sech)
+    (list '/ 1 (cons 'calcFunc-cosh (math-hyperbolic-trig-rewrite (cdr fn)))))
+   ((eq (car-safe fn) 'calcFunc-csch)
+    (list '/ 1 (cons 'calcFunc-sinh (math-hyperbolic-trig-rewrite (cdr fn)))))
+   ((eq (car-safe fn) 'calcFunc-tanh)
+    (let ((newfn (math-hyperbolic-trig-rewrite (cdr fn))))
+      (list '/ (cons 'calcFunc-sinh newfn)
+            (cons 'calcFunc-cosh newfn))))
+   ((eq (car-safe fn) 'calcFunc-coth)
+    (let ((newfn (math-hyperbolic-trig-rewrite (cdr fn))))
+      (list '/ (cons 'calcFunc-cosh newfn)
+            (cons 'calcFunc-sinh newfn))))
+   (t
+    (mapcar 'math-hyperbolic-trig-rewrite fn))))
+
 ;; math-top-only is local to math-simplify, but is used by 
 ;; math-simplify-step, which is called by math-simplify.
 (defvar math-top-only)