aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJay Belanger2005-02-19 05:36:21 +0000
committerJay Belanger2005-02-19 05:36:21 +0000
commit7db3d0d59e2ccd113de32d6551cacaee49f674c4 (patch)
treeb9c7c70eb2267a3dc358e11e1c1f38002c72f825
parent9efdfc10ec2c6f8953421aaacf5573b038063807 (diff)
downloademacs-7db3d0d59e2ccd113de32d6551cacaee49f674c4.tar.gz
emacs-7db3d0d59e2ccd113de32d6551cacaee49f674c4.zip
(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.
-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 38c10f5cc9f..d9acc2ebc52 100644
--- a/lisp/calc/calc-arith.el
+++ b/lisp/calc/calc-arith.el
@@ -1609,6 +1609,50 @@
1609 (math-reject-arg b "*Division by zero")) 1609 (math-reject-arg b "*Division by zero"))
1610 a)))) 1610 a))))
1611 1611
1612;; For math-div-symb-fancy
1613(defvar math-trig-inverses
1614 '((calcFunc-sin . calcFunc-csc)
1615 (calcFunc-cos . calcFunc-sec)
1616 (calcFunc-tan . calcFunc-cot)
1617 (calcFunc-sec . calcFunc-cos)
1618 (calcFunc-csc . calcFunc-sin)
1619 (calcFunc-cot . calcFunc-tan)
1620 (calcFunc-sinh . calcFunc-csch)
1621 (calcFunc-cosh . calcFunc-sech)
1622 (calcFunc-tanh . calcFunc-coth)
1623 (calcFunc-sech . calcFunc-cosh)
1624 (calcFunc-csch . calcFunc-sinh)
1625 (calcFunc-coth . calcFunc-tanh)))
1626
1627(defvar math-div-trig)
1628(defvar math-div-non-trig)
1629
1630(defun math-div-new-trig (tr)
1631 (if math-div-trig
1632 (setq math-div-trig
1633 (list '* tr math-div-trig))
1634 (setq math-div-trig tr)))
1635
1636(defun math-div-new-non-trig (ntr)
1637 (if math-div-non-trig
1638 (setq math-div-non-trig
1639 (list '* ntr math-div-non-trig))
1640 (setq math-div-non-trig ntr)))
1641
1642(defun math-div-isolate-trig (expr)
1643 (if (eq (car-safe expr) '*)
1644 (progn
1645 (math-div-isolate-trig-term (nth 1 expr))
1646 (math-div-isolate-trig (nth 2 expr)))
1647 (math-div-isolate-trig-term expr)))
1648
1649(defun math-div-isolate-trig-term (term)
1650 (let ((fn (assoc (car-safe term) math-trig-inverses)))
1651 (if fn
1652 (math-div-new-trig
1653 (cons (cdr fn) (cdr term)))
1654 (math-div-new-non-trig term))))
1655
1612(defun math-div-symb-fancy (a b) 1656(defun math-div-symb-fancy (a b)
1613 (or (and math-simplify-only 1657 (or (and math-simplify-only
1614 (not (equal a math-simplify-only)) 1658 (not (equal a math-simplify-only))
@@ -1667,6 +1711,15 @@
1667 (list 'calcFunc-idn (math-div a (nth 1 b)))) 1711 (list 'calcFunc-idn (math-div a (nth 1 b))))
1668 (and (math-known-matrixp a) 1712 (and (math-known-matrixp a)
1669 (math-div a (nth 1 b))))) 1713 (math-div a (nth 1 b)))))
1714 (and math-simplifying
1715 (let ((math-div-trig nil)
1716 (math-div-non-trig nil))
1717 (math-div-isolate-trig b)
1718 (if math-div-trig
1719 (if math-div-non-trig
1720 (math-div (math-mul a math-div-trig) math-div-non-trig)
1721 (math-mul a math-div-trig))
1722 nil)))
1670 (if (and calc-matrix-mode 1723 (if (and calc-matrix-mode
1671 (or (math-known-matrixp a) (math-known-matrixp b))) 1724 (or (math-known-matrixp a) (math-known-matrixp b)))
1672 (math-combine-prod a b nil t nil) 1725 (math-combine-prod a b nil t nil)
@@ -2674,6 +2727,8 @@
2674 invb 2727 invb
2675 (math-looks-negp (nth 2 b))) 2728 (math-looks-negp (nth 2 b)))
2676 (math-mul a (math-pow (nth 1 b) (math-neg (nth 2 b))))) 2729 (math-mul a (math-pow (nth 1 b) (math-neg (nth 2 b)))))
2730 ((and math-simplifying
2731 (math-combine-prod-trig a b)))
2677 (t (let ((apow 1) (bpow 1)) 2732 (t (let ((apow 1) (bpow 1))
2678 (and (consp a) 2733 (and (consp a)
2679 (cond ((and (eq (car a) '^) 2734 (cond ((and (eq (car a) '^)
@@ -2771,6 +2826,83 @@
2771 (math-pow a apow) 2826 (math-pow a apow)
2772 (inexact-result (list '^ a apow))))))))))) 2827 (inexact-result (list '^ a apow)))))))))))
2773 2828
2829(defun math-combine-prod-trig (a b)
2830 (cond
2831 ((and (eq (car-safe a) 'calcFunc-sin)
2832 (eq (car-safe b) 'calcFunc-csc)
2833 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2834 1)
2835 ((and (eq (car-safe a) 'calcFunc-sin)
2836 (eq (car-safe b) 'calcFunc-sec)
2837 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2838 (cons 'calcFunc-tan (cdr a)))
2839 ((and (eq (car-safe a) 'calcFunc-sin)
2840 (eq (car-safe b) 'calcFunc-cot)
2841 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2842 (cons 'calcFunc-cos (cdr a)))
2843 ((and (eq (car-safe a) 'calcFunc-cos)
2844 (eq (car-safe b) 'calcFunc-sec)
2845 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2846 1)
2847 ((and (eq (car-safe a) 'calcFunc-cos)
2848 (eq (car-safe b) 'calcFunc-csc)
2849 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2850 (cons 'calcFunc-cot (cdr a)))
2851 ((and (eq (car-safe a) 'calcFunc-cos)
2852 (eq (car-safe b) 'calcFunc-tan)
2853 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2854 (cons 'calcFunc-sin (cdr a)))
2855 ((and (eq (car-safe a) 'calcFunc-tan)
2856 (eq (car-safe b) 'calcFunc-cot)
2857 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2858 1)
2859 ((and (eq (car-safe a) 'calcFunc-tan)
2860 (eq (car-safe b) 'calcFunc-csc)
2861 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2862 (cons 'calcFunc-sec (cdr a)))
2863 ((and (eq (car-safe a) 'calcFunc-sec)
2864 (eq (car-safe b) 'calcFunc-cot)
2865 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2866 (cons 'calcFunc-csc (cdr a)))
2867 ((and (eq (car-safe a) 'calcFunc-sinh)
2868 (eq (car-safe b) 'calcFunc-csch)
2869 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2870 1)
2871 ((and (eq (car-safe a) 'calcFunc-sinh)
2872 (eq (car-safe b) 'calcFunc-sech)
2873 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2874 (cons 'calcFunc-tanh (cdr a)))
2875 ((and (eq (car-safe a) 'calcFunc-sinh)
2876 (eq (car-safe b) 'calcFunc-coth)
2877 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2878 (cons 'calcFunc-cosh (cdr a)))
2879 ((and (eq (car-safe a) 'calcFunc-cosh)
2880 (eq (car-safe b) 'calcFunc-sech)
2881 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2882 1)
2883 ((and (eq (car-safe a) 'calcFunc-cosh)
2884 (eq (car-safe b) 'calcFunc-csch)
2885 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2886 (cons 'calcFunc-coth (cdr a)))
2887 ((and (eq (car-safe a) 'calcFunc-cosh)
2888 (eq (car-safe b) 'calcFunc-tanh)
2889 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2890 (cons 'calcFunc-sinh (cdr a)))
2891 ((and (eq (car-safe a) 'calcFunc-tanh)
2892 (eq (car-safe b) 'calcFunc-coth)
2893 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2894 1)
2895 ((and (eq (car-safe a) 'calcFunc-tanh)
2896 (eq (car-safe b) 'calcFunc-csch)
2897 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2898 (cons 'calcFunc-sech (cdr a)))
2899 ((and (eq (car-safe a) 'calcFunc-sech)
2900 (eq (car-safe b) 'calcFunc-coth)
2901 (= 0 (math-simplify (math-sub (cdr a) (cdr b)))))
2902 (cons 'calcFunc-csch (cdr a)))
2903 (t
2904 nil)))
2905
2774(defun math-mul-or-div (a b ainv binv) 2906(defun math-mul-or-div (a b ainv binv)
2775 (if (or (Math-vectorp a) (Math-vectorp b)) 2907 (if (or (Math-vectorp a) (Math-vectorp b))
2776 (math-normalize 2908 (math-normalize