1 |
;; Calculator for GNU Emacs, part II [calc-alg-2.el] |
;; Calculator for GNU Emacs, part II [calc-alg-2.el] |
2 |
;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
3 |
;; Written by Dave Gillespie, daveg@synaptics.com. |
;; Written by Dave Gillespie, daveg@synaptics.com. |
4 |
|
|
5 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
46 |
expr (calc-top-n 1))) |
expr (calc-top-n 1))) |
47 |
(while (>= (setq num (1- num)) 0) |
(while (>= (setq num (1- num)) 0) |
48 |
(setq expr (list func expr var))) |
(setq expr (list func expr var))) |
49 |
(calc-enter-result n "derv" expr))) |
(calc-enter-result n "derv" expr)))) |
|
) |
|
50 |
|
|
51 |
(defun calc-integral (var) |
(defun calc-integral (var) |
52 |
(interactive "sIntegration variable: ") |
(interactive "sIntegration variable: ") |
60 |
(error "Bad format in expression: %s" (nth 1 var))) |
(error "Bad format in expression: %s" (nth 1 var))) |
61 |
(calc-enter-result 1 "intg" (list 'calcFunc-integ |
(calc-enter-result 1 "intg" (list 'calcFunc-integ |
62 |
(calc-top-n 1) |
(calc-top-n 1) |
63 |
var))))) |
var)))))) |
|
) |
|
64 |
|
|
65 |
(defun calc-num-integral (&optional varname lowname highname) |
(defun calc-num-integral (&optional varname lowname highname) |
66 |
(interactive "sIntegration variable: ") |
(interactive "sIntegration variable: ") |
67 |
(calc-tabular-command 'calcFunc-ninteg "Integration" "nint" |
(calc-tabular-command 'calcFunc-ninteg "Integration" "nint" |
68 |
nil varname lowname highname) |
nil varname lowname highname)) |
|
) |
|
69 |
|
|
70 |
(defun calc-summation (arg &optional varname lowname highname) |
(defun calc-summation (arg &optional varname lowname highname) |
71 |
(interactive "P\nsSummation variable: ") |
(interactive "P\nsSummation variable: ") |
72 |
(calc-tabular-command 'calcFunc-sum "Summation" "sum" |
(calc-tabular-command 'calcFunc-sum "Summation" "sum" |
73 |
arg varname lowname highname) |
arg varname lowname highname)) |
|
) |
|
74 |
|
|
75 |
(defun calc-alt-summation (arg &optional varname lowname highname) |
(defun calc-alt-summation (arg &optional varname lowname highname) |
76 |
(interactive "P\nsSummation variable: ") |
(interactive "P\nsSummation variable: ") |
77 |
(calc-tabular-command 'calcFunc-asum "Summation" "asum" |
(calc-tabular-command 'calcFunc-asum "Summation" "asum" |
78 |
arg varname lowname highname) |
arg varname lowname highname)) |
|
) |
|
79 |
|
|
80 |
(defun calc-product (arg &optional varname lowname highname) |
(defun calc-product (arg &optional varname lowname highname) |
81 |
(interactive "P\nsIndex variable: ") |
(interactive "P\nsIndex variable: ") |
82 |
(calc-tabular-command 'calcFunc-prod "Index" "prod" |
(calc-tabular-command 'calcFunc-prod "Index" "prod" |
83 |
arg varname lowname highname) |
arg varname lowname highname)) |
|
) |
|
84 |
|
|
85 |
(defun calc-tabulate (arg &optional varname lowname highname) |
(defun calc-tabulate (arg &optional varname lowname highname) |
86 |
(interactive "P\nsIndex variable: ") |
(interactive "P\nsIndex variable: ") |
87 |
(calc-tabular-command 'calcFunc-table "Index" "tabl" |
(calc-tabular-command 'calcFunc-table "Index" "tabl" |
88 |
arg varname lowname highname) |
arg varname lowname highname)) |
|
) |
|
89 |
|
|
90 |
(defun calc-tabular-command (func prompt prefix arg varname lowname highname) |
(defun calc-tabular-command (func prompt prefix arg varname lowname highname) |
91 |
(calc-slow-wrapper |
(calc-slow-wrapper |
143 |
(setq step (prefix-numeric-value arg))))) |
(setq step (prefix-numeric-value arg))))) |
144 |
(setq expr (calc-top-n num)) |
(setq expr (calc-top-n num)) |
145 |
(calc-enter-result num prefix (append (list func expr var low high) |
(calc-enter-result num prefix (append (list func expr var low high) |
146 |
(and step (list step)))))) |
(and step (list step))))))) |
|
) |
|
147 |
|
|
148 |
(defun calc-solve-for (var) |
(defun calc-solve-for (var) |
149 |
(interactive "sVariable to solve for: ") |
(interactive "sVariable to solve for: ") |
163 |
(error "Bad format in expression: %s" (nth 1 var))) |
(error "Bad format in expression: %s" (nth 1 var))) |
164 |
(calc-enter-result 1 "solv" (list func |
(calc-enter-result 1 "solv" (list func |
165 |
(calc-top-n 1) |
(calc-top-n 1) |
166 |
var)))))) |
var))))))) |
|
) |
|
167 |
|
|
168 |
(defun calc-poly-roots (var) |
(defun calc-poly-roots (var) |
169 |
(interactive "sVariable to solve for: ") |
(interactive "sVariable to solve for: ") |
180 |
(error "Bad format in expression: %s" (nth 1 var))) |
(error "Bad format in expression: %s" (nth 1 var))) |
181 |
(calc-enter-result 1 "prts" (list 'calcFunc-roots |
(calc-enter-result 1 "prts" (list 'calcFunc-roots |
182 |
(calc-top-n 1) |
(calc-top-n 1) |
183 |
var))))) |
var)))))) |
|
) |
|
184 |
|
|
185 |
(defun calc-taylor (var nterms) |
(defun calc-taylor (var nterms) |
186 |
(interactive "sTaylor expansion variable: \nNNumber of terms: ") |
(interactive "sTaylor expansion variable: \nNNumber of terms: ") |
191 |
(calc-enter-result 1 "tylr" (list 'calcFunc-taylor |
(calc-enter-result 1 "tylr" (list 'calcFunc-taylor |
192 |
(calc-top-n 1) |
(calc-top-n 1) |
193 |
var |
var |
194 |
(prefix-numeric-value nterms))))) |
(prefix-numeric-value nterms)))))) |
|
) |
|
195 |
|
|
196 |
|
|
197 |
(defun math-derivative (expr) ; uses global values: deriv-var, deriv-total. |
(defun math-derivative (expr) ; uses global values: deriv-var, deriv-total. |
321 |
(throw 'math-deriv nil) |
(throw 'math-deriv nil) |
322 |
(cons func (cdr expr)))))))))) |
(cons func (cdr expr)))))))))) |
323 |
(setq n (1+ n))) |
(setq n (1+ n))) |
324 |
accum))))) |
accum)))))) |
|
) |
|
325 |
|
|
326 |
(defun calcFunc-deriv (expr deriv-var &optional deriv-value deriv-symb) |
(defun calcFunc-deriv (expr deriv-var &optional deriv-value deriv-symb) |
327 |
(let* ((deriv-total nil) |
(let* ((deriv-total nil) |
332 |
(and res |
(and res |
333 |
(if deriv-value |
(if deriv-value |
334 |
(math-expr-subst res deriv-var deriv-value) |
(math-expr-subst res deriv-var deriv-value) |
335 |
res))) |
res)))) |
|
) |
|
336 |
|
|
337 |
(defun calcFunc-tderiv (expr deriv-var &optional deriv-value deriv-symb) |
(defun calcFunc-tderiv (expr deriv-var &optional deriv-value deriv-symb) |
338 |
(math-setup-declarations) |
(math-setup-declarations) |
344 |
(and res |
(and res |
345 |
(if deriv-value |
(if deriv-value |
346 |
(math-expr-subst res deriv-var deriv-value) |
(math-expr-subst res deriv-var deriv-value) |
347 |
res))) |
res)))) |
|
) |
|
348 |
|
|
349 |
(put 'calcFunc-inv\' 'math-derivative-1 |
(put 'calcFunc-inv\' 'math-derivative-1 |
350 |
(function (lambda (u) (math-neg (math-div 1 (math-sqr u)))))) |
(function (lambda (u) (math-neg (math-div 1 (math-sqr u)))))) |
478 |
(defun math-deriv-gamma (a x scale) |
(defun math-deriv-gamma (a x scale) |
479 |
(math-mul scale |
(math-mul scale |
480 |
(math-mul (math-pow x (math-add a -1)) |
(math-mul (math-pow x (math-add a -1)) |
481 |
(list 'calcFunc-exp (math-neg x)))) |
(list 'calcFunc-exp (math-neg x))))) |
|
) |
|
482 |
|
|
483 |
(put 'calcFunc-betaB\' 'math-derivative-3 |
(put 'calcFunc-betaB\' 'math-derivative-3 |
484 |
(function (lambda (x a b) (math-deriv-beta x a b 1)))) |
(function (lambda (x a b) (math-deriv-beta x a b 1)))) |
492 |
(defun math-deriv-beta (x a b scale) |
(defun math-deriv-beta (x a b scale) |
493 |
(math-mul (math-mul (math-pow x (math-add a -1)) |
(math-mul (math-mul (math-pow x (math-add a -1)) |
494 |
(math-pow (math-sub 1 x) (math-add b -1))) |
(math-pow (math-sub 1 x) (math-add b -1))) |
495 |
scale) |
scale)) |
|
) |
|
496 |
|
|
497 |
(put 'calcFunc-erf\' 'math-derivative-1 |
(put 'calcFunc-erf\' 'math-derivative-1 |
498 |
(function (lambda (x) (math-div 2 |
(function (lambda (x) (math-div 2 |
616 |
;;(list 'condition-case 'err |
;;(list 'condition-case 'err |
617 |
(cons 'insert parts) |
(cons 'insert parts) |
618 |
;; '(error (insert (prin1-to-string err)))) |
;; '(error (insert (prin1-to-string err)))) |
619 |
'(sit-for 0))) |
'(sit-for 0)))) |
|
) |
|
620 |
|
|
621 |
;;; The following wrapper caches results and avoids infinite recursion. |
;;; The following wrapper caches results and avoids infinite recursion. |
622 |
;;; Each cache entry is: ( A B ) Integral of A is B; |
;;; Each cache entry is: ( A B ) Integral of A is B; |
707 |
" is " |
" is " |
708 |
(math-format-value val 1000) |
(math-format-value val 1000) |
709 |
"\n") |
"\n") |
710 |
val) |
val)) |
|
) |
|
711 |
(defvar math-integral-cache nil) |
(defvar math-integral-cache nil) |
712 |
(defvar math-integral-cache-state nil) |
(defvar math-integral-cache-state nil) |
713 |
|
|
718 |
(listp (nth 2 expr))) |
(listp (nth 2 expr))) |
719 |
(while (and (setq expr (cdr expr)) |
(while (and (setq expr (cdr expr)) |
720 |
(not (math-integral-contains-parts (car expr))))) |
(not (math-integral-contains-parts (car expr))))) |
721 |
expr) |
expr)) |
|
) |
|
722 |
|
|
723 |
(defun math-replace-integral-parts (expr) |
(defun math-replace-integral-parts (expr) |
724 |
(or (Math-primp expr) |
(or (Math-primp expr) |
732 |
(setcar expr (nth 1 (nth 2 (car expr)))) |
(setcar expr (nth 1 (nth 2 (car expr)))) |
733 |
(math-replace-integral-parts (cons 'foo expr))) |
(math-replace-integral-parts (cons 'foo expr))) |
734 |
(setcar (cdr cur-record) 'cancelled))) |
(setcar (cdr cur-record) 'cancelled))) |
735 |
(math-replace-integral-parts (car expr)))))) |
(math-replace-integral-parts (car expr))))))) |
|
) |
|
736 |
|
|
737 |
(defun math-do-integral (expr) |
(defun math-do-integral (expr) |
738 |
(let (t1 t2) |
(let (t1 t2) |
954 |
;; Try expanding the function's definition. |
;; Try expanding the function's definition. |
955 |
(let ((res (math-expand-formula expr))) |
(let ((res (math-expand-formula expr))) |
956 |
(and res |
(and res |
957 |
(math-integral res))))) |
(math-integral res)))))) |
|
) |
|
958 |
|
|
959 |
(defun math-sub-integration (expr &rest rest) |
(defun math-sub-integration (expr &rest rest) |
960 |
(or (if (or (not rest) |
(or (if (or (not rest) |
965 |
(and (or (= math-integ-level math-integral-limit) |
(and (or (= math-integ-level math-integral-limit) |
966 |
(not (math-expr-calls res 'calcFunc-integ))) |
(not (math-expr-calls res 'calcFunc-integ))) |
967 |
res))) |
res))) |
968 |
(list 'calcFunc-integfailed expr)) |
(list 'calcFunc-integfailed expr))) |
|
) |
|
969 |
|
|
970 |
(defun math-do-integral-methods (expr) |
(defun math-do-integral-methods (expr) |
971 |
(let ((so-far math-integ-var-list-list) |
(let ((so-far math-integ-var-list-list) |
1052 |
(math-integ-try-parts expr) |
(math-integ-try-parts expr) |
1053 |
|
|
1054 |
;; Give up. |
;; Give up. |
1055 |
nil)) |
nil))) |
|
) |
|
1056 |
|
|
1057 |
(defun math-integ-parts-easy (expr) |
(defun math-integ-parts-easy (expr) |
1058 |
(cond ((Math-primp expr) t) |
(cond ((Math-primp expr) t) |
1067 |
(math-integ-parts-easy (nth 1 expr)))) |
(math-integ-parts-easy (nth 1 expr)))) |
1068 |
((eq (car expr) 'neg) |
((eq (car expr) 'neg) |
1069 |
(math-integ-parts-easy (nth 1 expr))) |
(math-integ-parts-easy (nth 1 expr))) |
1070 |
(t t)) |
(t t))) |
|
) |
|
1071 |
|
|
1072 |
(defun math-integ-try-parts (expr &optional math-good-parts) |
(defun math-integ-try-parts (expr &optional math-good-parts) |
1073 |
;; Integration by parts: |
;; Integration by parts: |
1093 |
(and (eq (car expr) '^) |
(and (eq (car expr) '^) |
1094 |
(math-integrate-by-parts (math-pow (nth 1 expr) |
(math-integrate-by-parts (math-pow (nth 1 expr) |
1095 |
(math-sub (nth 2 expr) 1)) |
(math-sub (nth 2 expr) 1)) |
1096 |
(nth 1 expr)))) |
(nth 1 expr))))) |
|
) |
|
1097 |
|
|
1098 |
(defun math-integrate-by-parts (u vprime) |
(defun math-integrate-by-parts (u vprime) |
1099 |
(let ((math-integ-level (if (or math-good-parts |
(let ((math-integ-level (if (or math-good-parts |
1124 |
(math-solve-for (math-sub v temp) 0 v nil))) |
(math-solve-for (math-sub v temp) 0 v nil))) |
1125 |
(and temp (not (integerp temp)) |
(and temp (not (integerp temp)) |
1126 |
(math-simplify-extended temp))))) |
(math-simplify-extended temp))))) |
1127 |
(setcar (cdr cur-record) 'busy)))) |
(setcar (cdr cur-record) 'busy))))) |
|
) |
|
1128 |
|
|
1129 |
;;; This tries two different formulations, hoping the algebraic simplifier |
;;; This tries two different formulations, hoping the algebraic simplifier |
1130 |
;;; will be strong enough to handle at least one. |
;;; will be strong enough to handle at least one. |
1131 |
(defun math-integrate-by-substitution (expr u &optional user uinv uinvprime) |
(defun math-integrate-by-substitution (expr u &optional user uinv uinvprime) |
1132 |
(and (> math-integ-level 0) |
(and (> math-integ-level 0) |
1133 |
(let ((math-integ-level (max (- math-integ-level 2) 0))) |
(let ((math-integ-level (max (- math-integ-level 2) 0))) |
1134 |
(math-integrate-by-good-substitution expr u user uinv uinvprime))) |
(math-integrate-by-good-substitution expr u user uinv uinvprime)))) |
|
) |
|
1135 |
|
|
1136 |
(defun math-integrate-by-good-substitution (expr u &optional user |
(defun math-integrate-by-good-substitution (expr u &optional user |
1137 |
uinv uinvprime) |
uinv uinvprime) |
1181 |
deriv) |
deriv) |
1182 |
'yes))))) |
'yes))))) |
1183 |
(math-simplify-extended |
(math-simplify-extended |
1184 |
(math-expr-subst temp math-integ-var u)))) |
(math-expr-subst temp math-integ-var u))))) |
|
) |
|
1185 |
|
|
1186 |
;;; Look for substitutions of the form u = a x + b. |
;;; Look for substitutions of the form u = a x + b. |
1187 |
(defun math-integ-try-linear-substitutions (sub-expr) |
(defun math-integ-try-linear-substitutions (sub-expr) |
1206 |
(while (and (setq sub-expr (cdr sub-expr)) |
(while (and (setq sub-expr (cdr sub-expr)) |
1207 |
(not (setq res (math-integ-try-linear-substitutions |
(not (setq res (math-integ-try-linear-substitutions |
1208 |
(car sub-expr)))))) |
(car sub-expr)))))) |
1209 |
res))) |
res)))) |
|
) |
|
1210 |
|
|
1211 |
;;; Recursively try different substitutions based on various sub-expressions. |
;;; Recursively try different substitutions based on various sub-expressions. |
1212 |
(defun math-integ-try-substitutions (sub-expr &optional allow-rat) |
(defun math-integ-try-substitutions (sub-expr &optional allow-rat) |
1231 |
(while (and (setq sub-expr (cdr sub-expr)) |
(while (and (setq sub-expr (cdr sub-expr)) |
1232 |
(not (setq res (math-integ-try-substitutions |
(not (setq res (math-integ-try-substitutions |
1233 |
(car sub-expr) allow-rat))))) |
(car sub-expr) allow-rat))))) |
1234 |
res))) |
res)))) |
|
) |
|
1235 |
|
|
1236 |
(defun math-expr-rational-in (expr) |
(defun math-expr-rational-in (expr) |
1237 |
(let ((parts nil)) |
(let ((parts nil)) |
1238 |
(math-expr-rational-in-rec expr) |
(math-expr-rational-in-rec expr) |
1239 |
(mapcar 'car parts)) |
(mapcar 'car parts))) |
|
) |
|
1240 |
|
|
1241 |
(defun math-expr-rational-in-rec (expr) |
(defun math-expr-rational-in-rec (expr) |
1242 |
(cond ((Math-primp expr) |
(cond ((Math-primp expr) |
1253 |
(t |
(t |
1254 |
(and (not (assoc expr parts)) |
(and (not (assoc expr parts)) |
1255 |
(math-expr-contains expr math-integ-var) |
(math-expr-contains expr math-integ-var) |
1256 |
(setq parts (cons (list expr) parts))))) |
(setq parts (cons (list expr) parts)))))) |
|
) |
|
1257 |
|
|
1258 |
(defun math-expr-calls (expr funcs &optional arg-contains) |
(defun math-expr-calls (expr funcs &optional arg-contains) |
1259 |
(if (consp expr) |
(if (consp expr) |
1268 |
(while (and (setq expr (cdr expr)) |
(while (and (setq expr (cdr expr)) |
1269 |
(not (setq res (math-expr-calls |
(not (setq res (math-expr-calls |
1270 |
(car expr) funcs arg-contains))))) |
(car expr) funcs arg-contains))))) |
1271 |
res)))) |
res))))) |
|
) |
|
1272 |
|
|
1273 |
(defun math-fix-const-terms (expr except-vars) |
(defun math-fix-const-terms (expr except-vars) |
1274 |
(cond ((not (math-expr-depends expr except-vars)) 0) |
(cond ((not (math-expr-depends expr except-vars)) 0) |
1279 |
((eq (car expr) '-) |
((eq (car expr) '-) |
1280 |
(math-sub (math-fix-const-terms (nth 1 expr) except-vars) |
(math-sub (math-fix-const-terms (nth 1 expr) except-vars) |
1281 |
(math-fix-const-terms (nth 2 expr) except-vars))) |
(math-fix-const-terms (nth 2 expr) except-vars))) |
1282 |
(t expr)) |
(t expr))) |
|
) |
|
1283 |
|
|
1284 |
;; Command for debugging the Calculator's symbolic integrator. |
;; Command for debugging the Calculator's symbolic integrator. |
1285 |
(defun calc-dump-integral-cache (&optional arg) |
(defun calc-dump-integral-cache (&optional arg) |
1302 |
"\n") |
"\n") |
1303 |
(setq p (cdr p))) |
(setq p (cdr p))) |
1304 |
(goto-char (point-min))) |
(goto-char (point-min))) |
1305 |
(set-buffer buf))) |
(set-buffer buf)))) |
|
) |
|
1306 |
|
|
1307 |
(defun math-try-integral (expr) |
(defun math-try-integral (expr) |
1308 |
(let ((math-integ-level math-integral-limit) |
(let ((math-integ-level math-integral-limit) |
1320 |
(and (> math-max-integral-limit math-integral-limit) |
(and (> math-max-integral-limit math-integral-limit) |
1321 |
(setq math-integral-limit math-max-integral-limit |
(setq math-integral-limit math-max-integral-limit |
1322 |
math-integ-level math-integral-limit) |
math-integ-level math-integral-limit) |
1323 |
(math-integral expr 'yes)))) |
(math-integral expr 'yes))))) |
|
) |
|
1324 |
|
|
1325 |
(defun calcFunc-integ (expr var &optional low high) |
(defun calcFunc-integ (expr var &optional low high) |
1326 |
(cond |
(cond |
1432 |
(math-expr-subst res math-integ-var var))))) |
(math-expr-subst res math-integ-var var))))) |
1433 |
(append (list 'calcFunc-integ expr var) |
(append (list 'calcFunc-integ expr var) |
1434 |
(and low (list low)) |
(and low (list low)) |
1435 |
(and high (list high))))))) |
(and high (list high)))))))) |
|
) |
|
1436 |
|
|
1437 |
|
|
1438 |
(math-defintegral calcFunc-inv |
(math-defintegral calcFunc-inv |
1645 |
(math-mul n (math-mul q (math-pow v n))))) |
(math-mul n (math-mul q (math-pow v n))))) |
1646 |
(math-mul-thru (math-div (math-mul b (1- (* 2 n))) |
(math-mul-thru (math-div (math-mul b (1- (* 2 n))) |
1647 |
(math-mul n q)) |
(math-mul n q)) |
1648 |
(math-integral-q02 a b c v n))))))) |
(math-integral-q02 a b c v n)))))))) |
|
) |
|
1649 |
|
|
1650 |
(defun math-integral-q02 (a b c v vpow) |
(defun math-integral-q02 (a b c v vpow) |
1651 |
(let (q rq part) |
(let (q rq part) |
1684 |
(math-div (math-mul 2 (math-to-radians-2 |
(math-div (math-mul 2 (math-to-radians-2 |
1685 |
(list 'calcFunc-arctan |
(list 'calcFunc-arctan |
1686 |
(math-div part rq)))) |
(math-div part rq)))) |
1687 |
rq)))) |
rq))))) |
|
) |
|
1688 |
|
|
1689 |
|
|
1690 |
(math-defintegral calcFunc-erf |
(math-defintegral calcFunc-erf |
1759 |
(and (not (and (equal low '(neg (var inf var-inf))) |
(and (not (and (equal low '(neg (var inf var-inf))) |
1760 |
(equal high '(var inf var-inf)))) |
(equal high '(var inf var-inf)))) |
1761 |
(list low high)) |
(list low high)) |
1762 |
(and step (list step))))) |
(and step (list step)))))) |
|
) |
|
1763 |
|
|
1764 |
(setq math-tabulate-initial nil) |
(setq math-tabulate-initial nil) |
1765 |
(setq math-tabulate-function nil) |
(setq math-tabulate-function nil) |
1782 |
high (math-min high (math-floor high-val))))) |
high (math-min high (math-floor high-val))))) |
1783 |
(t |
(t |
1784 |
(while (setq x (cdr x)) |
(while (setq x (cdr x)) |
1785 |
(math-scan-for-limits (car x))))) |
(math-scan-for-limits (car x)))))) |
|
) |
|
1786 |
|
|
1787 |
|
|
1788 |
(defun calcFunc-sum (expr var &optional low high step) |
(defun calcFunc-sum (expr var &optional low high step) |
1790 |
(let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2))) |
(let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2))) |
1791 |
(math-sum-rec expr var low high step))) |
(math-sum-rec expr var low high step))) |
1792 |
(math-disable-sums t)) |
(math-disable-sums t)) |
1793 |
(math-normalize res)) |
(math-normalize res))) |
|
) |
|
1794 |
(setq math-disable-sums nil) |
(setq math-disable-sums nil) |
1795 |
|
|
1796 |
(defun math-sum-rec (expr var &optional low high step) |
(defun math-sum-rec (expr var &optional low high step) |
1895 |
(or val |
(or val |
1896 |
(let* ((math-tabulate-initial 0) |
(let* ((math-tabulate-initial 0) |
1897 |
(math-tabulate-function 'calcFunc-sum)) |
(math-tabulate-function 'calcFunc-sum)) |
1898 |
(calcFunc-table expr var low high)))) |
(calcFunc-table expr var low high))))) |
|
) |
|
1899 |
|
|
1900 |
(defun calcFunc-asum (expr var low &optional high step no-mul-flag) |
(defun calcFunc-asum (expr var low &optional high step no-mul-flag) |
1901 |
(or high (setq high low low 1)) |
(or high (setq high low low 1)) |
1917 |
(math-simplify (math-div (math-sub high low) |
(math-simplify (math-div (math-sub high low) |
1918 |
step)))))) |
step)))))) |
1919 |
(math-mul (if no-mul-flag 1 (math-pow -1 low)) |
(math-mul (if no-mul-flag 1 (math-pow -1 low)) |
1920 |
(calcFunc-sum (math-mul (math-pow -1 var) expr) var low high))) |
(calcFunc-sum (math-mul (math-pow -1 var) expr) var low high)))) |
|
) |
|
1921 |
|
|
1922 |
(defun math-sum-const-factors (expr var) |
(defun math-sum-const-factors (expr var) |
1923 |
(let ((const nil) |
(let ((const nil) |
1939 |
(let ((temp (or (car not-const) 1))) |
(let ((temp (or (car not-const) 1))) |
1940 |
(while (setq not-const (cdr not-const)) |
(while (setq not-const (cdr not-const)) |
1941 |
(setq temp (list '* (car not-const) temp))) |
(setq temp (list '* (car not-const) temp))) |
1942 |
temp)))) |
temp))))) |
|
) |
|
1943 |
|
|
1944 |
;; Following is from CRC Math Tables, 27th ed, pp. 52-53. |
;; Following is from CRC Math Tables, 27th ed, pp. 52-53. |
1945 |
(defun math-sum-integer-power (pow) |
(defun math-sum-integer-power (pow) |
1962 |
(setq math-sum-int-pow-cache |
(setq math-sum-int-pow-cache |
1963 |
(nconc math-sum-int-pow-cache (list (nreverse new))) |
(nconc math-sum-int-pow-cache (list (nreverse new))) |
1964 |
n (1+ n)))) |
n (1+ n)))) |
1965 |
(nth pow math-sum-int-pow-cache)) |
(nth pow math-sum-int-pow-cache))) |
|
) |
|
1966 |
(setq math-sum-int-pow-cache (list '(0 1))) |
(setq math-sum-int-pow-cache (list '(0 1))) |
1967 |
|
|
1968 |
(defun math-to-exponentials (expr) |
(defun math-to-exponentials (expr) |
2000 |
(list '^ '(var e var-e) x) |
(list '^ '(var e var-e) x) |
2001 |
(list '^ '(var e var-e) (list 'neg x))) |
(list '^ '(var e var-e) (list 'neg x))) |
2002 |
2)) |
2)) |
2003 |
(t nil)))) |
(t nil))))) |
|
) |
|
2004 |
|
|
2005 |
(defun math-to-exps (expr) |
(defun math-to-exps (expr) |
2006 |
(cond (calc-symbolic-mode expr) |
(cond (calc-symbolic-mode expr) |
2010 |
(equal (nth 1 expr) '(var e var-e))) |
(equal (nth 1 expr) '(var e var-e))) |
2011 |
(list 'calcFunc-exp (nth 2 expr))) |
(list 'calcFunc-exp (nth 2 expr))) |
2012 |
(t |
(t |
2013 |
(cons (car expr) (mapcar 'math-to-exps (cdr expr))))) |
(cons (car expr) (mapcar 'math-to-exps (cdr expr)))))) |
|
) |
|
2014 |
|
|
2015 |
|
|
2016 |
(defun calcFunc-prod (expr var &optional low high step) |
(defun calcFunc-prod (expr var &optional low high step) |
2018 |
(let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2))) |
(let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2))) |
2019 |
(math-prod-rec expr var low high step))) |
(math-prod-rec expr var low high step))) |
2020 |
(math-disable-prods t)) |
(math-disable-prods t)) |
2021 |
(math-normalize res)) |
(math-normalize res))) |
|
) |
|
2022 |
(setq math-disable-prods nil) |
(setq math-disable-prods nil) |
2023 |
|
|
2024 |
(defun math-prod-rec (expr var &optional low high step) |
(defun math-prod-rec (expr var &optional low high step) |
2160 |
(or val |
(or val |
2161 |
(let* ((math-tabulate-initial 1) |
(let* ((math-tabulate-initial 1) |
2162 |
(math-tabulate-function 'calcFunc-prod)) |
(math-tabulate-function 'calcFunc-prod)) |
2163 |
(calcFunc-table expr var low high)))) |
(calcFunc-table expr var low high))))) |
|
) |
|
2164 |
|
|
2165 |
|
|
2166 |
|
|
2309 |
(math-try-solve-for t1 rhs sign)) |
(math-try-solve-for t1 rhs sign)) |
2310 |
(t |
(t |
2311 |
(calc-record-why "*No inverse known" lhs) |
(calc-record-why "*No inverse known" lhs) |
2312 |
nil))) |
nil)))) |
|
) |
|
2313 |
|
|
2314 |
(setq math-solve-ranges nil) |
(setq math-solve-ranges nil) |
2315 |
|
|
2419 |
(and sign |
(and sign |
2420 |
(math-oddp (nth 2 lhs)) |
(math-oddp (nth 2 lhs)) |
2421 |
(math-solve-sign sign (nth 2 lhs))))))))) |
(math-solve-sign sign (nth 2 lhs))))))))) |
2422 |
(t nil)) |
(t nil))) |
|
) |
|
2423 |
|
|
2424 |
(defun math-solve-prod (lsoln rsoln) |
(defun math-solve-prod (lsoln rsoln) |
2425 |
(cond ((null lsoln) |
(cond ((null lsoln) |
2433 |
(list 'calcFunc-gt (math-solve-get-sign 1) 0) |
(list 'calcFunc-gt (math-solve-get-sign 1) 0) |
2434 |
lsoln |
lsoln |
2435 |
rsoln)) |
rsoln)) |
2436 |
(t lsoln)) |
(t lsoln))) |
|
) |
|
2437 |
|
|
2438 |
;;; This deals with negative, fractional, and symbolic powers of "x". |
;;; This deals with negative, fractional, and symbolic powers of "x". |
2439 |
(defun math-solve-poly-funny-powers (sub-rhs) ; uses "t1", "t2" |
(defun math-solve-poly-funny-powers (sub-rhs) ; uses "t1", "t2" |
2450 |
(setq t2 (math-mul (or math-poly-mult-powers 1) |
(setq t2 (math-mul (or math-poly-mult-powers 1) |
2451 |
(let ((calc-prefer-frac t)) |
(let ((calc-prefer-frac t)) |
2452 |
(math-div 1 math-poly-frac-powers))) |
(math-div 1 math-poly-frac-powers))) |
2453 |
t1 (math-is-polynomial (math-simplify (calcFunc-expand t1)) b 50))) |
t1 (math-is-polynomial (math-simplify (calcFunc-expand t1)) b 50)))) |
|
) |
|
2454 |
|
|
2455 |
;;; This converts "a x^8 + b x^5 + c x^2" to "(a (x^3)^2 + b (x^3) + c) * x^2". |
;;; This converts "a x^8 + b x^5 + c x^2" to "(a (x^3)^2 + b (x^3) + c) * x^2". |
2456 |
(defun math-solve-crunch-poly (max-degree) ; uses "t1", "t3" |
(defun math-solve-crunch-poly (max-degree) ; uses "t1", "t3" |
2479 |
t1 new-t1)))) |
t1 new-t1)))) |
2480 |
(setq scale (1- scale))) |
(setq scale (1- scale))) |
2481 |
(setq t3 (list (math-mul (car t3) t2) (math-mul count t2))) |
(setq t3 (list (math-mul (car t3) t2) (math-mul count t2))) |
2482 |
(<= (1- (length t1)) max-degree)))) |
(<= (1- (length t1)) max-degree))))) |
|
) |
|
2483 |
|
|
2484 |
(defun calcFunc-poly (expr var &optional degree) |
(defun calcFunc-poly (expr var &optional degree) |
2485 |
(if degree |
(if degree |
2490 |
(if (equal p '(0)) |
(if (equal p '(0)) |
2491 |
(list 'vec) |
(list 'vec) |
2492 |
(cons 'vec p)) |
(cons 'vec p)) |
2493 |
(math-reject-arg expr "Expected a polynomial"))) |
(math-reject-arg expr "Expected a polynomial")))) |
|
) |
|
2494 |
|
|
2495 |
(defun calcFunc-gpoly (expr var &optional degree) |
(defun calcFunc-gpoly (expr var &optional degree) |
2496 |
(if degree |
(if degree |
2500 |
(d (math-decompose-poly expr var degree nil))) |
(d (math-decompose-poly expr var degree nil))) |
2501 |
(if d |
(if d |
2502 |
(cons 'vec d) |
(cons 'vec d) |
2503 |
(math-reject-arg expr "Expected a polynomial"))) |
(math-reject-arg expr "Expected a polynomial")))) |
|
) |
|
2504 |
|
|
2505 |
(defun math-decompose-poly (lhs solve-var degree sub-rhs) |
(defun math-decompose-poly (lhs solve-var degree sub-rhs) |
2506 |
(let ((rhs (or sub-rhs 1)) |
(let ((rhs (or sub-rhs 1)) |
2532 |
(cons 'vec t1) |
(cons 'vec t1) |
2533 |
(if sub-rhs |
(if sub-rhs |
2534 |
(math-pow t2 (nth 1 t3)) |
(math-pow t2 (nth 1 t3)) |
2535 |
(math-div (math-pow t2 (nth 1 t3)) rhs))))) |
(math-div (math-pow t2 (nth 1 t3)) rhs)))))) |
|
) |
|
2536 |
|
|
2537 |
(defun math-solve-linear (var sign b a) |
(defun math-solve-linear (var sign b a) |
2538 |
(math-try-solve-for var |
(math-try-solve-for var |
2539 |
(math-div (math-neg b) a) |
(math-div (math-neg b) a) |
2540 |
(math-solve-sign sign a) |
(math-solve-sign sign a) |
2541 |
t) |
t)) |
|
) |
|
2542 |
|
|
2543 |
(defun math-solve-quadratic (var c b a) |
(defun math-solve-quadratic (var c b a) |
2544 |
(math-try-solve-for |
(math-try-solve-for |
2563 |
(math-add (math-sqr b) |
(math-add (math-sqr b) |
2564 |
(math-mul 4 (math-mul (math-neg c) a))))))) |
(math-mul 4 (math-mul (math-neg c) a))))))) |
2565 |
(math-mul 2 a))) |
(math-mul 2 a))) |
2566 |
nil t) |
nil t)) |
|
) |
|
2567 |
|
|
2568 |
(defun math-solve-cubic (var d c b a) |
(defun math-solve-cubic (var d c b a) |
2569 |
(let* ((p (math-div b a)) |
(let* ((p (math-div b a)) |
2605 |
calc-symbolic-mode)))) |
calc-symbolic-mode)))) |
2606 |
3)))) |
3)))) |
2607 |
(math-div p 3)) |
(math-div p 3)) |
2608 |
nil t)))) |
nil t))))) |
|
) |
|
2609 |
|
|
2610 |
(defun math-solve-quartic (var d c b a aa) |
(defun math-solve-quartic (var d c b a aa) |
2611 |
(setq a (math-div a aa)) |
(setq a (math-div a aa)) |
2654 |
(math-sub (math-add (math-mul sign1 (math-div r 2)) |
(math-sub (math-add (math-mul sign1 (math-div r 2)) |
2655 |
(math-solve-get-sign (math-div de 2))) |
(math-solve-get-sign (math-div de 2))) |
2656 |
(math-div a 4)))) |
(math-div a 4)))) |
2657 |
nil t) |
nil t)) |
|
) |
|
2658 |
|
|
2659 |
(defun math-poly-all-roots (var p &optional math-factoring) |
(defun math-poly-all-roots (var p &optional math-factoring) |
2660 |
(catch 'ouch |
(catch 'ouch |
2749 |
(list 'calcFunc-subscr |
(list 'calcFunc-subscr |
2750 |
vec |
vec |
2751 |
(math-solve-get-int 1 (1- (length orig-p)) 1)) |
(math-solve-get-int 1 (1- (length orig-p)) 1)) |
2752 |
vec))))) |
vec)))))) |
|
) |
|
2753 |
(setq math-symbolic-solve nil) |
(setq math-symbolic-solve nil) |
2754 |
|
|
2755 |
(defun math-lcm-denoms (&rest fracs) |
(defun math-lcm-denoms (&rest fracs) |
2758 |
(if (eq (car-safe (car fracs)) 'frac) |
(if (eq (car-safe (car fracs)) 'frac) |
2759 |
(setq den (calcFunc-lcm den (nth 2 (car fracs))))) |
(setq den (calcFunc-lcm den (nth 2 (car fracs))))) |
2760 |
(setq fracs (cdr fracs))) |
(setq fracs (cdr fracs))) |
2761 |
den) |
den)) |
|
) |
|
2762 |
|
|
2763 |
(defun math-poly-any-root (p x polish) ; p is a reverse poly coeff list |
(defun math-poly-any-root (p x polish) ; p is a reverse poly coeff list |
2764 |
(let* ((newt (if (math-zerop x) |
(let* ((newt (if (math-zerop x) |
2774 |
(math-poly-laguerre-root p x polish))))) |
(math-poly-laguerre-root p x polish))))) |
2775 |
(and math-symbolic-solve (math-floatp res) |
(and math-symbolic-solve (math-floatp res) |
2776 |
(throw 'ouch nil)) |
(throw 'ouch nil)) |
2777 |
res) |
res)) |
|
) |
|
2778 |
|
|
2779 |
(defun math-poly-newton-root (p x iters) |
(defun math-poly-newton-root (p x iters) |
2780 |
(let* ((calc-prefer-frac nil) |
(let* ((calc-prefer-frac nil) |
2804 |
(math-nearly-zerop dx (math-abs-approx x)))) |
(math-nearly-zerop dx (math-abs-approx x)))) |
2805 |
(progn (setq dx 0) nil))))) |
(progn (setq dx 0) nil))))) |
2806 |
(cons x (if (math-zerop x) |
(cons x (if (math-zerop x) |
2807 |
1 (math-div (math-abs-approx dx) (math-abs-approx x))))) |
1 (math-div (math-abs-approx dx) (math-abs-approx x)))))) |
|
) |
|
2808 |
|
|
2809 |
(defun math-poly-integer-root (x) |
(defun math-poly-integer-root (x) |
2810 |
(and (math-lessp (calcFunc-xpon (math-abs-approx x)) calc-internal-prec) |
(and (math-lessp (calcFunc-xpon (math-abs-approx x)) calc-internal-prec) |
2869 |
(let ((calc-symbolic-mode math-symbolic-solve)) |
(let ((calc-symbolic-mode math-symbolic-solve)) |
2870 |
(math-mul (math-sqrt (math-sub (math-sqr aa) |
(math-mul (math-sqrt (math-sub (math-sqr aa) |
2871 |
rnd0)) |
rnd0)) |
2872 |
(if (math-negp xim) -1 1)))))))))) |
(if (math-negp xim) -1 1))))))))))) |
|
) |
|
2873 |
(setq math-int-coefs nil) |
(setq math-int-coefs nil) |
2874 |
|
|
2875 |
;;; The following routine is from Numerical Recipes, section 9.5. |
;;; The following routine is from Numerical Recipes, section 9.5. |
2951 |
dxold)))) |
dxold)))) |
2952 |
(or (and (math-floatp x) |
(or (and (math-floatp x) |
2953 |
(math-poly-integer-root x)) |
(math-poly-integer-root x)) |
2954 |
x)) |
x))) |
|
) |
|
2955 |
|
|
2956 |
(defun math-solve-above-dummy (x) |
(defun math-solve-above-dummy (x) |
2957 |
(and (not (Math-primp x)) |
(and (not (Math-primp x)) |
2961 |
(let ((res nil)) |
(let ((res nil)) |
2962 |
(while (and (setq x (cdr x)) |
(while (and (setq x (cdr x)) |
2963 |
(not (setq res (math-solve-above-dummy (car x)))))) |
(not (setq res (math-solve-above-dummy (car x)))))) |
2964 |
res))) |
res)))) |
|
) |
|
2965 |
|
|
2966 |
(defun math-solve-find-root-term (x neg) ; sets "t2", "t3" |
(defun math-solve-find-root-term (x neg) ; sets "t2", "t3" |
2967 |
(if (math-solve-find-root-in-prod x) |
(if (math-solve-find-root-in-prod x) |
2970 |
(and (memq (car-safe x) '(+ -)) |
(and (memq (car-safe x) '(+ -)) |
2971 |
(or (math-solve-find-root-term (nth 1 x) neg) |
(or (math-solve-find-root-term (nth 1 x) neg) |
2972 |
(math-solve-find-root-term (nth 2 x) |
(math-solve-find-root-term (nth 2 x) |
2973 |
(if (eq (car x) '-) (not neg) neg))))) |
(if (eq (car x) '-) (not neg) neg)))))) |
|
) |
|
2974 |
|
|
2975 |
(defun math-solve-find-root-in-prod (x) |
(defun math-solve-find-root-in-prod (x) |
2976 |
(and (consp x) |
(and (consp x) |
2987 |
(or (and (not (math-expr-contains (nth 1 x) solve-var)) |
(or (and (not (math-expr-contains (nth 1 x) solve-var)) |
2988 |
(math-solve-find-root-in-prod (nth 2 x))) |
(math-solve-find-root-in-prod (nth 2 x))) |
2989 |
(and (not (math-expr-contains (nth 2 x) solve-var)) |
(and (not (math-expr-contains (nth 2 x) solve-var)) |
2990 |
(math-solve-find-root-in-prod (nth 1 x))))))) |
(math-solve-find-root-in-prod (nth 1 x)))))))) |
|
) |
|
2991 |
|
|
2992 |
|
|
2993 |
(defun math-solve-system (exprs solve-vars solve-full) |
(defun math-solve-system (exprs solve-vars solve-full) |
3000 |
(or (let ((math-solve-simplifying nil)) |
(or (let ((math-solve-simplifying nil)) |
3001 |
(math-solve-system-rec exprs solve-vars nil)) |
(math-solve-system-rec exprs solve-vars nil)) |
3002 |
(let ((math-solve-simplifying t)) |
(let ((math-solve-simplifying t)) |
3003 |
(math-solve-system-rec exprs solve-vars nil))) |
(math-solve-system-rec exprs solve-vars nil)))) |
|
) |
|
3004 |
|
|
3005 |
;;; The following backtracking solver works by choosing a variable |
;;; The following backtracking solver works by choosing a variable |
3006 |
;;; and equation, and trying to solve the equation for the variable. |
;;; and equation, and trying to solve the equation for the variable. |
3095 |
(cons 'vec |
(cons 'vec |
3096 |
(if solns |
(if solns |
3097 |
(mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns) |
(mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns) |
3098 |
(mapcar 'car eqn-list)))))) |
(mapcar 'car eqn-list))))))) |
|
) |
|
3099 |
|
|
3100 |
(defun math-solve-system-subst (x) ; uses "res" and "v" |
(defun math-solve-system-subst (x) ; uses "res" and "v" |
3101 |
(let ((accum nil) |
(let ((accum nil) |
3111 |
(car res2))) |
(car res2))) |
3112 |
x (cdr x) |
x (cdr x) |
3113 |
res2 (cdr res2))) |
res2 (cdr res2))) |
3114 |
accum) |
accum)) |
|
) |
|
3115 |
|
|
3116 |
|
|
3117 |
(defun math-get-from-counter (name) |
(defun math-get-from-counter (name) |
3120 |
(setcdr ctr (1+ (cdr ctr))) |
(setcdr ctr (1+ (cdr ctr))) |
3121 |
(setq ctr (cons name 1) |
(setq ctr (cons name 1) |
3122 |
calc-command-flags (cons ctr calc-command-flags))) |
calc-command-flags (cons ctr calc-command-flags))) |
3123 |
(cdr ctr)) |
(cdr ctr))) |
|
) |
|
3124 |
|
|
3125 |
(defun math-solve-get-sign (val) |
(defun math-solve-get-sign (val) |
3126 |
(setq val (math-simplify val)) |
(setq val (math-simplify val)) |
3147 |
math-solve-ranges))) |
math-solve-ranges))) |
3148 |
(math-mul var2 val))) |
(math-mul var2 val))) |
3149 |
(calc-record-why "*Choosing positive solution") |
(calc-record-why "*Choosing positive solution") |
3150 |
val)) |
val))) |
|
) |
|
3151 |
|
|
3152 |
(defun math-solve-get-int (val &optional range first) |
(defun math-solve-get-int (val &optional range first) |
3153 |
(if solve-full |
(if solve-full |
3167 |
math-solve-ranges))) |
math-solve-ranges))) |
3168 |
(math-mul val var2))) |
(math-mul val var2))) |
3169 |
(calc-record-why "*Choosing 0 for arbitrary integer in solution") |
(calc-record-why "*Choosing 0 for arbitrary integer in solution") |
3170 |
0) |
0)) |
|
) |
|
3171 |
|
|
3172 |
(defun math-solve-sign (sign expr) |
(defun math-solve-sign (sign expr) |
3173 |
(and sign |
(and sign |
3175 |
(cond ((memq s1 '(4 6)) |
(cond ((memq s1 '(4 6)) |
3176 |
sign) |
sign) |
3177 |
((memq s1 '(1 3)) |
((memq s1 '(1 3)) |
3178 |
(- sign))))) |
(- sign)))))) |
|
) |
|
3179 |
|
|
3180 |
(defun math-looks-evenp (expr) |
(defun math-looks-evenp (expr) |
3181 |
(if (Math-integerp expr) |
(if (Math-integerp expr) |
3182 |
(math-evenp expr) |
(math-evenp expr) |
3183 |
(if (memq (car expr) '(* /)) |
(if (memq (car expr) '(* /)) |
3184 |
(math-looks-evenp (nth 1 expr)))) |
(math-looks-evenp (nth 1 expr))))) |
|
) |
|
3185 |
|
|
3186 |
(defun math-solve-for (lhs rhs solve-var solve-full &optional sign) |
(defun math-solve-for (lhs rhs solve-var solve-full &optional sign) |
3187 |
(if (math-expr-contains rhs solve-var) |
(if (math-expr-contains rhs solve-var) |
3208 |
(format |
(format |
3209 |
"*Omitted %d complex solutions" |
"*Omitted %d complex solutions" |
3210 |
(- old-len new-len))))))) |
(- old-len new-len))))))) |
3211 |
res)))) |
res))))) |
|
) |
|
3212 |
|
|
3213 |
(defun math-solve-eqn (expr var full) |
(defun math-solve-eqn (expr var full) |
3214 |
(if (memq (car-safe expr) '(calcFunc-neq calcFunc-lt calcFunc-gt |
(if (memq (car-safe expr) '(calcFunc-neq calcFunc-lt calcFunc-gt |
3228 |
(list 'calcFunc-neq var res)))))) |
(list 'calcFunc-neq var res)))))) |
3229 |
(let ((res (math-solve-for expr 0 var full))) |
(let ((res (math-solve-for expr 0 var full))) |
3230 |
(and res |
(and res |
3231 |
(list 'calcFunc-eq var res)))) |
(list 'calcFunc-eq var res))))) |
|
) |
|
3232 |
|
|
3233 |
(defun math-reject-solution (expr var func) |
(defun math-reject-solution (expr var func) |
3234 |
(if (math-expr-contains expr var) |
(if (math-expr-contains expr var) |
3235 |
(or (equal (car calc-next-why) '(* "Unable to find a symbolic solution")) |
(or (equal (car calc-next-why) '(* "Unable to find a symbolic solution")) |
3236 |
(calc-record-why "*Unable to find a solution"))) |
(calc-record-why "*Unable to find a solution"))) |
3237 |
(list func expr var) |
(list func expr var)) |
|
) |
|
3238 |
|
|
3239 |
(defun calcFunc-solve (expr var) |
(defun calcFunc-solve (expr var) |
3240 |
(or (if (or (Math-vectorp expr) (Math-vectorp var)) |
(or (if (or (Math-vectorp expr) (Math-vectorp var)) |
3241 |
(math-solve-system expr var nil) |
(math-solve-system expr var nil) |
3242 |
(math-solve-eqn expr var nil)) |
(math-solve-eqn expr var nil)) |
3243 |
(math-reject-solution expr var 'calcFunc-solve)) |
(math-reject-solution expr var 'calcFunc-solve))) |
|
) |
|
3244 |
|
|
3245 |
(defun calcFunc-fsolve (expr var) |
(defun calcFunc-fsolve (expr var) |
3246 |
(or (if (or (Math-vectorp expr) (Math-vectorp var)) |
(or (if (or (Math-vectorp expr) (Math-vectorp var)) |
3247 |
(math-solve-system expr var t) |
(math-solve-system expr var t) |
3248 |
(math-solve-eqn expr var t)) |
(math-solve-eqn expr var t)) |
3249 |
(math-reject-solution expr var 'calcFunc-fsolve)) |
(math-reject-solution expr var 'calcFunc-fsolve))) |
|
) |
|
3250 |
|
|
3251 |
(defun calcFunc-roots (expr var) |
(defun calcFunc-roots (expr var) |
3252 |
(let ((math-solve-ranges nil)) |
(let ((math-solve-ranges nil)) |
3253 |
(or (if (or (Math-vectorp expr) (Math-vectorp var)) |
(or (if (or (Math-vectorp expr) (Math-vectorp var)) |
3254 |
(math-solve-system expr var 'all) |
(math-solve-system expr var 'all) |
3255 |
(math-solve-for expr 0 var 'all)) |
(math-solve-for expr 0 var 'all)) |
3256 |
(math-reject-solution expr var 'calcFunc-roots))) |
(math-reject-solution expr var 'calcFunc-roots)))) |
|
) |
|
3257 |
|
|
3258 |
(defun calcFunc-finv (expr var) |
(defun calcFunc-finv (expr var) |
3259 |
(let ((res (math-solve-for expr math-integ-var var nil))) |
(let ((res (math-solve-for expr math-integ-var var nil))) |
3260 |
(if res |
(if res |
3261 |
(math-normalize (math-expr-subst res math-integ-var var)) |
(math-normalize (math-expr-subst res math-integ-var var)) |
3262 |
(math-reject-solution expr var 'calcFunc-finv))) |
(math-reject-solution expr var 'calcFunc-finv)))) |
|
) |
|
3263 |
|
|
3264 |
(defun calcFunc-ffinv (expr var) |
(defun calcFunc-ffinv (expr var) |
3265 |
(let ((res (math-solve-for expr math-integ-var var t))) |
(let ((res (math-solve-for expr math-integ-var var t))) |
3266 |
(if res |
(if res |
3267 |
(math-normalize (math-expr-subst res math-integ-var var)) |
(math-normalize (math-expr-subst res math-integ-var var)) |
3268 |
(math-reject-solution expr var 'calcFunc-finv))) |
(math-reject-solution expr var 'calcFunc-finv)))) |
|
) |
|
3269 |
|
|
3270 |
|
|
3271 |
(put 'calcFunc-inv 'math-inverse |
(put 'calcFunc-inv 'math-inverse |
3412 |
nfac)))) |
nfac)))) |
3413 |
(and fprime |
(and fprime |
3414 |
(math-normalize accum)))) |
(math-normalize accum)))) |
3415 |
(list 'calcFunc-taylor expr var num))) |
(list 'calcFunc-taylor expr var num)))) |
|
) |
|
|
|
|
|
|
|
|
|
|
3416 |
|
|
3417 |
|
;;; calcalg2.el ends here |