diff options
| author | Jay Belanger | 2004-11-17 19:21:57 +0000 |
|---|---|---|
| committer | Jay Belanger | 2004-11-17 19:21:57 +0000 |
| commit | 0c9089453091eb318a941ac2fb5621f70dc23733 (patch) | |
| tree | 47f589756d5fe6ef1b14b7ab63d464af1a77831b /lisp | |
| parent | f4872033df7b50cb99dba68f73479b844075d263 (diff) | |
| download | emacs-0c9089453091eb318a941ac2fb5621f70dc23733.tar.gz emacs-0c9089453091eb318a941ac2fb5621f70dc23733.zip | |
(calc-poly-div): Made calc-poly-div-remainder a local variable.
(math-eval-rules-cache, math-eval-rules-cache-other): Declared them.
(math-top-only): New variable
(math-simplify, math-simplify-step): Replace variable top-only by
declared variable math-top-only.
(math-simplify-expr): Declared it.
Replaced argument expr in all calls of math-defsimplify by
math-simplify-expr.
(math-simplify-plus, math-simplify-times, math-simplify-divide)
(math-simplify-divisor, math-simplify-one-divisor)
(math-simplify-mod, math-simplify-ineq, math-simplify-sqrt)
(math-simplify-pow): Replaced variable expr by declared variable
math-simplify-expr.
(math-simplify-divisor): Removed local variables temp and op.
(math-simplify-one-divisor): Made temp and op local variables.
(math-simplify-divisor-nover, math-simplify-divisor-dover): New
variables.
(math-simplify-divisor, math-simplify-one-divisor): Use declared
variables.
(math-expr-subst-new, math-expr-subst-old): New variables.
(math-expr-subst, math-expr-subst-rec): Use declared variables.
(math-is-poly-degree, math-is-poly-loose): New variables.
(math-is-polynomial, math-is-poly-rec): Use declared variables.
(math-poly-base-const-ok, math-poly-base-pred): New variables.
(math-polynomial-base, math-polynomial-base-rec): Use declared
variables.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/calc/calc-alg.el | 804 |
1 files changed, 437 insertions, 367 deletions
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 45ffff8baca..014e7c3eddf 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el | |||
| @@ -3,8 +3,7 @@ | |||
| 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: David Gillespie <daveg@synaptics.com> | 5 | ;; Author: David Gillespie <daveg@synaptics.com> |
| 6 | ;; Maintainers: D. Goel <deego@gnufans.org> | 6 | ;; Maintainer: Jay Belanger <belanger@truman.edu> |
| 7 | ;; Colin Walters <walters@debian.org> | ||
| 8 | 7 | ||
| 9 | ;; This file is part of GNU Emacs. | 8 | ;; This file is part of GNU Emacs. |
| 10 | 9 | ||
| @@ -121,19 +120,20 @@ | |||
| 121 | (calc-slow-wrapper | 120 | (calc-slow-wrapper |
| 122 | (calc-binary-op "pgcd" 'calcFunc-pgcd arg))) | 121 | (calc-binary-op "pgcd" 'calcFunc-pgcd arg))) |
| 123 | 122 | ||
| 123 | |||
| 124 | (defun calc-poly-div (arg) | 124 | (defun calc-poly-div (arg) |
| 125 | (interactive "P") | 125 | (interactive "P") |
| 126 | (calc-slow-wrapper | 126 | (calc-slow-wrapper |
| 127 | (setq calc-poly-div-remainder nil) | 127 | (let ((calc-poly-div-remainder nil)) |
| 128 | (calc-binary-op "pdiv" 'calcFunc-pdiv arg) | 128 | (calc-binary-op "pdiv" 'calcFunc-pdiv arg) |
| 129 | (if (and calc-poly-div-remainder (null arg)) | 129 | (if (and calc-poly-div-remainder (null arg)) |
| 130 | (progn | 130 | (progn |
| 131 | (calc-clear-command-flag 'clear-message) | 131 | (calc-clear-command-flag 'clear-message) |
| 132 | (calc-record calc-poly-div-remainder "prem") | 132 | (calc-record calc-poly-div-remainder "prem") |
| 133 | (if (not (Math-zerop calc-poly-div-remainder)) | 133 | (if (not (Math-zerop calc-poly-div-remainder)) |
| 134 | (message "(Remainder was %s)" | 134 | (message "(Remainder was %s)" |
| 135 | (math-format-flat-expr calc-poly-div-remainder 0)) | 135 | (math-format-flat-expr calc-poly-div-remainder 0)) |
| 136 | (message "(No remainder)")))))) | 136 | (message "(No remainder)"))))))) |
| 137 | 137 | ||
| 138 | (defun calc-poly-rem (arg) | 138 | (defun calc-poly-rem (arg) |
| 139 | (interactive "P") | 139 | (interactive "P") |
| @@ -184,6 +184,11 @@ | |||
| 184 | (memq (car name) '(vec calcFunc-assign calcFunc-condition)) | 184 | (memq (car name) '(vec calcFunc-assign calcFunc-condition)) |
| 185 | name)) | 185 | name)) |
| 186 | 186 | ||
| 187 | ;; math-eval-rules-cache and math-eval-rules-cache-other are | ||
| 188 | ;; declared in calc.el, but are used here by math-recompile-eval-rules. | ||
| 189 | (defvar math-eval-rules-cache) | ||
| 190 | (defvar math-eval-rules-cache-other) | ||
| 191 | |||
| 187 | (defun math-recompile-eval-rules () | 192 | (defun math-recompile-eval-rules () |
| 188 | (setq math-eval-rules-cache (and (calc-has-rules 'var-EvalRules) | 193 | (setq math-eval-rules-cache (and (calc-has-rules 'var-EvalRules) |
| 189 | (math-compile-rewrites | 194 | (math-compile-rewrites |
| @@ -266,9 +271,13 @@ | |||
| 266 | 271 | ||
| 267 | (defalias 'calcFunc-esimplify 'math-simplify-extended) | 272 | (defalias 'calcFunc-esimplify 'math-simplify-extended) |
| 268 | 273 | ||
| 274 | ;; math-top-only is local to math-simplify, but is used by | ||
| 275 | ;; math-simplify-step, which is called by math-simplify. | ||
| 276 | (defvar math-top-only) | ||
| 277 | |||
| 269 | (defun math-simplify (top-expr) | 278 | (defun math-simplify (top-expr) |
| 270 | (let ((math-simplifying t) | 279 | (let ((math-simplifying t) |
| 271 | (top-only (consp calc-simplify-mode)) | 280 | (math-top-only (consp calc-simplify-mode)) |
| 272 | (simp-rules (append (and (calc-has-rules 'var-AlgSimpRules) | 281 | (simp-rules (append (and (calc-has-rules 'var-AlgSimpRules) |
| 273 | '((var AlgSimpRules var-AlgSimpRules))) | 282 | '((var AlgSimpRules var-AlgSimpRules))) |
| 274 | (and math-living-dangerously | 283 | (and math-living-dangerously |
| @@ -281,7 +290,7 @@ | |||
| 281 | (calc-has-rules 'var-IntegSimpRules) | 290 | (calc-has-rules 'var-IntegSimpRules) |
| 282 | '((var IntegSimpRules var-IntegSimpRules))))) | 291 | '((var IntegSimpRules var-IntegSimpRules))))) |
| 283 | res) | 292 | res) |
| 284 | (if top-only | 293 | (if math-top-only |
| 285 | (let ((r simp-rules)) | 294 | (let ((r simp-rules)) |
| 286 | (setq res (math-simplify-step (math-normalize top-expr)) | 295 | (setq res (math-simplify-step (math-normalize top-expr)) |
| 287 | calc-simplify-mode '(nil) | 296 | calc-simplify-mode '(nil) |
| @@ -308,7 +317,7 @@ | |||
| 308 | (defun math-simplify-step (a) | 317 | (defun math-simplify-step (a) |
| 309 | (if (Math-primp a) | 318 | (if (Math-primp a) |
| 310 | a | 319 | a |
| 311 | (let ((aa (if (or top-only | 320 | (let ((aa (if (or math-top-only |
| 312 | (memq (car a) '(calcFunc-quote calcFunc-condition | 321 | (memq (car a) '(calcFunc-quote calcFunc-condition |
| 313 | calcFunc-evalto))) | 322 | calcFunc-evalto))) |
| 314 | a | 323 | a |
| @@ -328,151 +337,172 @@ | |||
| 328 | (defun math-need-std-simps () | 337 | (defun math-need-std-simps () |
| 329 | nil) | 338 | nil) |
| 330 | 339 | ||
| 340 | ;; The function created by math-defsimplify uses the variable | ||
| 341 | ;; math-simplify-expr, and so is used by functions in math-defsimplify | ||
| 342 | (defvar math-simplify-expr) | ||
| 343 | |||
| 331 | (math-defsimplify (+ -) | 344 | (math-defsimplify (+ -) |
| 332 | (math-simplify-plus)) | 345 | (math-simplify-plus)) |
| 333 | 346 | ||
| 334 | (defun math-simplify-plus () | 347 | (defun math-simplify-plus () |
| 335 | (cond ((and (memq (car-safe (nth 1 expr)) '(+ -)) | 348 | (cond ((and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -)) |
| 336 | (Math-numberp (nth 2 (nth 1 expr))) | 349 | (Math-numberp (nth 2 (nth 1 math-simplify-expr))) |
| 337 | (not (Math-numberp (nth 2 expr)))) | 350 | (not (Math-numberp (nth 2 math-simplify-expr)))) |
| 338 | (let ((x (nth 2 expr)) | 351 | (let ((x (nth 2 math-simplify-expr)) |
| 339 | (op (car expr))) | 352 | (op (car math-simplify-expr))) |
| 340 | (setcar (cdr (cdr expr)) (nth 2 (nth 1 expr))) | 353 | (setcar (cdr (cdr math-simplify-expr)) (nth 2 (nth 1 math-simplify-expr))) |
| 341 | (setcar expr (car (nth 1 expr))) | 354 | (setcar math-simplify-expr (car (nth 1 math-simplify-expr))) |
| 342 | (setcar (cdr (cdr (nth 1 expr))) x) | 355 | (setcar (cdr (cdr (nth 1 math-simplify-expr))) x) |
| 343 | (setcar (nth 1 expr) op))) | 356 | (setcar (nth 1 math-simplify-expr) op))) |
| 344 | ((and (eq (car expr) '+) | 357 | ((and (eq (car math-simplify-expr) '+) |
| 345 | (Math-numberp (nth 1 expr)) | 358 | (Math-numberp (nth 1 math-simplify-expr)) |
| 346 | (not (Math-numberp (nth 2 expr)))) | 359 | (not (Math-numberp (nth 2 math-simplify-expr)))) |
| 347 | (let ((x (nth 2 expr))) | 360 | (let ((x (nth 2 math-simplify-expr))) |
| 348 | (setcar (cdr (cdr expr)) (nth 1 expr)) | 361 | (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr)) |
| 349 | (setcar (cdr expr) x)))) | 362 | (setcar (cdr math-simplify-expr) x)))) |
| 350 | (let ((aa expr) | 363 | (let ((aa math-simplify-expr) |
| 351 | aaa temp) | 364 | aaa temp) |
| 352 | (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -)) | 365 | (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -)) |
| 353 | (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 expr) | 366 | (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr) |
| 354 | (eq (car aaa) '-) (eq (car expr) '-) t)) | 367 | (eq (car aaa) '-) |
| 368 | (eq (car math-simplify-expr) '-) t)) | ||
| 355 | (progn | 369 | (progn |
| 356 | (setcar (cdr (cdr expr)) temp) | 370 | (setcar (cdr (cdr math-simplify-expr)) temp) |
| 357 | (setcar expr '+) | 371 | (setcar math-simplify-expr '+) |
| 358 | (setcar (cdr (cdr aaa)) 0))) | 372 | (setcar (cdr (cdr aaa)) 0))) |
| 359 | (setq aa (nth 1 aa))) | 373 | (setq aa (nth 1 aa))) |
| 360 | (if (setq temp (math-combine-sum aaa (nth 2 expr) | 374 | (if (setq temp (math-combine-sum aaa (nth 2 math-simplify-expr) |
| 361 | nil (eq (car expr) '-) t)) | 375 | nil (eq (car math-simplify-expr) '-) t)) |
| 362 | (progn | 376 | (progn |
| 363 | (setcar (cdr (cdr expr)) temp) | 377 | (setcar (cdr (cdr math-simplify-expr)) temp) |
| 364 | (setcar expr '+) | 378 | (setcar math-simplify-expr '+) |
| 365 | (setcar (cdr aa) 0))) | 379 | (setcar (cdr aa) 0))) |
| 366 | expr)) | 380 | math-simplify-expr)) |
| 367 | 381 | ||
| 368 | (math-defsimplify * | 382 | (math-defsimplify * |
| 369 | (math-simplify-times)) | 383 | (math-simplify-times)) |
| 370 | 384 | ||
| 371 | (defun math-simplify-times () | 385 | (defun math-simplify-times () |
| 372 | (if (eq (car-safe (nth 2 expr)) '*) | 386 | (if (eq (car-safe (nth 2 math-simplify-expr)) '*) |
| 373 | (and (math-beforep (nth 1 (nth 2 expr)) (nth 1 expr)) | 387 | (and (math-beforep (nth 1 (nth 2 math-simplify-expr)) (nth 1 math-simplify-expr)) |
| 374 | (or (math-known-scalarp (nth 1 expr) t) | 388 | (or (math-known-scalarp (nth 1 math-simplify-expr) t) |
| 375 | (math-known-scalarp (nth 1 (nth 2 expr)) t)) | 389 | (math-known-scalarp (nth 1 (nth 2 math-simplify-expr)) t)) |
| 376 | (let ((x (nth 1 expr))) | 390 | (let ((x (nth 1 math-simplify-expr))) |
| 377 | (setcar (cdr expr) (nth 1 (nth 2 expr))) | 391 | (setcar (cdr math-simplify-expr) (nth 1 (nth 2 math-simplify-expr))) |
| 378 | (setcar (cdr (nth 2 expr)) x))) | 392 | (setcar (cdr (nth 2 math-simplify-expr)) x))) |
| 379 | (and (math-beforep (nth 2 expr) (nth 1 expr)) | 393 | (and (math-beforep (nth 2 math-simplify-expr) (nth 1 math-simplify-expr)) |
| 380 | (or (math-known-scalarp (nth 1 expr) t) | 394 | (or (math-known-scalarp (nth 1 math-simplify-expr) t) |
| 381 | (math-known-scalarp (nth 2 expr) t)) | 395 | (math-known-scalarp (nth 2 math-simplify-expr) t)) |
| 382 | (let ((x (nth 2 expr))) | 396 | (let ((x (nth 2 math-simplify-expr))) |
| 383 | (setcar (cdr (cdr expr)) (nth 1 expr)) | 397 | (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr)) |
| 384 | (setcar (cdr expr) x)))) | 398 | (setcar (cdr math-simplify-expr) x)))) |
| 385 | (let ((aa expr) | 399 | (let ((aa math-simplify-expr) |
| 386 | aaa temp | 400 | aaa temp |
| 387 | (safe t) (scalar (math-known-scalarp (nth 1 expr)))) | 401 | (safe t) (scalar (math-known-scalarp (nth 1 math-simplify-expr)))) |
| 388 | (if (and (Math-ratp (nth 1 expr)) | 402 | (if (and (Math-ratp (nth 1 math-simplify-expr)) |
| 389 | (setq temp (math-common-constant-factor (nth 2 expr)))) | 403 | (setq temp (math-common-constant-factor (nth 2 math-simplify-expr)))) |
| 390 | (progn | 404 | (progn |
| 391 | (setcar (cdr (cdr expr)) | 405 | (setcar (cdr (cdr math-simplify-expr)) |
| 392 | (math-cancel-common-factor (nth 2 expr) temp)) | 406 | (math-cancel-common-factor (nth 2 math-simplify-expr) temp)) |
| 393 | (setcar (cdr expr) (math-mul (nth 1 expr) temp)))) | 407 | (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp)))) |
| 394 | (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*) | 408 | (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*) |
| 395 | safe) | 409 | safe) |
| 396 | (if (setq temp (math-combine-prod (nth 1 expr) (nth 1 aaa) nil nil t)) | 410 | (if (setq temp (math-combine-prod (nth 1 math-simplify-expr) |
| 411 | (nth 1 aaa) nil nil t)) | ||
| 397 | (progn | 412 | (progn |
| 398 | (setcar (cdr expr) temp) | 413 | (setcar (cdr math-simplify-expr) temp) |
| 399 | (setcar (cdr aaa) 1))) | 414 | (setcar (cdr aaa) 1))) |
| 400 | (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t)) | 415 | (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t)) |
| 401 | aa (nth 2 aa))) | 416 | aa (nth 2 aa))) |
| 402 | (if (and (setq temp (math-combine-prod aaa (nth 1 expr) nil nil t)) | 417 | (if (and (setq temp (math-combine-prod aaa (nth 1 math-simplify-expr) nil nil t)) |
| 403 | safe) | 418 | safe) |
| 404 | (progn | 419 | (progn |
| 405 | (setcar (cdr expr) temp) | 420 | (setcar (cdr math-simplify-expr) temp) |
| 406 | (setcar (cdr (cdr aa)) 1))) | 421 | (setcar (cdr (cdr aa)) 1))) |
| 407 | (if (and (eq (car-safe (nth 1 expr)) 'frac) | 422 | (if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) |
| 408 | (memq (nth 1 (nth 1 expr)) '(1 -1))) | 423 | (memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1))) |
| 409 | (math-div (math-mul (nth 2 expr) (nth 1 (nth 1 expr))) | 424 | (math-div (math-mul (nth 2 math-simplify-expr) |
| 410 | (nth 2 (nth 1 expr))) | 425 | (nth 1 (nth 1 math-simplify-expr))) |
| 411 | expr))) | 426 | (nth 2 (nth 1 math-simplify-expr))) |
| 427 | math-simplify-expr))) | ||
| 412 | 428 | ||
| 413 | (math-defsimplify / | 429 | (math-defsimplify / |
| 414 | (math-simplify-divide)) | 430 | (math-simplify-divide)) |
| 415 | 431 | ||
| 416 | (defun math-simplify-divide () | 432 | (defun math-simplify-divide () |
| 417 | (let ((np (cdr expr)) | 433 | (let ((np (cdr math-simplify-expr)) |
| 418 | (nover nil) | 434 | (nover nil) |
| 419 | (nn (and (or (eq (car expr) '/) (not (Math-realp (nth 2 expr)))) | 435 | (nn (and (or (eq (car math-simplify-expr) '/) |
| 420 | (math-common-constant-factor (nth 2 expr)))) | 436 | (not (Math-realp (nth 2 math-simplify-expr)))) |
| 437 | (math-common-constant-factor (nth 2 math-simplify-expr)))) | ||
| 421 | n op) | 438 | n op) |
| 422 | (if nn | 439 | (if nn |
| 423 | (progn | 440 | (progn |
| 424 | (setq n (and (or (eq (car expr) '/) (not (Math-realp (nth 1 expr)))) | 441 | (setq n (and (or (eq (car math-simplify-expr) '/) |
| 425 | (math-common-constant-factor (nth 1 expr)))) | 442 | (not (Math-realp (nth 1 math-simplify-expr)))) |
| 443 | (math-common-constant-factor (nth 1 math-simplify-expr)))) | ||
| 426 | (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n)) | 444 | (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n)) |
| 427 | (progn | 445 | (progn |
| 428 | (setcar (cdr expr) (math-mul (nth 2 nn) (nth 1 expr))) | 446 | (setcar (cdr math-simplify-expr) |
| 429 | (setcar (cdr (cdr expr)) | 447 | (math-mul (nth 2 nn) (nth 1 math-simplify-expr))) |
| 430 | (math-cancel-common-factor (nth 2 expr) nn)) | 448 | (setcar (cdr (cdr math-simplify-expr)) |
| 449 | (math-cancel-common-factor (nth 2 math-simplify-expr) nn)) | ||
| 431 | (if (and (math-negp nn) | 450 | (if (and (math-negp nn) |
| 432 | (setq op (assq (car expr) calc-tweak-eqn-table))) | 451 | (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))) |
| 433 | (setcar expr (nth 1 op)))) | 452 | (setcar math-simplify-expr (nth 1 op)))) |
| 434 | (if (and n (not (eq (setq n (math-frac-gcd n nn)) 1))) | 453 | (if (and n (not (eq (setq n (math-frac-gcd n nn)) 1))) |
| 435 | (progn | 454 | (progn |
| 436 | (setcar (cdr expr) | 455 | (setcar (cdr math-simplify-expr) |
| 437 | (math-cancel-common-factor (nth 1 expr) n)) | 456 | (math-cancel-common-factor (nth 1 math-simplify-expr) n)) |
| 438 | (setcar (cdr (cdr expr)) | 457 | (setcar (cdr (cdr math-simplify-expr)) |
| 439 | (math-cancel-common-factor (nth 2 expr) n)) | 458 | (math-cancel-common-factor (nth 2 math-simplify-expr) n)) |
| 440 | (if (and (math-negp n) | 459 | (if (and (math-negp n) |
| 441 | (setq op (assq (car expr) calc-tweak-eqn-table))) | 460 | (setq op (assq (car math-simplify-expr) |
| 442 | (setcar expr (nth 1 op)))))))) | 461 | calc-tweak-eqn-table))) |
| 462 | (setcar math-simplify-expr (nth 1 op)))))))) | ||
| 443 | (if (and (eq (car-safe (car np)) '/) | 463 | (if (and (eq (car-safe (car np)) '/) |
| 444 | (math-known-scalarp (nth 2 expr) t)) | 464 | (math-known-scalarp (nth 2 math-simplify-expr) t)) |
| 445 | (progn | 465 | (progn |
| 446 | (setq np (cdr (nth 1 expr))) | 466 | (setq np (cdr (nth 1 math-simplify-expr))) |
| 447 | (while (eq (car-safe (setq n (car np))) '*) | 467 | (while (eq (car-safe (setq n (car np))) '*) |
| 448 | (and (math-known-scalarp (nth 2 n) t) | 468 | (and (math-known-scalarp (nth 2 n) t) |
| 449 | (math-simplify-divisor (cdr n) (cdr (cdr expr)) nil t)) | 469 | (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nil t)) |
| 450 | (setq np (cdr (cdr n)))) | 470 | (setq np (cdr (cdr n)))) |
| 451 | (math-simplify-divisor np (cdr (cdr expr)) nil t) | 471 | (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nil t) |
| 452 | (setq nover t | 472 | (setq nover t |
| 453 | np (cdr (cdr (nth 1 expr)))))) | 473 | np (cdr (cdr (nth 1 math-simplify-expr)))))) |
| 454 | (while (eq (car-safe (setq n (car np))) '*) | 474 | (while (eq (car-safe (setq n (car np))) '*) |
| 455 | (and (math-known-scalarp (nth 2 n) t) | 475 | (and (math-known-scalarp (nth 2 n) t) |
| 456 | (math-simplify-divisor (cdr n) (cdr (cdr expr)) nover t)) | 476 | (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nover t)) |
| 457 | (setq np (cdr (cdr n)))) | 477 | (setq np (cdr (cdr n)))) |
| 458 | (math-simplify-divisor np (cdr (cdr expr)) nover t) | 478 | (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nover t) |
| 459 | expr)) | 479 | math-simplify-expr)) |
| 480 | |||
| 481 | ;; The variables math-simplify-divisor-nover and math-simplify-divisor-dover | ||
| 482 | ;; are local variables for math-simplify-divisor, but are used by | ||
| 483 | ;; math-simplify-one-divisor. | ||
| 484 | (defvar math-simplify-divisor-nover) | ||
| 485 | (defvar math-simplify-divisor-dover) | ||
| 460 | 486 | ||
| 461 | (defun math-simplify-divisor (np dp nover dover) | 487 | (defun math-simplify-divisor (np dp math-simplify-divisor-nover |
| 488 | math-simplify-divisor-dover) | ||
| 462 | (cond ((eq (car-safe (car dp)) '/) | 489 | (cond ((eq (car-safe (car dp)) '/) |
| 463 | (math-simplify-divisor np (cdr (car dp)) nover dover) | 490 | (math-simplify-divisor np (cdr (car dp)) |
| 491 | math-simplify-divisor-nover | ||
| 492 | math-simplify-divisor-dover) | ||
| 464 | (and (math-known-scalarp (nth 1 (car dp)) t) | 493 | (and (math-known-scalarp (nth 1 (car dp)) t) |
| 465 | (math-simplify-divisor np (cdr (cdr (car dp))) | 494 | (math-simplify-divisor np (cdr (cdr (car dp))) |
| 466 | nover (not dover)))) | 495 | math-simplify-divisor-nover |
| 467 | ((or (or (eq (car expr) '/) | 496 | (not math-simplify-divisor-dover)))) |
| 497 | ((or (or (eq (car math-simplify-expr) '/) | ||
| 468 | (let ((signs (math-possible-signs (car np)))) | 498 | (let ((signs (math-possible-signs (car np)))) |
| 469 | (or (memq signs '(1 4)) | 499 | (or (memq signs '(1 4)) |
| 470 | (and (memq (car expr) '(calcFunc-eq calcFunc-neq)) | 500 | (and (memq (car math-simplify-expr) '(calcFunc-eq calcFunc-neq)) |
| 471 | (eq signs 5)) | 501 | (eq signs 5)) |
| 472 | math-living-dangerously))) | 502 | math-living-dangerously))) |
| 473 | (math-numberp (car np))) | 503 | (math-numberp (car np))) |
| 474 | (let ((n (car np)) | 504 | (let ((n (car np)) |
| 475 | d dd temp op | 505 | d dd |
| 476 | (safe t) (scalar (math-known-scalarp n))) | 506 | (safe t) (scalar (math-known-scalarp n))) |
| 477 | (while (and (eq (car-safe (setq d (car dp))) '*) | 507 | (while (and (eq (car-safe (setq d (car dp))) '*) |
| 478 | safe) | 508 | safe) |
| @@ -483,21 +513,25 @@ | |||
| 483 | (math-simplify-one-divisor np dp)))))) | 513 | (math-simplify-one-divisor np dp)))))) |
| 484 | 514 | ||
| 485 | (defun math-simplify-one-divisor (np dp) | 515 | (defun math-simplify-one-divisor (np dp) |
| 486 | (if (setq temp (math-combine-prod (car np) (car dp) nover dover t)) | 516 | (let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover |
| 487 | (progn | 517 | math-simplify-divisor-dover t)) |
| 488 | (and (not (memq (car expr) '(/ calcFunc-eq calcFunc-neq))) | 518 | op) |
| 489 | (math-known-negp (car dp)) | 519 | (if temp |
| 490 | (setq op (assq (car expr) calc-tweak-eqn-table)) | 520 | (progn |
| 491 | (setcar expr (nth 1 op))) | 521 | (and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq))) |
| 492 | (setcar np (if nover (math-div 1 temp) temp)) | 522 | (math-known-negp (car dp)) |
| 493 | (setcar dp 1)) | 523 | (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table)) |
| 494 | (and dover (not nover) (eq (car expr) '/) | 524 | (setcar math-simplify-expr (nth 1 op))) |
| 495 | (eq (car-safe (car dp)) 'calcFunc-sqrt) | 525 | (setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp)) |
| 496 | (Math-integerp (nth 1 (car dp))) | 526 | (setcar dp 1)) |
| 497 | (progn | 527 | (and math-simplify-divisor-dover (not math-simplify-divisor-nover) |
| 498 | (setcar np (math-mul (car np) | 528 | (eq (car math-simplify-expr) '/) |
| 499 | (list 'calcFunc-sqrt (nth 1 (car dp))))) | 529 | (eq (car-safe (car dp)) 'calcFunc-sqrt) |
| 500 | (setcar dp (nth 1 (car dp))))))) | 530 | (Math-integerp (nth 1 (car dp))) |
| 531 | (progn | ||
| 532 | (setcar np (math-mul (car np) | ||
| 533 | (list 'calcFunc-sqrt (nth 1 (car dp))))) | ||
| 534 | (setcar dp (nth 1 (car dp)))))))) | ||
| 501 | 535 | ||
| 502 | (defun math-common-constant-factor (expr) | 536 | (defun math-common-constant-factor (expr) |
| 503 | (if (Math-realp expr) | 537 | (if (Math-realp expr) |
| @@ -546,23 +580,23 @@ | |||
| 546 | (math-simplify-mod)) | 580 | (math-simplify-mod)) |
| 547 | 581 | ||
| 548 | (defun math-simplify-mod () | 582 | (defun math-simplify-mod () |
| 549 | (and (Math-realp (nth 2 expr)) | 583 | (and (Math-realp (nth 2 math-simplify-expr)) |
| 550 | (Math-posp (nth 2 expr)) | 584 | (Math-posp (nth 2 math-simplify-expr)) |
| 551 | (let ((lin (math-is-linear (nth 1 expr))) | 585 | (let ((lin (math-is-linear (nth 1 math-simplify-expr))) |
| 552 | t1 t2 t3) | 586 | t1 t2 t3) |
| 553 | (or (and lin | 587 | (or (and lin |
| 554 | (or (math-negp (car lin)) | 588 | (or (math-negp (car lin)) |
| 555 | (not (Math-lessp (car lin) (nth 2 expr)))) | 589 | (not (Math-lessp (car lin) (nth 2 math-simplify-expr)))) |
| 556 | (list '% | 590 | (list '% |
| 557 | (list '+ | 591 | (list '+ |
| 558 | (math-mul (nth 1 lin) (nth 2 lin)) | 592 | (math-mul (nth 1 lin) (nth 2 lin)) |
| 559 | (math-mod (car lin) (nth 2 expr))) | 593 | (math-mod (car lin) (nth 2 math-simplify-expr))) |
| 560 | (nth 2 expr))) | 594 | (nth 2 math-simplify-expr))) |
| 561 | (and lin | 595 | (and lin |
| 562 | (not (math-equal-int (nth 1 lin) 1)) | 596 | (not (math-equal-int (nth 1 lin) 1)) |
| 563 | (math-num-integerp (nth 1 lin)) | 597 | (math-num-integerp (nth 1 lin)) |
| 564 | (math-num-integerp (nth 2 expr)) | 598 | (math-num-integerp (nth 2 math-simplify-expr)) |
| 565 | (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 expr))) | 599 | (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 math-simplify-expr))) |
| 566 | (not (math-equal-int t1 1)) | 600 | (not (math-equal-int t1 1)) |
| 567 | (list '* | 601 | (list '* |
| 568 | t1 | 602 | t1 |
| @@ -572,47 +606,48 @@ | |||
| 572 | (nth 2 lin)) | 606 | (nth 2 lin)) |
| 573 | (let ((calc-prefer-frac t)) | 607 | (let ((calc-prefer-frac t)) |
| 574 | (math-div (car lin) t1))) | 608 | (math-div (car lin) t1))) |
| 575 | (math-div (nth 2 expr) t1)))) | 609 | (math-div (nth 2 math-simplify-expr) t1)))) |
| 576 | (and (math-equal-int (nth 2 expr) 1) | 610 | (and (math-equal-int (nth 2 math-simplify-expr) 1) |
| 577 | (math-known-integerp (if lin | 611 | (math-known-integerp (if lin |
| 578 | (math-mul (nth 1 lin) (nth 2 lin)) | 612 | (math-mul (nth 1 lin) (nth 2 lin)) |
| 579 | (nth 1 expr))) | 613 | (nth 1 math-simplify-expr))) |
| 580 | (if lin (math-mod (car lin) 1) 0)))))) | 614 | (if lin (math-mod (car lin) 1) 0)))))) |
| 581 | 615 | ||
| 582 | (math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt | 616 | (math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt |
| 583 | calcFunc-gt calcFunc-leq calcFunc-geq) | 617 | calcFunc-gt calcFunc-leq calcFunc-geq) |
| 584 | (if (= (length expr) 3) | 618 | (if (= (length math-simplify-expr) 3) |
| 585 | (math-simplify-ineq))) | 619 | (math-simplify-ineq))) |
| 586 | 620 | ||
| 587 | (defun math-simplify-ineq () | 621 | (defun math-simplify-ineq () |
| 588 | (let ((np (cdr expr)) | 622 | (let ((np (cdr math-simplify-expr)) |
| 589 | n) | 623 | n) |
| 590 | (while (memq (car-safe (setq n (car np))) '(+ -)) | 624 | (while (memq (car-safe (setq n (car np))) '(+ -)) |
| 591 | (math-simplify-add-term (cdr (cdr n)) (cdr (cdr expr)) | 625 | (math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr)) |
| 592 | (eq (car n) '-) nil) | 626 | (eq (car n) '-) nil) |
| 593 | (setq np (cdr n))) | 627 | (setq np (cdr n))) |
| 594 | (math-simplify-add-term np (cdr (cdr expr)) nil (eq np (cdr expr))) | 628 | (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil |
| 629 | (eq np (cdr math-simplify-expr))) | ||
| 595 | (math-simplify-divide) | 630 | (math-simplify-divide) |
| 596 | (let ((signs (math-possible-signs (cons '- (cdr expr))))) | 631 | (let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr))))) |
| 597 | (or (cond ((eq (car expr) 'calcFunc-eq) | 632 | (or (cond ((eq (car math-simplify-expr) 'calcFunc-eq) |
| 598 | (or (and (eq signs 2) 1) | 633 | (or (and (eq signs 2) 1) |
| 599 | (and (memq signs '(1 4 5)) 0))) | 634 | (and (memq signs '(1 4 5)) 0))) |
| 600 | ((eq (car expr) 'calcFunc-neq) | 635 | ((eq (car math-simplify-expr) 'calcFunc-neq) |
| 601 | (or (and (eq signs 2) 0) | 636 | (or (and (eq signs 2) 0) |
| 602 | (and (memq signs '(1 4 5)) 1))) | 637 | (and (memq signs '(1 4 5)) 1))) |
| 603 | ((eq (car expr) 'calcFunc-lt) | 638 | ((eq (car math-simplify-expr) 'calcFunc-lt) |
| 604 | (or (and (eq signs 1) 1) | 639 | (or (and (eq signs 1) 1) |
| 605 | (and (memq signs '(2 4 6)) 0))) | 640 | (and (memq signs '(2 4 6)) 0))) |
| 606 | ((eq (car expr) 'calcFunc-gt) | 641 | ((eq (car math-simplify-expr) 'calcFunc-gt) |
| 607 | (or (and (eq signs 4) 1) | 642 | (or (and (eq signs 4) 1) |
| 608 | (and (memq signs '(1 2 3)) 0))) | 643 | (and (memq signs '(1 2 3)) 0))) |
| 609 | ((eq (car expr) 'calcFunc-leq) | 644 | ((eq (car math-simplify-expr) 'calcFunc-leq) |
| 610 | (or (and (eq signs 4) 0) | 645 | (or (and (eq signs 4) 0) |
| 611 | (and (memq signs '(1 2 3)) 1))) | 646 | (and (memq signs '(1 2 3)) 1))) |
| 612 | ((eq (car expr) 'calcFunc-geq) | 647 | ((eq (car math-simplify-expr) 'calcFunc-geq) |
| 613 | (or (and (eq signs 1) 0) | 648 | (or (and (eq signs 1) 0) |
| 614 | (and (memq signs '(2 4 6)) 1)))) | 649 | (and (memq signs '(2 4 6)) 1)))) |
| 615 | expr)))) | 650 | math-simplify-expr)))) |
| 616 | 651 | ||
| 617 | (defun math-simplify-add-term (np dp minus lplain) | 652 | (defun math-simplify-add-term (np dp minus lplain) |
| 618 | (or (math-vectorp (car np)) | 653 | (or (math-vectorp (car np)) |
| @@ -644,25 +679,27 @@ | |||
| 644 | (setcar dp (setq n (math-neg temp))))))))) | 679 | (setcar dp (setq n (math-neg temp))))))))) |
| 645 | 680 | ||
| 646 | (math-defsimplify calcFunc-sin | 681 | (math-defsimplify calcFunc-sin |
| 647 | (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) | 682 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) |
| 648 | (nth 1 (nth 1 expr))) | 683 | (nth 1 (nth 1 math-simplify-expr))) |
| 649 | (and (math-looks-negp (nth 1 expr)) | 684 | (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 650 | (math-neg (list 'calcFunc-sin (math-neg (nth 1 expr))))) | 685 | (math-neg (list 'calcFunc-sin (math-neg (nth 1 math-simplify-expr))))) |
| 651 | (and (eq calc-angle-mode 'rad) | 686 | (and (eq calc-angle-mode 'rad) |
| 652 | (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) | 687 | (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) |
| 653 | (and n | 688 | (and n |
| 654 | (math-known-sin (car n) (nth 1 n) 120 0)))) | 689 | (math-known-sin (car n) (nth 1 n) 120 0)))) |
| 655 | (and (eq calc-angle-mode 'deg) | 690 | (and (eq calc-angle-mode 'deg) |
| 656 | (let ((n (math-integer-plus (nth 1 expr)))) | 691 | (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) |
| 657 | (and n | 692 | (and n |
| 658 | (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))) | 693 | (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))) |
| 659 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) | 694 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) |
| 660 | (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))) | 695 | (list 'calcFunc-sqrt (math-sub 1 (math-sqr |
| 661 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) | 696 | (nth 1 (nth 1 math-simplify-expr)))))) |
| 662 | (math-div (nth 1 (nth 1 expr)) | 697 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) |
| 698 | (math-div (nth 1 (nth 1 math-simplify-expr)) | ||
| 663 | (list 'calcFunc-sqrt | 699 | (list 'calcFunc-sqrt |
| 664 | (math-add 1 (math-sqr (nth 1 (nth 1 expr))))))) | 700 | (math-add 1 (math-sqr |
| 665 | (let ((m (math-should-expand-trig (nth 1 expr)))) | 701 | (nth 1 (nth 1 math-simplify-expr))))))) |
| 702 | (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) | ||
| 666 | (and m (integerp (car m)) | 703 | (and m (integerp (car m)) |
| 667 | (let ((n (car m)) (a (nth 1 m))) | 704 | (let ((n (car m)) (a (nth 1 m))) |
| 668 | (list '+ | 705 | (list '+ |
| @@ -672,25 +709,27 @@ | |||
| 672 | (list 'calcFunc-sin a)))))))) | 709 | (list 'calcFunc-sin a)))))))) |
| 673 | 710 | ||
| 674 | (math-defsimplify calcFunc-cos | 711 | (math-defsimplify calcFunc-cos |
| 675 | (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) | 712 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) |
| 676 | (nth 1 (nth 1 expr))) | 713 | (nth 1 (nth 1 math-simplify-expr))) |
| 677 | (and (math-looks-negp (nth 1 expr)) | 714 | (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 678 | (list 'calcFunc-cos (math-neg (nth 1 expr)))) | 715 | (list 'calcFunc-cos (math-neg (nth 1 math-simplify-expr)))) |
| 679 | (and (eq calc-angle-mode 'rad) | 716 | (and (eq calc-angle-mode 'rad) |
| 680 | (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) | 717 | (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) |
| 681 | (and n | 718 | (and n |
| 682 | (math-known-sin (car n) (nth 1 n) 120 300)))) | 719 | (math-known-sin (car n) (nth 1 n) 120 300)))) |
| 683 | (and (eq calc-angle-mode 'deg) | 720 | (and (eq calc-angle-mode 'deg) |
| 684 | (let ((n (math-integer-plus (nth 1 expr)))) | 721 | (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) |
| 685 | (and n | 722 | (and n |
| 686 | (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))) | 723 | (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))) |
| 687 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) | 724 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) |
| 688 | (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))) | 725 | (list 'calcFunc-sqrt |
| 689 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) | 726 | (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))) |
| 727 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) | ||
| 690 | (math-div 1 | 728 | (math-div 1 |
| 691 | (list 'calcFunc-sqrt | 729 | (list 'calcFunc-sqrt |
| 692 | (math-add 1 (math-sqr (nth 1 (nth 1 expr))))))) | 730 | (math-add 1 |
| 693 | (let ((m (math-should-expand-trig (nth 1 expr)))) | 731 | (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) |
| 732 | (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) | ||
| 694 | (and m (integerp (car m)) | 733 | (and m (integerp (car m)) |
| 695 | (let ((n (car m)) (a (nth 1 m))) | 734 | (let ((n (car m)) (a (nth 1 m))) |
| 696 | (list '- | 735 | (list '- |
| @@ -752,33 +791,33 @@ | |||
| 752 | (t nil)))))) | 791 | (t nil)))))) |
| 753 | 792 | ||
| 754 | (math-defsimplify calcFunc-tan | 793 | (math-defsimplify calcFunc-tan |
| 755 | (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) | 794 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) |
| 756 | (nth 1 (nth 1 expr))) | 795 | (nth 1 (nth 1 math-simplify-expr))) |
| 757 | (and (math-looks-negp (nth 1 expr)) | 796 | (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 758 | (math-neg (list 'calcFunc-tan (math-neg (nth 1 expr))))) | 797 | (math-neg (list 'calcFunc-tan (math-neg (nth 1 math-simplify-expr))))) |
| 759 | (and (eq calc-angle-mode 'rad) | 798 | (and (eq calc-angle-mode 'rad) |
| 760 | (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) | 799 | (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) |
| 761 | (and n | 800 | (and n |
| 762 | (math-known-tan (car n) (nth 1 n) 120)))) | 801 | (math-known-tan (car n) (nth 1 n) 120)))) |
| 763 | (and (eq calc-angle-mode 'deg) | 802 | (and (eq calc-angle-mode 'deg) |
| 764 | (let ((n (math-integer-plus (nth 1 expr)))) | 803 | (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) |
| 765 | (and n | 804 | (and n |
| 766 | (math-known-tan (car n) (nth 1 n) '(frac 2 3))))) | 805 | (math-known-tan (car n) (nth 1 n) '(frac 2 3))))) |
| 767 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) | 806 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) |
| 768 | (math-div (nth 1 (nth 1 expr)) | 807 | (math-div (nth 1 (nth 1 math-simplify-expr)) |
| 769 | (list 'calcFunc-sqrt | 808 | (list 'calcFunc-sqrt |
| 770 | (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) | 809 | (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) |
| 771 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) | 810 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) |
| 772 | (math-div (list 'calcFunc-sqrt | 811 | (math-div (list 'calcFunc-sqrt |
| 773 | (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))) | 812 | (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))) |
| 774 | (nth 1 (nth 1 expr)))) | 813 | (nth 1 (nth 1 math-simplify-expr)))) |
| 775 | (let ((m (math-should-expand-trig (nth 1 expr)))) | 814 | (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) |
| 776 | (and m | 815 | (and m |
| 777 | (if (equal (car m) '(frac 1 2)) | 816 | (if (equal (car m) '(frac 1 2)) |
| 778 | (math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m))) | 817 | (math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m))) |
| 779 | (list 'calcFunc-sin (nth 1 m))) | 818 | (list 'calcFunc-sin (nth 1 m))) |
| 780 | (math-div (list 'calcFunc-sin (nth 1 expr)) | 819 | (math-div (list 'calcFunc-sin (nth 1 math-simplify-expr)) |
| 781 | (list 'calcFunc-cos (nth 1 expr)))))))) | 820 | (list 'calcFunc-cos (nth 1 math-simplify-expr)))))))) |
| 782 | 821 | ||
| 783 | (defun math-known-tan (plus n mul) | 822 | (defun math-known-tan (plus n mul) |
| 784 | (setq n (math-mul n mul)) | 823 | (setq n (math-mul n mul)) |
| @@ -813,19 +852,20 @@ | |||
| 813 | (t nil)))))) | 852 | (t nil)))))) |
| 814 | 853 | ||
| 815 | (math-defsimplify calcFunc-sinh | 854 | (math-defsimplify calcFunc-sinh |
| 816 | (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) | 855 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) |
| 817 | (nth 1 (nth 1 expr))) | 856 | (nth 1 (nth 1 math-simplify-expr))) |
| 818 | (and (math-looks-negp (nth 1 expr)) | 857 | (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 819 | (math-neg (list 'calcFunc-sinh (math-neg (nth 1 expr))))) | 858 | (math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr))))) |
| 820 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) | 859 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) |
| 821 | math-living-dangerously | 860 | math-living-dangerously |
| 822 | (list 'calcFunc-sqrt (math-sub (math-sqr (nth 1 (nth 1 expr))) 1))) | 861 | (list 'calcFunc-sqrt |
| 823 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) | 862 | (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) |
| 863 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) | ||
| 824 | math-living-dangerously | 864 | math-living-dangerously |
| 825 | (math-div (nth 1 (nth 1 expr)) | 865 | (math-div (nth 1 (nth 1 math-simplify-expr)) |
| 826 | (list 'calcFunc-sqrt | 866 | (list 'calcFunc-sqrt |
| 827 | (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) | 867 | (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) |
| 828 | (let ((m (math-should-expand-trig (nth 1 expr) t))) | 868 | (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) |
| 829 | (and m (integerp (car m)) | 869 | (and m (integerp (car m)) |
| 830 | (let ((n (car m)) (a (nth 1 m))) | 870 | (let ((n (car m)) (a (nth 1 m))) |
| 831 | (if (> n 1) | 871 | (if (> n 1) |
| @@ -836,19 +876,20 @@ | |||
| 836 | (list 'calcFunc-sinh a))))))))) | 876 | (list 'calcFunc-sinh a))))))))) |
| 837 | 877 | ||
| 838 | (math-defsimplify calcFunc-cosh | 878 | (math-defsimplify calcFunc-cosh |
| 839 | (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) | 879 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) |
| 840 | (nth 1 (nth 1 expr))) | 880 | (nth 1 (nth 1 math-simplify-expr))) |
| 841 | (and (math-looks-negp (nth 1 expr)) | 881 | (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 842 | (list 'calcFunc-cosh (math-neg (nth 1 expr)))) | 882 | (list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr)))) |
| 843 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) | 883 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) |
| 844 | math-living-dangerously | 884 | math-living-dangerously |
| 845 | (list 'calcFunc-sqrt (math-add (math-sqr (nth 1 (nth 1 expr))) 1))) | 885 | (list 'calcFunc-sqrt |
| 846 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) | 886 | (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) |
| 887 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) | ||
| 847 | math-living-dangerously | 888 | math-living-dangerously |
| 848 | (math-div 1 | 889 | (math-div 1 |
| 849 | (list 'calcFunc-sqrt | 890 | (list 'calcFunc-sqrt |
| 850 | (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) | 891 | (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) |
| 851 | (let ((m (math-should-expand-trig (nth 1 expr) t))) | 892 | (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) |
| 852 | (and m (integerp (car m)) | 893 | (and m (integerp (car m)) |
| 853 | (let ((n (car m)) (a (nth 1 m))) | 894 | (let ((n (car m)) (a (nth 1 m))) |
| 854 | (if (> n 1) | 895 | (if (> n 1) |
| @@ -859,133 +900,136 @@ | |||
| 859 | (list 'calcFunc-sinh a))))))))) | 900 | (list 'calcFunc-sinh a))))))))) |
| 860 | 901 | ||
| 861 | (math-defsimplify calcFunc-tanh | 902 | (math-defsimplify calcFunc-tanh |
| 862 | (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) | 903 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) |
| 863 | (nth 1 (nth 1 expr))) | 904 | (nth 1 (nth 1 math-simplify-expr))) |
| 864 | (and (math-looks-negp (nth 1 expr)) | 905 | (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 865 | (math-neg (list 'calcFunc-tanh (math-neg (nth 1 expr))))) | 906 | (math-neg (list 'calcFunc-tanh (math-neg (nth 1 math-simplify-expr))))) |
| 866 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) | 907 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) |
| 867 | math-living-dangerously | 908 | math-living-dangerously |
| 868 | (math-div (nth 1 (nth 1 expr)) | 909 | (math-div (nth 1 (nth 1 math-simplify-expr)) |
| 869 | (list 'calcFunc-sqrt | 910 | (list 'calcFunc-sqrt |
| 870 | (math-add (math-sqr (nth 1 (nth 1 expr))) 1)))) | 911 | (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) |
| 871 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) | 912 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) |
| 872 | math-living-dangerously | 913 | math-living-dangerously |
| 873 | (math-div (list 'calcFunc-sqrt | 914 | (math-div (list 'calcFunc-sqrt |
| 874 | (math-sub (math-sqr (nth 1 (nth 1 expr))) 1)) | 915 | (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)) |
| 875 | (nth 1 (nth 1 expr)))) | 916 | (nth 1 (nth 1 math-simplify-expr)))) |
| 876 | (let ((m (math-should-expand-trig (nth 1 expr) t))) | 917 | (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) |
| 877 | (and m | 918 | (and m |
| 878 | (if (equal (car m) '(frac 1 2)) | 919 | (if (equal (car m) '(frac 1 2)) |
| 879 | (math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1) | 920 | (math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1) |
| 880 | (list 'calcFunc-sinh (nth 1 m))) | 921 | (list 'calcFunc-sinh (nth 1 m))) |
| 881 | (math-div (list 'calcFunc-sinh (nth 1 expr)) | 922 | (math-div (list 'calcFunc-sinh (nth 1 math-simplify-expr)) |
| 882 | (list 'calcFunc-cosh (nth 1 expr)))))))) | 923 | (list 'calcFunc-cosh (nth 1 math-simplify-expr)))))))) |
| 883 | 924 | ||
| 884 | (math-defsimplify calcFunc-arcsin | 925 | (math-defsimplify calcFunc-arcsin |
| 885 | (or (and (math-looks-negp (nth 1 expr)) | 926 | (or (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 886 | (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 expr))))) | 927 | (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 math-simplify-expr))))) |
| 887 | (and (eq (nth 1 expr) 1) | 928 | (and (eq (nth 1 math-simplify-expr) 1) |
| 888 | (math-quarter-circle t)) | 929 | (math-quarter-circle t)) |
| 889 | (and (equal (nth 1 expr) '(frac 1 2)) | 930 | (and (equal (nth 1 math-simplify-expr) '(frac 1 2)) |
| 890 | (math-div (math-half-circle t) 6)) | 931 | (math-div (math-half-circle t) 6)) |
| 891 | (and math-living-dangerously | 932 | (and math-living-dangerously |
| 892 | (eq (car-safe (nth 1 expr)) 'calcFunc-sin) | 933 | (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin) |
| 893 | (nth 1 (nth 1 expr))) | 934 | (nth 1 (nth 1 math-simplify-expr))) |
| 894 | (and math-living-dangerously | 935 | (and math-living-dangerously |
| 895 | (eq (car-safe (nth 1 expr)) 'calcFunc-cos) | 936 | (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) |
| 896 | (math-sub (math-quarter-circle t) | 937 | (math-sub (math-quarter-circle t) |
| 897 | (nth 1 (nth 1 expr)))))) | 938 | (nth 1 (nth 1 math-simplify-expr)))))) |
| 898 | 939 | ||
| 899 | (math-defsimplify calcFunc-arccos | 940 | (math-defsimplify calcFunc-arccos |
| 900 | (or (and (eq (nth 1 expr) 0) | 941 | (or (and (eq (nth 1 math-simplify-expr) 0) |
| 901 | (math-quarter-circle t)) | 942 | (math-quarter-circle t)) |
| 902 | (and (eq (nth 1 expr) -1) | 943 | (and (eq (nth 1 math-simplify-expr) -1) |
| 903 | (math-half-circle t)) | 944 | (math-half-circle t)) |
| 904 | (and (equal (nth 1 expr) '(frac 1 2)) | 945 | (and (equal (nth 1 math-simplify-expr) '(frac 1 2)) |
| 905 | (math-div (math-half-circle t) 3)) | 946 | (math-div (math-half-circle t) 3)) |
| 906 | (and (equal (nth 1 expr) '(frac -1 2)) | 947 | (and (equal (nth 1 math-simplify-expr) '(frac -1 2)) |
| 907 | (math-div (math-mul (math-half-circle t) 2) 3)) | 948 | (math-div (math-mul (math-half-circle t) 2) 3)) |
| 908 | (and math-living-dangerously | 949 | (and math-living-dangerously |
| 909 | (eq (car-safe (nth 1 expr)) 'calcFunc-cos) | 950 | (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) |
| 910 | (nth 1 (nth 1 expr))) | 951 | (nth 1 (nth 1 math-simplify-expr))) |
| 911 | (and math-living-dangerously | 952 | (and math-living-dangerously |
| 912 | (eq (car-safe (nth 1 expr)) 'calcFunc-sin) | 953 | (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin) |
| 913 | (math-sub (math-quarter-circle t) | 954 | (math-sub (math-quarter-circle t) |
| 914 | (nth 1 (nth 1 expr)))))) | 955 | (nth 1 (nth 1 math-simplify-expr)))))) |
| 915 | 956 | ||
| 916 | (math-defsimplify calcFunc-arctan | 957 | (math-defsimplify calcFunc-arctan |
| 917 | (or (and (math-looks-negp (nth 1 expr)) | 958 | (or (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 918 | (math-neg (list 'calcFunc-arctan (math-neg (nth 1 expr))))) | 959 | (math-neg (list 'calcFunc-arctan (math-neg (nth 1 math-simplify-expr))))) |
| 919 | (and (eq (nth 1 expr) 1) | 960 | (and (eq (nth 1 math-simplify-expr) 1) |
| 920 | (math-div (math-half-circle t) 4)) | 961 | (math-div (math-half-circle t) 4)) |
| 921 | (and math-living-dangerously | 962 | (and math-living-dangerously |
| 922 | (eq (car-safe (nth 1 expr)) 'calcFunc-tan) | 963 | (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tan) |
| 923 | (nth 1 (nth 1 expr))))) | 964 | (nth 1 (nth 1 math-simplify-expr))))) |
| 924 | 965 | ||
| 925 | (math-defsimplify calcFunc-arcsinh | 966 | (math-defsimplify calcFunc-arcsinh |
| 926 | (or (and (math-looks-negp (nth 1 expr)) | 967 | (or (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 927 | (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 expr))))) | 968 | (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 math-simplify-expr))))) |
| 928 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-sinh) | 969 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sinh) |
| 929 | (or math-living-dangerously | 970 | (or math-living-dangerously |
| 930 | (math-known-realp (nth 1 (nth 1 expr)))) | 971 | (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) |
| 931 | (nth 1 (nth 1 expr))))) | 972 | (nth 1 (nth 1 math-simplify-expr))))) |
| 932 | 973 | ||
| 933 | (math-defsimplify calcFunc-arccosh | 974 | (math-defsimplify calcFunc-arccosh |
| 934 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh) | 975 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh) |
| 935 | (or math-living-dangerously | 976 | (or math-living-dangerously |
| 936 | (math-known-realp (nth 1 (nth 1 expr)))) | 977 | (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) |
| 937 | (nth 1 (nth 1 expr)))) | 978 | (nth 1 (nth 1 math-simplify-expr)))) |
| 938 | 979 | ||
| 939 | (math-defsimplify calcFunc-arctanh | 980 | (math-defsimplify calcFunc-arctanh |
| 940 | (or (and (math-looks-negp (nth 1 expr)) | 981 | (or (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 941 | (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 expr))))) | 982 | (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 math-simplify-expr))))) |
| 942 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-tanh) | 983 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tanh) |
| 943 | (or math-living-dangerously | 984 | (or math-living-dangerously |
| 944 | (math-known-realp (nth 1 (nth 1 expr)))) | 985 | (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) |
| 945 | (nth 1 (nth 1 expr))))) | 986 | (nth 1 (nth 1 math-simplify-expr))))) |
| 946 | 987 | ||
| 947 | (math-defsimplify calcFunc-sqrt | 988 | (math-defsimplify calcFunc-sqrt |
| 948 | (math-simplify-sqrt)) | 989 | (math-simplify-sqrt)) |
| 949 | 990 | ||
| 950 | (defun math-simplify-sqrt () | 991 | (defun math-simplify-sqrt () |
| 951 | (or (and (eq (car-safe (nth 1 expr)) 'frac) | 992 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) |
| 952 | (math-div (list 'calcFunc-sqrt (math-mul (nth 1 (nth 1 expr)) | 993 | (math-div (list 'calcFunc-sqrt |
| 953 | (nth 2 (nth 1 expr)))) | 994 | (math-mul (nth 1 (nth 1 math-simplify-expr)) |
| 954 | (nth 2 (nth 1 expr)))) | 995 | (nth 2 (nth 1 math-simplify-expr)))) |
| 955 | (let ((fac (if (math-objectp (nth 1 expr)) | 996 | (nth 2 (nth 1 math-simplify-expr)))) |
| 956 | (math-squared-factor (nth 1 expr)) | 997 | (let ((fac (if (math-objectp (nth 1 math-simplify-expr)) |
| 957 | (math-common-constant-factor (nth 1 expr))))) | 998 | (math-squared-factor (nth 1 math-simplify-expr)) |
| 999 | (math-common-constant-factor (nth 1 math-simplify-expr))))) | ||
| 958 | (and fac (not (eq fac 1)) | 1000 | (and fac (not (eq fac 1)) |
| 959 | (math-mul (math-normalize (list 'calcFunc-sqrt fac)) | 1001 | (math-mul (math-normalize (list 'calcFunc-sqrt fac)) |
| 960 | (math-normalize | 1002 | (math-normalize |
| 961 | (list 'calcFunc-sqrt | 1003 | (list 'calcFunc-sqrt |
| 962 | (math-cancel-common-factor (nth 1 expr) fac)))))) | 1004 | (math-cancel-common-factor |
| 1005 | (nth 1 math-simplify-expr) fac)))))) | ||
| 963 | (and math-living-dangerously | 1006 | (and math-living-dangerously |
| 964 | (or (and (eq (car-safe (nth 1 expr)) '-) | 1007 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) '-) |
| 965 | (math-equal-int (nth 1 (nth 1 expr)) 1) | 1008 | (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 1) |
| 966 | (eq (car-safe (nth 2 (nth 1 expr))) '^) | 1009 | (eq (car-safe (nth 2 (nth 1 math-simplify-expr))) '^) |
| 967 | (math-equal-int (nth 2 (nth 2 (nth 1 expr))) 2) | 1010 | (math-equal-int (nth 2 (nth 2 (nth 1 math-simplify-expr))) 2) |
| 968 | (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr)))) | 1011 | (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr)))) |
| 969 | 'calcFunc-sin) | 1012 | 'calcFunc-sin) |
| 970 | (list 'calcFunc-cos | 1013 | (list 'calcFunc-cos |
| 971 | (nth 1 (nth 1 (nth 2 (nth 1 expr)))))) | 1014 | (nth 1 (nth 1 (nth 2 (nth 1 math-simplify-expr)))))) |
| 972 | (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr)))) | 1015 | (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr)))) |
| 973 | 'calcFunc-cos) | 1016 | 'calcFunc-cos) |
| 974 | (list 'calcFunc-sin | 1017 | (list 'calcFunc-sin |
| 975 | (nth 1 (nth 1 (nth 2 (nth 1 expr)))))))) | 1018 | (nth 1 (nth 1 (nth 2 |
| 976 | (and (eq (car-safe (nth 1 expr)) '-) | 1019 | (nth 1 math-simplify-expr)))))))) |
| 977 | (math-equal-int (nth 2 (nth 1 expr)) 1) | 1020 | (and (eq (car-safe (nth 1 math-simplify-expr)) '-) |
| 978 | (eq (car-safe (nth 1 (nth 1 expr))) '^) | 1021 | (math-equal-int (nth 2 (nth 1 math-simplify-expr)) 1) |
| 979 | (math-equal-int (nth 2 (nth 1 (nth 1 expr))) 2) | 1022 | (eq (car-safe (nth 1 (nth 1 math-simplify-expr))) '^) |
| 980 | (and (eq (car-safe (nth 1 (nth 1 (nth 1 expr)))) | 1023 | (math-equal-int (nth 2 (nth 1 (nth 1 math-simplify-expr))) 2) |
| 1024 | (and (eq (car-safe (nth 1 (nth 1 (nth 1 math-simplify-expr)))) | ||
| 981 | 'calcFunc-cosh) | 1025 | 'calcFunc-cosh) |
| 982 | (list 'calcFunc-sinh | 1026 | (list 'calcFunc-sinh |
| 983 | (nth 1 (nth 1 (nth 1 (nth 1 expr))))))) | 1027 | (nth 1 (nth 1 (nth 1 (nth 1 math-simplify-expr))))))) |
| 984 | (and (eq (car-safe (nth 1 expr)) '+) | 1028 | (and (eq (car-safe (nth 1 math-simplify-expr)) '+) |
| 985 | (let ((a (nth 1 (nth 1 expr))) | 1029 | (let ((a (nth 1 (nth 1 math-simplify-expr))) |
| 986 | (b (nth 2 (nth 1 expr)))) | 1030 | (b (nth 2 (nth 1 math-simplify-expr)))) |
| 987 | (and (or (and (math-equal-int a 1) | 1031 | (and (or (and (math-equal-int a 1) |
| 988 | (setq a b b (nth 1 (nth 1 expr)))) | 1032 | (setq a b b (nth 1 (nth 1 math-simplify-expr)))) |
| 989 | (math-equal-int b 1)) | 1033 | (math-equal-int b 1)) |
| 990 | (eq (car-safe a) '^) | 1034 | (eq (car-safe a) '^) |
| 991 | (math-equal-int (nth 2 a) 2) | 1035 | (math-equal-int (nth 2 a) 2) |
| @@ -994,20 +1038,20 @@ | |||
| 994 | (and (eq (car-safe (nth 1 a)) 'calcFunc-tan) | 1038 | (and (eq (car-safe (nth 1 a)) 'calcFunc-tan) |
| 995 | (list '/ 1 (list 'calcFunc-cos | 1039 | (list '/ 1 (list 'calcFunc-cos |
| 996 | (nth 1 (nth 1 a))))))))) | 1040 | (nth 1 (nth 1 a))))))))) |
| 997 | (and (eq (car-safe (nth 1 expr)) '^) | 1041 | (and (eq (car-safe (nth 1 math-simplify-expr)) '^) |
| 998 | (list '^ | 1042 | (list '^ |
| 999 | (nth 1 (nth 1 expr)) | 1043 | (nth 1 (nth 1 math-simplify-expr)) |
| 1000 | (math-div (nth 2 (nth 1 expr)) 2))) | 1044 | (math-div (nth 2 (nth 1 math-simplify-expr)) 2))) |
| 1001 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt) | 1045 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt) |
| 1002 | (list '^ (nth 1 (nth 1 expr)) (math-div 1 4))) | 1046 | (list '^ (nth 1 (nth 1 math-simplify-expr)) (math-div 1 4))) |
| 1003 | (and (memq (car-safe (nth 1 expr)) '(* /)) | 1047 | (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) |
| 1004 | (list (car (nth 1 expr)) | 1048 | (list (car (nth 1 math-simplify-expr)) |
| 1005 | (list 'calcFunc-sqrt (nth 1 (nth 1 expr))) | 1049 | (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr))) |
| 1006 | (list 'calcFunc-sqrt (nth 2 (nth 1 expr))))) | 1050 | (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr))))) |
| 1007 | (and (memq (car-safe (nth 1 expr)) '(+ -)) | 1051 | (and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -)) |
| 1008 | (not (math-any-floats (nth 1 expr))) | 1052 | (not (math-any-floats (nth 1 math-simplify-expr))) |
| 1009 | (let ((f (calcFunc-factors (calcFunc-expand | 1053 | (let ((f (calcFunc-factors (calcFunc-expand |
| 1010 | (nth 1 expr))))) | 1054 | (nth 1 math-simplify-expr))))) |
| 1011 | (and (math-vectorp f) | 1055 | (and (math-vectorp f) |
| 1012 | (or (> (length f) 2) | 1056 | (or (> (length f) 2) |
| 1013 | (> (nth 2 (nth 1 f)) 1)) | 1057 | (> (nth 2 (nth 1 f)) 1)) |
| @@ -1043,7 +1087,7 @@ | |||
| 1043 | fac))) | 1087 | fac))) |
| 1044 | 1088 | ||
| 1045 | (math-defsimplify calcFunc-exp | 1089 | (math-defsimplify calcFunc-exp |
| 1046 | (math-simplify-exp (nth 1 expr))) | 1090 | (math-simplify-exp (nth 1 math-simplify-expr))) |
| 1047 | 1091 | ||
| 1048 | (defun math-simplify-exp (x) | 1092 | (defun math-simplify-exp (x) |
| 1049 | (or (and (eq (car-safe x) 'calcFunc-ln) | 1093 | (or (and (eq (car-safe x) 'calcFunc-ln) |
| @@ -1074,22 +1118,22 @@ | |||
| 1074 | (list '+ c (list '* s '(var i var-i)))))))) | 1118 | (list '+ c (list '* s '(var i var-i)))))))) |
| 1075 | 1119 | ||
| 1076 | (math-defsimplify calcFunc-ln | 1120 | (math-defsimplify calcFunc-ln |
| 1077 | (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp) | 1121 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp) |
| 1078 | (or math-living-dangerously | 1122 | (or math-living-dangerously |
| 1079 | (math-known-realp (nth 1 (nth 1 expr)))) | 1123 | (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) |
| 1080 | (nth 1 (nth 1 expr))) | 1124 | (nth 1 (nth 1 math-simplify-expr))) |
| 1081 | (and (eq (car-safe (nth 1 expr)) '^) | 1125 | (and (eq (car-safe (nth 1 math-simplify-expr)) '^) |
| 1082 | (equal (nth 1 (nth 1 expr)) '(var e var-e)) | 1126 | (equal (nth 1 (nth 1 math-simplify-expr)) '(var e var-e)) |
| 1083 | (or math-living-dangerously | 1127 | (or math-living-dangerously |
| 1084 | (math-known-realp (nth 2 (nth 1 expr)))) | 1128 | (math-known-realp (nth 2 (nth 1 math-simplify-expr)))) |
| 1085 | (nth 2 (nth 1 expr))) | 1129 | (nth 2 (nth 1 math-simplify-expr))) |
| 1086 | (and calc-symbolic-mode | 1130 | (and calc-symbolic-mode |
| 1087 | (math-known-negp (nth 1 expr)) | 1131 | (math-known-negp (nth 1 math-simplify-expr)) |
| 1088 | (math-add (list 'calcFunc-ln (math-neg (nth 1 expr))) | 1132 | (math-add (list 'calcFunc-ln (math-neg (nth 1 math-simplify-expr))) |
| 1089 | '(* (var pi var-pi) (var i var-i)))) | 1133 | '(* (var pi var-pi) (var i var-i)))) |
| 1090 | (and calc-symbolic-mode | 1134 | (and calc-symbolic-mode |
| 1091 | (math-known-imagp (nth 1 expr)) | 1135 | (math-known-imagp (nth 1 math-simplify-expr)) |
| 1092 | (let* ((ip (calcFunc-im (nth 1 expr))) | 1136 | (let* ((ip (calcFunc-im (nth 1 math-simplify-expr))) |
| 1093 | (ips (math-possible-signs ip))) | 1137 | (ips (math-possible-signs ip))) |
| 1094 | (or (and (memq ips '(4 6)) | 1138 | (or (and (memq ips '(4 6)) |
| 1095 | (math-add (list 'calcFunc-ln ip) | 1139 | (math-add (list 'calcFunc-ln ip) |
| @@ -1103,83 +1147,91 @@ | |||
| 1103 | 1147 | ||
| 1104 | (defun math-simplify-pow () | 1148 | (defun math-simplify-pow () |
| 1105 | (or (and math-living-dangerously | 1149 | (or (and math-living-dangerously |
| 1106 | (or (and (eq (car-safe (nth 1 expr)) '^) | 1150 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) '^) |
| 1107 | (list '^ | 1151 | (list '^ |
| 1108 | (nth 1 (nth 1 expr)) | 1152 | (nth 1 (nth 1 math-simplify-expr)) |
| 1109 | (math-mul (nth 2 expr) (nth 2 (nth 1 expr))))) | 1153 | (math-mul (nth 2 math-simplify-expr) |
| 1110 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt) | 1154 | (nth 2 (nth 1 math-simplify-expr))))) |
| 1155 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt) | ||
| 1111 | (list '^ | 1156 | (list '^ |
| 1112 | (nth 1 (nth 1 expr)) | 1157 | (nth 1 (nth 1 math-simplify-expr)) |
| 1113 | (math-div (nth 2 expr) 2))) | 1158 | (math-div (nth 2 math-simplify-expr) 2))) |
| 1114 | (and (memq (car-safe (nth 1 expr)) '(* /)) | 1159 | (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) |
| 1115 | (list (car (nth 1 expr)) | 1160 | (list (car (nth 1 math-simplify-expr)) |
| 1116 | (list '^ (nth 1 (nth 1 expr)) (nth 2 expr)) | 1161 | (list '^ (nth 1 (nth 1 math-simplify-expr)) |
| 1117 | (list '^ (nth 2 (nth 1 expr)) (nth 2 expr)))))) | 1162 | (nth 2 math-simplify-expr)) |
| 1118 | (and (math-equal-int (nth 1 expr) 10) | 1163 | (list '^ (nth 2 (nth 1 math-simplify-expr)) |
| 1119 | (eq (car-safe (nth 2 expr)) 'calcFunc-log10) | 1164 | (nth 2 math-simplify-expr)))))) |
| 1120 | (nth 1 (nth 2 expr))) | 1165 | (and (math-equal-int (nth 1 math-simplify-expr) 10) |
| 1121 | (and (equal (nth 1 expr) '(var e var-e)) | 1166 | (eq (car-safe (nth 2 math-simplify-expr)) 'calcFunc-log10) |
| 1122 | (math-simplify-exp (nth 2 expr))) | 1167 | (nth 1 (nth 2 math-simplify-expr))) |
| 1123 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp) | 1168 | (and (equal (nth 1 math-simplify-expr) '(var e var-e)) |
| 1169 | (math-simplify-exp (nth 2 math-simplify-expr))) | ||
| 1170 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp) | ||
| 1124 | (not math-integrating) | 1171 | (not math-integrating) |
| 1125 | (list 'calcFunc-exp (math-mul (nth 1 (nth 1 expr)) (nth 2 expr)))) | 1172 | (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr)) |
| 1126 | (and (equal (nth 1 expr) '(var i var-i)) | 1173 | (nth 2 math-simplify-expr)))) |
| 1174 | (and (equal (nth 1 math-simplify-expr) '(var i var-i)) | ||
| 1127 | (math-imaginary-i) | 1175 | (math-imaginary-i) |
| 1128 | (math-num-integerp (nth 2 expr)) | 1176 | (math-num-integerp (nth 2 math-simplify-expr)) |
| 1129 | (let ((x (math-mod (math-trunc (nth 2 expr)) 4))) | 1177 | (let ((x (math-mod (math-trunc (nth 2 math-simplify-expr)) 4))) |
| 1130 | (cond ((eq x 0) 1) | 1178 | (cond ((eq x 0) 1) |
| 1131 | ((eq x 1) (nth 1 expr)) | 1179 | ((eq x 1) (nth 1 math-simplify-expr)) |
| 1132 | ((eq x 2) -1) | 1180 | ((eq x 2) -1) |
| 1133 | ((eq x 3) (math-neg (nth 1 expr)))))) | 1181 | ((eq x 3) (math-neg (nth 1 math-simplify-expr)))))) |
| 1134 | (and math-integrating | 1182 | (and math-integrating |
| 1135 | (integerp (nth 2 expr)) | 1183 | (integerp (nth 2 math-simplify-expr)) |
| 1136 | (>= (nth 2 expr) 2) | 1184 | (>= (nth 2 math-simplify-expr) 2) |
| 1137 | (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-cos) | 1185 | (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) |
| 1138 | (math-mul (math-pow (nth 1 expr) (- (nth 2 expr) 2)) | 1186 | (math-mul (math-pow (nth 1 math-simplify-expr) |
| 1187 | (- (nth 2 math-simplify-expr) 2)) | ||
| 1139 | (math-sub 1 | 1188 | (math-sub 1 |
| 1140 | (math-sqr | 1189 | (math-sqr |
| 1141 | (list 'calcFunc-sin | 1190 | (list 'calcFunc-sin |
| 1142 | (nth 1 (nth 1 expr))))))) | 1191 | (nth 1 (nth 1 math-simplify-expr))))))) |
| 1143 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh) | 1192 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh) |
| 1144 | (math-mul (math-pow (nth 1 expr) (- (nth 2 expr) 2)) | 1193 | (math-mul (math-pow (nth 1 math-simplify-expr) |
| 1194 | (- (nth 2 math-simplify-expr) 2)) | ||
| 1145 | (math-add 1 | 1195 | (math-add 1 |
| 1146 | (math-sqr | 1196 | (math-sqr |
| 1147 | (list 'calcFunc-sinh | 1197 | (list 'calcFunc-sinh |
| 1148 | (nth 1 (nth 1 expr))))))))) | 1198 | (nth 1 (nth 1 math-simplify-expr))))))))) |
| 1149 | (and (eq (car-safe (nth 2 expr)) 'frac) | 1199 | (and (eq (car-safe (nth 2 math-simplify-expr)) 'frac) |
| 1150 | (Math-ratp (nth 1 expr)) | 1200 | (Math-ratp (nth 1 math-simplify-expr)) |
| 1151 | (Math-posp (nth 1 expr)) | 1201 | (Math-posp (nth 1 math-simplify-expr)) |
| 1152 | (if (equal (nth 2 expr) '(frac 1 2)) | 1202 | (if (equal (nth 2 math-simplify-expr) '(frac 1 2)) |
| 1153 | (list 'calcFunc-sqrt (nth 1 expr)) | 1203 | (list 'calcFunc-sqrt (nth 1 math-simplify-expr)) |
| 1154 | (let ((flr (math-floor (nth 2 expr)))) | 1204 | (let ((flr (math-floor (nth 2 math-simplify-expr)))) |
| 1155 | (and (not (Math-zerop flr)) | 1205 | (and (not (Math-zerop flr)) |
| 1156 | (list '* (list '^ (nth 1 expr) flr) | 1206 | (list '* (list '^ (nth 1 math-simplify-expr) flr) |
| 1157 | (list '^ (nth 1 expr) | 1207 | (list '^ (nth 1 math-simplify-expr) |
| 1158 | (math-sub (nth 2 expr) flr))))))) | 1208 | (math-sub (nth 2 math-simplify-expr) flr))))))) |
| 1159 | (and (eq (math-quarter-integer (nth 2 expr)) 2) | 1209 | (and (eq (math-quarter-integer (nth 2 math-simplify-expr)) 2) |
| 1160 | (let ((temp (math-simplify-sqrt))) | 1210 | (let ((temp (math-simplify-sqrt))) |
| 1161 | (and temp | 1211 | (and temp |
| 1162 | (list '^ temp (math-mul (nth 2 expr) 2))))))) | 1212 | (list '^ temp (math-mul (nth 2 math-simplify-expr) 2))))))) |
| 1163 | 1213 | ||
| 1164 | (math-defsimplify calcFunc-log10 | 1214 | (math-defsimplify calcFunc-log10 |
| 1165 | (and (eq (car-safe (nth 1 expr)) '^) | 1215 | (and (eq (car-safe (nth 1 math-simplify-expr)) '^) |
| 1166 | (math-equal-int (nth 1 (nth 1 expr)) 10) | 1216 | (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 10) |
| 1167 | (or math-living-dangerously | 1217 | (or math-living-dangerously |
| 1168 | (math-known-realp (nth 2 (nth 1 expr)))) | 1218 | (math-known-realp (nth 2 (nth 1 math-simplify-expr)))) |
| 1169 | (nth 2 (nth 1 expr)))) | 1219 | (nth 2 (nth 1 math-simplify-expr)))) |
| 1170 | 1220 | ||
| 1171 | 1221 | ||
| 1172 | (math-defsimplify calcFunc-erf | 1222 | (math-defsimplify calcFunc-erf |
| 1173 | (or (and (math-looks-negp (nth 1 expr)) | 1223 | (or (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 1174 | (math-neg (list 'calcFunc-erf (math-neg (nth 1 expr))))) | 1224 | (math-neg (list 'calcFunc-erf (math-neg (nth 1 math-simplify-expr))))) |
| 1175 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj) | 1225 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) |
| 1176 | (list 'calcFunc-conj (list 'calcFunc-erf (nth 1 (nth 1 expr))))))) | 1226 | (list 'calcFunc-conj |
| 1227 | (list 'calcFunc-erf (nth 1 (nth 1 math-simplify-expr))))))) | ||
| 1177 | 1228 | ||
| 1178 | (math-defsimplify calcFunc-erfc | 1229 | (math-defsimplify calcFunc-erfc |
| 1179 | (or (and (math-looks-negp (nth 1 expr)) | 1230 | (or (and (math-looks-negp (nth 1 math-simplify-expr)) |
| 1180 | (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 expr))))) | 1231 | (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 math-simplify-expr))))) |
| 1181 | (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj) | 1232 | (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) |
| 1182 | (list 'calcFunc-conj (list 'calcFunc-erfc (nth 1 (nth 1 expr))))))) | 1233 | (list 'calcFunc-conj |
| 1234 | (list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr))))))) | ||
| 1183 | 1235 | ||
| 1184 | 1236 | ||
| 1185 | (defun math-linear-in (expr term &optional always) | 1237 | (defun math-linear-in (expr term &optional always) |
| @@ -1325,19 +1377,25 @@ | |||
| 1325 | thing)) | 1377 | thing)) |
| 1326 | 1378 | ||
| 1327 | ;;; Substitute all occurrences of old for new in expr (non-destructive). | 1379 | ;;; Substitute all occurrences of old for new in expr (non-destructive). |
| 1328 | (defun math-expr-subst (expr old new) | 1380 | |
| 1381 | ;; The variables math-expr-subst-old and math-expr-subst-new are local | ||
| 1382 | ;; for math-expr-subst, but used by math-expr-subst-rec. | ||
| 1383 | (defvar math-expr-subst-old) | ||
| 1384 | (defvar math-expr-subst-new) | ||
| 1385 | |||
| 1386 | (defun math-expr-subst (expr math-expr-subst-old math-expr-subst-new) | ||
| 1329 | (math-expr-subst-rec expr)) | 1387 | (math-expr-subst-rec expr)) |
| 1330 | 1388 | ||
| 1331 | (defalias 'calcFunc-subst 'math-expr-subst) | 1389 | (defalias 'calcFunc-subst 'math-expr-subst) |
| 1332 | 1390 | ||
| 1333 | (defun math-expr-subst-rec (expr) | 1391 | (defun math-expr-subst-rec (expr) |
| 1334 | (cond ((equal expr old) new) | 1392 | (cond ((equal expr math-expr-subst-old) math-expr-subst-new) |
| 1335 | ((Math-primp expr) expr) | 1393 | ((Math-primp expr) expr) |
| 1336 | ((memq (car expr) '(calcFunc-deriv | 1394 | ((memq (car expr) '(calcFunc-deriv |
| 1337 | calcFunc-tderiv)) | 1395 | calcFunc-tderiv)) |
| 1338 | (if (= (length expr) 2) | 1396 | (if (= (length expr) 2) |
| 1339 | (if (equal (nth 1 expr) old) | 1397 | (if (equal (nth 1 expr) math-expr-subst-old) |
| 1340 | (append expr (list new)) | 1398 | (append expr (list math-expr-subst-new)) |
| 1341 | expr) | 1399 | expr) |
| 1342 | (list (car expr) (nth 1 expr) | 1400 | (list (car expr) (nth 1 expr) |
| 1343 | (math-expr-subst-rec (nth 2 expr))))) | 1401 | (math-expr-subst-rec (nth 2 expr))))) |
| @@ -1375,15 +1433,21 @@ | |||
| 1375 | expr))) | 1433 | expr))) |
| 1376 | 1434 | ||
| 1377 | ;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...), | 1435 | ;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...), |
| 1378 | ;;; else return nil if not in polynomial form. If "loose", coefficients | 1436 | ;;; else return nil if not in polynomial form. If "loose" (math-is-poly-loose), |
| 1379 | ;;; may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x. | 1437 | ;;; coefficients may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x. |
| 1380 | (defun math-is-polynomial (expr var &optional degree loose) | 1438 | |
| 1381 | (let* ((math-poly-base-variable (if loose | 1439 | ;; The variables math-is-poly-degree and math-is-poly-loose are local to |
| 1382 | (if (eq loose 'gen) var '(var XXX XXX)) | 1440 | ;; math-is-polynomial, but are used by math-is-poly-rec |
| 1441 | (defvar math-is-poly-degree) | ||
| 1442 | (defvar math-is-poly-loose) | ||
| 1443 | |||
| 1444 | (defun math-is-polynomial (expr var &optional math-is-poly-degree math-is-poly-loose) | ||
| 1445 | (let* ((math-poly-base-variable (if math-is-poly-loose | ||
| 1446 | (if (eq math-is-poly-loose 'gen) var '(var XXX XXX)) | ||
| 1383 | math-poly-base-variable)) | 1447 | math-poly-base-variable)) |
| 1384 | (poly (math-is-poly-rec expr math-poly-neg-powers))) | 1448 | (poly (math-is-poly-rec expr math-poly-neg-powers))) |
| 1385 | (and (or (null degree) | 1449 | (and (or (null math-is-poly-degree) |
| 1386 | (<= (length poly) (1+ degree))) | 1450 | (<= (length poly) (1+ math-is-poly-degree))) |
| 1387 | poly))) | 1451 | poly))) |
| 1388 | 1452 | ||
| 1389 | (defun math-is-poly-rec (expr negpow) | 1453 | (defun math-is-poly-rec (expr negpow) |
| @@ -1431,8 +1495,8 @@ | |||
| 1431 | (n pow) | 1495 | (n pow) |
| 1432 | (accum (list 1))) | 1496 | (accum (list 1))) |
| 1433 | (and p1 | 1497 | (and p1 |
| 1434 | (or (null degree) | 1498 | (or (null math-is-poly-degree) |
| 1435 | (<= (* (1- (length p1)) n) degree)) | 1499 | (<= (* (1- (length p1)) n) math-is-poly-degree)) |
| 1436 | (progn | 1500 | (progn |
| 1437 | (while (>= n 1) | 1501 | (while (>= n 1) |
| 1438 | (setq accum (math-poly-mul accum p1) | 1502 | (setq accum (math-poly-mul accum p1) |
| @@ -1460,8 +1524,9 @@ | |||
| 1460 | (and p1 | 1524 | (and p1 |
| 1461 | (let ((p2 (math-is-poly-rec (nth 2 expr) negpow))) | 1525 | (let ((p2 (math-is-poly-rec (nth 2 expr) negpow))) |
| 1462 | (and p2 | 1526 | (and p2 |
| 1463 | (or (null degree) | 1527 | (or (null math-is-poly-degree) |
| 1464 | (<= (- (+ (length p1) (length p2)) 2) degree)) | 1528 | (<= (- (+ (length p1) (length p2)) 2) |
| 1529 | math-is-poly-degree)) | ||
| 1465 | (math-poly-mul p1 p2)))))) | 1530 | (math-poly-mul p1 p2)))))) |
| 1466 | ((eq (car expr) '/) | 1531 | ((eq (car expr) '/) |
| 1467 | (and (or (not (math-poly-depends (nth 2 expr) var)) | 1532 | (and (or (not (math-poly-depends (nth 2 expr) var)) |
| @@ -1481,7 +1546,7 @@ | |||
| 1481 | (math-is-poly-rec (list '^ (nth 1 expr) '(frac 1 2)) negpow)) | 1546 | (math-is-poly-rec (list '^ (nth 1 expr) '(frac 1 2)) negpow)) |
| 1482 | (t nil)) | 1547 | (t nil)) |
| 1483 | (and (or (not (math-poly-depends expr var)) | 1548 | (and (or (not (math-poly-depends expr var)) |
| 1484 | loose) | 1549 | math-is-poly-loose) |
| 1485 | (not (eq (car expr) 'vec)) | 1550 | (not (eq (car expr) 'vec)) |
| 1486 | (list expr))))) | 1551 | (list expr))))) |
| 1487 | 1552 | ||
| @@ -1517,13 +1582,18 @@ | |||
| 1517 | (math-expr-depends expr var))) | 1582 | (math-expr-depends expr var))) |
| 1518 | 1583 | ||
| 1519 | ;;; Find the variable (or sub-expression) which is the base of polynomial expr. | 1584 | ;;; Find the variable (or sub-expression) which is the base of polynomial expr. |
| 1520 | (defun math-polynomial-base (mpb-top-expr &optional mpb-pred) | 1585 | ;; The variables math-poly-base-const-ok and math-poly-base-pred are |
| 1521 | (or mpb-pred | 1586 | ;; local to math-polynomial-base, but are used by math-polynomial-base-rec. |
| 1522 | (setq mpb-pred (function (lambda (base) (math-polynomial-p | 1587 | (defvar math-poly-base-const-ok) |
| 1588 | (defvar math-poly-base-pred) | ||
| 1589 | |||
| 1590 | (defun math-polynomial-base (mpb-top-expr &optional math-poly-base-pred) | ||
| 1591 | (or math-poly-base-pred | ||
| 1592 | (setq math-poly-base-pred (function (lambda (base) (math-polynomial-p | ||
| 1523 | mpb-top-expr base))))) | 1593 | mpb-top-expr base))))) |
| 1524 | (or (let ((const-ok nil)) | 1594 | (or (let ((math-poly-base-const-ok nil)) |
| 1525 | (math-polynomial-base-rec mpb-top-expr)) | 1595 | (math-polynomial-base-rec mpb-top-expr)) |
| 1526 | (let ((const-ok t)) | 1596 | (let ((math-poly-base-const-ok t)) |
| 1527 | (math-polynomial-base-rec mpb-top-expr)))) | 1597 | (math-polynomial-base-rec mpb-top-expr)))) |
| 1528 | 1598 | ||
| 1529 | (defun math-polynomial-base-rec (mpb-expr) | 1599 | (defun math-polynomial-base-rec (mpb-expr) |
| @@ -1537,8 +1607,8 @@ | |||
| 1537 | (math-polynomial-base-rec (nth 1 mpb-expr))) | 1607 | (math-polynomial-base-rec (nth 1 mpb-expr))) |
| 1538 | (and (eq (car mpb-expr) 'calcFunc-exp) | 1608 | (and (eq (car mpb-expr) 'calcFunc-exp) |
| 1539 | (math-polynomial-base-rec '(var e var-e))) | 1609 | (math-polynomial-base-rec '(var e var-e))) |
| 1540 | (and (or const-ok (math-expr-contains-vars mpb-expr)) | 1610 | (and (or math-poly-base-const-ok (math-expr-contains-vars mpb-expr)) |
| 1541 | (funcall mpb-pred mpb-expr) | 1611 | (funcall math-poly-base-pred mpb-expr) |
| 1542 | mpb-expr)))) | 1612 | mpb-expr)))) |
| 1543 | 1613 | ||
| 1544 | ;;; Return non-nil if expr refers to any variables. | 1614 | ;;; Return non-nil if expr refers to any variables. |