aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorJay Belanger2004-11-17 19:21:57 +0000
committerJay Belanger2004-11-17 19:21:57 +0000
commit0c9089453091eb318a941ac2fb5621f70dc23733 (patch)
tree47f589756d5fe6ef1b14b7ab63d464af1a77831b /lisp
parentf4872033df7b50cb99dba68f73479b844075d263 (diff)
downloademacs-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.el804
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.