3 |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: David Gillespie <daveg@synaptics.com> |
;; Author: David Gillespie <daveg@synaptics.com> |
6 |
;; Maintainers: D. Goel <deego@gnufans.org> |
;; Maintainer: Jay Belanger <belanger@truman.edu> |
|
;; Colin Walters <walters@debian.org> |
|
7 |
|
|
8 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
9 |
|
|
939 |
(math-simplify a))) |
(math-simplify a))) |
940 |
(defalias 'calcFunc-usimplify 'math-simplify-units) |
(defalias 'calcFunc-usimplify 'math-simplify-units) |
941 |
|
|
942 |
|
;; The function created by math-defsimplify uses the variable |
943 |
|
;; math-simplify-expr, and so is used by functions in math-defsimplify |
944 |
|
(defvar math-simplify-expr) |
945 |
|
|
946 |
(math-defsimplify (+ -) |
(math-defsimplify (+ -) |
947 |
(and math-simplifying-units |
(and math-simplifying-units |
948 |
(math-units-in-expr-p (nth 1 expr) nil) |
(math-units-in-expr-p (nth 1 math-simplify-expr) nil) |
949 |
(let* ((units (math-extract-units (nth 1 expr))) |
(let* ((units (math-extract-units (nth 1 math-simplify-expr))) |
950 |
(ratio (math-simplify (math-to-standard-units |
(ratio (math-simplify (math-to-standard-units |
951 |
(list '/ (nth 2 expr) units) nil)))) |
(list '/ (nth 2 math-simplify-expr) units) nil)))) |
952 |
(if (math-units-in-expr-p ratio nil) |
(if (math-units-in-expr-p ratio nil) |
953 |
(progn |
(progn |
954 |
(calc-record-why "*Inconsistent units" expr) |
(calc-record-why "*Inconsistent units" math-simplify-expr) |
955 |
expr) |
math-simplify-expr) |
956 |
(list '* (math-add (math-remove-units (nth 1 expr)) |
(list '* (math-add (math-remove-units (nth 1 math-simplify-expr)) |
957 |
(if (eq (car expr) '-) (math-neg ratio) ratio)) |
(if (eq (car math-simplify-expr) '-) |
958 |
|
(math-neg ratio) ratio)) |
959 |
units))))) |
units))))) |
960 |
|
|
961 |
(math-defsimplify * |
(math-defsimplify * |
964 |
(defun math-simplify-units-prod () |
(defun math-simplify-units-prod () |
965 |
(and math-simplifying-units |
(and math-simplifying-units |
966 |
calc-autorange-units |
calc-autorange-units |
967 |
(Math-realp (nth 1 expr)) |
(Math-realp (nth 1 math-simplify-expr)) |
968 |
(let* ((num (math-float (nth 1 expr))) |
(let* ((num (math-float (nth 1 math-simplify-expr))) |
969 |
(xpon (calcFunc-xpon num)) |
(xpon (calcFunc-xpon num)) |
970 |
(unitp (cdr (cdr expr))) |
(unitp (cdr (cdr math-simplify-expr))) |
971 |
(unit (car unitp)) |
(unit (car unitp)) |
972 |
(pow (if (eq (car expr) '*) 1 -1)) |
(pow (if (eq (car math-simplify-expr) '*) 1 -1)) |
973 |
u) |
u) |
974 |
(and (eq (car-safe unit) '*) |
(and (eq (car-safe unit) '*) |
975 |
(setq unitp (cdr unit) |
(setq unitp (cdr unit) |
1019 |
(or (not (eq p pref)) |
(or (not (eq p pref)) |
1020 |
(< xpon (+ pxpon (* (math-abs pow) 3)))) |
(< xpon (+ pxpon (* (math-abs pow) 3)))) |
1021 |
(progn |
(progn |
1022 |
(setcar (cdr expr) |
(setcar (cdr math-simplify-expr) |
1023 |
(let ((calc-prefer-frac nil)) |
(let ((calc-prefer-frac nil)) |
1024 |
(calcFunc-scf (nth 1 expr) |
(calcFunc-scf (nth 1 math-simplify-expr) |
1025 |
(- uxpon pxpon)))) |
(- uxpon pxpon)))) |
1026 |
(setcar unitp pname) |
(setcar unitp pname) |
1027 |
expr))))))) |
math-simplify-expr))))))) |
1028 |
|
|
1029 |
(math-defsimplify / |
(math-defsimplify / |
1030 |
(and math-simplifying-units |
(and math-simplifying-units |
1031 |
(let ((np (cdr expr)) |
(let ((np (cdr math-simplify-expr)) |
1032 |
(try-cancel-units 0) |
(try-cancel-units 0) |
1033 |
n nn) |
n nn) |
1034 |
(setq n (if (eq (car-safe (nth 2 expr)) '*) |
(setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*) |
1035 |
(cdr (nth 2 expr)) |
(cdr (nth 2 math-simplify-expr)) |
1036 |
(nthcdr 2 expr))) |
(nthcdr 2 math-simplify-expr))) |
1037 |
(if (math-realp (car n)) |
(if (math-realp (car n)) |
1038 |
(progn |
(progn |
1039 |
(setcar (cdr expr) (math-mul (nth 1 expr) |
(setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) |
1040 |
(let ((calc-prefer-frac nil)) |
(let ((calc-prefer-frac nil)) |
1041 |
(math-div 1 (car n))))) |
(math-div 1 (car n))))) |
1042 |
(setcar n 1))) |
(setcar n 1))) |
1043 |
(while (eq (car-safe (setq n (car np))) '*) |
(while (eq (car-safe (setq n (car np))) '*) |
1044 |
(math-simplify-units-divisor (cdr n) (cdr (cdr expr))) |
(math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr))) |
1045 |
(setq np (cdr (cdr n)))) |
(setq np (cdr (cdr n)))) |
1046 |
(math-simplify-units-divisor np (cdr (cdr expr))) |
(math-simplify-units-divisor np (cdr (cdr math-simplify-expr))) |
1047 |
(if (eq try-cancel-units 0) |
(if (eq try-cancel-units 0) |
1048 |
(let* ((math-simplifying-units nil) |
(let* ((math-simplifying-units nil) |
1049 |
(base (math-simplify (math-to-standard-units expr nil)))) |
(base (math-simplify |
1050 |
|
(math-to-standard-units math-simplify-expr nil)))) |
1051 |
(if (Math-numberp base) |
(if (Math-numberp base) |
1052 |
(setq expr base)))) |
(setq math-simplify-expr base)))) |
1053 |
(if (eq (car-safe expr) '/) |
(if (eq (car-safe math-simplify-expr) '/) |
1054 |
(math-simplify-units-prod)) |
(math-simplify-units-prod)) |
1055 |
expr))) |
math-simplify-expr))) |
1056 |
|
|
1057 |
(defun math-simplify-units-divisor (np dp) |
(defun math-simplify-units-divisor (np dp) |
1058 |
(let ((n (car np)) |
(let ((n (car np)) |
1099 |
|
|
1100 |
(math-defsimplify ^ |
(math-defsimplify ^ |
1101 |
(and math-simplifying-units |
(and math-simplifying-units |
1102 |
(math-realp (nth 2 expr)) |
(math-realp (nth 2 math-simplify-expr)) |
1103 |
(if (memq (car-safe (nth 1 expr)) '(* /)) |
(if (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) |
1104 |
(list (car (nth 1 expr)) |
(list (car (nth 1 math-simplify-expr)) |
1105 |
(list '^ (nth 1 (nth 1 expr)) (nth 2 expr)) |
(list '^ (nth 1 (nth 1 math-simplify-expr)) |
1106 |
(list '^ (nth 2 (nth 1 expr)) (nth 2 expr))) |
(nth 2 math-simplify-expr)) |
1107 |
(math-simplify-units-pow (nth 1 expr) (nth 2 expr))))) |
(list '^ (nth 2 (nth 1 math-simplify-expr)) |
1108 |
|
(nth 2 math-simplify-expr))) |
1109 |
|
(math-simplify-units-pow (nth 1 math-simplify-expr) |
1110 |
|
(nth 2 math-simplify-expr))))) |
1111 |
|
|
1112 |
(math-defsimplify calcFunc-sqrt |
(math-defsimplify calcFunc-sqrt |
1113 |
(and math-simplifying-units |
(and math-simplifying-units |
1114 |
(if (memq (car-safe (nth 1 expr)) '(* /)) |
(if (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) |
1115 |
(list (car (nth 1 expr)) |
(list (car (nth 1 math-simplify-expr)) |
1116 |
(list 'calcFunc-sqrt (nth 1 (nth 1 expr))) |
(list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr))) |
1117 |
(list 'calcFunc-sqrt (nth 2 (nth 1 expr)))) |
(list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr)))) |
1118 |
(math-simplify-units-pow (nth 1 expr) '(frac 1 2))))) |
(math-simplify-units-pow (nth 1 math-simplify-expr) '(frac 1 2))))) |
1119 |
|
|
1120 |
(math-defsimplify (calcFunc-floor |
(math-defsimplify (calcFunc-floor |
1121 |
calcFunc-ceil |
calcFunc-ceil |
1128 |
calcFunc-abs |
calcFunc-abs |
1129 |
calcFunc-clean) |
calcFunc-clean) |
1130 |
(and math-simplifying-units |
(and math-simplifying-units |
1131 |
(= (length expr) 2) |
(= (length math-simplify-expr) 2) |
1132 |
(if (math-only-units-in-expr-p (nth 1 expr)) |
(if (math-only-units-in-expr-p (nth 1 math-simplify-expr)) |
1133 |
(nth 1 expr) |
(nth 1 math-simplify-expr) |
1134 |
(if (and (memq (car-safe (nth 1 expr)) '(* /)) |
(if (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) |
1135 |
(or (math-only-units-in-expr-p |
(or (math-only-units-in-expr-p |
1136 |
(nth 1 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
1137 |
(math-only-units-in-expr-p |
(math-only-units-in-expr-p |
1138 |
(nth 2 (nth 1 expr))))) |
(nth 2 (nth 1 math-simplify-expr))))) |
1139 |
(list (car (nth 1 expr)) |
(list (car (nth 1 math-simplify-expr)) |
1140 |
(cons (car expr) |
(cons (car math-simplify-expr) |
1141 |
(cons (nth 1 (nth 1 expr)) |
(cons (nth 1 (nth 1 math-simplify-expr)) |
1142 |
(cdr (cdr expr)))) |
(cdr (cdr math-simplify-expr)))) |
1143 |
(cons (car expr) |
(cons (car math-simplify-expr) |
1144 |
(cons (nth 2 (nth 1 expr)) |
(cons (nth 2 (nth 1 math-simplify-expr)) |
1145 |
(cdr (cdr expr))))))))) |
(cdr (cdr math-simplify-expr))))))))) |
1146 |
|
|
1147 |
(defun math-simplify-units-pow (a pow) |
(defun math-simplify-units-pow (a pow) |
1148 |
(if (and (eq (car-safe a) '^) |
(if (and (eq (car-safe a) '^) |
1165 |
|
|
1166 |
(math-defsimplify calcFunc-sin |
(math-defsimplify calcFunc-sin |
1167 |
(and math-simplifying-units |
(and math-simplifying-units |
1168 |
(math-units-in-expr-p (nth 1 expr) nil) |
(math-units-in-expr-p (nth 1 math-simplify-expr) nil) |
1169 |
(let ((rad (math-simplify-units |
(let ((rad (math-simplify-units |
1170 |
(math-evaluate-expr |
(math-evaluate-expr |
1171 |
(math-to-standard-units (nth 1 expr) nil)))) |
(math-to-standard-units (nth 1 math-simplify-expr) nil)))) |
1172 |
(calc-angle-mode 'rad)) |
(calc-angle-mode 'rad)) |
1173 |
(and (eq (car-safe rad) '*) |
(and (eq (car-safe rad) '*) |
1174 |
(math-realp (nth 1 rad)) |
(math-realp (nth 1 rad)) |
1178 |
|
|
1179 |
(math-defsimplify calcFunc-cos |
(math-defsimplify calcFunc-cos |
1180 |
(and math-simplifying-units |
(and math-simplifying-units |
1181 |
(math-units-in-expr-p (nth 1 expr) nil) |
(math-units-in-expr-p (nth 1 math-simplify-expr) nil) |
1182 |
(let ((rad (math-simplify-units |
(let ((rad (math-simplify-units |
1183 |
(math-evaluate-expr |
(math-evaluate-expr |
1184 |
(math-to-standard-units (nth 1 expr) nil)))) |
(math-to-standard-units (nth 1 math-simplify-expr) nil)))) |
1185 |
(calc-angle-mode 'rad)) |
(calc-angle-mode 'rad)) |
1186 |
(and (eq (car-safe rad) '*) |
(and (eq (car-safe rad) '*) |
1187 |
(math-realp (nth 1 rad)) |
(math-realp (nth 1 rad)) |
1191 |
|
|
1192 |
(math-defsimplify calcFunc-tan |
(math-defsimplify calcFunc-tan |
1193 |
(and math-simplifying-units |
(and math-simplifying-units |
1194 |
(math-units-in-expr-p (nth 1 expr) nil) |
(math-units-in-expr-p (nth 1 math-simplify-expr) nil) |
1195 |
(let ((rad (math-simplify-units |
(let ((rad (math-simplify-units |
1196 |
(math-evaluate-expr |
(math-evaluate-expr |
1197 |
(math-to-standard-units (nth 1 expr) nil)))) |
(math-to-standard-units (nth 1 math-simplify-expr) nil)))) |
1198 |
(calc-angle-mode 'rad)) |
(calc-angle-mode 'rad)) |
1199 |
(and (eq (car-safe rad) '*) |
(and (eq (car-safe rad) '*) |
1200 |
(math-realp (nth 1 rad)) |
(math-realp (nth 1 rad)) |