41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
1 ;;; calcalg2.el --- more algebraic functions for Calc
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
2
|
64325
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
|
|
4 ;; 2005 Free Software Foundation, Inc.
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
5
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
6 ;; Author: David Gillespie <daveg@synaptics.com>
|
58573
87c7dff39cb0
(math-expr-parts, math-try-solve-sign, math-solve-b, math-int-factors)
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
7 ;; Maintainer: Jay Belanger <belanger@truman.edu>
|
40785
|
8
|
|
9 ;; This file is part of GNU Emacs.
|
|
10
|
|
11 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
12 ;; but WITHOUT ANY WARRANTY. No author or distributor
|
|
13 ;; accepts responsibility to anyone for the consequences of using it
|
|
14 ;; or for whether it serves any particular purpose or works at all,
|
|
15 ;; unless he says so in writing. Refer to the GNU Emacs General Public
|
|
16 ;; License for full details.
|
|
17
|
|
18 ;; Everyone is granted permission to copy, modify and redistribute
|
|
19 ;; GNU Emacs, but only under the conditions described in the
|
|
20 ;; GNU Emacs General Public License. A copy of this license is
|
|
21 ;; supposed to have been given to you along with GNU Emacs so you
|
|
22 ;; can know your rights and responsibilities. It should be in a
|
|
23 ;; file named COPYING. Among other things, the copyright notice
|
|
24 ;; and this notice must be preserved on all copies.
|
|
25
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
26 ;;; Commentary:
|
40785
|
27
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
28 ;;; Code:
|
40785
|
29
|
|
30 ;; This file is autoloaded from calc-ext.el.
|
58681
|
31
|
40785
|
32 (require 'calc-ext)
|
|
33 (require 'calc-macs)
|
|
34
|
|
35 (defun calc-derivative (var num)
|
|
36 (interactive "sDifferentiate with respect to: \np")
|
|
37 (calc-slow-wrapper
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
38 (when (< num 0)
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
39 (error "Order of derivative must be positive"))
|
40785
|
40 (let ((func (if (calc-is-hyperbolic) 'calcFunc-tderiv 'calcFunc-deriv))
|
|
41 n expr)
|
|
42 (if (or (equal var "") (equal var "$"))
|
|
43 (setq n 2
|
|
44 expr (calc-top-n 2)
|
|
45 var (calc-top-n 1))
|
|
46 (setq var (math-read-expr var))
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
47 (when (eq (car-safe var) 'error)
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
48 (error "Bad format in expression: %s" (nth 1 var)))
|
40785
|
49 (setq n 1
|
|
50 expr (calc-top-n 1)))
|
|
51 (while (>= (setq num (1- num)) 0)
|
|
52 (setq expr (list func expr var)))
|
41047
|
53 (calc-enter-result n "derv" expr))))
|
40785
|
54
|
|
55 (defun calc-integral (var)
|
|
56 (interactive "sIntegration variable: ")
|
|
57 (calc-slow-wrapper
|
|
58 (if (or (equal var "") (equal var "$"))
|
|
59 (calc-enter-result 2 "intg" (list 'calcFunc-integ
|
|
60 (calc-top-n 2)
|
|
61 (calc-top-n 1)))
|
|
62 (let ((var (math-read-expr var)))
|
|
63 (if (eq (car-safe var) 'error)
|
|
64 (error "Bad format in expression: %s" (nth 1 var)))
|
|
65 (calc-enter-result 1 "intg" (list 'calcFunc-integ
|
|
66 (calc-top-n 1)
|
41047
|
67 var))))))
|
40785
|
68
|
|
69 (defun calc-num-integral (&optional varname lowname highname)
|
|
70 (interactive "sIntegration variable: ")
|
|
71 (calc-tabular-command 'calcFunc-ninteg "Integration" "nint"
|
41047
|
72 nil varname lowname highname))
|
40785
|
73
|
|
74 (defun calc-summation (arg &optional varname lowname highname)
|
|
75 (interactive "P\nsSummation variable: ")
|
|
76 (calc-tabular-command 'calcFunc-sum "Summation" "sum"
|
41047
|
77 arg varname lowname highname))
|
40785
|
78
|
|
79 (defun calc-alt-summation (arg &optional varname lowname highname)
|
|
80 (interactive "P\nsSummation variable: ")
|
|
81 (calc-tabular-command 'calcFunc-asum "Summation" "asum"
|
41047
|
82 arg varname lowname highname))
|
40785
|
83
|
|
84 (defun calc-product (arg &optional varname lowname highname)
|
|
85 (interactive "P\nsIndex variable: ")
|
|
86 (calc-tabular-command 'calcFunc-prod "Index" "prod"
|
41047
|
87 arg varname lowname highname))
|
40785
|
88
|
|
89 (defun calc-tabulate (arg &optional varname lowname highname)
|
|
90 (interactive "P\nsIndex variable: ")
|
|
91 (calc-tabular-command 'calcFunc-table "Index" "tabl"
|
41047
|
92 arg varname lowname highname))
|
40785
|
93
|
|
94 (defun calc-tabular-command (func prompt prefix arg varname lowname highname)
|
|
95 (calc-slow-wrapper
|
|
96 (let (var (low nil) (high nil) (step nil) stepname stepnum (num 1) expr)
|
|
97 (if (consp arg)
|
|
98 (setq stepnum 1)
|
|
99 (setq stepnum 0))
|
|
100 (if (or (equal varname "") (equal varname "$") (null varname))
|
|
101 (setq high (calc-top-n (+ stepnum 1))
|
|
102 low (calc-top-n (+ stepnum 2))
|
|
103 var (calc-top-n (+ stepnum 3))
|
|
104 num (+ stepnum 4))
|
|
105 (setq var (if (stringp varname) (math-read-expr varname) varname))
|
|
106 (if (eq (car-safe var) 'error)
|
|
107 (error "Bad format in expression: %s" (nth 1 var)))
|
|
108 (or lowname
|
|
109 (setq lowname (read-string (concat prompt " variable: " varname
|
|
110 ", from: "))))
|
|
111 (if (or (equal lowname "") (equal lowname "$"))
|
|
112 (setq high (calc-top-n (+ stepnum 1))
|
|
113 low (calc-top-n (+ stepnum 2))
|
|
114 num (+ stepnum 3))
|
|
115 (setq low (if (stringp lowname) (math-read-expr lowname) lowname))
|
|
116 (if (eq (car-safe low) 'error)
|
|
117 (error "Bad format in expression: %s" (nth 1 low)))
|
|
118 (or highname
|
|
119 (setq highname (read-string (concat prompt " variable: " varname
|
|
120 ", from: " lowname
|
|
121 ", to: "))))
|
|
122 (if (or (equal highname "") (equal highname "$"))
|
|
123 (setq high (calc-top-n (+ stepnum 1))
|
|
124 num (+ stepnum 2))
|
|
125 (setq high (if (stringp highname) (math-read-expr highname)
|
|
126 highname))
|
|
127 (if (eq (car-safe high) 'error)
|
|
128 (error "Bad format in expression: %s" (nth 1 high)))
|
|
129 (if (consp arg)
|
|
130 (progn
|
|
131 (setq stepname (read-string (concat prompt " variable: "
|
|
132 varname
|
|
133 ", from: " lowname
|
|
134 ", to: " highname
|
|
135 ", step: ")))
|
|
136 (if (or (equal stepname "") (equal stepname "$"))
|
|
137 (setq step (calc-top-n 1)
|
|
138 num 2)
|
|
139 (setq step (math-read-expr stepname))
|
|
140 (if (eq (car-safe step) 'error)
|
|
141 (error "Bad format in expression: %s"
|
|
142 (nth 1 step)))))))))
|
|
143 (or step
|
|
144 (if (consp arg)
|
|
145 (setq step (calc-top-n 1))
|
|
146 (if arg
|
|
147 (setq step (prefix-numeric-value arg)))))
|
|
148 (setq expr (calc-top-n num))
|
|
149 (calc-enter-result num prefix (append (list func expr var low high)
|
41047
|
150 (and step (list step)))))))
|
40785
|
151
|
|
152 (defun calc-solve-for (var)
|
60940
f296abb7ee57
(calc-solve-for): Use "Variable(s)" to prompt for variables.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
153 (interactive "sVariable(s) to solve for: ")
|
40785
|
154 (calc-slow-wrapper
|
|
155 (let ((func (if (calc-is-inverse)
|
|
156 (if (calc-is-hyperbolic) 'calcFunc-ffinv 'calcFunc-finv)
|
|
157 (if (calc-is-hyperbolic) 'calcFunc-fsolve 'calcFunc-solve))))
|
|
158 (if (or (equal var "") (equal var "$"))
|
|
159 (calc-enter-result 2 "solv" (list func
|
|
160 (calc-top-n 2)
|
|
161 (calc-top-n 1)))
|
|
162 (let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
|
|
163 (not (string-match "\\[" var)))
|
|
164 (math-read-expr (concat "[" var "]"))
|
|
165 (math-read-expr var))))
|
|
166 (if (eq (car-safe var) 'error)
|
|
167 (error "Bad format in expression: %s" (nth 1 var)))
|
|
168 (calc-enter-result 1 "solv" (list func
|
|
169 (calc-top-n 1)
|
41047
|
170 var)))))))
|
40785
|
171
|
|
172 (defun calc-poly-roots (var)
|
|
173 (interactive "sVariable to solve for: ")
|
|
174 (calc-slow-wrapper
|
|
175 (if (or (equal var "") (equal var "$"))
|
|
176 (calc-enter-result 2 "prts" (list 'calcFunc-roots
|
|
177 (calc-top-n 2)
|
|
178 (calc-top-n 1)))
|
|
179 (let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
|
|
180 (not (string-match "\\[" var)))
|
|
181 (math-read-expr (concat "[" var "]"))
|
|
182 (math-read-expr var))))
|
|
183 (if (eq (car-safe var) 'error)
|
|
184 (error "Bad format in expression: %s" (nth 1 var)))
|
|
185 (calc-enter-result 1 "prts" (list 'calcFunc-roots
|
|
186 (calc-top-n 1)
|
41047
|
187 var))))))
|
40785
|
188
|
|
189 (defun calc-taylor (var nterms)
|
|
190 (interactive "sTaylor expansion variable: \nNNumber of terms: ")
|
|
191 (calc-slow-wrapper
|
|
192 (let ((var (math-read-expr var)))
|
|
193 (if (eq (car-safe var) 'error)
|
|
194 (error "Bad format in expression: %s" (nth 1 var)))
|
|
195 (calc-enter-result 1 "tylr" (list 'calcFunc-taylor
|
|
196 (calc-top-n 1)
|
|
197 var
|
41047
|
198 (prefix-numeric-value nterms))))))
|
40785
|
199
|
|
200
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
201 ;; The following are global variables used by math-derivative and some
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
202 ;; related functions
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
203 (defvar math-deriv-var)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
204 (defvar math-deriv-total)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
205 (defvar math-deriv-symb)
|
62834
|
206 (defvar math-decls-cache)
|
|
207 (defvar math-decls-all)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
208
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
209 (defun math-derivative (expr)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
210 (cond ((equal expr math-deriv-var)
|
40785
|
211 1)
|
|
212 ((or (Math-scalarp expr)
|
|
213 (eq (car expr) 'sdev)
|
|
214 (and (eq (car expr) 'var)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
215 (or (not math-deriv-total)
|
40785
|
216 (math-const-var expr)
|
|
217 (progn
|
|
218 (math-setup-declarations)
|
|
219 (memq 'const (nth 1 (or (assq (nth 2 expr)
|
|
220 math-decls-cache)
|
|
221 math-decls-all)))))))
|
|
222 0)
|
|
223 ((eq (car expr) '+)
|
|
224 (math-add (math-derivative (nth 1 expr))
|
|
225 (math-derivative (nth 2 expr))))
|
|
226 ((eq (car expr) '-)
|
|
227 (math-sub (math-derivative (nth 1 expr))
|
|
228 (math-derivative (nth 2 expr))))
|
|
229 ((memq (car expr) '(calcFunc-eq calcFunc-neq calcFunc-lt
|
|
230 calcFunc-gt calcFunc-leq calcFunc-geq))
|
|
231 (list (car expr)
|
|
232 (math-derivative (nth 1 expr))
|
|
233 (math-derivative (nth 2 expr))))
|
|
234 ((eq (car expr) 'neg)
|
|
235 (math-neg (math-derivative (nth 1 expr))))
|
|
236 ((eq (car expr) '*)
|
|
237 (math-add (math-mul (nth 2 expr)
|
|
238 (math-derivative (nth 1 expr)))
|
|
239 (math-mul (nth 1 expr)
|
|
240 (math-derivative (nth 2 expr)))))
|
|
241 ((eq (car expr) '/)
|
|
242 (math-sub (math-div (math-derivative (nth 1 expr))
|
|
243 (nth 2 expr))
|
|
244 (math-div (math-mul (nth 1 expr)
|
|
245 (math-derivative (nth 2 expr)))
|
|
246 (math-sqr (nth 2 expr)))))
|
|
247 ((eq (car expr) '^)
|
|
248 (let ((du (math-derivative (nth 1 expr)))
|
|
249 (dv (math-derivative (nth 2 expr))))
|
|
250 (or (Math-zerop du)
|
|
251 (setq du (math-mul (nth 2 expr)
|
|
252 (math-mul (math-normalize
|
|
253 (list '^
|
|
254 (nth 1 expr)
|
|
255 (math-add (nth 2 expr) -1)))
|
|
256 du))))
|
|
257 (or (Math-zerop dv)
|
|
258 (setq dv (math-mul (math-normalize
|
|
259 (list 'calcFunc-ln (nth 1 expr)))
|
|
260 (math-mul expr dv))))
|
|
261 (math-add du dv)))
|
|
262 ((eq (car expr) '%)
|
|
263 (math-derivative (nth 1 expr))) ; a reasonable definition
|
|
264 ((eq (car expr) 'vec)
|
|
265 (math-map-vec 'math-derivative expr))
|
|
266 ((and (memq (car expr) '(calcFunc-conj calcFunc-re calcFunc-im))
|
|
267 (= (length expr) 2))
|
|
268 (list (car expr) (math-derivative (nth 1 expr))))
|
|
269 ((and (memq (car expr) '(calcFunc-subscr calcFunc-mrow calcFunc-mcol))
|
|
270 (= (length expr) 3))
|
|
271 (let ((d (math-derivative (nth 1 expr))))
|
|
272 (if (math-numberp d)
|
|
273 0 ; assume x and x_1 are independent vars
|
|
274 (list (car expr) d (nth 2 expr)))))
|
|
275 (t (or (and (symbolp (car expr))
|
|
276 (if (= (length expr) 2)
|
|
277 (let ((handler (get (car expr) 'math-derivative)))
|
|
278 (and handler
|
|
279 (let ((deriv (math-derivative (nth 1 expr))))
|
|
280 (if (Math-zerop deriv)
|
|
281 deriv
|
|
282 (math-mul (funcall handler (nth 1 expr))
|
|
283 deriv)))))
|
|
284 (let ((handler (get (car expr) 'math-derivative-n)))
|
|
285 (and handler
|
|
286 (funcall handler expr)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
287 (and (not (eq math-deriv-symb 'pre-expand))
|
40785
|
288 (let ((exp (math-expand-formula expr)))
|
|
289 (and exp
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
290 (or (let ((math-deriv-symb 'pre-expand))
|
40785
|
291 (catch 'math-deriv (math-derivative expr)))
|
|
292 (math-derivative exp)))))
|
|
293 (if (or (Math-objvecp expr)
|
|
294 (eq (car expr) 'var)
|
|
295 (not (symbolp (car expr))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
296 (if math-deriv-symb
|
40785
|
297 (throw 'math-deriv nil)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
298 (list (if math-deriv-total 'calcFunc-tderiv 'calcFunc-deriv)
|
40785
|
299 expr
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
300 math-deriv-var))
|
40785
|
301 (let ((accum 0)
|
|
302 (arg expr)
|
|
303 (n 1)
|
|
304 derv)
|
|
305 (while (setq arg (cdr arg))
|
|
306 (or (Math-zerop (setq derv (math-derivative (car arg))))
|
|
307 (let ((func (intern (concat (symbol-name (car expr))
|
|
308 "'"
|
|
309 (if (> n 1)
|
|
310 (int-to-string n)
|
|
311 ""))))
|
|
312 (prop (cond ((= (length expr) 2)
|
|
313 'math-derivative-1)
|
|
314 ((= (length expr) 3)
|
|
315 'math-derivative-2)
|
|
316 ((= (length expr) 4)
|
|
317 'math-derivative-3)
|
|
318 ((= (length expr) 5)
|
|
319 'math-derivative-4)
|
|
320 ((= (length expr) 6)
|
|
321 'math-derivative-5))))
|
|
322 (setq accum
|
|
323 (math-add
|
|
324 accum
|
|
325 (math-mul
|
|
326 derv
|
|
327 (let ((handler (get func prop)))
|
|
328 (or (and prop handler
|
|
329 (apply handler (cdr expr)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
330 (if (and math-deriv-symb
|
40785
|
331 (not (get func
|
|
332 'calc-user-defn)))
|
|
333 (throw 'math-deriv nil)
|
|
334 (cons func (cdr expr))))))))))
|
|
335 (setq n (1+ n)))
|
41047
|
336 accum))))))
|
40785
|
337
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
338 (defun calcFunc-deriv (expr math-deriv-var &optional deriv-value math-deriv-symb)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
339 (let* ((math-deriv-total nil)
|
40785
|
340 (res (catch 'math-deriv (math-derivative expr))))
|
|
341 (or (eq (car-safe res) 'calcFunc-deriv)
|
|
342 (null res)
|
|
343 (setq res (math-normalize res)))
|
|
344 (and res
|
|
345 (if deriv-value
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
346 (math-expr-subst res math-deriv-var deriv-value)
|
41047
|
347 res))))
|
40785
|
348
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
349 (defun calcFunc-tderiv (expr math-deriv-var &optional deriv-value math-deriv-symb)
|
40785
|
350 (math-setup-declarations)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
351 (let* ((math-deriv-total t)
|
40785
|
352 (res (catch 'math-deriv (math-derivative expr))))
|
|
353 (or (eq (car-safe res) 'calcFunc-tderiv)
|
|
354 (null res)
|
|
355 (setq res (math-normalize res)))
|
|
356 (and res
|
|
357 (if deriv-value
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
358 (math-expr-subst res math-deriv-var deriv-value)
|
41047
|
359 res))))
|
40785
|
360
|
|
361 (put 'calcFunc-inv\' 'math-derivative-1
|
|
362 (function (lambda (u) (math-neg (math-div 1 (math-sqr u))))))
|
|
363
|
|
364 (put 'calcFunc-sqrt\' 'math-derivative-1
|
|
365 (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))))
|
|
366
|
|
367 (put 'calcFunc-deg\' 'math-derivative-1
|
|
368 (function (lambda (u) (math-div-float '(float 18 1) (math-pi)))))
|
|
369
|
|
370 (put 'calcFunc-rad\' 'math-derivative-1
|
|
371 (function (lambda (u) (math-pi-over-180))))
|
|
372
|
|
373 (put 'calcFunc-ln\' 'math-derivative-1
|
|
374 (function (lambda (u) (math-div 1 u))))
|
|
375
|
|
376 (put 'calcFunc-log10\' 'math-derivative-1
|
|
377 (function (lambda (u)
|
|
378 (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
|
|
379 u))))
|
|
380
|
|
381 (put 'calcFunc-lnp1\' 'math-derivative-1
|
|
382 (function (lambda (u) (math-div 1 (math-add u 1)))))
|
|
383
|
|
384 (put 'calcFunc-log\' 'math-derivative-2
|
|
385 (function (lambda (x b)
|
|
386 (and (not (Math-zerop b))
|
|
387 (let ((lnv (math-normalize
|
|
388 (list 'calcFunc-ln b))))
|
|
389 (math-div 1 (math-mul lnv x)))))))
|
|
390
|
|
391 (put 'calcFunc-log\'2 'math-derivative-2
|
|
392 (function (lambda (x b)
|
|
393 (let ((lnv (list 'calcFunc-ln b)))
|
|
394 (math-neg (math-div (list 'calcFunc-log x b)
|
|
395 (math-mul lnv b)))))))
|
|
396
|
|
397 (put 'calcFunc-exp\' 'math-derivative-1
|
|
398 (function (lambda (u) (math-normalize (list 'calcFunc-exp u)))))
|
|
399
|
|
400 (put 'calcFunc-expm1\' 'math-derivative-1
|
|
401 (function (lambda (u) (math-normalize (list 'calcFunc-expm1 u)))))
|
|
402
|
|
403 (put 'calcFunc-sin\' 'math-derivative-1
|
|
404 (function (lambda (u) (math-to-radians-2 (math-normalize
|
|
405 (list 'calcFunc-cos u))))))
|
|
406
|
|
407 (put 'calcFunc-cos\' 'math-derivative-1
|
|
408 (function (lambda (u) (math-neg (math-to-radians-2
|
|
409 (math-normalize
|
|
410 (list 'calcFunc-sin u)))))))
|
|
411
|
|
412 (put 'calcFunc-tan\' 'math-derivative-1
|
|
413 (function (lambda (u) (math-to-radians-2
|
60171
|
414 (math-sqr
|
|
415 (math-normalize
|
|
416 (list 'calcFunc-sec u)))))))
|
40785
|
417
|
60083
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
418 (put 'calcFunc-sec\' 'math-derivative-1
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
419 (function (lambda (u) (math-to-radians-2
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
420 (math-mul
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
421 (math-normalize
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
422 (list 'calcFunc-sec u))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
423 (math-normalize
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
424 (list 'calcFunc-tan u)))))))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
425
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
426 (put 'calcFunc-csc\' 'math-derivative-1
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
427 (function (lambda (u) (math-neg
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
428 (math-to-radians-2
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
429 (math-mul
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
430 (math-normalize
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
431 (list 'calcFunc-csc u))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
432 (math-normalize
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
433 (list 'calcFunc-cot u))))))))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
434
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
435 (put 'calcFunc-cot\' 'math-derivative-1
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
436 (function (lambda (u) (math-neg
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
437 (math-to-radians-2
|
60171
|
438 (math-sqr
|
|
439 (math-normalize
|
|
440 (list 'calcFunc-csc u))))))))
|
60083
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
441
|
40785
|
442 (put 'calcFunc-arcsin\' 'math-derivative-1
|
|
443 (function (lambda (u)
|
|
444 (math-from-radians-2
|
|
445 (math-div 1 (math-normalize
|
|
446 (list 'calcFunc-sqrt
|
|
447 (math-sub 1 (math-sqr u)))))))))
|
|
448
|
|
449 (put 'calcFunc-arccos\' 'math-derivative-1
|
|
450 (function (lambda (u)
|
|
451 (math-from-radians-2
|
|
452 (math-div -1 (math-normalize
|
|
453 (list 'calcFunc-sqrt
|
|
454 (math-sub 1 (math-sqr u)))))))))
|
|
455
|
|
456 (put 'calcFunc-arctan\' 'math-derivative-1
|
|
457 (function (lambda (u) (math-from-radians-2
|
|
458 (math-div 1 (math-add 1 (math-sqr u)))))))
|
|
459
|
|
460 (put 'calcFunc-sinh\' 'math-derivative-1
|
|
461 (function (lambda (u) (math-normalize (list 'calcFunc-cosh u)))))
|
|
462
|
|
463 (put 'calcFunc-cosh\' 'math-derivative-1
|
|
464 (function (lambda (u) (math-normalize (list 'calcFunc-sinh u)))))
|
|
465
|
|
466 (put 'calcFunc-tanh\' 'math-derivative-1
|
60171
|
467 (function (lambda (u) (math-sqr
|
|
468 (math-normalize
|
|
469 (list 'calcFunc-sech u))))))
|
40785
|
470
|
60083
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
471 (put 'calcFunc-sech\' 'math-derivative-1
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
472 (function (lambda (u) (math-neg
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
473 (math-mul
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
474 (math-normalize (list 'calcFunc-sech u))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
475 (math-normalize (list 'calcFunc-tanh u)))))))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
476
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
477 (put 'calcFunc-csch\' 'math-derivative-1
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
478 (function (lambda (u) (math-neg
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
479 (math-mul
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
480 (math-normalize (list 'calcFunc-csch u))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
481 (math-normalize (list 'calcFunc-coth u)))))))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
482
|
60171
|
483 (put 'calcFunc-coth\' 'math-derivative-1
|
60083
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
484 (function (lambda (u) (math-neg
|
60171
|
485 (math-sqr
|
|
486 (math-normalize
|
|
487 (list 'calcFunc-csch u)))))))
|
60083
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
488
|
40785
|
489 (put 'calcFunc-arcsinh\' 'math-derivative-1
|
|
490 (function (lambda (u)
|
|
491 (math-div 1 (math-normalize
|
|
492 (list 'calcFunc-sqrt
|
|
493 (math-add (math-sqr u) 1)))))))
|
|
494
|
|
495 (put 'calcFunc-arccosh\' 'math-derivative-1
|
|
496 (function (lambda (u)
|
|
497 (math-div 1 (math-normalize
|
|
498 (list 'calcFunc-sqrt
|
|
499 (math-add (math-sqr u) -1)))))))
|
|
500
|
|
501 (put 'calcFunc-arctanh\' 'math-derivative-1
|
|
502 (function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u))))))
|
|
503
|
|
504 (put 'calcFunc-bern\'2 'math-derivative-2
|
|
505 (function (lambda (n x)
|
|
506 (math-mul n (list 'calcFunc-bern (math-add n -1) x)))))
|
|
507
|
|
508 (put 'calcFunc-euler\'2 'math-derivative-2
|
|
509 (function (lambda (n x)
|
|
510 (math-mul n (list 'calcFunc-euler (math-add n -1) x)))))
|
|
511
|
|
512 (put 'calcFunc-gammag\'2 'math-derivative-2
|
|
513 (function (lambda (a x) (math-deriv-gamma a x 1))))
|
|
514
|
|
515 (put 'calcFunc-gammaG\'2 'math-derivative-2
|
|
516 (function (lambda (a x) (math-deriv-gamma a x -1))))
|
|
517
|
|
518 (put 'calcFunc-gammaP\'2 'math-derivative-2
|
|
519 (function (lambda (a x) (math-deriv-gamma a x
|
|
520 (math-div
|
|
521 1 (math-normalize
|
|
522 (list 'calcFunc-gamma
|
|
523 a)))))))
|
|
524
|
|
525 (put 'calcFunc-gammaQ\'2 'math-derivative-2
|
|
526 (function (lambda (a x) (math-deriv-gamma a x
|
|
527 (math-div
|
|
528 -1 (math-normalize
|
|
529 (list 'calcFunc-gamma
|
|
530 a)))))))
|
|
531
|
|
532 (defun math-deriv-gamma (a x scale)
|
|
533 (math-mul scale
|
|
534 (math-mul (math-pow x (math-add a -1))
|
41047
|
535 (list 'calcFunc-exp (math-neg x)))))
|
40785
|
536
|
|
537 (put 'calcFunc-betaB\' 'math-derivative-3
|
|
538 (function (lambda (x a b) (math-deriv-beta x a b 1))))
|
|
539
|
|
540 (put 'calcFunc-betaI\' 'math-derivative-3
|
|
541 (function (lambda (x a b) (math-deriv-beta x a b
|
|
542 (math-div
|
|
543 1 (list 'calcFunc-beta
|
|
544 a b))))))
|
|
545
|
|
546 (defun math-deriv-beta (x a b scale)
|
|
547 (math-mul (math-mul (math-pow x (math-add a -1))
|
|
548 (math-pow (math-sub 1 x) (math-add b -1)))
|
41047
|
549 scale))
|
40785
|
550
|
|
551 (put 'calcFunc-erf\' 'math-derivative-1
|
|
552 (function (lambda (x) (math-div 2
|
|
553 (math-mul (list 'calcFunc-exp
|
|
554 (math-sqr x))
|
|
555 (if calc-symbolic-mode
|
|
556 '(calcFunc-sqrt
|
|
557 (var pi var-pi))
|
|
558 (math-sqrt-pi)))))))
|
|
559
|
|
560 (put 'calcFunc-erfc\' 'math-derivative-1
|
|
561 (function (lambda (x) (math-div -2
|
|
562 (math-mul (list 'calcFunc-exp
|
|
563 (math-sqr x))
|
|
564 (if calc-symbolic-mode
|
|
565 '(calcFunc-sqrt
|
|
566 (var pi var-pi))
|
|
567 (math-sqrt-pi)))))))
|
|
568
|
|
569 (put 'calcFunc-besJ\'2 'math-derivative-2
|
|
570 (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
|
|
571 (math-add v -1)
|
|
572 z)
|
|
573 (list 'calcFunc-besJ
|
|
574 (math-add v 1)
|
|
575 z))
|
|
576 2))))
|
|
577
|
|
578 (put 'calcFunc-besY\'2 'math-derivative-2
|
|
579 (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
|
|
580 (math-add v -1)
|
|
581 z)
|
|
582 (list 'calcFunc-besY
|
|
583 (math-add v 1)
|
|
584 z))
|
|
585 2))))
|
|
586
|
|
587 (put 'calcFunc-sum 'math-derivative-n
|
|
588 (function
|
|
589 (lambda (expr)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
590 (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
|
40785
|
591 (throw 'math-deriv nil)
|
|
592 (cons 'calcFunc-sum
|
|
593 (cons (math-derivative (nth 1 expr))
|
|
594 (cdr (cdr expr))))))))
|
|
595
|
|
596 (put 'calcFunc-prod 'math-derivative-n
|
|
597 (function
|
|
598 (lambda (expr)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
599 (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
|
40785
|
600 (throw 'math-deriv nil)
|
|
601 (math-mul expr
|
|
602 (cons 'calcFunc-sum
|
|
603 (cons (math-div (math-derivative (nth 1 expr))
|
|
604 (nth 1 expr))
|
|
605 (cdr (cdr expr)))))))))
|
|
606
|
|
607 (put 'calcFunc-integ 'math-derivative-n
|
|
608 (function
|
|
609 (lambda (expr)
|
|
610 (if (= (length expr) 3)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
611 (if (equal (nth 2 expr) math-deriv-var)
|
40785
|
612 (nth 1 expr)
|
|
613 (math-normalize
|
|
614 (list 'calcFunc-integ
|
|
615 (math-derivative (nth 1 expr))
|
|
616 (nth 2 expr))))
|
|
617 (if (= (length expr) 5)
|
|
618 (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
|
|
619 (nth 3 expr)))
|
|
620 (upper (math-expr-subst (nth 1 expr) (nth 2 expr)
|
|
621 (nth 4 expr))))
|
|
622 (math-add (math-sub (math-mul upper
|
|
623 (math-derivative (nth 4 expr)))
|
|
624 (math-mul lower
|
|
625 (math-derivative (nth 3 expr))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
626 (if (equal (nth 2 expr) math-deriv-var)
|
40785
|
627 0
|
|
628 (math-normalize
|
|
629 (list 'calcFunc-integ
|
|
630 (math-derivative (nth 1 expr)) (nth 2 expr)
|
|
631 (nth 3 expr) (nth 4 expr)))))))))))
|
|
632
|
|
633 (put 'calcFunc-if 'math-derivative-n
|
|
634 (function
|
|
635 (lambda (expr)
|
|
636 (and (= (length expr) 4)
|
|
637 (list 'calcFunc-if (nth 1 expr)
|
|
638 (math-derivative (nth 2 expr))
|
|
639 (math-derivative (nth 3 expr)))))))
|
|
640
|
|
641 (put 'calcFunc-subscr 'math-derivative-n
|
|
642 (function
|
|
643 (lambda (expr)
|
|
644 (and (= (length expr) 3)
|
|
645 (list 'calcFunc-subscr (nth 1 expr)
|
|
646 (math-derivative (nth 2 expr)))))))
|
|
647
|
|
648
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
649 (defvar math-integ-var '(var X ---))
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
650 (defvar math-integ-var-2 '(var Y ---))
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
651 (defvar math-integ-vars (list 'f math-integ-var math-integ-var-2))
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
652 (defvar math-integ-var-list (list math-integ-var))
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
653 (defvar math-integ-var-list-list (list math-integ-var-list))
|
40785
|
654
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
655 ;; math-integ-depth is a local variable for math-try-integral, but is used
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
656 ;; by math-integral and math-tracing-integral
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
657 ;; which are called (directly or indirectly) by math-try-integral.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
658 (defvar math-integ-depth)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
659 ;; math-integ-level is a local variable for math-try-integral, but is used
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
660 ;; by math-integral, math-do-integral, math-tracing-integral,
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
661 ;; math-sub-integration, math-integrate-by-parts and
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
662 ;; math-integrate-by-substitution, which are called (directly or
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
663 ;; indirectly) by math-try-integral.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
664 (defvar math-integ-level)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
665 ;; math-integral-limit is a local variable for calcFunc-integ, but is
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
666 ;; used by math-tracing-integral, math-sub-integration and
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
667 ;; math-try-integration.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
668 (defvar math-integral-limit)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
669
|
40785
|
670 (defmacro math-tracing-integral (&rest parts)
|
|
671 (list 'and
|
|
672 'trace-buffer
|
|
673 (list 'save-excursion
|
|
674 '(set-buffer trace-buffer)
|
|
675 '(goto-char (point-max))
|
|
676 (list 'and
|
|
677 '(bolp)
|
|
678 '(insert (make-string (- math-integral-limit
|
|
679 math-integ-level) 32)
|
|
680 (format "%2d " math-integ-depth)
|
|
681 (make-string math-integ-level 32)))
|
|
682 ;;(list 'condition-case 'err
|
|
683 (cons 'insert parts)
|
|
684 ;; '(error (insert (prin1-to-string err))))
|
41047
|
685 '(sit-for 0))))
|
40785
|
686
|
|
687 ;;; The following wrapper caches results and avoids infinite recursion.
|
|
688 ;;; Each cache entry is: ( A B ) Integral of A is B;
|
|
689 ;;; ( A N ) Integral of A failed at level N;
|
|
690 ;;; ( A busy ) Currently working on integral of A;
|
|
691 ;;; ( A parts ) Currently working, integ-by-parts;
|
|
692 ;;; ( A parts2 ) Currently working, integ-by-parts;
|
|
693 ;;; ( A cancelled ) Ignore this cache entry;
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
694 ;;; ( A [B] ) Same result as for math-cur-record = B.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
695
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
696 ;; math-cur-record is a local variable for math-try-integral, but is used
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
697 ;; by math-integral, math-replace-integral-parts and math-integrate-by-parts
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
698 ;; which are called (directly or indirectly) by math-try-integral, as well as
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
699 ;; by calc-dump-integral-cache
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
700 (defvar math-cur-record)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
701 ;; math-enable-subst and math-any-substs are local variables for
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
702 ;; calcFunc-integ, but are used by math-integral and math-try-integral.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
703 (defvar math-enable-subst)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
704 (defvar math-any-substs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
705
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
706 ;; math-integ-msg is a local variable for math-try-integral, but is
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
707 ;; used (both locally and non-locally) by math-integral.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
708 (defvar math-integ-msg)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
709
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
710 (defvar math-integral-cache nil)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
711 (defvar math-integral-cache-state nil)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
712
|
40785
|
713 (defun math-integral (expr &optional simplify same-as-above)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
714 (let* ((simp math-cur-record)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
715 (math-cur-record (assoc expr math-integral-cache))
|
40785
|
716 (math-integ-depth (1+ math-integ-depth))
|
|
717 (val 'cancelled))
|
|
718 (math-tracing-integral "Integrating "
|
|
719 (math-format-value expr 1000)
|
|
720 "...\n")
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
721 (and math-cur-record
|
40785
|
722 (progn
|
|
723 (math-tracing-integral "Found "
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
724 (math-format-value (nth 1 math-cur-record) 1000))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
725 (and (consp (nth 1 math-cur-record))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
726 (math-replace-integral-parts math-cur-record))
|
40785
|
727 (math-tracing-integral " => "
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
728 (math-format-value (nth 1 math-cur-record) 1000)
|
40785
|
729 "\n")))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
730 (or (and math-cur-record
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
731 (not (eq (nth 1 math-cur-record) 'cancelled))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
732 (or (not (integerp (nth 1 math-cur-record)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
733 (>= (nth 1 math-cur-record) math-integ-level)))
|
40785
|
734 (and (math-integral-contains-parts expr)
|
|
735 (progn
|
|
736 (setq val nil)
|
|
737 t))
|
|
738 (unwind-protect
|
|
739 (progn
|
|
740 (let (math-integ-msg)
|
|
741 (if (eq calc-display-working-message 'lots)
|
|
742 (progn
|
|
743 (calc-set-command-flag 'clear-message)
|
|
744 (setq math-integ-msg (format
|
|
745 "Working... Integrating %s"
|
|
746 (math-format-flat-expr expr 0)))
|
|
747 (message math-integ-msg)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
748 (if math-cur-record
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
749 (setcar (cdr math-cur-record)
|
40785
|
750 (if same-as-above (vector simp) 'busy))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
751 (setq math-cur-record
|
40785
|
752 (list expr (if same-as-above (vector simp) 'busy))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
753 math-integral-cache (cons math-cur-record
|
40785
|
754 math-integral-cache)))
|
|
755 (if (eq simplify 'yes)
|
|
756 (progn
|
|
757 (math-tracing-integral "Simplifying...")
|
|
758 (setq simp (math-simplify expr))
|
|
759 (setq val (if (equal simp expr)
|
|
760 (progn
|
|
761 (math-tracing-integral " no change\n")
|
|
762 (math-do-integral expr))
|
|
763 (math-tracing-integral " simplified\n")
|
|
764 (math-integral simp 'no t))))
|
|
765 (or (setq val (math-do-integral expr))
|
|
766 (eq simplify 'no)
|
|
767 (let ((simp (math-simplify expr)))
|
|
768 (or (equal simp expr)
|
|
769 (progn
|
|
770 (math-tracing-integral "Trying again after "
|
|
771 "simplification...\n")
|
|
772 (setq val (math-integral simp 'no t))))))))
|
|
773 (if (eq calc-display-working-message 'lots)
|
|
774 (message math-integ-msg)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
775 (setcar (cdr math-cur-record) (or val
|
40785
|
776 (if (or math-enable-subst
|
|
777 (not math-any-substs))
|
|
778 math-integ-level
|
|
779 'cancelled)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
780 (setq val math-cur-record)
|
40785
|
781 (while (vectorp (nth 1 val))
|
|
782 (setq val (aref (nth 1 val) 0)))
|
|
783 (setq val (if (memq (nth 1 val) '(parts parts2))
|
|
784 (progn
|
|
785 (setcar (cdr val) 'parts2)
|
|
786 (list 'var 'PARTS val))
|
|
787 (and (consp (nth 1 val))
|
|
788 (nth 1 val))))
|
|
789 (math-tracing-integral "Integral of "
|
|
790 (math-format-value expr 1000)
|
|
791 " is "
|
|
792 (math-format-value val 1000)
|
|
793 "\n")
|
41047
|
794 val))
|
40785
|
795
|
|
796 (defun math-integral-contains-parts (expr)
|
|
797 (if (Math-primp expr)
|
|
798 (and (eq (car-safe expr) 'var)
|
|
799 (eq (nth 1 expr) 'PARTS)
|
|
800 (listp (nth 2 expr)))
|
|
801 (while (and (setq expr (cdr expr))
|
|
802 (not (math-integral-contains-parts (car expr)))))
|
41047
|
803 expr))
|
40785
|
804
|
|
805 (defun math-replace-integral-parts (expr)
|
|
806 (or (Math-primp expr)
|
|
807 (while (setq expr (cdr expr))
|
|
808 (and (consp (car expr))
|
|
809 (if (eq (car (car expr)) 'var)
|
|
810 (and (eq (nth 1 (car expr)) 'PARTS)
|
|
811 (consp (nth 2 (car expr)))
|
|
812 (if (listp (nth 1 (nth 2 (car expr))))
|
|
813 (progn
|
|
814 (setcar expr (nth 1 (nth 2 (car expr))))
|
|
815 (math-replace-integral-parts (cons 'foo expr)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
816 (setcar (cdr math-cur-record) 'cancelled)))
|
41047
|
817 (math-replace-integral-parts (car expr)))))))
|
40785
|
818
|
58023
|
819 (defvar math-linear-subst-tried t
|
|
820 "Non-nil means that a linear substitution has been tried.")
|
|
821
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
822 ;; The variable math-has-rules is a local variable for math-try-integral,
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
823 ;; but is used by math-do-integral, which is called (non-directly) by
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
824 ;; math-try-integral.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
825 (defvar math-has-rules)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
826
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
827 ;; math-old-integ is a local variable for math-do-integral, but is
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
828 ;; used by math-sub-integration.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
829 (defvar math-old-integ)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
830
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
831 ;; The variables math-t1, math-t2 and math-t3 are local to
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
832 ;; math-do-integral, math-try-solve-for and math-decompose-poly, but
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
833 ;; are used by functions they call (directly or indirectly);
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
834 ;; math-do-integral calls math-do-integral-methods;
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
835 ;; math-try-solve-for calls math-try-solve-prod,
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
836 ;; math-solve-find-root-term and math-solve-find-root-in-prod;
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
837 ;; math-decompose-poly calls math-solve-poly-funny-powers and
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
838 ;; math-solve-crunch-poly.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
839 (defvar math-t1)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
840 (defvar math-t2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
841 (defvar math-t3)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
842
|
40785
|
843 (defun math-do-integral (expr)
|
58023
|
844 (let ((math-linear-subst-tried nil)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
845 math-t1 math-t2)
|
40785
|
846 (or (cond ((not (math-expr-contains expr math-integ-var))
|
|
847 (math-mul expr math-integ-var))
|
|
848 ((equal expr math-integ-var)
|
|
849 (math-div (math-sqr expr) 2))
|
|
850 ((eq (car expr) '+)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
851 (and (setq math-t1 (math-integral (nth 1 expr)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
852 (setq math-t2 (math-integral (nth 2 expr)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
853 (math-add math-t1 math-t2)))
|
40785
|
854 ((eq (car expr) '-)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
855 (and (setq math-t1 (math-integral (nth 1 expr)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
856 (setq math-t2 (math-integral (nth 2 expr)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
857 (math-sub math-t1 math-t2)))
|
40785
|
858 ((eq (car expr) 'neg)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
859 (and (setq math-t1 (math-integral (nth 1 expr)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
860 (math-neg math-t1)))
|
40785
|
861 ((eq (car expr) '*)
|
|
862 (cond ((not (math-expr-contains (nth 1 expr) math-integ-var))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
863 (and (setq math-t1 (math-integral (nth 2 expr)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
864 (math-mul (nth 1 expr) math-t1)))
|
40785
|
865 ((not (math-expr-contains (nth 2 expr) math-integ-var))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
866 (and (setq math-t1 (math-integral (nth 1 expr)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
867 (math-mul math-t1 (nth 2 expr))))
|
40785
|
868 ((memq (car-safe (nth 1 expr)) '(+ -))
|
|
869 (math-integral (list (car (nth 1 expr))
|
|
870 (math-mul (nth 1 (nth 1 expr))
|
|
871 (nth 2 expr))
|
|
872 (math-mul (nth 2 (nth 1 expr))
|
|
873 (nth 2 expr)))
|
|
874 'yes t))
|
|
875 ((memq (car-safe (nth 2 expr)) '(+ -))
|
|
876 (math-integral (list (car (nth 2 expr))
|
|
877 (math-mul (nth 1 (nth 2 expr))
|
|
878 (nth 1 expr))
|
|
879 (math-mul (nth 2 (nth 2 expr))
|
|
880 (nth 1 expr)))
|
|
881 'yes t))))
|
|
882 ((eq (car expr) '/)
|
|
883 (cond ((and (not (math-expr-contains (nth 1 expr)
|
|
884 math-integ-var))
|
|
885 (not (math-equal-int (nth 1 expr) 1)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
886 (and (setq math-t1 (math-integral (math-div 1 (nth 2 expr))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
887 (math-mul (nth 1 expr) math-t1)))
|
40785
|
888 ((not (math-expr-contains (nth 2 expr) math-integ-var))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
889 (and (setq math-t1 (math-integral (nth 1 expr)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
890 (math-div math-t1 (nth 2 expr))))
|
40785
|
891 ((and (eq (car-safe (nth 1 expr)) '*)
|
|
892 (not (math-expr-contains (nth 1 (nth 1 expr))
|
|
893 math-integ-var)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
894 (and (setq math-t1 (math-integral
|
40785
|
895 (math-div (nth 2 (nth 1 expr))
|
|
896 (nth 2 expr))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
897 (math-mul math-t1 (nth 1 (nth 1 expr)))))
|
40785
|
898 ((and (eq (car-safe (nth 1 expr)) '*)
|
|
899 (not (math-expr-contains (nth 2 (nth 1 expr))
|
|
900 math-integ-var)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
901 (and (setq math-t1 (math-integral
|
40785
|
902 (math-div (nth 1 (nth 1 expr))
|
|
903 (nth 2 expr))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
904 (math-mul math-t1 (nth 2 (nth 1 expr)))))
|
40785
|
905 ((and (eq (car-safe (nth 2 expr)) '*)
|
|
906 (not (math-expr-contains (nth 1 (nth 2 expr))
|
|
907 math-integ-var)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
908 (and (setq math-t1 (math-integral
|
40785
|
909 (math-div (nth 1 expr)
|
|
910 (nth 2 (nth 2 expr)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
911 (math-div math-t1 (nth 1 (nth 2 expr)))))
|
40785
|
912 ((and (eq (car-safe (nth 2 expr)) '*)
|
|
913 (not (math-expr-contains (nth 2 (nth 2 expr))
|
|
914 math-integ-var)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
915 (and (setq math-t1 (math-integral
|
40785
|
916 (math-div (nth 1 expr)
|
|
917 (nth 1 (nth 2 expr)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
918 (math-div math-t1 (nth 2 (nth 2 expr)))))
|
40785
|
919 ((eq (car-safe (nth 2 expr)) 'calcFunc-exp)
|
|
920 (math-integral
|
|
921 (math-mul (nth 1 expr)
|
|
922 (list 'calcFunc-exp
|
|
923 (math-neg (nth 1 (nth 2 expr)))))))))
|
|
924 ((eq (car expr) '^)
|
|
925 (cond ((not (math-expr-contains (nth 1 expr) math-integ-var))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
926 (or (and (setq math-t1 (math-is-polynomial (nth 2 expr)
|
40785
|
927 math-integ-var 1))
|
|
928 (math-div expr
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
929 (math-mul (nth 1 math-t1)
|
40785
|
930 (math-normalize
|
|
931 (list 'calcFunc-ln
|
|
932 (nth 1 expr))))))
|
|
933 (math-integral
|
|
934 (list 'calcFunc-exp
|
|
935 (math-mul (nth 2 expr)
|
|
936 (math-normalize
|
|
937 (list 'calcFunc-ln
|
|
938 (nth 1 expr)))))
|
|
939 'yes t)))
|
|
940 ((not (math-expr-contains (nth 2 expr) math-integ-var))
|
|
941 (if (and (integerp (nth 2 expr)) (< (nth 2 expr) 0))
|
|
942 (math-integral
|
|
943 (list '/ 1 (math-pow (nth 1 expr) (- (nth 2 expr))))
|
|
944 nil t)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
945 (or (and (setq math-t1 (math-is-polynomial (nth 1 expr)
|
40785
|
946 math-integ-var
|
|
947 1))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
948 (setq math-t2 (math-add (nth 2 expr) 1))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
949 (math-div (math-pow (nth 1 expr) math-t2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
950 (math-mul math-t2 (nth 1 math-t1))))
|
40785
|
951 (and (Math-negp (nth 2 expr))
|
|
952 (math-integral
|
|
953 (math-div 1
|
|
954 (math-pow (nth 1 expr)
|
|
955 (math-neg
|
|
956 (nth 2 expr))))
|
|
957 nil t))
|
|
958 nil))))))
|
|
959
|
|
960 ;; Integral of a polynomial.
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
961 (and (setq math-t1 (math-is-polynomial expr math-integ-var 20))
|
40785
|
962 (let ((accum 0)
|
|
963 (n 1))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
964 (while math-t1
|
40785
|
965 (if (setq accum (math-add accum
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
966 (math-div (math-mul (car math-t1)
|
40785
|
967 (math-pow
|
|
968 math-integ-var
|
|
969 n))
|
|
970 n))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
971 math-t1 (cdr math-t1))
|
40785
|
972 (setq n (1+ n))))
|
|
973 accum))
|
|
974
|
|
975 ;; Try looking it up!
|
|
976 (cond ((= (length expr) 2)
|
|
977 (and (symbolp (car expr))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
978 (setq math-t1 (get (car expr) 'math-integral))
|
40785
|
979 (progn
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
980 (while (and math-t1
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
981 (not (setq math-t2 (funcall (car math-t1)
|
40785
|
982 (nth 1 expr)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
983 (setq math-t1 (cdr math-t1)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
984 (and math-t2 (math-normalize math-t2)))))
|
40785
|
985 ((= (length expr) 3)
|
|
986 (and (symbolp (car expr))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
987 (setq math-t1 (get (car expr) 'math-integral-2))
|
40785
|
988 (progn
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
989 (while (and math-t1
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
990 (not (setq math-t2 (funcall (car math-t1)
|
40785
|
991 (nth 1 expr)
|
|
992 (nth 2 expr)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
993 (setq math-t1 (cdr math-t1)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
994 (and math-t2 (math-normalize math-t2))))))
|
40785
|
995
|
|
996 ;; Integral of a rational function.
|
|
997 (and (math-ratpoly-p expr math-integ-var)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
998 (setq math-t1 (calcFunc-apart expr math-integ-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
999 (not (equal math-t1 expr))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1000 (math-integral math-t1))
|
40785
|
1001
|
|
1002 ;; Try user-defined integration rules.
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1003 (and math-has-rules
|
40785
|
1004 (let ((math-old-integ (symbol-function 'calcFunc-integ))
|
|
1005 (input (list 'calcFunc-integtry expr math-integ-var))
|
|
1006 res part)
|
|
1007 (unwind-protect
|
|
1008 (progn
|
|
1009 (fset 'calcFunc-integ 'math-sub-integration)
|
|
1010 (setq res (math-rewrite input
|
|
1011 '(var IntegRules var-IntegRules)
|
|
1012 1))
|
|
1013 (fset 'calcFunc-integ math-old-integ)
|
|
1014 (and (not (equal res input))
|
|
1015 (if (setq part (math-expr-calls
|
|
1016 res '(calcFunc-integsubst)))
|
|
1017 (and (memq (length part) '(3 4 5))
|
|
1018 (let ((parts (mapcar
|
|
1019 (function
|
|
1020 (lambda (x)
|
|
1021 (math-expr-subst
|
|
1022 x (nth 2 part)
|
|
1023 math-integ-var)))
|
|
1024 (cdr part))))
|
|
1025 (math-integrate-by-substitution
|
|
1026 expr (car parts) t
|
|
1027 (or (nth 2 parts)
|
|
1028 (list 'calcFunc-integfailed
|
|
1029 math-integ-var))
|
|
1030 (nth 3 parts))))
|
|
1031 (if (not (math-expr-calls res
|
|
1032 '(calcFunc-integtry
|
|
1033 calcFunc-integfailed)))
|
|
1034 res))))
|
|
1035 (fset 'calcFunc-integ math-old-integ))))
|
|
1036
|
|
1037 ;; See if the function is a symbolic derivative.
|
|
1038 (and (string-match "'" (symbol-name (car expr)))
|
|
1039 (let ((name (symbol-name (car expr)))
|
|
1040 (p expr) (n 0) (which nil) (bad nil))
|
|
1041 (while (setq n (1+ n) p (cdr p))
|
|
1042 (if (equal (car p) math-integ-var)
|
|
1043 (if which (setq bad t) (setq which n))
|
|
1044 (if (math-expr-contains (car p) math-integ-var)
|
|
1045 (setq bad t))))
|
|
1046 (and which (not bad)
|
|
1047 (let ((prime (if (= which 1) "'" (format "'%d" which))))
|
|
1048 (and (string-match (concat prime "\\('['0-9]*\\|$\\)")
|
|
1049 name)
|
|
1050 (cons (intern
|
|
1051 (concat
|
|
1052 (substring name 0 (match-beginning 0))
|
|
1053 (substring name (+ (match-beginning 0)
|
|
1054 (length prime)))))
|
|
1055 (cdr expr)))))))
|
|
1056
|
|
1057 ;; Try transformation methods (parts, substitutions).
|
|
1058 (and (> math-integ-level 0)
|
|
1059 (math-do-integral-methods expr))
|
|
1060
|
|
1061 ;; Try expanding the function's definition.
|
|
1062 (let ((res (math-expand-formula expr)))
|
|
1063 (and res
|
41047
|
1064 (math-integral res))))))
|
40785
|
1065
|
|
1066 (defun math-sub-integration (expr &rest rest)
|
|
1067 (or (if (or (not rest)
|
|
1068 (and (< math-integ-level math-integral-limit)
|
|
1069 (eq (car rest) math-integ-var)))
|
|
1070 (math-integral expr)
|
|
1071 (let ((res (apply math-old-integ expr rest)))
|
|
1072 (and (or (= math-integ-level math-integral-limit)
|
|
1073 (not (math-expr-calls res 'calcFunc-integ)))
|
|
1074 res)))
|
41047
|
1075 (list 'calcFunc-integfailed expr)))
|
40785
|
1076
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1077 ;; math-so-far is a local variable for math-do-integral-methods, but
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1078 ;; is used by math-integ-try-linear-substitutions and
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1079 ;; math-integ-try-substitutions.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1080 (defvar math-so-far)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1081
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1082 ;; math-integ-expr is a local variable for math-do-integral-methods,
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1083 ;; but is used by math-integ-try-linear-substitutions and
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1084 ;; math-integ-try-substitutions.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1085 (defvar math-integ-expr)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1086
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1087 (defun math-do-integral-methods (math-integ-expr)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1088 (let ((math-so-far math-integ-var-list-list)
|
40785
|
1089 rat-in)
|
|
1090
|
|
1091 ;; Integration by substitution, for various likely sub-expressions.
|
|
1092 ;; (In first pass, we look only for sub-exprs that are linear in X.)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1093 (or (math-integ-try-linear-substitutions math-integ-expr)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1094 (math-integ-try-substitutions math-integ-expr)
|
40785
|
1095
|
|
1096 ;; If function has sines and cosines, try tan(x/2) substitution.
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1097 (and (let ((p (setq rat-in (math-expr-rational-in math-integ-expr))))
|
40785
|
1098 (while (and p
|
|
1099 (memq (car (car p)) '(calcFunc-sin
|
|
1100 calcFunc-cos
|
60083
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1101 calcFunc-tan
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1102 calcFunc-sec
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1103 calcFunc-csc
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1104 calcFunc-cot))
|
40785
|
1105 (equal (nth 1 (car p)) math-integ-var))
|
|
1106 (setq p (cdr p)))
|
|
1107 (null p))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1108 (or (and (math-integ-parts-easy math-integ-expr)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1109 (math-integ-try-parts math-integ-expr t))
|
40785
|
1110 (math-integrate-by-good-substitution
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1111 math-integ-expr (list 'calcFunc-tan (math-div math-integ-var 2)))))
|
40785
|
1112
|
|
1113 ;; If function has sinh and cosh, try tanh(x/2) substitution.
|
|
1114 (and (let ((p rat-in))
|
|
1115 (while (and p
|
|
1116 (memq (car (car p)) '(calcFunc-sinh
|
|
1117 calcFunc-cosh
|
|
1118 calcFunc-tanh
|
60083
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1119 calcFunc-sech
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1120 calcFunc-csch
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1121 calcFunc-coth
|
40785
|
1122 calcFunc-exp))
|
|
1123 (equal (nth 1 (car p)) math-integ-var))
|
|
1124 (setq p (cdr p)))
|
|
1125 (null p))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1126 (or (and (math-integ-parts-easy math-integ-expr)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1127 (math-integ-try-parts math-integ-expr t))
|
40785
|
1128 (math-integrate-by-good-substitution
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1129 math-integ-expr (list 'calcFunc-tanh (math-div math-integ-var 2)))))
|
40785
|
1130
|
|
1131 ;; If function has square roots, try sin, tan, or sec substitution.
|
|
1132 (and (let ((p rat-in))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1133 (setq math-t1 nil)
|
40785
|
1134 (while (and p
|
|
1135 (or (equal (car p) math-integ-var)
|
|
1136 (and (eq (car (car p)) 'calcFunc-sqrt)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1137 (setq math-t1 (math-is-polynomial
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1138 (nth 1 (setq math-t2 (car p)))
|
40785
|
1139 math-integ-var 2)))))
|
|
1140 (setq p (cdr p)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1141 (and (null p) math-t1))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1142 (if (cdr (cdr math-t1))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1143 (if (math-guess-if-neg (nth 2 math-t1))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1144 (let* ((c (math-sqrt (math-neg (nth 2 math-t1))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1145 (d (math-div (nth 1 math-t1) (math-mul -2 c)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1146 (a (math-sqrt (math-add (car math-t1) (math-sqr d)))))
|
40785
|
1147 (math-integrate-by-good-substitution
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1148 math-integ-expr (list 'calcFunc-arcsin
|
40785
|
1149 (math-div-thru
|
|
1150 (math-add (math-mul c math-integ-var) d)
|
|
1151 a))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1152 (let* ((c (math-sqrt (nth 2 math-t1)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1153 (d (math-div (nth 1 math-t1) (math-mul 2 c)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1154 (aa (math-sub (car math-t1) (math-sqr d))))
|
40785
|
1155 (if (and nil (not (and (eq d 0) (eq c 1))))
|
|
1156 (math-integrate-by-good-substitution
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1157 math-integ-expr (math-add (math-mul c math-integ-var) d))
|
40785
|
1158 (if (math-guess-if-neg aa)
|
|
1159 (math-integrate-by-good-substitution
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1160 math-integ-expr (list 'calcFunc-arccosh
|
40785
|
1161 (math-div-thru
|
|
1162 (math-add (math-mul c math-integ-var)
|
|
1163 d)
|
|
1164 (math-sqrt (math-neg aa)))))
|
|
1165 (math-integrate-by-good-substitution
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1166 math-integ-expr (list 'calcFunc-arcsinh
|
40785
|
1167 (math-div-thru
|
|
1168 (math-add (math-mul c math-integ-var)
|
|
1169 d)
|
|
1170 (math-sqrt aa))))))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1171 (math-integrate-by-good-substitution math-integ-expr math-t2)) )
|
40785
|
1172
|
|
1173 ;; Try integration by parts.
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1174 (math-integ-try-parts math-integ-expr)
|
40785
|
1175
|
|
1176 ;; Give up.
|
41047
|
1177 nil)))
|
40785
|
1178
|
|
1179 (defun math-integ-parts-easy (expr)
|
|
1180 (cond ((Math-primp expr) t)
|
|
1181 ((memq (car expr) '(+ - *))
|
|
1182 (and (math-integ-parts-easy (nth 1 expr))
|
|
1183 (math-integ-parts-easy (nth 2 expr))))
|
|
1184 ((eq (car expr) '/)
|
|
1185 (and (math-integ-parts-easy (nth 1 expr))
|
|
1186 (math-atomic-factorp (nth 2 expr))))
|
|
1187 ((eq (car expr) '^)
|
|
1188 (and (natnump (nth 2 expr))
|
|
1189 (math-integ-parts-easy (nth 1 expr))))
|
|
1190 ((eq (car expr) 'neg)
|
|
1191 (math-integ-parts-easy (nth 1 expr)))
|
41047
|
1192 (t t)))
|
40785
|
1193
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1194 ;; math-prev-parts-v is local to calcFunc-integ (as well as
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1195 ;; math-integrate-by-parts), but is used by math-integ-try-parts.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1196 (defvar math-prev-parts-v)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1197
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1198 ;; math-good-parts is local to calcFunc-integ (as well as
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1199 ;; math-integ-try-parts), but is used by math-integrate-by-parts.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1200 (defvar math-good-parts)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1201
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1202
|
40785
|
1203 (defun math-integ-try-parts (expr &optional math-good-parts)
|
|
1204 ;; Integration by parts:
|
|
1205 ;; integ(f(x) g(x),x) = f(x) h(x) - integ(h(x) f'(x),x)
|
|
1206 ;; where h(x) = integ(g(x),x).
|
|
1207 (or (let ((exp (calcFunc-expand expr)))
|
|
1208 (and (not (equal exp expr))
|
|
1209 (math-integral exp)))
|
|
1210 (and (eq (car expr) '*)
|
|
1211 (let ((first-bad (or (math-polynomial-p (nth 1 expr)
|
|
1212 math-integ-var)
|
|
1213 (equal (nth 2 expr) math-prev-parts-v))))
|
|
1214 (or (and first-bad ; so try this one first
|
|
1215 (math-integrate-by-parts (nth 1 expr) (nth 2 expr)))
|
|
1216 (math-integrate-by-parts (nth 2 expr) (nth 1 expr))
|
|
1217 (and (not first-bad)
|
|
1218 (math-integrate-by-parts (nth 1 expr) (nth 2 expr))))))
|
|
1219 (and (eq (car expr) '/)
|
|
1220 (math-expr-contains (nth 1 expr) math-integ-var)
|
|
1221 (let ((recip (math-div 1 (nth 2 expr))))
|
|
1222 (or (math-integrate-by-parts (nth 1 expr) recip)
|
|
1223 (math-integrate-by-parts recip (nth 1 expr)))))
|
|
1224 (and (eq (car expr) '^)
|
|
1225 (math-integrate-by-parts (math-pow (nth 1 expr)
|
|
1226 (math-sub (nth 2 expr) 1))
|
41047
|
1227 (nth 1 expr)))))
|
40785
|
1228
|
|
1229 (defun math-integrate-by-parts (u vprime)
|
|
1230 (let ((math-integ-level (if (or math-good-parts
|
|
1231 (math-polynomial-p u math-integ-var))
|
|
1232 math-integ-level
|
|
1233 (1- math-integ-level)))
|
|
1234 (math-doing-parts t)
|
|
1235 v temp)
|
|
1236 (and (>= math-integ-level 0)
|
|
1237 (unwind-protect
|
|
1238 (progn
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1239 (setcar (cdr math-cur-record) 'parts)
|
40785
|
1240 (math-tracing-integral "Integrating by parts, u = "
|
|
1241 (math-format-value u 1000)
|
|
1242 ", v' = "
|
|
1243 (math-format-value vprime 1000)
|
|
1244 "\n")
|
|
1245 (and (setq v (math-integral vprime))
|
|
1246 (setq temp (calcFunc-deriv u math-integ-var nil t))
|
|
1247 (setq temp (let ((math-prev-parts-v v))
|
|
1248 (math-integral (math-mul v temp) 'yes)))
|
|
1249 (setq temp (math-sub (math-mul u v) temp))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1250 (if (eq (nth 1 math-cur-record) 'parts)
|
40785
|
1251 (calcFunc-expand temp)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1252 (setq v (list 'var 'PARTS math-cur-record)
|
40785
|
1253 temp (let (calc-next-why)
|
|
1254 (math-solve-for (math-sub v temp) 0 v nil)))
|
|
1255 (and temp (not (integerp temp))
|
|
1256 (math-simplify-extended temp)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1257 (setcar (cdr math-cur-record) 'busy)))))
|
40785
|
1258
|
|
1259 ;;; This tries two different formulations, hoping the algebraic simplifier
|
|
1260 ;;; will be strong enough to handle at least one.
|
|
1261 (defun math-integrate-by-substitution (expr u &optional user uinv uinvprime)
|
|
1262 (and (> math-integ-level 0)
|
|
1263 (let ((math-integ-level (max (- math-integ-level 2) 0)))
|
41047
|
1264 (math-integrate-by-good-substitution expr u user uinv uinvprime))))
|
40785
|
1265
|
|
1266 (defun math-integrate-by-good-substitution (expr u &optional user
|
|
1267 uinv uinvprime)
|
|
1268 (let ((math-living-dangerously t)
|
|
1269 deriv temp)
|
|
1270 (and (setq uinv (if uinv
|
|
1271 (math-expr-subst uinv math-integ-var
|
|
1272 math-integ-var-2)
|
|
1273 (let (calc-next-why)
|
|
1274 (math-solve-for u
|
|
1275 math-integ-var-2
|
|
1276 math-integ-var nil))))
|
|
1277 (progn
|
|
1278 (math-tracing-integral "Integrating by substitution, u = "
|
|
1279 (math-format-value u 1000)
|
|
1280 "\n")
|
|
1281 (or (and (setq deriv (calcFunc-deriv u
|
|
1282 math-integ-var nil
|
|
1283 (not user)))
|
|
1284 (setq temp (math-integral (math-expr-subst
|
|
1285 (math-expr-subst
|
|
1286 (math-expr-subst
|
|
1287 (math-div expr deriv)
|
|
1288 u
|
|
1289 math-integ-var-2)
|
|
1290 math-integ-var
|
|
1291 uinv)
|
|
1292 math-integ-var-2
|
|
1293 math-integ-var)
|
|
1294 'yes)))
|
|
1295 (and (setq deriv (or uinvprime
|
|
1296 (calcFunc-deriv uinv
|
|
1297 math-integ-var-2
|
|
1298 math-integ-var
|
|
1299 (not user))))
|
|
1300 (setq temp (math-integral (math-mul
|
|
1301 (math-expr-subst
|
|
1302 (math-expr-subst
|
|
1303 (math-expr-subst
|
|
1304 expr
|
|
1305 u
|
|
1306 math-integ-var-2)
|
|
1307 math-integ-var
|
|
1308 uinv)
|
|
1309 math-integ-var-2
|
|
1310 math-integ-var)
|
|
1311 deriv)
|
|
1312 'yes)))))
|
|
1313 (math-simplify-extended
|
41047
|
1314 (math-expr-subst temp math-integ-var u)))))
|
40785
|
1315
|
|
1316 ;;; Look for substitutions of the form u = a x + b.
|
|
1317 (defun math-integ-try-linear-substitutions (sub-expr)
|
58023
|
1318 (setq math-linear-subst-tried t)
|
40785
|
1319 (and (not (Math-primp sub-expr))
|
|
1320 (or (and (not (memq (car sub-expr) '(+ - * / neg)))
|
|
1321 (not (and (eq (car sub-expr) '^)
|
|
1322 (integerp (nth 2 sub-expr))))
|
|
1323 (math-expr-contains sub-expr math-integ-var)
|
|
1324 (let ((res nil))
|
|
1325 (while (and (setq sub-expr (cdr sub-expr))
|
|
1326 (or (not (math-linear-in (car sub-expr)
|
|
1327 math-integ-var))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1328 (assoc (car sub-expr) math-so-far)
|
40785
|
1329 (progn
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1330 (setq math-so-far (cons (list (car sub-expr))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1331 math-so-far))
|
40785
|
1332 (not (setq res
|
|
1333 (math-integrate-by-substitution
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1334 math-integ-expr (car sub-expr))))))))
|
40785
|
1335 res))
|
|
1336 (let ((res nil))
|
|
1337 (while (and (setq sub-expr (cdr sub-expr))
|
|
1338 (not (setq res (math-integ-try-linear-substitutions
|
|
1339 (car sub-expr))))))
|
41047
|
1340 res))))
|
40785
|
1341
|
|
1342 ;;; Recursively try different substitutions based on various sub-expressions.
|
|
1343 (defun math-integ-try-substitutions (sub-expr &optional allow-rat)
|
|
1344 (and (not (Math-primp sub-expr))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1345 (not (assoc sub-expr math-so-far))
|
40785
|
1346 (math-expr-contains sub-expr math-integ-var)
|
|
1347 (or (and (if (and (not (memq (car sub-expr) '(+ - * / neg)))
|
|
1348 (not (and (eq (car sub-expr) '^)
|
|
1349 (integerp (nth 2 sub-expr)))))
|
|
1350 (setq allow-rat t)
|
|
1351 (prog1 allow-rat (setq allow-rat nil)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1352 (not (eq sub-expr math-integ-expr))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1353 (or (math-integrate-by-substitution math-integ-expr sub-expr)
|
40785
|
1354 (and (eq (car sub-expr) '^)
|
|
1355 (integerp (nth 2 sub-expr))
|
|
1356 (< (nth 2 sub-expr) 0)
|
|
1357 (math-integ-try-substitutions
|
|
1358 (math-pow (nth 1 sub-expr) (- (nth 2 sub-expr)))
|
|
1359 t))))
|
|
1360 (let ((res nil))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1361 (setq math-so-far (cons (list sub-expr) math-so-far))
|
40785
|
1362 (while (and (setq sub-expr (cdr sub-expr))
|
|
1363 (not (setq res (math-integ-try-substitutions
|
|
1364 (car sub-expr) allow-rat)))))
|
41047
|
1365 res))))
|
40785
|
1366
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1367 ;; The variable math-expr-parts is local to math-expr-rational-in,
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1368 ;; but is used by math-expr-rational-in-rec
|
58573
87c7dff39cb0
(math-expr-parts, math-try-solve-sign, math-solve-b, math-int-factors)
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1369 (defvar math-expr-parts)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1370
|
40785
|
1371 (defun math-expr-rational-in (expr)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1372 (let ((math-expr-parts nil))
|
40785
|
1373 (math-expr-rational-in-rec expr)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1374 (mapcar 'car math-expr-parts)))
|
40785
|
1375
|
|
1376 (defun math-expr-rational-in-rec (expr)
|
|
1377 (cond ((Math-primp expr)
|
|
1378 (and (equal expr math-integ-var)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1379 (not (assoc expr math-expr-parts))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1380 (setq math-expr-parts (cons (list expr) math-expr-parts))))
|
40785
|
1381 ((or (memq (car expr) '(+ - * / neg))
|
|
1382 (and (eq (car expr) '^) (integerp (nth 2 expr))))
|
|
1383 (math-expr-rational-in-rec (nth 1 expr))
|
|
1384 (and (nth 2 expr) (math-expr-rational-in-rec (nth 2 expr))))
|
|
1385 ((and (eq (car expr) '^)
|
|
1386 (eq (math-quarter-integer (nth 2 expr)) 2))
|
|
1387 (math-expr-rational-in-rec (list 'calcFunc-sqrt (nth 1 expr))))
|
|
1388 (t
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1389 (and (not (assoc expr math-expr-parts))
|
40785
|
1390 (math-expr-contains expr math-integ-var)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1391 (setq math-expr-parts (cons (list expr) math-expr-parts))))))
|
40785
|
1392
|
|
1393 (defun math-expr-calls (expr funcs &optional arg-contains)
|
|
1394 (if (consp expr)
|
|
1395 (if (or (memq (car expr) funcs)
|
|
1396 (and (eq (car expr) '^) (eq (car funcs) 'calcFunc-sqrt)
|
|
1397 (eq (math-quarter-integer (nth 2 expr)) 2)))
|
|
1398 (and (or (not arg-contains)
|
|
1399 (math-expr-contains expr arg-contains))
|
|
1400 expr)
|
|
1401 (and (not (Math-primp expr))
|
|
1402 (let ((res nil))
|
|
1403 (while (and (setq expr (cdr expr))
|
|
1404 (not (setq res (math-expr-calls
|
|
1405 (car expr) funcs arg-contains)))))
|
41047
|
1406 res)))))
|
40785
|
1407
|
|
1408 (defun math-fix-const-terms (expr except-vars)
|
|
1409 (cond ((not (math-expr-depends expr except-vars)) 0)
|
|
1410 ((Math-primp expr) expr)
|
|
1411 ((eq (car expr) '+)
|
|
1412 (math-add (math-fix-const-terms (nth 1 expr) except-vars)
|
|
1413 (math-fix-const-terms (nth 2 expr) except-vars)))
|
|
1414 ((eq (car expr) '-)
|
|
1415 (math-sub (math-fix-const-terms (nth 1 expr) except-vars)
|
|
1416 (math-fix-const-terms (nth 2 expr) except-vars)))
|
41047
|
1417 (t expr)))
|
40785
|
1418
|
|
1419 ;; Command for debugging the Calculator's symbolic integrator.
|
|
1420 (defun calc-dump-integral-cache (&optional arg)
|
|
1421 (interactive "P")
|
|
1422 (let ((buf (current-buffer)))
|
|
1423 (unwind-protect
|
|
1424 (let ((p math-integral-cache)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1425 math-cur-record)
|
49598
|
1426 (display-buffer (get-buffer-create "*Integral Cache*"))
|
40785
|
1427 (set-buffer (get-buffer "*Integral Cache*"))
|
|
1428 (erase-buffer)
|
|
1429 (while p
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1430 (setq math-cur-record (car p))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1431 (or arg (math-replace-integral-parts math-cur-record))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1432 (insert (math-format-flat-expr (car math-cur-record) 0)
|
40785
|
1433 " --> "
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1434 (if (symbolp (nth 1 math-cur-record))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1435 (concat "(" (symbol-name (nth 1 math-cur-record)) ")")
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1436 (math-format-flat-expr (nth 1 math-cur-record) 0))
|
40785
|
1437 "\n")
|
|
1438 (setq p (cdr p)))
|
|
1439 (goto-char (point-min)))
|
41047
|
1440 (set-buffer buf))))
|
40785
|
1441
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1442 ;; The variable math-max-integral-limit is local to calcFunc-integ,
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1443 ;; but is used by math-try-integral.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1444 (defvar math-max-integral-limit)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1445
|
40785
|
1446 (defun math-try-integral (expr)
|
|
1447 (let ((math-integ-level math-integral-limit)
|
|
1448 (math-integ-depth 0)
|
|
1449 (math-integ-msg "Working...done")
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1450 (math-cur-record nil) ; a technicality
|
40785
|
1451 (math-integrating t)
|
|
1452 (calc-prefer-frac t)
|
|
1453 (calc-symbolic-mode t)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1454 (math-has-rules (calc-has-rules 'var-IntegRules)))
|
40785
|
1455 (or (math-integral expr 'yes)
|
|
1456 (and math-any-substs
|
|
1457 (setq math-enable-subst t)
|
|
1458 (math-integral expr 'yes))
|
|
1459 (and (> math-max-integral-limit math-integral-limit)
|
|
1460 (setq math-integral-limit math-max-integral-limit
|
|
1461 math-integ-level math-integral-limit)
|
41047
|
1462 (math-integral expr 'yes)))))
|
40785
|
1463
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1464 (defvar var-IntegLimit nil)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1465
|
40785
|
1466 (defun calcFunc-integ (expr var &optional low high)
|
|
1467 (cond
|
|
1468 ;; Do these even if the parts turn out not to be integrable.
|
|
1469 ((eq (car-safe expr) '+)
|
|
1470 (math-add (calcFunc-integ (nth 1 expr) var low high)
|
|
1471 (calcFunc-integ (nth 2 expr) var low high)))
|
|
1472 ((eq (car-safe expr) '-)
|
|
1473 (math-sub (calcFunc-integ (nth 1 expr) var low high)
|
|
1474 (calcFunc-integ (nth 2 expr) var low high)))
|
|
1475 ((eq (car-safe expr) 'neg)
|
|
1476 (math-neg (calcFunc-integ (nth 1 expr) var low high)))
|
|
1477 ((and (eq (car-safe expr) '*)
|
|
1478 (not (math-expr-contains (nth 1 expr) var)))
|
|
1479 (math-mul (nth 1 expr) (calcFunc-integ (nth 2 expr) var low high)))
|
|
1480 ((and (eq (car-safe expr) '*)
|
|
1481 (not (math-expr-contains (nth 2 expr) var)))
|
|
1482 (math-mul (calcFunc-integ (nth 1 expr) var low high) (nth 2 expr)))
|
|
1483 ((and (eq (car-safe expr) '/)
|
|
1484 (not (math-expr-contains (nth 1 expr) var))
|
|
1485 (not (math-equal-int (nth 1 expr) 1)))
|
|
1486 (math-mul (nth 1 expr)
|
|
1487 (calcFunc-integ (math-div 1 (nth 2 expr)) var low high)))
|
|
1488 ((and (eq (car-safe expr) '/)
|
|
1489 (not (math-expr-contains (nth 2 expr) var)))
|
|
1490 (math-div (calcFunc-integ (nth 1 expr) var low high) (nth 2 expr)))
|
|
1491 ((and (eq (car-safe expr) '/)
|
|
1492 (eq (car-safe (nth 1 expr)) '*)
|
|
1493 (not (math-expr-contains (nth 1 (nth 1 expr)) var)))
|
|
1494 (math-mul (nth 1 (nth 1 expr))
|
|
1495 (calcFunc-integ (math-div (nth 2 (nth 1 expr)) (nth 2 expr))
|
|
1496 var low high)))
|
|
1497 ((and (eq (car-safe expr) '/)
|
|
1498 (eq (car-safe (nth 1 expr)) '*)
|
|
1499 (not (math-expr-contains (nth 2 (nth 1 expr)) var)))
|
|
1500 (math-mul (nth 2 (nth 1 expr))
|
|
1501 (calcFunc-integ (math-div (nth 1 (nth 1 expr)) (nth 2 expr))
|
|
1502 var low high)))
|
|
1503 ((and (eq (car-safe expr) '/)
|
|
1504 (eq (car-safe (nth 2 expr)) '*)
|
|
1505 (not (math-expr-contains (nth 1 (nth 2 expr)) var)))
|
|
1506 (math-div (calcFunc-integ (math-div (nth 1 expr) (nth 2 (nth 2 expr)))
|
|
1507 var low high)
|
|
1508 (nth 1 (nth 2 expr))))
|
|
1509 ((and (eq (car-safe expr) '/)
|
|
1510 (eq (car-safe (nth 2 expr)) '*)
|
|
1511 (not (math-expr-contains (nth 2 (nth 2 expr)) var)))
|
|
1512 (math-div (calcFunc-integ (math-div (nth 1 expr) (nth 1 (nth 2 expr)))
|
|
1513 var low high)
|
|
1514 (nth 2 (nth 2 expr))))
|
|
1515 ((eq (car-safe expr) 'vec)
|
|
1516 (cons 'vec (mapcar (function (lambda (x) (calcFunc-integ x var low high)))
|
|
1517 (cdr expr))))
|
|
1518 (t
|
|
1519 (let ((state (list calc-angle-mode
|
|
1520 ;;calc-symbolic-mode
|
|
1521 ;;calc-prefer-frac
|
|
1522 calc-internal-prec
|
|
1523 (calc-var-value 'var-IntegRules)
|
|
1524 (calc-var-value 'var-IntegSimpRules))))
|
|
1525 (or (equal state math-integral-cache-state)
|
|
1526 (setq math-integral-cache-state state
|
|
1527 math-integral-cache nil)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1528 (let* ((math-max-integral-limit (or (and (natnump var-IntegLimit)
|
40785
|
1529 var-IntegLimit)
|
|
1530 3))
|
|
1531 (math-integral-limit 1)
|
|
1532 (sexpr (math-expr-subst expr var math-integ-var))
|
|
1533 (trace-buffer (get-buffer "*Trace*"))
|
|
1534 (calc-language (if (eq calc-language 'big) nil calc-language))
|
|
1535 (math-any-substs t)
|
|
1536 (math-enable-subst nil)
|
|
1537 (math-prev-parts-v nil)
|
|
1538 (math-doing-parts nil)
|
|
1539 (math-good-parts nil)
|
|
1540 (res
|
|
1541 (if trace-buffer
|
|
1542 (let ((calcbuf (current-buffer))
|
|
1543 (calcwin (selected-window)))
|
|
1544 (unwind-protect
|
|
1545 (progn
|
|
1546 (if (get-buffer-window trace-buffer)
|
|
1547 (select-window (get-buffer-window trace-buffer)))
|
|
1548 (set-buffer trace-buffer)
|
|
1549 (goto-char (point-max))
|
|
1550 (or (assq 'scroll-stop (buffer-local-variables))
|
|
1551 (progn
|
|
1552 (make-local-variable 'scroll-step)
|
|
1553 (setq scroll-step 3)))
|
|
1554 (insert "\n\n\n")
|
|
1555 (set-buffer calcbuf)
|
|
1556 (math-try-integral sexpr))
|
|
1557 (select-window calcwin)
|
|
1558 (set-buffer calcbuf)))
|
|
1559 (math-try-integral sexpr))))
|
|
1560 (if res
|
|
1561 (progn
|
|
1562 (if (calc-has-rules 'var-IntegAfterRules)
|
|
1563 (setq res (math-rewrite res '(var IntegAfterRules
|
|
1564 var-IntegAfterRules))))
|
|
1565 (math-simplify
|
|
1566 (if (and low high)
|
|
1567 (math-sub (math-expr-subst res math-integ-var high)
|
|
1568 (math-expr-subst res math-integ-var low))
|
|
1569 (setq res (math-fix-const-terms res math-integ-vars))
|
|
1570 (if low
|
|
1571 (math-expr-subst res math-integ-var low)
|
|
1572 (math-expr-subst res math-integ-var var)))))
|
|
1573 (append (list 'calcFunc-integ expr var)
|
|
1574 (and low (list low))
|
41047
|
1575 (and high (list high))))))))
|
40785
|
1576
|
|
1577
|
|
1578 (math-defintegral calcFunc-inv
|
|
1579 (math-integral (math-div 1 u)))
|
|
1580
|
|
1581 (math-defintegral calcFunc-conj
|
|
1582 (let ((int (math-integral u)))
|
|
1583 (and int
|
|
1584 (list 'calcFunc-conj int))))
|
|
1585
|
|
1586 (math-defintegral calcFunc-deg
|
|
1587 (let ((int (math-integral u)))
|
|
1588 (and int
|
|
1589 (list 'calcFunc-deg int))))
|
|
1590
|
|
1591 (math-defintegral calcFunc-rad
|
|
1592 (let ((int (math-integral u)))
|
|
1593 (and int
|
|
1594 (list 'calcFunc-rad int))))
|
|
1595
|
|
1596 (math-defintegral calcFunc-re
|
|
1597 (let ((int (math-integral u)))
|
|
1598 (and int
|
|
1599 (list 'calcFunc-re int))))
|
|
1600
|
|
1601 (math-defintegral calcFunc-im
|
|
1602 (let ((int (math-integral u)))
|
|
1603 (and int
|
|
1604 (list 'calcFunc-im int))))
|
|
1605
|
|
1606 (math-defintegral calcFunc-sqrt
|
|
1607 (and (equal u math-integ-var)
|
|
1608 (math-mul '(frac 2 3)
|
|
1609 (list 'calcFunc-sqrt (math-pow u 3)))))
|
|
1610
|
|
1611 (math-defintegral calcFunc-exp
|
|
1612 (or (and (equal u math-integ-var)
|
|
1613 (list 'calcFunc-exp u))
|
|
1614 (let ((p (math-is-polynomial u math-integ-var 2)))
|
|
1615 (and (nth 2 p)
|
|
1616 (let ((sqa (math-sqrt (math-neg (nth 2 p)))))
|
|
1617 (math-div
|
|
1618 (math-mul
|
|
1619 (math-mul (math-div (list 'calcFunc-sqrt '(var pi var-pi))
|
|
1620 sqa)
|
|
1621 (math-normalize
|
|
1622 (list 'calcFunc-exp
|
|
1623 (math-div (math-sub (math-mul (car p)
|
|
1624 (nth 2 p))
|
|
1625 (math-div
|
|
1626 (math-sqr (nth 1 p))
|
|
1627 4))
|
|
1628 (nth 2 p)))))
|
|
1629 (list 'calcFunc-erf
|
|
1630 (math-sub (math-mul sqa math-integ-var)
|
|
1631 (math-div (nth 1 p) (math-mul 2 sqa)))))
|
|
1632 2))))))
|
|
1633
|
|
1634 (math-defintegral calcFunc-ln
|
|
1635 (or (and (equal u math-integ-var)
|
|
1636 (math-sub (math-mul u (list 'calcFunc-ln u)) u))
|
|
1637 (and (eq (car u) '*)
|
|
1638 (math-integral (math-add (list 'calcFunc-ln (nth 1 u))
|
|
1639 (list 'calcFunc-ln (nth 2 u)))))
|
|
1640 (and (eq (car u) '/)
|
|
1641 (math-integral (math-sub (list 'calcFunc-ln (nth 1 u))
|
|
1642 (list 'calcFunc-ln (nth 2 u)))))
|
|
1643 (and (eq (car u) '^)
|
|
1644 (math-integral (math-mul (nth 2 u)
|
|
1645 (list 'calcFunc-ln (nth 1 u)))))))
|
|
1646
|
|
1647 (math-defintegral calcFunc-log10
|
|
1648 (and (equal u math-integ-var)
|
|
1649 (math-sub (math-mul u (list 'calcFunc-ln u))
|
|
1650 (math-div u (list 'calcFunc-ln 10)))))
|
|
1651
|
|
1652 (math-defintegral-2 calcFunc-log
|
|
1653 (math-integral (math-div (list 'calcFunc-ln u)
|
|
1654 (list 'calcFunc-ln v))))
|
|
1655
|
|
1656 (math-defintegral calcFunc-sin
|
|
1657 (or (and (equal u math-integ-var)
|
|
1658 (math-neg (math-from-radians-2 (list 'calcFunc-cos u))))
|
|
1659 (and (nth 2 (math-is-polynomial u math-integ-var 2))
|
|
1660 (math-integral (math-to-exponentials (list 'calcFunc-sin u))))))
|
|
1661
|
|
1662 (math-defintegral calcFunc-cos
|
|
1663 (or (and (equal u math-integ-var)
|
|
1664 (math-from-radians-2 (list 'calcFunc-sin u)))
|
|
1665 (and (nth 2 (math-is-polynomial u math-integ-var 2))
|
|
1666 (math-integral (math-to-exponentials (list 'calcFunc-cos u))))))
|
|
1667
|
|
1668 (math-defintegral calcFunc-tan
|
|
1669 (and (equal u math-integ-var)
|
60171
|
1670 (math-from-radians-2
|
|
1671 (list 'calcFunc-ln (list 'calcFunc-sec u)))))
|
40785
|
1672
|
60083
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1673 (math-defintegral calcFunc-sec
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1674 (and (equal u math-integ-var)
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1675 (math-from-radians-2
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1676 (list 'calcFunc-ln
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1677 (math-add
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1678 (list 'calcFunc-sec u)
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1679 (list 'calcFunc-tan u))))))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1680
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1681 (math-defintegral calcFunc-csc
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1682 (and (equal u math-integ-var)
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1683 (math-from-radians-2
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1684 (list 'calcFunc-ln
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1685 (math-sub
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1686 (list 'calcFunc-csc u)
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1687 (list 'calcFunc-cot u))))))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1688
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1689 (math-defintegral calcFunc-cot
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1690 (and (equal u math-integ-var)
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1691 (math-from-radians-2
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1692 (list 'calcFunc-ln (list 'calcFunc-sin u)))))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1693
|
40785
|
1694 (math-defintegral calcFunc-arcsin
|
|
1695 (and (equal u math-integ-var)
|
|
1696 (math-add (math-mul u (list 'calcFunc-arcsin u))
|
|
1697 (math-from-radians-2
|
|
1698 (list 'calcFunc-sqrt (math-sub 1 (math-sqr u)))))))
|
|
1699
|
|
1700 (math-defintegral calcFunc-arccos
|
|
1701 (and (equal u math-integ-var)
|
|
1702 (math-sub (math-mul u (list 'calcFunc-arccos u))
|
|
1703 (math-from-radians-2
|
|
1704 (list 'calcFunc-sqrt (math-sub 1 (math-sqr u)))))))
|
|
1705
|
|
1706 (math-defintegral calcFunc-arctan
|
|
1707 (and (equal u math-integ-var)
|
|
1708 (math-sub (math-mul u (list 'calcFunc-arctan u))
|
|
1709 (math-from-radians-2
|
|
1710 (math-div (list 'calcFunc-ln (math-add 1 (math-sqr u)))
|
|
1711 2)))))
|
|
1712
|
|
1713 (math-defintegral calcFunc-sinh
|
|
1714 (and (equal u math-integ-var)
|
|
1715 (list 'calcFunc-cosh u)))
|
|
1716
|
|
1717 (math-defintegral calcFunc-cosh
|
|
1718 (and (equal u math-integ-var)
|
|
1719 (list 'calcFunc-sinh u)))
|
|
1720
|
|
1721 (math-defintegral calcFunc-tanh
|
|
1722 (and (equal u math-integ-var)
|
|
1723 (list 'calcFunc-ln (list 'calcFunc-cosh u))))
|
|
1724
|
60083
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1725 (math-defintegral calcFunc-sech
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1726 (and (equal u math-integ-var)
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1727 (list 'calcFunc-arctan (list 'calcFunc-sinh u))))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1728
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1729 (math-defintegral calcFunc-csch
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1730 (and (equal u math-integ-var)
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1731 (list 'calcFunc-ln (list 'calcFunc-tanh (math-div u 2)))))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1732
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1733 (math-defintegral calcFunc-coth
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1734 (and (equal u math-integ-var)
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1735 (list 'calcFunc-ln (list 'calcFunc-sinh u))))
|
c96f8fda0cfb
Add derivative and integration rules for calcFunc-sec, calcFunc-csc,
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1736
|
40785
|
1737 (math-defintegral calcFunc-arcsinh
|
|
1738 (and (equal u math-integ-var)
|
|
1739 (math-sub (math-mul u (list 'calcFunc-arcsinh u))
|
|
1740 (list 'calcFunc-sqrt (math-add (math-sqr u) 1)))))
|
|
1741
|
|
1742 (math-defintegral calcFunc-arccosh
|
|
1743 (and (equal u math-integ-var)
|
|
1744 (math-sub (math-mul u (list 'calcFunc-arccosh u))
|
|
1745 (list 'calcFunc-sqrt (math-sub 1 (math-sqr u))))))
|
|
1746
|
|
1747 (math-defintegral calcFunc-arctanh
|
|
1748 (and (equal u math-integ-var)
|
|
1749 (math-sub (math-mul u (list 'calcFunc-arctan u))
|
|
1750 (math-div (list 'calcFunc-ln
|
|
1751 (math-add 1 (math-sqr u)))
|
|
1752 2))))
|
|
1753
|
|
1754 ;;; (Ax + B) / (ax^2 + bx + c)^n forms.
|
|
1755 (math-defintegral-2 /
|
|
1756 (math-integral-rational-funcs u v))
|
|
1757
|
|
1758 (defun math-integral-rational-funcs (u v)
|
|
1759 (let ((pu (math-is-polynomial u math-integ-var 1))
|
|
1760 (vpow 1) pv)
|
|
1761 (and pu
|
|
1762 (catch 'int-rat
|
|
1763 (if (and (eq (car-safe v) '^) (natnump (nth 2 v)))
|
|
1764 (setq vpow (nth 2 v)
|
|
1765 v (nth 1 v)))
|
|
1766 (and (setq pv (math-is-polynomial v math-integ-var 2))
|
|
1767 (let ((int (math-mul-thru
|
|
1768 (car pu)
|
|
1769 (math-integral-q02 (car pv) (nth 1 pv)
|
|
1770 (nth 2 pv) v vpow))))
|
|
1771 (if (cdr pu)
|
|
1772 (setq int (math-add int
|
|
1773 (math-mul-thru
|
|
1774 (nth 1 pu)
|
|
1775 (math-integral-q12
|
|
1776 (car pv) (nth 1 pv)
|
|
1777 (nth 2 pv) v vpow)))))
|
|
1778 int))))))
|
|
1779
|
|
1780 (defun math-integral-q12 (a b c v vpow)
|
|
1781 (let (q)
|
|
1782 (cond ((not c)
|
|
1783 (cond ((= vpow 1)
|
|
1784 (math-sub (math-div math-integ-var b)
|
|
1785 (math-mul (math-div a (math-sqr b))
|
|
1786 (list 'calcFunc-ln v))))
|
|
1787 ((= vpow 2)
|
|
1788 (math-div (math-add (list 'calcFunc-ln v)
|
|
1789 (math-div a v))
|
|
1790 (math-sqr b)))
|
|
1791 (t
|
|
1792 (let ((nm1 (math-sub vpow 1))
|
|
1793 (nm2 (math-sub vpow 2)))
|
|
1794 (math-div (math-sub
|
|
1795 (math-div a (math-mul nm1 (math-pow v nm1)))
|
|
1796 (math-div 1 (math-mul nm2 (math-pow v nm2))))
|
|
1797 (math-sqr b))))))
|
|
1798 ((math-zerop
|
|
1799 (setq q (math-sub (math-mul 4 (math-mul a c)) (math-sqr b))))
|
|
1800 (let ((part (math-div b (math-mul 2 c))))
|
|
1801 (math-mul-thru (math-pow c vpow)
|
|
1802 (math-integral-q12 part 1 nil
|
|
1803 (math-add math-integ-var part)
|
|
1804 (* vpow 2)))))
|
|
1805 ((= vpow 1)
|
|
1806 (and (math-ratp q) (math-negp q)
|
|
1807 (let ((calc-symbolic-mode t))
|
|
1808 (math-ratp (math-sqrt (math-neg q))))
|
|
1809 (throw 'int-rat nil)) ; should have used calcFunc-apart first
|
|
1810 (math-sub (math-div (list 'calcFunc-ln v) (math-mul 2 c))
|
|
1811 (math-mul-thru (math-div b (math-mul 2 c))
|
|
1812 (math-integral-q02 a b c v 1))))
|
|
1813 (t
|
|
1814 (let ((n (1- vpow)))
|
|
1815 (math-sub (math-neg (math-div
|
|
1816 (math-add (math-mul b math-integ-var)
|
|
1817 (math-mul 2 a))
|
|
1818 (math-mul n (math-mul q (math-pow v n)))))
|
|
1819 (math-mul-thru (math-div (math-mul b (1- (* 2 n)))
|
|
1820 (math-mul n q))
|
41047
|
1821 (math-integral-q02 a b c v n))))))))
|
40785
|
1822
|
|
1823 (defun math-integral-q02 (a b c v vpow)
|
|
1824 (let (q rq part)
|
|
1825 (cond ((not c)
|
|
1826 (cond ((= vpow 1)
|
|
1827 (math-div (list 'calcFunc-ln v) b))
|
|
1828 (t
|
|
1829 (math-div (math-pow v (- 1 vpow))
|
|
1830 (math-mul (- 1 vpow) b)))))
|
|
1831 ((math-zerop
|
|
1832 (setq q (math-sub (math-mul 4 (math-mul a c)) (math-sqr b))))
|
|
1833 (let ((part (math-div b (math-mul 2 c))))
|
|
1834 (math-mul-thru (math-pow c vpow)
|
|
1835 (math-integral-q02 part 1 nil
|
|
1836 (math-add math-integ-var part)
|
|
1837 (* vpow 2)))))
|
|
1838 ((progn
|
|
1839 (setq part (math-add (math-mul 2 (math-mul c math-integ-var)) b))
|
|
1840 (> vpow 1))
|
|
1841 (let ((n (1- vpow)))
|
|
1842 (math-add (math-div part (math-mul n (math-mul q (math-pow v n))))
|
|
1843 (math-mul-thru (math-div (math-mul (- (* 4 n) 2) c)
|
|
1844 (math-mul n q))
|
|
1845 (math-integral-q02 a b c v n)))))
|
|
1846 ((math-guess-if-neg q)
|
|
1847 (setq rq (list 'calcFunc-sqrt (math-neg q)))
|
|
1848 ;;(math-div-thru (list 'calcFunc-ln
|
|
1849 ;; (math-div (math-sub part rq)
|
|
1850 ;; (math-add part rq)))
|
|
1851 ;; rq)
|
|
1852 (math-div (math-mul -2 (list 'calcFunc-arctanh
|
|
1853 (math-div part rq)))
|
|
1854 rq))
|
|
1855 (t
|
|
1856 (setq rq (list 'calcFunc-sqrt q))
|
|
1857 (math-div (math-mul 2 (math-to-radians-2
|
|
1858 (list 'calcFunc-arctan
|
|
1859 (math-div part rq))))
|
41047
|
1860 rq)))))
|
40785
|
1861
|
|
1862
|
|
1863 (math-defintegral calcFunc-erf
|
|
1864 (and (equal u math-integ-var)
|
|
1865 (math-add (math-mul u (list 'calcFunc-erf u))
|
|
1866 (math-div 1 (math-mul (list 'calcFunc-exp (math-sqr u))
|
|
1867 (list 'calcFunc-sqrt
|
|
1868 '(var pi var-pi)))))))
|
|
1869
|
|
1870 (math-defintegral calcFunc-erfc
|
|
1871 (and (equal u math-integ-var)
|
|
1872 (math-sub (math-mul u (list 'calcFunc-erfc u))
|
|
1873 (math-div 1 (math-mul (list 'calcFunc-exp (math-sqr u))
|
|
1874 (list 'calcFunc-sqrt
|
|
1875 '(var pi var-pi)))))))
|
|
1876
|
|
1877
|
|
1878
|
|
1879
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
1880 (defvar math-tabulate-initial nil)
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
1881 (defvar math-tabulate-function nil)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1882
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1883 ;; The variables calc-low and calc-high are local to calcFunc-table,
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1884 ;; but are used by math-scan-for-limits.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1885 (defvar calc-low)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1886 (defvar calc-high)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1887
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1888 (defun calcFunc-table (expr var &optional calc-low calc-high step)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1889 (or calc-low
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1890 (setq calc-low '(neg (var inf var-inf)) calc-high '(var inf var-inf)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1891 (or calc-high (setq calc-high calc-low calc-low 1))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1892 (and (or (math-infinitep calc-low) (math-infinitep calc-high))
|
40785
|
1893 (not step)
|
|
1894 (math-scan-for-limits expr))
|
|
1895 (and step (math-zerop step) (math-reject-arg step 'nonzerop))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1896 (let ((known (+ (if (Math-objectp calc-low) 1 0)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1897 (if (Math-objectp calc-high) 1 0)
|
40785
|
1898 (if (or (null step) (Math-objectp step)) 1 0)))
|
|
1899 (count '(var inf var-inf))
|
|
1900 vec)
|
|
1901 (or (= known 2) ; handy optimization
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1902 (equal calc-high '(var inf var-inf))
|
40785
|
1903 (progn
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1904 (setq count (math-div (math-sub calc-high calc-low) (or step 1)))
|
40785
|
1905 (or (Math-objectp count)
|
|
1906 (setq count (math-simplify count)))
|
|
1907 (if (Math-messy-integerp count)
|
|
1908 (setq count (math-trunc count)))))
|
|
1909 (if (Math-negp count)
|
|
1910 (setq count -1))
|
|
1911 (if (integerp count)
|
|
1912 (let ((var-DUMMY nil)
|
|
1913 (vec math-tabulate-initial)
|
|
1914 (math-working-step-2 (1+ count))
|
|
1915 (math-working-step 0))
|
|
1916 (setq expr (math-evaluate-expr
|
|
1917 (math-expr-subst expr var '(var DUMMY var-DUMMY))))
|
|
1918 (while (>= count 0)
|
|
1919 (setq math-working-step (1+ math-working-step)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1920 var-DUMMY calc-low
|
40785
|
1921 vec (cond ((eq math-tabulate-function 'calcFunc-sum)
|
|
1922 (math-add vec (math-evaluate-expr expr)))
|
|
1923 ((eq math-tabulate-function 'calcFunc-prod)
|
|
1924 (math-mul vec (math-evaluate-expr expr)))
|
|
1925 (t
|
|
1926 (cons (math-evaluate-expr expr) vec)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1927 calc-low (math-add calc-low (or step 1))
|
40785
|
1928 count (1- count)))
|
|
1929 (if math-tabulate-function
|
|
1930 vec
|
|
1931 (cons 'vec (nreverse vec))))
|
|
1932 (if (Math-integerp count)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1933 (calc-record-why 'fixnump calc-high)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1934 (if (Math-num-integerp calc-low)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1935 (if (Math-num-integerp calc-high)
|
40785
|
1936 (calc-record-why 'integerp step)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1937 (calc-record-why 'integerp calc-high))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1938 (calc-record-why 'integerp calc-low)))
|
40785
|
1939 (append (list (or math-tabulate-function 'calcFunc-table)
|
|
1940 expr var)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1941 (and (not (and (equal calc-low '(neg (var inf var-inf)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1942 (equal calc-high '(var inf var-inf))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1943 (list calc-low calc-high))
|
41047
|
1944 (and step (list step))))))
|
40785
|
1945
|
|
1946 (defun math-scan-for-limits (x)
|
|
1947 (cond ((Math-primp x))
|
|
1948 ((and (eq (car x) 'calcFunc-subscr)
|
|
1949 (Math-vectorp (nth 1 x))
|
|
1950 (math-expr-contains (nth 2 x) var))
|
|
1951 (let* ((calc-next-why nil)
|
|
1952 (low-val (math-solve-for (nth 2 x) 1 var nil))
|
|
1953 (high-val (math-solve-for (nth 2 x) (1- (length (nth 1 x)))
|
|
1954 var nil))
|
|
1955 temp)
|
|
1956 (and low-val (math-realp low-val)
|
|
1957 high-val (math-realp high-val))
|
|
1958 (and (Math-lessp high-val low-val)
|
|
1959 (setq temp low-val low-val high-val high-val temp))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1960 (setq calc-low (math-max calc-low (math-ceiling low-val))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
1961 calc-high (math-min calc-high (math-floor high-val)))))
|
40785
|
1962 (t
|
|
1963 (while (setq x (cdr x))
|
41047
|
1964 (math-scan-for-limits (car x))))))
|
40785
|
1965
|
|
1966
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
1967 (defvar math-disable-sums nil)
|
40785
|
1968 (defun calcFunc-sum (expr var &optional low high step)
|
|
1969 (if math-disable-sums (math-reject-arg))
|
|
1970 (let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2)))
|
|
1971 (math-sum-rec expr var low high step)))
|
|
1972 (math-disable-sums t))
|
41047
|
1973 (math-normalize res)))
|
40785
|
1974
|
|
1975 (defun math-sum-rec (expr var &optional low high step)
|
|
1976 (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
|
|
1977 (and low (not high) (setq high low low 1))
|
|
1978 (let (t1 t2 val)
|
|
1979 (setq val
|
|
1980 (cond
|
|
1981 ((not (math-expr-contains expr var))
|
|
1982 (math-mul expr (math-add (math-div (math-sub high low) (or step 1))
|
|
1983 1)))
|
|
1984 ((and step (not (math-equal-int step 1)))
|
|
1985 (if (math-negp step)
|
|
1986 (math-sum-rec expr var high low (math-neg step))
|
|
1987 (let ((lo (math-simplify (math-div low step))))
|
|
1988 (if (math-known-num-integerp lo)
|
|
1989 (math-sum-rec (math-normalize
|
|
1990 (math-expr-subst expr var
|
|
1991 (math-mul step var)))
|
|
1992 var lo (math-simplify (math-div high step)))
|
|
1993 (math-sum-rec (math-normalize
|
|
1994 (math-expr-subst expr var
|
|
1995 (math-add (math-mul step var)
|
|
1996 low)))
|
|
1997 var 0
|
|
1998 (math-simplify (math-div (math-sub high low)
|
|
1999 step)))))))
|
|
2000 ((memq (setq t1 (math-compare low high)) '(0 1))
|
|
2001 (if (eq t1 0)
|
|
2002 (math-expr-subst expr var low)
|
|
2003 0))
|
|
2004 ((setq t1 (math-is-polynomial expr var 20))
|
|
2005 (let ((poly nil)
|
|
2006 (n 0))
|
|
2007 (while t1
|
|
2008 (setq poly (math-poly-mix poly 1
|
|
2009 (math-sum-integer-power n) (car t1))
|
|
2010 n (1+ n)
|
|
2011 t1 (cdr t1)))
|
|
2012 (setq n (math-build-polynomial-expr poly high))
|
|
2013 (if (memq low '(0 1))
|
|
2014 n
|
|
2015 (math-sub n (math-build-polynomial-expr poly
|
|
2016 (math-sub low 1))))))
|
|
2017 ((and (memq (car expr) '(+ -))
|
|
2018 (setq t1 (math-sum-rec (nth 1 expr) var low high)
|
|
2019 t2 (math-sum-rec (nth 2 expr) var low high))
|
|
2020 (not (and (math-expr-calls t1 '(calcFunc-sum))
|
|
2021 (math-expr-calls t2 '(calcFunc-sum)))))
|
|
2022 (list (car expr) t1 t2))
|
|
2023 ((and (eq (car expr) '*)
|
|
2024 (setq t1 (math-sum-const-factors expr var)))
|
|
2025 (math-mul (car t1) (math-sum-rec (cdr t1) var low high)))
|
|
2026 ((and (eq (car expr) '*) (memq (car-safe (nth 1 expr)) '(+ -)))
|
|
2027 (math-sum-rec (math-add-or-sub (math-mul (nth 1 (nth 1 expr))
|
|
2028 (nth 2 expr))
|
|
2029 (math-mul (nth 2 (nth 1 expr))
|
|
2030 (nth 2 expr))
|
|
2031 nil (eq (car (nth 1 expr)) '-))
|
|
2032 var low high))
|
|
2033 ((and (eq (car expr) '*) (memq (car-safe (nth 2 expr)) '(+ -)))
|
|
2034 (math-sum-rec (math-add-or-sub (math-mul (nth 1 expr)
|
|
2035 (nth 1 (nth 2 expr)))
|
|
2036 (math-mul (nth 1 expr)
|
|
2037 (nth 2 (nth 2 expr)))
|
|
2038 nil (eq (car (nth 2 expr)) '-))
|
|
2039 var low high))
|
|
2040 ((and (eq (car expr) '/)
|
|
2041 (not (math-primp (nth 1 expr)))
|
|
2042 (setq t1 (math-sum-const-factors (nth 1 expr) var)))
|
|
2043 (math-mul (car t1)
|
|
2044 (math-sum-rec (math-div (cdr t1) (nth 2 expr))
|
|
2045 var low high)))
|
|
2046 ((and (eq (car expr) '/)
|
|
2047 (setq t1 (math-sum-const-factors (nth 2 expr) var)))
|
|
2048 (math-div (math-sum-rec (math-div (nth 1 expr) (cdr t1))
|
|
2049 var low high)
|
|
2050 (car t1)))
|
|
2051 ((eq (car expr) 'neg)
|
|
2052 (math-neg (math-sum-rec (nth 1 expr) var low high)))
|
|
2053 ((and (eq (car expr) '^)
|
|
2054 (not (math-expr-contains (nth 1 expr) var))
|
|
2055 (setq t1 (math-is-polynomial (nth 2 expr) var 1)))
|
|
2056 (let ((x (math-pow (nth 1 expr) (nth 1 t1))))
|
|
2057 (math-div (math-mul (math-sub (math-pow x (math-add 1 high))
|
|
2058 (math-pow x low))
|
|
2059 (math-pow (nth 1 expr) (car t1)))
|
|
2060 (math-sub x 1))))
|
|
2061 ((and (setq t1 (math-to-exponentials expr))
|
|
2062 (setq t1 (math-sum-rec t1 var low high))
|
|
2063 (not (math-expr-calls t1 '(calcFunc-sum))))
|
|
2064 (math-to-exps t1))
|
|
2065 ((memq (car expr) '(calcFunc-ln calcFunc-log10))
|
|
2066 (list (car expr) (calcFunc-prod (nth 1 expr) var low high)))
|
|
2067 ((and (eq (car expr) 'calcFunc-log)
|
|
2068 (= (length expr) 3)
|
|
2069 (not (math-expr-contains (nth 2 expr) var)))
|
|
2070 (list 'calcFunc-log
|
|
2071 (calcFunc-prod (nth 1 expr) var low high)
|
|
2072 (nth 2 expr)))))
|
|
2073 (if (equal val '(var nan var-nan)) (setq val nil))
|
|
2074 (or val
|
|
2075 (let* ((math-tabulate-initial 0)
|
|
2076 (math-tabulate-function 'calcFunc-sum))
|
41047
|
2077 (calcFunc-table expr var low high)))))
|
40785
|
2078
|
|
2079 (defun calcFunc-asum (expr var low &optional high step no-mul-flag)
|
|
2080 (or high (setq high low low 1))
|
|
2081 (if (and step (not (math-equal-int step 1)))
|
|
2082 (if (math-negp step)
|
|
2083 (math-mul (math-pow -1 low)
|
|
2084 (calcFunc-asum expr var high low (math-neg step) t))
|
|
2085 (let ((lo (math-simplify (math-div low step))))
|
|
2086 (if (math-num-integerp lo)
|
|
2087 (calcFunc-asum (math-normalize
|
|
2088 (math-expr-subst expr var
|
|
2089 (math-mul step var)))
|
|
2090 var lo (math-simplify (math-div high step)))
|
|
2091 (calcFunc-asum (math-normalize
|
|
2092 (math-expr-subst expr var
|
|
2093 (math-add (math-mul step var)
|
|
2094 low)))
|
|
2095 var 0
|
|
2096 (math-simplify (math-div (math-sub high low)
|
|
2097 step))))))
|
|
2098 (math-mul (if no-mul-flag 1 (math-pow -1 low))
|
41047
|
2099 (calcFunc-sum (math-mul (math-pow -1 var) expr) var low high))))
|
40785
|
2100
|
|
2101 (defun math-sum-const-factors (expr var)
|
|
2102 (let ((const nil)
|
|
2103 (not-const nil)
|
|
2104 (p expr))
|
|
2105 (while (eq (car-safe p) '*)
|
|
2106 (if (math-expr-contains (nth 1 p) var)
|
|
2107 (setq not-const (cons (nth 1 p) not-const))
|
|
2108 (setq const (cons (nth 1 p) const)))
|
|
2109 (setq p (nth 2 p)))
|
|
2110 (if (math-expr-contains p var)
|
|
2111 (setq not-const (cons p not-const))
|
|
2112 (setq const (cons p const)))
|
|
2113 (and const
|
|
2114 (cons (let ((temp (car const)))
|
|
2115 (while (setq const (cdr const))
|
|
2116 (setq temp (list '* (car const) temp)))
|
|
2117 temp)
|
|
2118 (let ((temp (or (car not-const) 1)))
|
|
2119 (while (setq not-const (cdr not-const))
|
|
2120 (setq temp (list '* (car not-const) temp)))
|
41047
|
2121 temp)))))
|
40785
|
2122
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
2123 (defvar math-sum-int-pow-cache (list '(0 1)))
|
40785
|
2124 ;; Following is from CRC Math Tables, 27th ed, pp. 52-53.
|
|
2125 (defun math-sum-integer-power (pow)
|
|
2126 (let ((calc-prefer-frac t)
|
|
2127 (n (length math-sum-int-pow-cache)))
|
|
2128 (while (<= n pow)
|
|
2129 (let* ((new (list 0 0))
|
|
2130 (lin new)
|
|
2131 (pp (cdr (nth (1- n) math-sum-int-pow-cache)))
|
|
2132 (p 2)
|
|
2133 (sum 0)
|
|
2134 q)
|
|
2135 (while pp
|
|
2136 (setq q (math-div (car pp) p)
|
|
2137 new (cons (math-mul q n) new)
|
|
2138 sum (math-add sum q)
|
|
2139 p (1+ p)
|
|
2140 pp (cdr pp)))
|
|
2141 (setcar lin (math-sub 1 (math-mul n sum)))
|
|
2142 (setq math-sum-int-pow-cache
|
|
2143 (nconc math-sum-int-pow-cache (list (nreverse new)))
|
|
2144 n (1+ n))))
|
41047
|
2145 (nth pow math-sum-int-pow-cache)))
|
40785
|
2146
|
|
2147 (defun math-to-exponentials (expr)
|
|
2148 (and (consp expr)
|
|
2149 (= (length expr) 2)
|
|
2150 (let ((x (nth 1 expr))
|
|
2151 (pi (if calc-symbolic-mode '(var pi var-pi) (math-pi)))
|
|
2152 (i (if calc-symbolic-mode '(var i var-i) '(cplx 0 1))))
|
|
2153 (cond ((eq (car expr) 'calcFunc-exp)
|
|
2154 (list '^ '(var e var-e) x))
|
|
2155 ((eq (car expr) 'calcFunc-sin)
|
|
2156 (or (eq calc-angle-mode 'rad)
|
|
2157 (setq x (list '/ (list '* x pi) 180)))
|
|
2158 (list '/ (list '-
|
|
2159 (list '^ '(var e var-e) (list '* x i))
|
|
2160 (list '^ '(var e var-e)
|
|
2161 (list 'neg (list '* x i))))
|
|
2162 (list '* 2 i)))
|
|
2163 ((eq (car expr) 'calcFunc-cos)
|
|
2164 (or (eq calc-angle-mode 'rad)
|
|
2165 (setq x (list '/ (list '* x pi) 180)))
|
|
2166 (list '/ (list '+
|
|
2167 (list '^ '(var e var-e)
|
|
2168 (list '* x i))
|
|
2169 (list '^ '(var e var-e)
|
|
2170 (list 'neg (list '* x i))))
|
|
2171 2))
|
|
2172 ((eq (car expr) 'calcFunc-sinh)
|
|
2173 (list '/ (list '-
|
|
2174 (list '^ '(var e var-e) x)
|
|
2175 (list '^ '(var e var-e) (list 'neg x)))
|
|
2176 2))
|
|
2177 ((eq (car expr) 'calcFunc-cosh)
|
|
2178 (list '/ (list '+
|
|
2179 (list '^ '(var e var-e) x)
|
|
2180 (list '^ '(var e var-e) (list 'neg x)))
|
|
2181 2))
|
41047
|
2182 (t nil)))))
|
40785
|
2183
|
|
2184 (defun math-to-exps (expr)
|
|
2185 (cond (calc-symbolic-mode expr)
|
|
2186 ((Math-primp expr)
|
|
2187 (if (equal expr '(var e var-e)) (math-e) expr))
|
|
2188 ((and (eq (car expr) '^)
|
|
2189 (equal (nth 1 expr) '(var e var-e)))
|
|
2190 (list 'calcFunc-exp (nth 2 expr)))
|
|
2191 (t
|
41047
|
2192 (cons (car expr) (mapcar 'math-to-exps (cdr expr))))))
|
40785
|
2193
|
|
2194
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
2195 (defvar math-disable-prods nil)
|
40785
|
2196 (defun calcFunc-prod (expr var &optional low high step)
|
|
2197 (if math-disable-prods (math-reject-arg))
|
|
2198 (let* ((res (let* ((calc-internal-prec (+ calc-internal-prec 2)))
|
|
2199 (math-prod-rec expr var low high step)))
|
|
2200 (math-disable-prods t))
|
41047
|
2201 (math-normalize res)))
|
40785
|
2202
|
|
2203 (defun math-prod-rec (expr var &optional low high step)
|
|
2204 (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
|
|
2205 (and low (not high) (setq high '(var inf var-inf)))
|
|
2206 (let (t1 t2 t3 val)
|
|
2207 (setq val
|
|
2208 (cond
|
|
2209 ((not (math-expr-contains expr var))
|
|
2210 (math-pow expr (math-add (math-div (math-sub high low) (or step 1))
|
|
2211 1)))
|
|
2212 ((and step (not (math-equal-int step 1)))
|
|
2213 (if (math-negp step)
|
|
2214 (math-prod-rec expr var high low (math-neg step))
|
|
2215 (let ((lo (math-simplify (math-div low step))))
|
|
2216 (if (math-known-num-integerp lo)
|
|
2217 (math-prod-rec (math-normalize
|
|
2218 (math-expr-subst expr var
|
|
2219 (math-mul step var)))
|
|
2220 var lo (math-simplify (math-div high step)))
|
|
2221 (math-prod-rec (math-normalize
|
|
2222 (math-expr-subst expr var
|
|
2223 (math-add (math-mul step
|
|
2224 var)
|
|
2225 low)))
|
|
2226 var 0
|
|
2227 (math-simplify (math-div (math-sub high low)
|
|
2228 step)))))))
|
|
2229 ((and (memq (car expr) '(* /))
|
|
2230 (setq t1 (math-prod-rec (nth 1 expr) var low high)
|
|
2231 t2 (math-prod-rec (nth 2 expr) var low high))
|
|
2232 (not (and (math-expr-calls t1 '(calcFunc-prod))
|
|
2233 (math-expr-calls t2 '(calcFunc-prod)))))
|
|
2234 (list (car expr) t1 t2))
|
|
2235 ((and (eq (car expr) '^)
|
|
2236 (not (math-expr-contains (nth 2 expr) var)))
|
|
2237 (math-pow (math-prod-rec (nth 1 expr) var low high)
|
|
2238 (nth 2 expr)))
|
|
2239 ((and (eq (car expr) '^)
|
|
2240 (not (math-expr-contains (nth 1 expr) var)))
|
|
2241 (math-pow (nth 1 expr)
|
|
2242 (calcFunc-sum (nth 2 expr) var low high)))
|
|
2243 ((eq (car expr) 'sqrt)
|
|
2244 (math-normalize (list 'calcFunc-sqrt
|
|
2245 (list 'calcFunc-prod (nth 1 expr)
|
|
2246 var low high))))
|
|
2247 ((eq (car expr) 'neg)
|
|
2248 (math-mul (math-pow -1 (math-add (math-sub high low) 1))
|
|
2249 (math-prod-rec (nth 1 expr) var low high)))
|
|
2250 ((eq (car expr) 'calcFunc-exp)
|
|
2251 (list 'calcFunc-exp (calcFunc-sum (nth 1 expr) var low high)))
|
|
2252 ((and (setq t1 (math-is-polynomial expr var 1))
|
|
2253 (setq t2
|
|
2254 (cond
|
|
2255 ((or (and (math-equal-int (nth 1 t1) 1)
|
|
2256 (setq low (math-simplify
|
|
2257 (math-add low (car t1)))
|
|
2258 high (math-simplify
|
|
2259 (math-add high (car t1)))))
|
|
2260 (and (math-equal-int (nth 1 t1) -1)
|
|
2261 (setq t2 low
|
|
2262 low (math-simplify
|
|
2263 (math-sub (car t1) high))
|
|
2264 high (math-simplify
|
|
2265 (math-sub (car t1) t2)))))
|
|
2266 (if (or (math-zerop low) (math-zerop high))
|
|
2267 0
|
|
2268 (if (and (or (math-negp low) (math-negp high))
|
|
2269 (or (math-num-integerp low)
|
|
2270 (math-num-integerp high)))
|
|
2271 (if (math-posp high)
|
|
2272 0
|
|
2273 (math-mul (math-pow -1
|
|
2274 (math-add
|
|
2275 (math-add low high) 1))
|
|
2276 (list '/
|
|
2277 (list 'calcFunc-fact
|
|
2278 (math-neg low))
|
|
2279 (list 'calcFunc-fact
|
|
2280 (math-sub -1 high)))))
|
|
2281 (list '/
|
|
2282 (list 'calcFunc-fact high)
|
|
2283 (list 'calcFunc-fact (math-sub low 1))))))
|
|
2284 ((and (or (and (math-equal-int (nth 1 t1) 2)
|
|
2285 (setq t2 (math-simplify
|
|
2286 (math-add (math-mul low 2)
|
|
2287 (car t1)))
|
|
2288 t3 (math-simplify
|
|
2289 (math-add (math-mul high 2)
|
|
2290 (car t1)))))
|
|
2291 (and (math-equal-int (nth 1 t1) -2)
|
|
2292 (setq t2 (math-simplify
|
|
2293 (math-sub (car t1)
|
|
2294 (math-mul high 2)))
|
49598
|
2295 t3 (math-simplify
|
40785
|
2296 (math-sub (car t1)
|
|
2297 (math-mul low
|
|
2298 2))))))
|
|
2299 (or (math-integerp t2)
|
|
2300 (and (math-messy-integerp t2)
|
|
2301 (setq t2 (math-trunc t2)))
|
|
2302 (math-integerp t3)
|
|
2303 (and (math-messy-integerp t3)
|
|
2304 (setq t3 (math-trunc t3)))))
|
|
2305 (if (or (math-zerop t2) (math-zerop t3))
|
|
2306 0
|
|
2307 (if (or (math-evenp t2) (math-evenp t3))
|
|
2308 (if (or (math-negp t2) (math-negp t3))
|
|
2309 (if (math-posp high)
|
|
2310 0
|
|
2311 (list '/
|
|
2312 (list 'calcFunc-dfact
|
|
2313 (math-neg t2))
|
|
2314 (list 'calcFunc-dfact
|
|
2315 (math-sub -2 t3))))
|
|
2316 (list '/
|
|
2317 (list 'calcFunc-dfact t3)
|
|
2318 (list 'calcFunc-dfact
|
|
2319 (math-sub t2 2))))
|
|
2320 (if (math-negp t3)
|
|
2321 (list '*
|
|
2322 (list '^ -1
|
|
2323 (list '/ (list '- (list '- t2 t3)
|
|
2324 2)
|
|
2325 2))
|
|
2326 (list '/
|
|
2327 (list 'calcFunc-dfact
|
|
2328 (math-neg t2))
|
|
2329 (list 'calcFunc-dfact
|
|
2330 (math-sub -2 t3))))
|
|
2331 (if (math-posp t2)
|
|
2332 (list '/
|
|
2333 (list 'calcFunc-dfact t3)
|
|
2334 (list 'calcFunc-dfact
|
|
2335 (math-sub t2 2)))
|
|
2336 nil))))))))
|
|
2337 t2)))
|
|
2338 (if (equal val '(var nan var-nan)) (setq val nil))
|
|
2339 (or val
|
|
2340 (let* ((math-tabulate-initial 1)
|
|
2341 (math-tabulate-function 'calcFunc-prod))
|
41047
|
2342 (calcFunc-table expr var low high)))))
|
40785
|
2343
|
|
2344
|
|
2345
|
|
2346
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
2347 (defvar math-solve-ranges nil)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2348 (defvar math-solve-sign)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2349 ;;; Attempt to reduce math-solve-lhs = math-solve-rhs to
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2350 ;;; math-solve-var = math-solve-rhs', where math-solve-var appears
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2351 ;;; in math-solve-lhs but not in math-solve-rhs or math-solve-rhs';
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2352 ;;; return math-solve-rhs'.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2353 ;;; Uses global values: math-solve-var, math-solve-full.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2354 (defvar math-solve-var)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2355 (defvar math-solve-full)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2356
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2357 ;; The variables math-solve-lhs, math-solve-rhs and math-try-solve-sign
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2358 ;; are local to math-try-solve-for, but are used by math-try-solve-prod.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2359 ;; (math-solve-lhs and math-solve-rhs are is also local to
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2360 ;; math-decompose-poly, but used by math-solve-poly-funny-powers.)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2361 (defvar math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2362 (defvar math-solve-rhs)
|
58573
87c7dff39cb0
(math-expr-parts, math-try-solve-sign, math-solve-b, math-int-factors)
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2363 (defvar math-try-solve-sign)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2364
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2365 (defun math-try-solve-for
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2366 (math-solve-lhs math-solve-rhs &optional math-try-solve-sign no-poly)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2367 (let (math-t1 math-t2 math-t3)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2368 (cond ((equal math-solve-lhs math-solve-var)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2369 (setq math-solve-sign math-try-solve-sign)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2370 (if (eq math-solve-full 'all)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2371 (let ((vec (list 'vec (math-evaluate-expr math-solve-rhs)))
|
40785
|
2372 newvec var p)
|
|
2373 (while math-solve-ranges
|
|
2374 (setq p (car math-solve-ranges)
|
|
2375 var (car p)
|
|
2376 newvec (list 'vec))
|
|
2377 (while (setq p (cdr p))
|
|
2378 (setq newvec (nconc newvec
|
|
2379 (cdr (math-expr-subst
|
|
2380 vec var (car p))))))
|
|
2381 (setq vec newvec
|
|
2382 math-solve-ranges (cdr math-solve-ranges)))
|
|
2383 (math-normalize vec))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2384 math-solve-rhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2385 ((Math-primp math-solve-lhs)
|
40785
|
2386 nil)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2387 ((and (eq (car math-solve-lhs) '-)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2388 (eq (car-safe (nth 1 math-solve-lhs)) (car-safe (nth 2 math-solve-lhs)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2389 (Math-zerop math-solve-rhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2390 (= (length (nth 1 math-solve-lhs)) 2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2391 (= (length (nth 2 math-solve-lhs)) 2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2392 (setq math-t1 (get (car (nth 1 math-solve-lhs)) 'math-inverse))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2393 (setq math-t2 (funcall math-t1 '(var SOLVEDUM SOLVEDUM)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2394 (eq (math-expr-contains-count math-t2 '(var SOLVEDUM SOLVEDUM)) 1)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2395 (setq math-t3 (math-solve-above-dummy math-t2))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2396 (setq math-t1 (math-try-solve-for
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2397 (math-sub (nth 1 (nth 1 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2398 (math-expr-subst
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2399 math-t2 math-t3
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2400 (nth 1 (nth 2 math-solve-lhs))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2401 0)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2402 math-t1)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2403 ((eq (car math-solve-lhs) 'neg)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2404 (math-try-solve-for (nth 1 math-solve-lhs) (math-neg math-solve-rhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2405 (and math-try-solve-sign (- math-try-solve-sign))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2406 ((and (not (eq math-solve-full 't)) (math-try-solve-prod)))
|
40785
|
2407 ((and (not no-poly)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2408 (setq math-t2
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2409 (math-decompose-poly math-solve-lhs
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2410 math-solve-var 15 math-solve-rhs)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2411 (setq math-t1 (cdr (nth 1 math-t2))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2412 math-t1 (let ((math-solve-ranges math-solve-ranges))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2413 (cond ((= (length math-t1) 5)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2414 (apply 'math-solve-quartic (car math-t2) math-t1))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2415 ((= (length math-t1) 4)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2416 (apply 'math-solve-cubic (car math-t2) math-t1))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2417 ((= (length math-t1) 3)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2418 (apply 'math-solve-quadratic (car math-t2) math-t1))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2419 ((= (length math-t1) 2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2420 (apply 'math-solve-linear
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2421 (car math-t2) math-try-solve-sign math-t1))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2422 (math-solve-full
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2423 (math-poly-all-roots (car math-t2) math-t1))
|
40785
|
2424 (calc-symbolic-mode nil)
|
|
2425 (t
|
|
2426 (math-try-solve-for
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2427 (car math-t2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2428 (math-poly-any-root (reverse math-t1) 0 t)
|
40785
|
2429 nil t)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2430 (if math-t1
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2431 (if (eq (nth 2 math-t2) 1)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2432 math-t1
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2433 (math-solve-prod math-t1 (math-try-solve-for (nth 2 math-t2) 0 nil t)))
|
40785
|
2434 (calc-record-why "*Unable to find a symbolic solution")
|
|
2435 nil))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2436 ((and (math-solve-find-root-term math-solve-lhs nil)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2437 (eq (math-expr-contains-count math-solve-lhs math-t1) 1)) ; just in case
|
40785
|
2438 (math-try-solve-for (math-simplify
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2439 (math-sub (if (or math-t3 (math-evenp math-t2))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2440 (math-pow math-t1 math-t2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2441 (math-neg (math-pow math-t1 math-t2)))
|
40785
|
2442 (math-expand-power
|
|
2443 (math-sub (math-normalize
|
|
2444 (math-expr-subst
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2445 math-solve-lhs math-t1 0))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2446 math-solve-rhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2447 math-t2 math-solve-var)))
|
40785
|
2448 0))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2449 ((eq (car math-solve-lhs) '+)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2450 (cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2451 (math-try-solve-for (nth 2 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2452 (math-sub math-solve-rhs (nth 1 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2453 math-try-solve-sign))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2454 ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2455 (math-try-solve-for (nth 1 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2456 (math-sub math-solve-rhs (nth 2 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2457 math-try-solve-sign))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2458 ((eq (car math-solve-lhs) 'calcFunc-eq)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2459 (math-try-solve-for (math-sub (nth 1 math-solve-lhs) (nth 2 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2460 math-solve-rhs math-try-solve-sign no-poly))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2461 ((eq (car math-solve-lhs) '-)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2462 (cond ((or (and (eq (car-safe (nth 1 math-solve-lhs)) 'calcFunc-sin)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2463 (eq (car-safe (nth 2 math-solve-lhs)) 'calcFunc-cos))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2464 (and (eq (car-safe (nth 1 math-solve-lhs)) 'calcFunc-cos)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2465 (eq (car-safe (nth 2 math-solve-lhs)) 'calcFunc-sin)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2466 (math-try-solve-for (math-sub (nth 1 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2467 (list (car (nth 1 math-solve-lhs))
|
40785
|
2468 (math-sub
|
|
2469 (math-quarter-circle t)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2470 (nth 1 (nth 2 math-solve-lhs)))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2471 math-solve-rhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2472 ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2473 (math-try-solve-for (nth 2 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2474 (math-sub (nth 1 math-solve-lhs) math-solve-rhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2475 (and math-try-solve-sign
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2476 (- math-try-solve-sign))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2477 ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2478 (math-try-solve-for (nth 1 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2479 (math-add math-solve-rhs (nth 2 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2480 math-try-solve-sign))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2481 ((and (eq math-solve-full 't) (math-try-solve-prod)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2482 ((and (eq (car math-solve-lhs) '%)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2483 (not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2484 (math-try-solve-for (nth 1 math-solve-lhs) (math-add math-solve-rhs
|
40785
|
2485 (math-solve-get-int
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2486 (nth 2 math-solve-lhs)))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2487 ((eq (car math-solve-lhs) 'calcFunc-log)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2488 (cond ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2489 (math-try-solve-for (nth 1 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2490 (math-pow (nth 2 math-solve-lhs) math-solve-rhs)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2491 ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2492 (math-try-solve-for (nth 2 math-solve-lhs) (math-pow
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2493 (nth 1 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2494 (math-div 1 math-solve-rhs))))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2495 ((and (= (length math-solve-lhs) 2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2496 (symbolp (car math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2497 (setq math-t1 (get (car math-solve-lhs) 'math-inverse))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2498 (setq math-t2 (funcall math-t1 math-solve-rhs)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2499 (setq math-t1 (get (car math-solve-lhs) 'math-inverse-sign))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2500 (math-try-solve-for (nth 1 math-solve-lhs) (math-normalize math-t2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2501 (and math-try-solve-sign math-t1
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2502 (if (integerp math-t1)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2503 (* math-t1 math-try-solve-sign)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2504 (funcall math-t1 math-solve-lhs
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2505 math-try-solve-sign)))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2506 ((and (symbolp (car math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2507 (setq math-t1 (get (car math-solve-lhs) 'math-inverse-n))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2508 (setq math-t2 (funcall math-t1 math-solve-lhs math-solve-rhs)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2509 math-t2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2510 ((setq math-t1 (math-expand-formula math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2511 (math-try-solve-for math-t1 math-solve-rhs math-try-solve-sign))
|
40785
|
2512 (t
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2513 (calc-record-why "*No inverse known" math-solve-lhs)
|
41047
|
2514 nil))))
|
40785
|
2515
|
|
2516
|
|
2517 (defun math-try-solve-prod ()
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2518 (cond ((eq (car math-solve-lhs) '*)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2519 (cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2520 (math-try-solve-for (nth 2 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2521 (math-div math-solve-rhs (nth 1 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2522 (math-solve-sign math-try-solve-sign
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2523 (nth 1 math-solve-lhs))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2524 ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2525 (math-try-solve-for (nth 1 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2526 (math-div math-solve-rhs (nth 2 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2527 (math-solve-sign math-try-solve-sign
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2528 (nth 2 math-solve-lhs))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2529 ((Math-zerop math-solve-rhs)
|
40785
|
2530 (math-solve-prod (let ((math-solve-ranges math-solve-ranges))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2531 (math-try-solve-for (nth 2 math-solve-lhs) 0))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2532 (math-try-solve-for (nth 1 math-solve-lhs) 0)))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2533 ((eq (car math-solve-lhs) '/)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2534 (cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2535 (math-try-solve-for (nth 2 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2536 (math-div (nth 1 math-solve-lhs) math-solve-rhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2537 (math-solve-sign math-try-solve-sign
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2538 (nth 1 math-solve-lhs))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2539 ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2540 (math-try-solve-for (nth 1 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2541 (math-mul math-solve-rhs (nth 2 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2542 (math-solve-sign math-try-solve-sign
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2543 (nth 2 math-solve-lhs))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2544 ((setq math-t1 (math-try-solve-for (math-sub (nth 1 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2545 (math-mul (nth 2 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2546 math-solve-rhs))
|
40785
|
2547 0))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2548 math-t1)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2549 ((eq (car math-solve-lhs) '^)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2550 (cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
|
40785
|
2551 (math-try-solve-for
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2552 (nth 2 math-solve-lhs)
|
40785
|
2553 (math-add (math-normalize
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2554 (list 'calcFunc-log math-solve-rhs (nth 1 math-solve-lhs)))
|
40785
|
2555 (math-div
|
|
2556 (math-mul 2
|
|
2557 (math-mul '(var pi var-pi)
|
|
2558 (math-solve-get-int
|
|
2559 '(var i var-i))))
|
|
2560 (math-normalize
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2561 (list 'calcFunc-ln (nth 1 math-solve-lhs)))))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2562 ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2563 (cond ((and (integerp (nth 2 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2564 (>= (nth 2 math-solve-lhs) 2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2565 (setq math-t1 (math-integer-log2 (nth 2 math-solve-lhs))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2566 (setq math-t2 math-solve-rhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2567 (if (and (eq math-solve-full t)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2568 (math-known-realp (nth 1 math-solve-lhs)))
|
40785
|
2569 (progn
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2570 (while (>= (setq math-t1 (1- math-t1)) 0)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2571 (setq math-t2 (list 'calcFunc-sqrt math-t2)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2572 (setq math-t2 (math-solve-get-sign math-t2)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2573 (while (>= (setq math-t1 (1- math-t1)) 0)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2574 (setq math-t2 (math-solve-get-sign
|
40785
|
2575 (math-normalize
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2576 (list 'calcFunc-sqrt math-t2))))))
|
40785
|
2577 (math-try-solve-for
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2578 (nth 1 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2579 (math-normalize math-t2)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2580 ((math-looks-negp (nth 2 math-solve-lhs))
|
40785
|
2581 (math-try-solve-for
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2582 (list '^ (nth 1 math-solve-lhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2583 (math-neg (nth 2 math-solve-lhs)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2584 (math-div 1 math-solve-rhs)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2585 ((and (eq math-solve-full t)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2586 (Math-integerp (nth 2 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2587 (math-known-realp (nth 1 math-solve-lhs)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2588 (setq math-t1 (math-normalize
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2589 (list 'calcFunc-nroot math-solve-rhs
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2590 (nth 2 math-solve-lhs))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2591 (if (math-evenp (nth 2 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2592 (setq math-t1 (math-solve-get-sign math-t1)))
|
40785
|
2593 (math-try-solve-for
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2594 (nth 1 math-solve-lhs) math-t1
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2595 (and math-try-solve-sign
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2596 (math-oddp (nth 2 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2597 (math-solve-sign math-try-solve-sign
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2598 (nth 2 math-solve-lhs)))))
|
40785
|
2599 (t (math-try-solve-for
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2600 (nth 1 math-solve-lhs)
|
40785
|
2601 (math-mul
|
|
2602 (math-normalize
|
|
2603 (list 'calcFunc-exp
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2604 (if (Math-realp (nth 2 math-solve-lhs))
|
40785
|
2605 (math-div (math-mul
|
|
2606 '(var pi var-pi)
|
|
2607 (math-solve-get-int
|
|
2608 '(var i var-i)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2609 (and (integerp (nth 2 math-solve-lhs))
|
40785
|
2610 (math-abs
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2611 (nth 2 math-solve-lhs)))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2612 (math-div (nth 2 math-solve-lhs) 2))
|
40785
|
2613 (math-div (math-mul
|
|
2614 2
|
|
2615 (math-mul
|
|
2616 '(var pi var-pi)
|
|
2617 (math-solve-get-int
|
|
2618 '(var i var-i)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2619 (and (integerp (nth 2 math-solve-lhs))
|
40785
|
2620 (math-abs
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2621 (nth 2 math-solve-lhs))))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2622 (nth 2 math-solve-lhs)))))
|
40785
|
2623 (math-normalize
|
|
2624 (list 'calcFunc-nroot
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2625 math-solve-rhs
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2626 (nth 2 math-solve-lhs))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2627 (and math-try-solve-sign
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2628 (math-oddp (nth 2 math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2629 (math-solve-sign math-try-solve-sign
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2630 (nth 2 math-solve-lhs)))))))))
|
41047
|
2631 (t nil)))
|
40785
|
2632
|
|
2633 (defun math-solve-prod (lsoln rsoln)
|
|
2634 (cond ((null lsoln)
|
|
2635 rsoln)
|
|
2636 ((null rsoln)
|
|
2637 lsoln)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2638 ((eq math-solve-full 'all)
|
40785
|
2639 (cons 'vec (append (cdr lsoln) (cdr rsoln))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2640 (math-solve-full
|
40785
|
2641 (list 'calcFunc-if
|
|
2642 (list 'calcFunc-gt (math-solve-get-sign 1) 0)
|
|
2643 lsoln
|
|
2644 rsoln))
|
41047
|
2645 (t lsoln)))
|
40785
|
2646
|
|
2647 ;;; This deals with negative, fractional, and symbolic powers of "x".
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2648 ;; The variable math-solve-b is local to math-decompose-poly,
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2649 ;; but is used by math-solve-poly-funny-powers.
|
58573
87c7dff39cb0
(math-expr-parts, math-try-solve-sign, math-solve-b, math-int-factors)
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2650 (defvar math-solve-b)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2651
|
40785
|
2652 (defun math-solve-poly-funny-powers (sub-rhs) ; uses "t1", "t2"
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2653 (setq math-t1 math-solve-lhs)
|
40785
|
2654 (let ((pp math-poly-neg-powers)
|
|
2655 fac)
|
|
2656 (while pp
|
|
2657 (setq fac (math-pow (car pp) (or math-poly-mult-powers 1))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2658 math-t1 (math-mul math-t1 fac)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2659 math-solve-rhs (math-mul math-solve-rhs fac)
|
40785
|
2660 pp (cdr pp))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2661 (if sub-rhs (setq math-t1 (math-sub math-t1 math-solve-rhs)))
|
40785
|
2662 (let ((math-poly-neg-powers nil))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2663 (setq math-t2 (math-mul (or math-poly-mult-powers 1)
|
40785
|
2664 (let ((calc-prefer-frac t))
|
|
2665 (math-div 1 math-poly-frac-powers)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2666 math-t1 (math-is-polynomial
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2667 (math-simplify (calcFunc-expand math-t1)) math-solve-b 50))))
|
40785
|
2668
|
|
2669 ;;; This converts "a x^8 + b x^5 + c x^2" to "(a (x^3)^2 + b (x^3) + c) * x^2".
|
|
2670 (defun math-solve-crunch-poly (max-degree) ; uses "t1", "t3"
|
|
2671 (let ((count 0))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2672 (while (and math-t1 (Math-zerop (car math-t1)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2673 (setq math-t1 (cdr math-t1)
|
40785
|
2674 count (1+ count)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2675 (and math-t1
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2676 (let* ((degree (1- (length math-t1)))
|
40785
|
2677 (scale degree))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2678 (while (and (> scale 1) (= (car math-t3) 1))
|
40785
|
2679 (and (= (% degree scale) 0)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2680 (let ((p math-t1)
|
40785
|
2681 (n 0)
|
|
2682 (new-t1 nil)
|
|
2683 (okay t))
|
|
2684 (while (and p okay)
|
|
2685 (if (= (% n scale) 0)
|
|
2686 (setq new-t1 (nconc new-t1 (list (car p))))
|
|
2687 (or (Math-zerop (car p))
|
|
2688 (setq okay nil)))
|
|
2689 (setq p (cdr p)
|
|
2690 n (1+ n)))
|
|
2691 (if okay
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2692 (setq math-t3 (cons scale (cdr math-t3))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2693 math-t1 new-t1))))
|
40785
|
2694 (setq scale (1- scale)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2695 (setq math-t3 (list (math-mul (car math-t3) math-t2)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2696 (math-mul count math-t2)))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2697 (<= (1- (length math-t1)) max-degree)))))
|
40785
|
2698
|
|
2699 (defun calcFunc-poly (expr var &optional degree)
|
|
2700 (if degree
|
|
2701 (or (natnump degree) (math-reject-arg degree 'fixnatnump))
|
|
2702 (setq degree 50))
|
|
2703 (let ((p (math-is-polynomial expr var degree 'gen)))
|
|
2704 (if p
|
|
2705 (if (equal p '(0))
|
|
2706 (list 'vec)
|
|
2707 (cons 'vec p))
|
41047
|
2708 (math-reject-arg expr "Expected a polynomial"))))
|
40785
|
2709
|
|
2710 (defun calcFunc-gpoly (expr var &optional degree)
|
|
2711 (if degree
|
|
2712 (or (natnump degree) (math-reject-arg degree 'fixnatnump))
|
|
2713 (setq degree 50))
|
|
2714 (let* ((math-poly-base-variable var)
|
|
2715 (d (math-decompose-poly expr var degree nil)))
|
|
2716 (if d
|
|
2717 (cons 'vec d)
|
41047
|
2718 (math-reject-arg expr "Expected a polynomial"))))
|
40785
|
2719
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2720 (defun math-decompose-poly (math-solve-lhs math-solve-var degree sub-rhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2721 (let ((math-solve-rhs (or sub-rhs 1))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2722 math-t1 math-t2 math-t3)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2723 (setq math-t2 (math-polynomial-base
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2724 math-solve-lhs
|
40785
|
2725 (function
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2726 (lambda (math-solve-b)
|
40785
|
2727 (let ((math-poly-neg-powers '(1))
|
|
2728 (math-poly-mult-powers nil)
|
|
2729 (math-poly-frac-powers 1)
|
|
2730 (math-poly-exp-base t))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2731 (and (not (equal math-solve-b math-solve-lhs))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2732 (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2733 (setq math-t3 '(1 0) math-t2 1
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2734 math-t1 (math-is-polynomial math-solve-lhs
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2735 math-solve-b 50))
|
40785
|
2736 (if (and (equal math-poly-neg-powers '(1))
|
|
2737 (memq math-poly-mult-powers '(nil 1))
|
|
2738 (eq math-poly-frac-powers 1)
|
|
2739 sub-rhs)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2740 (setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2741 (cdr math-t1)))
|
40785
|
2742 (math-solve-poly-funny-powers sub-rhs))
|
|
2743 (math-solve-crunch-poly degree)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2744 (or (math-expr-contains math-solve-b math-solve-var)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2745 (math-expr-contains (car math-t3) math-solve-var))))))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2746 (if math-t2
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2747 (list (math-pow math-t2 (car math-t3))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2748 (cons 'vec math-t1)
|
40785
|
2749 (if sub-rhs
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2750 (math-pow math-t2 (nth 1 math-t3))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2751 (math-div (math-pow math-t2 (nth 1 math-t3)) math-solve-rhs))))))
|
40785
|
2752
|
|
2753 (defun math-solve-linear (var sign b a)
|
|
2754 (math-try-solve-for var
|
|
2755 (math-div (math-neg b) a)
|
|
2756 (math-solve-sign sign a)
|
41047
|
2757 t))
|
40785
|
2758
|
|
2759 (defun math-solve-quadratic (var c b a)
|
|
2760 (math-try-solve-for
|
|
2761 var
|
|
2762 (if (math-looks-evenp b)
|
|
2763 (let ((halfb (math-div b 2)))
|
|
2764 (math-div
|
|
2765 (math-add
|
|
2766 (math-neg halfb)
|
|
2767 (math-solve-get-sign
|
|
2768 (math-normalize
|
|
2769 (list 'calcFunc-sqrt
|
|
2770 (math-add (math-sqr halfb)
|
|
2771 (math-mul (math-neg c) a))))))
|
|
2772 a))
|
|
2773 (math-div
|
|
2774 (math-add
|
|
2775 (math-neg b)
|
|
2776 (math-solve-get-sign
|
|
2777 (math-normalize
|
|
2778 (list 'calcFunc-sqrt
|
|
2779 (math-add (math-sqr b)
|
|
2780 (math-mul 4 (math-mul (math-neg c) a)))))))
|
|
2781 (math-mul 2 a)))
|
41047
|
2782 nil t))
|
40785
|
2783
|
|
2784 (defun math-solve-cubic (var d c b a)
|
|
2785 (let* ((p (math-div b a))
|
|
2786 (q (math-div c a))
|
|
2787 (r (math-div d a))
|
|
2788 (psqr (math-sqr p))
|
|
2789 (aa (math-sub q (math-div psqr 3)))
|
|
2790 (bb (math-add r
|
|
2791 (math-div (math-sub (math-mul 2 (math-mul psqr p))
|
|
2792 (math-mul 9 (math-mul p q)))
|
|
2793 27)))
|
|
2794 m)
|
|
2795 (if (Math-zerop aa)
|
|
2796 (math-try-solve-for (math-pow (math-add var (math-div p 3)) 3)
|
|
2797 (math-neg bb) nil t)
|
|
2798 (if (Math-zerop bb)
|
|
2799 (math-try-solve-for
|
|
2800 (math-mul (math-add var (math-div p 3))
|
|
2801 (math-add (math-sqr (math-add var (math-div p 3)))
|
|
2802 aa))
|
|
2803 0 nil t)
|
|
2804 (setq m (math-mul 2 (list 'calcFunc-sqrt (math-div aa -3))))
|
|
2805 (math-try-solve-for
|
|
2806 var
|
|
2807 (math-sub
|
|
2808 (math-normalize
|
|
2809 (math-mul
|
|
2810 m
|
|
2811 (list 'calcFunc-cos
|
|
2812 (math-div
|
|
2813 (math-sub (list 'calcFunc-arccos
|
|
2814 (math-div (math-mul 3 bb)
|
|
2815 (math-mul aa m)))
|
|
2816 (math-mul 2
|
|
2817 (math-mul
|
|
2818 (math-add 1 (math-solve-get-int
|
|
2819 1 3))
|
|
2820 (math-half-circle
|
|
2821 calc-symbolic-mode))))
|
|
2822 3))))
|
|
2823 (math-div p 3))
|
41047
|
2824 nil t)))))
|
40785
|
2825
|
|
2826 (defun math-solve-quartic (var d c b a aa)
|
|
2827 (setq a (math-div a aa))
|
|
2828 (setq b (math-div b aa))
|
|
2829 (setq c (math-div c aa))
|
|
2830 (setq d (math-div d aa))
|
|
2831 (math-try-solve-for
|
|
2832 var
|
|
2833 (let* ((asqr (math-sqr a))
|
|
2834 (asqr4 (math-div asqr 4))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2835 (y (let ((math-solve-full nil)
|
40785
|
2836 calc-next-why)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2837 (math-solve-cubic math-solve-var
|
40785
|
2838 (math-sub (math-sub
|
|
2839 (math-mul 4 (math-mul b d))
|
|
2840 (math-mul asqr d))
|
|
2841 (math-sqr c))
|
|
2842 (math-sub (math-mul a c)
|
|
2843 (math-mul 4 d))
|
|
2844 (math-neg b)
|
|
2845 1)))
|
|
2846 (rsqr (math-add (math-sub asqr4 b) y))
|
|
2847 (r (list 'calcFunc-sqrt rsqr))
|
|
2848 (sign1 (math-solve-get-sign 1))
|
|
2849 (de (list 'calcFunc-sqrt
|
|
2850 (math-add
|
|
2851 (math-sub (math-mul 3 asqr4)
|
|
2852 (math-mul 2 b))
|
|
2853 (if (Math-zerop rsqr)
|
|
2854 (math-mul
|
|
2855 2
|
|
2856 (math-mul sign1
|
|
2857 (list 'calcFunc-sqrt
|
|
2858 (math-sub (math-sqr y)
|
|
2859 (math-mul 4 d)))))
|
|
2860 (math-sub
|
|
2861 (math-mul sign1
|
|
2862 (math-div
|
|
2863 (math-sub (math-sub
|
|
2864 (math-mul 4 (math-mul a b))
|
|
2865 (math-mul 8 c))
|
|
2866 (math-mul asqr a))
|
|
2867 (math-mul 4 r)))
|
|
2868 rsqr))))))
|
|
2869 (math-normalize
|
|
2870 (math-sub (math-add (math-mul sign1 (math-div r 2))
|
|
2871 (math-solve-get-sign (math-div de 2)))
|
|
2872 (math-div a 4))))
|
41047
|
2873 nil t))
|
40785
|
2874
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
2875 (defvar math-symbolic-solve nil)
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
2876 (defvar math-int-coefs nil)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2877
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2878 ;; The variable math-int-threshold is local to math-poly-all-roots,
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2879 ;; but is used by math-poly-newton-root.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2880 (defvar math-int-threshold)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2881 ;; The variables math-int-scale, math-int-factors and math-double-roots
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2882 ;; are local to math-poly-all-roots, but are used by math-poly-integer-root.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2883 (defvar math-int-scale)
|
58573
87c7dff39cb0
(math-expr-parts, math-try-solve-sign, math-solve-b, math-int-factors)
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2884 (defvar math-int-factors)
|
87c7dff39cb0
(math-expr-parts, math-try-solve-sign, math-solve-b, math-int-factors)
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2885 (defvar math-double-roots)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2886
|
40785
|
2887 (defun math-poly-all-roots (var p &optional math-factoring)
|
|
2888 (catch 'ouch
|
|
2889 (let* ((math-symbolic-solve calc-symbolic-mode)
|
|
2890 (roots nil)
|
|
2891 (deg (1- (length p)))
|
|
2892 (orig-p (reverse p))
|
|
2893 (math-int-coefs nil)
|
|
2894 (math-int-scale nil)
|
|
2895 (math-double-roots nil)
|
|
2896 (math-int-factors nil)
|
|
2897 (math-int-threshold nil)
|
|
2898 (pp p))
|
|
2899 ;; If rational coefficients, look for exact rational factors.
|
|
2900 (while (and pp (Math-ratp (car pp)))
|
|
2901 (setq pp (cdr pp)))
|
|
2902 (if pp
|
|
2903 (if (or math-factoring math-symbolic-solve)
|
|
2904 (throw 'ouch nil))
|
|
2905 (let ((lead (car orig-p))
|
|
2906 (calc-prefer-frac t)
|
|
2907 (scale (apply 'math-lcm-denoms p)))
|
|
2908 (setq math-int-scale (math-abs (math-mul scale lead))
|
|
2909 math-int-threshold (math-div '(float 5 -2) math-int-scale)
|
|
2910 math-int-coefs (cdr (math-div (cons 'vec orig-p) lead)))))
|
|
2911 (if (> deg 4)
|
|
2912 (let ((calc-prefer-frac nil)
|
|
2913 (calc-symbolic-mode nil)
|
|
2914 (pp p)
|
|
2915 (def-p (copy-sequence orig-p)))
|
|
2916 (while pp
|
|
2917 (if (Math-numberp (car pp))
|
|
2918 (setq pp (cdr pp))
|
|
2919 (throw 'ouch nil)))
|
|
2920 (while (> deg (if math-symbolic-solve 2 4))
|
|
2921 (let* ((x (math-poly-any-root def-p '(float 0 0) nil))
|
|
2922 b c pp)
|
|
2923 (if (and (eq (car-safe x) 'cplx)
|
|
2924 (math-nearly-zerop (nth 2 x) (nth 1 x)))
|
|
2925 (setq x (calcFunc-re x)))
|
|
2926 (or math-factoring
|
|
2927 (setq roots (cons x roots)))
|
|
2928 (or (math-numberp x)
|
|
2929 (setq x (math-evaluate-expr x)))
|
|
2930 (setq pp def-p
|
|
2931 b (car def-p))
|
|
2932 (while (setq pp (cdr pp))
|
|
2933 (setq c (car pp))
|
|
2934 (setcar pp b)
|
|
2935 (setq b (math-add (math-mul x b) c)))
|
|
2936 (setq def-p (cdr def-p)
|
|
2937 deg (1- deg))))
|
|
2938 (setq p (reverse def-p))))
|
|
2939 (if (> deg 1)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2940 (let ((math-solve-var '(var DUMMY var-DUMMY))
|
40785
|
2941 (math-solve-sign nil)
|
|
2942 (math-solve-ranges nil)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2943 (math-solve-full 'all))
|
40785
|
2944 (if (= (length p) (length math-int-coefs))
|
|
2945 (setq p (reverse math-int-coefs)))
|
|
2946 (setq roots (append (cdr (apply (cond ((= deg 2)
|
|
2947 'math-solve-quadratic)
|
|
2948 ((= deg 3)
|
|
2949 'math-solve-cubic)
|
|
2950 (t
|
|
2951 'math-solve-quartic))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2952 math-solve-var p))
|
40785
|
2953 roots)))
|
|
2954 (if (> deg 0)
|
|
2955 (setq roots (cons (math-div (math-neg (car p)) (nth 1 p))
|
|
2956 roots))))
|
|
2957 (if math-factoring
|
|
2958 (progn
|
|
2959 (while roots
|
|
2960 (math-poly-integer-root (car roots))
|
|
2961 (setq roots (cdr roots)))
|
|
2962 (list math-int-factors (nreverse math-int-coefs) math-int-scale))
|
|
2963 (let ((vec nil) res)
|
|
2964 (while roots
|
|
2965 (let ((root (car roots))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2966 (math-solve-full (and math-solve-full 'all)))
|
40785
|
2967 (if (math-floatp root)
|
|
2968 (setq root (math-poly-any-root orig-p root t)))
|
|
2969 (setq vec (append vec
|
|
2970 (cdr (or (math-try-solve-for var root nil t)
|
|
2971 (throw 'ouch nil))))))
|
|
2972 (setq roots (cdr roots)))
|
|
2973 (setq vec (cons 'vec (nreverse vec)))
|
|
2974 (if math-symbolic-solve
|
|
2975 (setq vec (math-normalize vec)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
2976 (if (eq math-solve-full t)
|
40785
|
2977 (list 'calcFunc-subscr
|
|
2978 vec
|
|
2979 (math-solve-get-int 1 (1- (length orig-p)) 1))
|
41047
|
2980 vec))))))
|
40785
|
2981
|
|
2982 (defun math-lcm-denoms (&rest fracs)
|
|
2983 (let ((den 1))
|
|
2984 (while fracs
|
|
2985 (if (eq (car-safe (car fracs)) 'frac)
|
|
2986 (setq den (calcFunc-lcm den (nth 2 (car fracs)))))
|
|
2987 (setq fracs (cdr fracs)))
|
41047
|
2988 den))
|
40785
|
2989
|
|
2990 (defun math-poly-any-root (p x polish) ; p is a reverse poly coeff list
|
|
2991 (let* ((newt (if (math-zerop x)
|
|
2992 (math-poly-newton-root
|
|
2993 p '(cplx (float 123 -6) (float 1 -4)) 4)
|
|
2994 (math-poly-newton-root p x 4)))
|
|
2995 (res (if (math-zerop (cdr newt))
|
|
2996 (car newt)
|
|
2997 (if (and (math-lessp (cdr newt) '(float 1 -3)) (not polish))
|
|
2998 (setq newt (math-poly-newton-root p (car newt) 30)))
|
|
2999 (if (math-zerop (cdr newt))
|
|
3000 (car newt)
|
|
3001 (math-poly-laguerre-root p x polish)))))
|
|
3002 (and math-symbolic-solve (math-floatp res)
|
|
3003 (throw 'ouch nil))
|
41047
|
3004 res))
|
40785
|
3005
|
|
3006 (defun math-poly-newton-root (p x iters)
|
|
3007 (let* ((calc-prefer-frac nil)
|
|
3008 (calc-symbolic-mode nil)
|
|
3009 (try-integer math-int-coefs)
|
|
3010 (dx x) b d)
|
|
3011 (while (and (> (setq iters (1- iters)) 0)
|
|
3012 (let ((pp p))
|
|
3013 (math-working "newton" x)
|
|
3014 (setq b (car p)
|
|
3015 d 0)
|
|
3016 (while (setq pp (cdr pp))
|
|
3017 (setq d (math-add (math-mul x d) b)
|
|
3018 b (math-add (math-mul x b) (car pp))))
|
|
3019 (not (math-zerop d)))
|
|
3020 (progn
|
|
3021 (setq dx (math-div b d)
|
|
3022 x (math-sub x dx))
|
|
3023 (if try-integer
|
|
3024 (let ((adx (math-abs-approx dx)))
|
|
3025 (and (math-lessp adx math-int-threshold)
|
|
3026 (let ((iroot (math-poly-integer-root x)))
|
|
3027 (if iroot
|
|
3028 (setq x iroot dx 0)
|
|
3029 (setq try-integer nil))))))
|
|
3030 (or (not (or (eq dx 0)
|
|
3031 (math-nearly-zerop dx (math-abs-approx x))))
|
|
3032 (progn (setq dx 0) nil)))))
|
|
3033 (cons x (if (math-zerop x)
|
41047
|
3034 1 (math-div (math-abs-approx dx) (math-abs-approx x))))))
|
40785
|
3035
|
|
3036 (defun math-poly-integer-root (x)
|
|
3037 (and (math-lessp (calcFunc-xpon (math-abs-approx x)) calc-internal-prec)
|
|
3038 math-int-coefs
|
|
3039 (let* ((calc-prefer-frac t)
|
|
3040 (xre (calcFunc-re x))
|
|
3041 (xim (calcFunc-im x))
|
|
3042 (xresq (math-sqr xre))
|
|
3043 (ximsq (math-sqr xim)))
|
|
3044 (if (math-lessp ximsq (calcFunc-scf xresq -1))
|
|
3045 ;; Look for linear factor
|
|
3046 (let* ((rnd (math-div (math-round (math-mul xre math-int-scale))
|
|
3047 math-int-scale))
|
|
3048 (icp math-int-coefs)
|
|
3049 (rem (car icp))
|
|
3050 (newcoef nil))
|
|
3051 (while (setq icp (cdr icp))
|
|
3052 (setq newcoef (cons rem newcoef)
|
|
3053 rem (math-add (car icp)
|
|
3054 (math-mul rem rnd))))
|
|
3055 (and (math-zerop rem)
|
|
3056 (progn
|
|
3057 (setq math-int-coefs (nreverse newcoef)
|
|
3058 math-int-factors (cons (list (math-neg rnd))
|
|
3059 math-int-factors))
|
|
3060 rnd)))
|
|
3061 ;; Look for irreducible quadratic factor
|
|
3062 (let* ((rnd1 (math-div (math-round
|
|
3063 (math-mul xre (math-mul -2 math-int-scale)))
|
|
3064 math-int-scale))
|
|
3065 (sqscale (math-sqr math-int-scale))
|
|
3066 (rnd0 (math-div (math-round (math-mul (math-add xresq ximsq)
|
|
3067 sqscale))
|
|
3068 sqscale))
|
|
3069 (rem1 (car math-int-coefs))
|
|
3070 (icp (cdr math-int-coefs))
|
|
3071 (rem0 (car icp))
|
|
3072 (newcoef nil)
|
|
3073 (found (assoc (list rnd0 rnd1 (math-posp xim))
|
|
3074 math-double-roots))
|
|
3075 this)
|
|
3076 (if found
|
|
3077 (setq math-double-roots (delq found math-double-roots)
|
|
3078 rem0 0 rem1 0)
|
|
3079 (while (setq icp (cdr icp))
|
|
3080 (setq this rem1
|
|
3081 newcoef (cons rem1 newcoef)
|
|
3082 rem1 (math-sub rem0 (math-mul this rnd1))
|
|
3083 rem0 (math-sub (car icp) (math-mul this rnd0)))))
|
|
3084 (and (math-zerop rem0)
|
|
3085 (math-zerop rem1)
|
|
3086 (let ((aa (math-div rnd1 -2)))
|
|
3087 (or found (setq math-int-coefs (reverse newcoef)
|
|
3088 math-double-roots (cons (list
|
|
3089 (list
|
|
3090 rnd0 rnd1
|
|
3091 (math-negp xim)))
|
|
3092 math-double-roots)
|
|
3093 math-int-factors (cons (cons rnd0 rnd1)
|
|
3094 math-int-factors)))
|
|
3095 (math-add aa
|
|
3096 (let ((calc-symbolic-mode math-symbolic-solve))
|
|
3097 (math-mul (math-sqrt (math-sub (math-sqr aa)
|
|
3098 rnd0))
|
41047
|
3099 (if (math-negp xim) -1 1)))))))))))
|
40785
|
3100
|
|
3101 ;;; The following routine is from Numerical Recipes, section 9.5.
|
|
3102 (defun math-poly-laguerre-root (p x polish)
|
|
3103 (let* ((calc-prefer-frac nil)
|
|
3104 (calc-symbolic-mode nil)
|
|
3105 (iters 0)
|
|
3106 (m (1- (length p)))
|
|
3107 (try-newt (not polish))
|
|
3108 (tried-newt nil)
|
|
3109 b d f x1 dx dxold)
|
|
3110 (while
|
|
3111 (and (or (< (setq iters (1+ iters)) 50)
|
|
3112 (math-reject-arg x "*Laguerre's method failed to converge"))
|
|
3113 (let ((err (math-abs-approx (car p)))
|
|
3114 (abx (math-abs-approx x))
|
|
3115 (pp p))
|
|
3116 (setq b (car p)
|
|
3117 d 0 f 0)
|
|
3118 (while (setq pp (cdr pp))
|
|
3119 (setq f (math-add (math-mul x f) d)
|
|
3120 d (math-add (math-mul x d) b)
|
|
3121 b (math-add (math-mul x b) (car pp))
|
|
3122 err (math-add (math-abs-approx b) (math-mul abx err))))
|
|
3123 (math-lessp (calcFunc-scf err (- -2 calc-internal-prec))
|
|
3124 (math-abs-approx b)))
|
|
3125 (or (not (math-zerop d))
|
|
3126 (not (math-zerop f))
|
|
3127 (progn
|
|
3128 (setq x (math-pow (math-neg b) (list 'frac 1 m)))
|
|
3129 nil))
|
|
3130 (let* ((g (math-div d b))
|
|
3131 (g2 (math-sqr g))
|
|
3132 (h (math-sub g2 (math-mul 2 (math-div f b))))
|
|
3133 (sq (math-sqrt
|
|
3134 (math-mul (1- m) (math-sub (math-mul m h) g2))))
|
|
3135 (gp (math-add g sq))
|
|
3136 (gm (math-sub g sq)))
|
|
3137 (if (math-lessp (calcFunc-abssqr gp) (calcFunc-abssqr gm))
|
|
3138 (setq gp gm))
|
|
3139 (setq dx (math-div m gp)
|
|
3140 x1 (math-sub x dx))
|
|
3141 (if (and try-newt
|
|
3142 (math-lessp (math-abs-approx dx)
|
|
3143 (calcFunc-scf (math-abs-approx x) -3)))
|
|
3144 (let ((newt (math-poly-newton-root p x1 7)))
|
|
3145 (setq tried-newt t
|
|
3146 try-newt nil)
|
|
3147 (if (math-zerop (cdr newt))
|
|
3148 (setq x (car newt) x1 x)
|
|
3149 (if (math-lessp (cdr newt) '(float 1 -6))
|
|
3150 (let ((newt2 (math-poly-newton-root
|
|
3151 p (car newt) 20)))
|
|
3152 (if (math-zerop (cdr newt2))
|
|
3153 (setq x (car newt2) x1 x)
|
|
3154 (setq x (car newt))))))))
|
|
3155 (not (or (eq x x1)
|
|
3156 (math-nearly-equal x x1))))
|
|
3157 (let ((cdx (math-abs-approx dx)))
|
|
3158 (setq x x1
|
|
3159 tried-newt nil)
|
|
3160 (prog1
|
|
3161 (or (<= iters 6)
|
|
3162 (math-lessp cdx dxold)
|
|
3163 (progn
|
|
3164 (if polish
|
|
3165 (let ((digs (calcFunc-xpon
|
|
3166 (math-div (math-abs-approx x) cdx))))
|
|
3167 (calc-record-why
|
|
3168 "*Could not attain full precision")
|
|
3169 (if (natnump digs)
|
|
3170 (let ((calc-internal-prec (max 3 digs)))
|
|
3171 (setq x (math-normalize x))))))
|
|
3172 nil))
|
|
3173 (setq dxold cdx)))
|
|
3174 (or polish
|
|
3175 (math-lessp (calcFunc-scf (math-abs-approx x)
|
|
3176 (- calc-internal-prec))
|
|
3177 dxold))))
|
|
3178 (or (and (math-floatp x)
|
|
3179 (math-poly-integer-root x))
|
41047
|
3180 x)))
|
40785
|
3181
|
|
3182 (defun math-solve-above-dummy (x)
|
|
3183 (and (not (Math-primp x))
|
|
3184 (if (and (equal (nth 1 x) '(var SOLVEDUM SOLVEDUM))
|
|
3185 (= (length x) 2))
|
|
3186 x
|
|
3187 (let ((res nil))
|
|
3188 (while (and (setq x (cdr x))
|
|
3189 (not (setq res (math-solve-above-dummy (car x))))))
|
41047
|
3190 res))))
|
40785
|
3191
|
|
3192 (defun math-solve-find-root-term (x neg) ; sets "t2", "t3"
|
|
3193 (if (math-solve-find-root-in-prod x)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3194 (setq math-t3 neg
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3195 math-t1 x)
|
40785
|
3196 (and (memq (car-safe x) '(+ -))
|
|
3197 (or (math-solve-find-root-term (nth 1 x) neg)
|
|
3198 (math-solve-find-root-term (nth 2 x)
|
41047
|
3199 (if (eq (car x) '-) (not neg) neg))))))
|
40785
|
3200
|
|
3201 (defun math-solve-find-root-in-prod (x)
|
|
3202 (and (consp x)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3203 (math-expr-contains x math-solve-var)
|
40785
|
3204 (or (and (eq (car x) 'calcFunc-sqrt)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3205 (setq math-t2 2))
|
40785
|
3206 (and (eq (car x) '^)
|
|
3207 (or (and (memq (math-quarter-integer (nth 2 x)) '(1 2 3))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3208 (setq math-t2 2))
|
40785
|
3209 (and (eq (car-safe (nth 2 x)) 'frac)
|
|
3210 (eq (nth 2 (nth 2 x)) 3)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3211 (setq math-t2 3))))
|
40785
|
3212 (and (memq (car x) '(* /))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3213 (or (and (not (math-expr-contains (nth 1 x) math-solve-var))
|
40785
|
3214 (math-solve-find-root-in-prod (nth 2 x)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3215 (and (not (math-expr-contains (nth 2 x) math-solve-var))
|
41047
|
3216 (math-solve-find-root-in-prod (nth 1 x))))))))
|
40785
|
3217
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3218 ;; The variable math-solve-vars is local to math-solve-system,
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3219 ;; but is used by math-solve-system-rec.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3220 (defvar math-solve-vars)
|
40785
|
3221
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3222 ;; The variable math-solve-simplifying is local to math-solve-system
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3223 ;; and math-solve-system-rec, but is used by math-solve-system-subst.
|
58573
87c7dff39cb0
(math-expr-parts, math-try-solve-sign, math-solve-b, math-int-factors)
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3224 (defvar math-solve-simplifying)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3225
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3226 (defun math-solve-system (exprs math-solve-vars math-solve-full)
|
40785
|
3227 (setq exprs (mapcar 'list (if (Math-vectorp exprs)
|
|
3228 (cdr exprs)
|
|
3229 (list exprs)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3230 math-solve-vars (if (Math-vectorp math-solve-vars)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3231 (cdr math-solve-vars)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3232 (list math-solve-vars)))
|
40785
|
3233 (or (let ((math-solve-simplifying nil))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3234 (math-solve-system-rec exprs math-solve-vars nil))
|
40785
|
3235 (let ((math-solve-simplifying t))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3236 (math-solve-system-rec exprs math-solve-vars nil))))
|
40785
|
3237
|
|
3238 ;;; The following backtracking solver works by choosing a variable
|
|
3239 ;;; and equation, and trying to solve the equation for the variable.
|
|
3240 ;;; If it succeeds it calls itself recursively with that variable and
|
|
3241 ;;; equation removed from their respective lists, and with the solution
|
|
3242 ;;; added to solns as well as being substituted into all existing
|
|
3243 ;;; equations. The algorithm terminates when any solution path
|
|
3244 ;;; manages to remove all the variables from var-list.
|
|
3245
|
|
3246 ;;; To support calcFunc-roots, entries in eqn-list and solns are
|
|
3247 ;;; actually lists of equations.
|
|
3248
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3249 ;; The variables math-solve-system-res and math-solve-system-vv are
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3250 ;; local to math-solve-system-rec, but are used by math-solve-system-subst.
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3251 (defvar math-solve-system-vv)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3252 (defvar math-solve-system-res)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3253
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3254
|
40785
|
3255 (defun math-solve-system-rec (eqn-list var-list solns)
|
|
3256 (if var-list
|
|
3257 (let ((v var-list)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3258 (math-solve-system-res nil))
|
40785
|
3259
|
|
3260 ;; Try each variable in turn.
|
|
3261 (while
|
|
3262 (and
|
|
3263 v
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3264 (let* ((math-solve-system-vv (car v))
|
40785
|
3265 (e eqn-list)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3266 (elim (eq (car-safe math-solve-system-vv) 'calcFunc-elim)))
|
40785
|
3267 (if elim
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3268 (setq math-solve-system-vv (nth 1 math-solve-system-vv)))
|
40785
|
3269
|
|
3270 ;; Try each equation in turn.
|
|
3271 (while
|
|
3272 (and
|
|
3273 e
|
|
3274 (let ((e2 (car e))
|
|
3275 (eprev nil)
|
|
3276 res2)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3277 (setq math-solve-system-res nil)
|
40785
|
3278
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3279 ;; Try to solve for math-solve-system-vv the list of equations e2.
|
40785
|
3280 (while (and e2
|
|
3281 (setq res2 (or (and (eq (car e2) eprev)
|
|
3282 res2)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3283 (math-solve-for (car e2) 0
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3284 math-solve-system-vv
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3285 math-solve-full))))
|
40785
|
3286 (setq eprev (car e2)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3287 math-solve-system-res (cons (if (eq math-solve-full 'all)
|
40785
|
3288 (cdr res2)
|
|
3289 (list res2))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3290 math-solve-system-res)
|
40785
|
3291 e2 (cdr e2)))
|
|
3292 (if e2
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3293 (setq math-solve-system-res nil)
|
40785
|
3294
|
|
3295 ;; Found a solution. Now try other variables.
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3296 (setq math-solve-system-res (nreverse math-solve-system-res)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3297 math-solve-system-res (math-solve-system-rec
|
40785
|
3298 (mapcar
|
|
3299 'math-solve-system-subst
|
|
3300 (delq (car e)
|
|
3301 (copy-sequence eqn-list)))
|
|
3302 (delq (car v) (copy-sequence var-list))
|
|
3303 (let ((math-solve-simplifying nil)
|
|
3304 (s (mapcar
|
|
3305 (function
|
|
3306 (lambda (x)
|
|
3307 (cons
|
|
3308 (car x)
|
|
3309 (math-solve-system-subst
|
|
3310 (cdr x)))))
|
|
3311 solns)))
|
|
3312 (if elim
|
|
3313 s
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3314 (cons (cons
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3315 math-solve-system-vv
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3316 (apply 'append math-solve-system-res))
|
40785
|
3317 s)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3318 (not math-solve-system-res))))
|
40785
|
3319 (setq e (cdr e)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3320 (not math-solve-system-res)))
|
40785
|
3321 (setq v (cdr v)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3322 math-solve-system-res)
|
40785
|
3323
|
|
3324 ;; Eliminated all variables, so now put solution into the proper format.
|
|
3325 (setq solns (sort solns
|
|
3326 (function
|
|
3327 (lambda (x y)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3328 (not (memq (car x) (memq (car y) math-solve-vars)))))))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3329 (if (eq math-solve-full 'all)
|
40785
|
3330 (math-transpose
|
|
3331 (math-normalize
|
|
3332 (cons 'vec
|
|
3333 (if solns
|
|
3334 (mapcar (function (lambda (x) (cons 'vec (cdr x)))) solns)
|
|
3335 (mapcar (function (lambda (x) (cons 'vec x))) eqn-list)))))
|
|
3336 (math-normalize
|
49598
|
3337 (cons 'vec
|
40785
|
3338 (if solns
|
|
3339 (mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns)
|
41047
|
3340 (mapcar 'car eqn-list)))))))
|
40785
|
3341
|
|
3342 (defun math-solve-system-subst (x) ; uses "res" and "v"
|
|
3343 (let ((accum nil)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3344 (res2 math-solve-system-res))
|
40785
|
3345 (while x
|
|
3346 (setq accum (nconc accum
|
|
3347 (mapcar (function
|
|
3348 (lambda (r)
|
|
3349 (if math-solve-simplifying
|
|
3350 (math-simplify
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3351 (math-expr-subst
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3352 (car x) math-solve-system-vv r))
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3353 (math-expr-subst
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3354 (car x) math-solve-system-vv r))))
|
40785
|
3355 (car res2)))
|
|
3356 x (cdr x)
|
|
3357 res2 (cdr res2)))
|
41047
|
3358 accum))
|
40785
|
3359
|
|
3360
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3361 ;; calc-command-flags is declared in calc.el
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3362 (defvar calc-command-flags)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3363
|
40785
|
3364 (defun math-get-from-counter (name)
|
|
3365 (let ((ctr (assq name calc-command-flags)))
|
|
3366 (if ctr
|
|
3367 (setcdr ctr (1+ (cdr ctr)))
|
|
3368 (setq ctr (cons name 1)
|
|
3369 calc-command-flags (cons ctr calc-command-flags)))
|
41047
|
3370 (cdr ctr)))
|
40785
|
3371
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3372 (defvar var-GenCount)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3373
|
40785
|
3374 (defun math-solve-get-sign (val)
|
|
3375 (setq val (math-simplify val))
|
|
3376 (if (and (eq (car-safe val) '*)
|
|
3377 (Math-numberp (nth 1 val)))
|
|
3378 (list '* (nth 1 val) (math-solve-get-sign (nth 2 val)))
|
|
3379 (and (eq (car-safe val) 'calcFunc-sqrt)
|
|
3380 (eq (car-safe (nth 1 val)) '^)
|
|
3381 (setq val (math-normalize (list '^
|
|
3382 (nth 1 (nth 1 val))
|
|
3383 (math-div (nth 2 (nth 1 val)) 2)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3384 (if math-solve-full
|
40785
|
3385 (if (and (calc-var-value 'var-GenCount)
|
|
3386 (Math-natnump var-GenCount)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3387 (not (eq math-solve-full 'all)))
|
40785
|
3388 (prog1
|
|
3389 (math-mul (list 'calcFunc-as var-GenCount) val)
|
|
3390 (setq var-GenCount (math-add var-GenCount 1))
|
|
3391 (calc-refresh-evaltos 'var-GenCount))
|
43506
|
3392 (let* ((var (concat "s" (int-to-string (math-get-from-counter 'solve-sign))))
|
40785
|
3393 (var2 (list 'var (intern var) (intern (concat "var-" var)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3394 (if (eq math-solve-full 'all)
|
40785
|
3395 (setq math-solve-ranges (cons (list var2 1 -1)
|
|
3396 math-solve-ranges)))
|
|
3397 (math-mul var2 val)))
|
|
3398 (calc-record-why "*Choosing positive solution")
|
41047
|
3399 val)))
|
40785
|
3400
|
|
3401 (defun math-solve-get-int (val &optional range first)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3402 (if math-solve-full
|
40785
|
3403 (if (and (calc-var-value 'var-GenCount)
|
|
3404 (Math-natnump var-GenCount)
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3405 (not (eq math-solve-full 'all)))
|
40785
|
3406 (prog1
|
|
3407 (math-mul val (list 'calcFunc-an var-GenCount))
|
|
3408 (setq var-GenCount (math-add var-GenCount 1))
|
|
3409 (calc-refresh-evaltos 'var-GenCount))
|
43404
|
3410 (let* ((var (concat "n" (int-to-string
|
|
3411 (math-get-from-counter 'solve-int))))
|
40785
|
3412 (var2 (list 'var (intern var) (intern (concat "var-" var)))))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3413 (if (and range (eq math-solve-full 'all))
|
40785
|
3414 (setq math-solve-ranges (cons (cons var2
|
|
3415 (cdr (calcFunc-index
|
|
3416 range (or first 0))))
|
|
3417 math-solve-ranges)))
|
|
3418 (math-mul val var2)))
|
|
3419 (calc-record-why "*Choosing 0 for arbitrary integer in solution")
|
41047
|
3420 0))
|
40785
|
3421
|
|
3422 (defun math-solve-sign (sign expr)
|
|
3423 (and sign
|
|
3424 (let ((s1 (math-possible-signs expr)))
|
|
3425 (cond ((memq s1 '(4 6))
|
|
3426 sign)
|
|
3427 ((memq s1 '(1 3))
|
41047
|
3428 (- sign))))))
|
40785
|
3429
|
|
3430 (defun math-looks-evenp (expr)
|
|
3431 (if (Math-integerp expr)
|
|
3432 (math-evenp expr)
|
|
3433 (if (memq (car expr) '(* /))
|
41047
|
3434 (math-looks-evenp (nth 1 expr)))))
|
40785
|
3435
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3436 (defun math-solve-for (lhs rhs math-solve-var math-solve-full &optional sign)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3437 (if (math-expr-contains rhs math-solve-var)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3438 (math-solve-for (math-sub lhs rhs) 0 math-solve-var math-solve-full)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3439 (and (math-expr-contains lhs math-solve-var)
|
40785
|
3440 (math-with-extra-prec 1
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3441 (let* ((math-poly-base-variable math-solve-var)
|
40785
|
3442 (res (math-try-solve-for lhs rhs sign)))
|
58229
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3443 (if (and (eq math-solve-full 'all)
|
7f5b01c17652
(math-integrate-by-parts): Removed unused variable var-thing.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
3444 (math-known-realp math-solve-var))
|
40785
|
3445 (let ((old-len (length res))
|
|
3446 new-len)
|
|
3447 (setq res (delq nil
|
|
3448 (mapcar (function
|
|
3449 (lambda (x)
|
|
3450 (and (not (memq (car-safe x)
|
|
3451 '(cplx polar)))
|
|
3452 x)))
|
|
3453 res))
|
|
3454 new-len (length res))
|
|
3455 (if (< new-len old-len)
|
|
3456 (calc-record-why (if (= new-len 1)
|
|
3457 "*All solutions were complex"
|
|
3458 (format
|
|
3459 "*Omitted %d complex solutions"
|
|
3460 (- old-len new-len)))))))
|
41047
|
3461 res)))))
|
40785
|
3462
|
|
3463 (defun math-solve-eqn (expr var full)
|
|
3464 (if (memq (car-safe expr) '(calcFunc-neq calcFunc-lt calcFunc-gt
|
|
3465 calcFunc-leq calcFunc-geq))
|
|
3466 (let ((res (math-solve-for (cons '- (cdr expr))
|
|
3467 0 var full
|
|
3468 (if (eq (car expr) 'calcFunc-neq) nil 1))))
|
|
3469 (and res
|
|
3470 (if (eq math-solve-sign 1)
|
|
3471 (list (car expr) var res)
|
|
3472 (if (eq math-solve-sign -1)
|
|
3473 (list (car expr) res var)
|
|
3474 (or (eq (car expr) 'calcFunc-neq)
|
|
3475 (calc-record-why
|
|
3476 "*Can't determine direction of inequality"))
|
|
3477 (and (memq (car expr) '(calcFunc-neq calcFunc-lt calcFunc-gt))
|
|
3478 (list 'calcFunc-neq var res))))))
|
|
3479 (let ((res (math-solve-for expr 0 var full)))
|
|
3480 (and res
|
41047
|
3481 (list 'calcFunc-eq var res)))))
|
40785
|
3482
|
|
3483 (defun math-reject-solution (expr var func)
|
|
3484 (if (math-expr-contains expr var)
|
|
3485 (or (equal (car calc-next-why) '(* "Unable to find a symbolic solution"))
|
|
3486 (calc-record-why "*Unable to find a solution")))
|
41047
|
3487 (list func expr var))
|
40785
|
3488
|
|
3489 (defun calcFunc-solve (expr var)
|
|
3490 (or (if (or (Math-vectorp expr) (Math-vectorp var))
|
|
3491 (math-solve-system expr var nil)
|
|
3492 (math-solve-eqn expr var nil))
|
41047
|
3493 (math-reject-solution expr var 'calcFunc-solve)))
|
40785
|
3494
|
|
3495 (defun calcFunc-fsolve (expr var)
|
|
3496 (or (if (or (Math-vectorp expr) (Math-vectorp var))
|
|
3497 (math-solve-system expr var t)
|
|
3498 (math-solve-eqn expr var t))
|
41047
|
3499 (math-reject-solution expr var 'calcFunc-fsolve)))
|
40785
|
3500
|
|
3501 (defun calcFunc-roots (expr var)
|
|
3502 (let ((math-solve-ranges nil))
|
|
3503 (or (if (or (Math-vectorp expr) (Math-vectorp var))
|
|
3504 (math-solve-system expr var 'all)
|
|
3505 (math-solve-for expr 0 var 'all))
|
41047
|
3506 (math-reject-solution expr var 'calcFunc-roots))))
|
40785
|
3507
|
|
3508 (defun calcFunc-finv (expr var)
|
|
3509 (let ((res (math-solve-for expr math-integ-var var nil)))
|
|
3510 (if res
|
|
3511 (math-normalize (math-expr-subst res math-integ-var var))
|
41047
|
3512 (math-reject-solution expr var 'calcFunc-finv))))
|
40785
|
3513
|
|
3514 (defun calcFunc-ffinv (expr var)
|
|
3515 (let ((res (math-solve-for expr math-integ-var var t)))
|
|
3516 (if res
|
|
3517 (math-normalize (math-expr-subst res math-integ-var var))
|
41047
|
3518 (math-reject-solution expr var 'calcFunc-finv))))
|
40785
|
3519
|
|
3520
|
|
3521 (put 'calcFunc-inv 'math-inverse
|
|
3522 (function (lambda (x) (math-div 1 x))))
|
|
3523 (put 'calcFunc-inv 'math-inverse-sign -1)
|
|
3524
|
|
3525 (put 'calcFunc-sqrt 'math-inverse
|
|
3526 (function (lambda (x) (math-sqr x))))
|
|
3527
|
|
3528 (put 'calcFunc-conj 'math-inverse
|
|
3529 (function (lambda (x) (list 'calcFunc-conj x))))
|
|
3530
|
|
3531 (put 'calcFunc-abs 'math-inverse
|
|
3532 (function (lambda (x) (math-solve-get-sign x))))
|
|
3533
|
|
3534 (put 'calcFunc-deg 'math-inverse
|
|
3535 (function (lambda (x) (list 'calcFunc-rad x))))
|
|
3536 (put 'calcFunc-deg 'math-inverse-sign 1)
|
|
3537
|
|
3538 (put 'calcFunc-rad 'math-inverse
|
|
3539 (function (lambda (x) (list 'calcFunc-deg x))))
|
|
3540 (put 'calcFunc-rad 'math-inverse-sign 1)
|
|
3541
|
|
3542 (put 'calcFunc-ln 'math-inverse
|
|
3543 (function (lambda (x) (list 'calcFunc-exp x))))
|
|
3544 (put 'calcFunc-ln 'math-inverse-sign 1)
|
|
3545
|
|
3546 (put 'calcFunc-log10 'math-inverse
|
|
3547 (function (lambda (x) (list 'calcFunc-exp10 x))))
|
|
3548 (put 'calcFunc-log10 'math-inverse-sign 1)
|
|
3549
|
|
3550 (put 'calcFunc-lnp1 'math-inverse
|
|
3551 (function (lambda (x) (list 'calcFunc-expm1 x))))
|
|
3552 (put 'calcFunc-lnp1 'math-inverse-sign 1)
|
|
3553
|
|
3554 (put 'calcFunc-exp 'math-inverse
|
|
3555 (function (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
|
|
3556 (math-mul 2
|
|
3557 (math-mul '(var pi var-pi)
|
|
3558 (math-solve-get-int
|
|
3559 '(var i var-i))))))))
|
|
3560 (put 'calcFunc-exp 'math-inverse-sign 1)
|
|
3561
|
|
3562 (put 'calcFunc-expm1 'math-inverse
|
|
3563 (function (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
|
|
3564 (math-mul 2
|
|
3565 (math-mul '(var pi var-pi)
|
|
3566 (math-solve-get-int
|
|
3567 '(var i var-i))))))))
|
|
3568 (put 'calcFunc-expm1 'math-inverse-sign 1)
|
|
3569
|
|
3570 (put 'calcFunc-sin 'math-inverse
|
|
3571 (function (lambda (x) (let ((n (math-solve-get-int 1)))
|
|
3572 (math-add (math-mul (math-normalize
|
|
3573 (list 'calcFunc-arcsin x))
|
|
3574 (math-pow -1 n))
|
|
3575 (math-mul (math-half-circle t)
|
|
3576 n))))))
|
|
3577
|
|
3578 (put 'calcFunc-cos 'math-inverse
|
|
3579 (function (lambda (x) (math-add (math-solve-get-sign
|
|
3580 (math-normalize
|
|
3581 (list 'calcFunc-arccos x)))
|
|
3582 (math-solve-get-int
|
|
3583 (math-full-circle t))))))
|
|
3584
|
|
3585 (put 'calcFunc-tan 'math-inverse
|
|
3586 (function (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
|
|
3587 (math-solve-get-int
|
|
3588 (math-half-circle t))))))
|
|
3589
|
|
3590 (put 'calcFunc-arcsin 'math-inverse
|
|
3591 (function (lambda (x) (math-normalize (list 'calcFunc-sin x)))))
|
|
3592
|
|
3593 (put 'calcFunc-arccos 'math-inverse
|
|
3594 (function (lambda (x) (math-normalize (list 'calcFunc-cos x)))))
|
|
3595
|
|
3596 (put 'calcFunc-arctan 'math-inverse
|
|
3597 (function (lambda (x) (math-normalize (list 'calcFunc-tan x)))))
|
|
3598
|
|
3599 (put 'calcFunc-sinh 'math-inverse
|
|
3600 (function (lambda (x) (let ((n (math-solve-get-int 1)))
|
|
3601 (math-add (math-mul (math-normalize
|
|
3602 (list 'calcFunc-arcsinh x))
|
|
3603 (math-pow -1 n))
|
|
3604 (math-mul (math-half-circle t)
|
|
3605 (math-mul
|
|
3606 '(var i var-i)
|
|
3607 n)))))))
|
|
3608 (put 'calcFunc-sinh 'math-inverse-sign 1)
|
|
3609
|
|
3610 (put 'calcFunc-cosh 'math-inverse
|
|
3611 (function (lambda (x) (math-add (math-solve-get-sign
|
|
3612 (math-normalize
|
|
3613 (list 'calcFunc-arccosh x)))
|
|
3614 (math-mul (math-full-circle t)
|
|
3615 (math-solve-get-int
|
|
3616 '(var i var-i)))))))
|
|
3617
|
|
3618 (put 'calcFunc-tanh 'math-inverse
|
|
3619 (function (lambda (x) (math-add (math-normalize
|
|
3620 (list 'calcFunc-arctanh x))
|
|
3621 (math-mul (math-half-circle t)
|
|
3622 (math-solve-get-int
|
|
3623 '(var i var-i)))))))
|
|
3624 (put 'calcFunc-tanh 'math-inverse-sign 1)
|
|
3625
|
|
3626 (put 'calcFunc-arcsinh 'math-inverse
|
|
3627 (function (lambda (x) (math-normalize (list 'calcFunc-sinh x)))))
|
|
3628 (put 'calcFunc-arcsinh 'math-inverse-sign 1)
|
|
3629
|
|
3630 (put 'calcFunc-arccosh 'math-inverse
|
|
3631 (function (lambda (x) (math-normalize (list 'calcFunc-cosh x)))))
|
|
3632
|
|
3633 (put 'calcFunc-arctanh 'math-inverse
|
|
3634 (function (lambda (x) (math-normalize (list 'calcFunc-tanh x)))))
|
|
3635 (put 'calcFunc-arctanh 'math-inverse-sign 1)
|
|
3636
|
|
3637
|
|
3638
|
|
3639 (defun calcFunc-taylor (expr var num)
|
|
3640 (let ((x0 0) (v var))
|
|
3641 (if (memq (car-safe var) '(+ - calcFunc-eq))
|
|
3642 (setq x0 (if (eq (car var) '+) (math-neg (nth 2 var)) (nth 2 var))
|
|
3643 v (nth 1 var)))
|
|
3644 (or (and (eq (car-safe v) 'var)
|
|
3645 (math-expr-contains expr v)
|
|
3646 (natnump num)
|
|
3647 (let ((accum (math-expr-subst expr v x0))
|
|
3648 (var2 (if (eq (car var) 'calcFunc-eq)
|
|
3649 (cons '- (cdr var))
|
|
3650 var))
|
|
3651 (n 0)
|
|
3652 (nfac 1)
|
|
3653 (fprime expr))
|
|
3654 (while (and (<= (setq n (1+ n)) num)
|
|
3655 (setq fprime (calcFunc-deriv fprime v nil t)))
|
|
3656 (setq fprime (math-simplify fprime)
|
|
3657 nfac (math-mul nfac n)
|
|
3658 accum (math-add accum
|
|
3659 (math-div (math-mul (math-pow var2 n)
|
|
3660 (math-expr-subst
|
|
3661 fprime v x0))
|
|
3662 nfac))))
|
|
3663 (and fprime
|
|
3664 (math-normalize accum))))
|
41047
|
3665 (list 'calcFunc-taylor expr var num))))
|
40785
|
3666
|
58681
|
3667 (provide 'calcalg2)
|
|
3668
|
52401
|
3669 ;;; arch-tag: f2932ec8-dd63-418b-a542-11a644b9d4c4
|
41047
|
3670 ;;; calcalg2.el ends here
|