diff options
| author | Jay Belanger | 2005-02-19 05:36:21 +0000 |
|---|---|---|
| committer | Jay Belanger | 2005-02-19 05:36:21 +0000 |
| commit | 7db3d0d59e2ccd113de32d6551cacaee49f674c4 (patch) | |
| tree | b9c7c70eb2267a3dc358e11e1c1f38002c72f825 | |
| parent | 9efdfc10ec2c6f8953421aaacf5573b038063807 (diff) | |
| download | emacs-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.el | 132 |
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 |