3 |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: David Gillespie <daveg@synaptics.com> |
;; Author: David Gillespie <daveg@synaptics.com> |
6 |
;; Maintainers: D. Goel <deego@gnufans.org> |
;; Maintainer: Jay Belanger <belanger@truman.edu> |
|
;; Colin Walters <walters@debian.org> |
|
7 |
|
|
8 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
9 |
|
|
120 |
(calc-slow-wrapper |
(calc-slow-wrapper |
121 |
(calc-binary-op "pgcd" 'calcFunc-pgcd arg))) |
(calc-binary-op "pgcd" 'calcFunc-pgcd arg))) |
122 |
|
|
123 |
|
|
124 |
(defun calc-poly-div (arg) |
(defun calc-poly-div (arg) |
125 |
(interactive "P") |
(interactive "P") |
126 |
(calc-slow-wrapper |
(calc-slow-wrapper |
127 |
(setq calc-poly-div-remainder nil) |
(let ((calc-poly-div-remainder nil)) |
128 |
(calc-binary-op "pdiv" 'calcFunc-pdiv arg) |
(calc-binary-op "pdiv" 'calcFunc-pdiv arg) |
129 |
(if (and calc-poly-div-remainder (null arg)) |
(if (and calc-poly-div-remainder (null arg)) |
130 |
(progn |
(progn |
131 |
(calc-clear-command-flag 'clear-message) |
(calc-clear-command-flag 'clear-message) |
132 |
(calc-record calc-poly-div-remainder "prem") |
(calc-record calc-poly-div-remainder "prem") |
133 |
(if (not (Math-zerop calc-poly-div-remainder)) |
(if (not (Math-zerop calc-poly-div-remainder)) |
134 |
(message "(Remainder was %s)" |
(message "(Remainder was %s)" |
135 |
(math-format-flat-expr calc-poly-div-remainder 0)) |
(math-format-flat-expr calc-poly-div-remainder 0)) |
136 |
(message "(No remainder)")))))) |
(message "(No remainder)"))))))) |
137 |
|
|
138 |
(defun calc-poly-rem (arg) |
(defun calc-poly-rem (arg) |
139 |
(interactive "P") |
(interactive "P") |
184 |
(memq (car name) '(vec calcFunc-assign calcFunc-condition)) |
(memq (car name) '(vec calcFunc-assign calcFunc-condition)) |
185 |
name)) |
name)) |
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 |
|
|
192 |
(defun math-recompile-eval-rules () |
(defun math-recompile-eval-rules () |
193 |
(setq math-eval-rules-cache (and (calc-has-rules 'var-EvalRules) |
(setq math-eval-rules-cache (and (calc-has-rules 'var-EvalRules) |
194 |
(math-compile-rewrites |
(math-compile-rewrites |
271 |
|
|
272 |
(defalias 'calcFunc-esimplify 'math-simplify-extended) |
(defalias 'calcFunc-esimplify 'math-simplify-extended) |
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 |
|
|
278 |
(defun math-simplify (top-expr) |
(defun math-simplify (top-expr) |
279 |
(let ((math-simplifying t) |
(let ((math-simplifying t) |
280 |
(top-only (consp calc-simplify-mode)) |
(math-top-only (consp calc-simplify-mode)) |
281 |
(simp-rules (append (and (calc-has-rules 'var-AlgSimpRules) |
(simp-rules (append (and (calc-has-rules 'var-AlgSimpRules) |
282 |
'((var AlgSimpRules var-AlgSimpRules))) |
'((var AlgSimpRules var-AlgSimpRules))) |
283 |
(and math-living-dangerously |
(and math-living-dangerously |
290 |
(calc-has-rules 'var-IntegSimpRules) |
(calc-has-rules 'var-IntegSimpRules) |
291 |
'((var IntegSimpRules var-IntegSimpRules))))) |
'((var IntegSimpRules var-IntegSimpRules))))) |
292 |
res) |
res) |
293 |
(if top-only |
(if math-top-only |
294 |
(let ((r simp-rules)) |
(let ((r simp-rules)) |
295 |
(setq res (math-simplify-step (math-normalize top-expr)) |
(setq res (math-simplify-step (math-normalize top-expr)) |
296 |
calc-simplify-mode '(nil) |
calc-simplify-mode '(nil) |
317 |
(defun math-simplify-step (a) |
(defun math-simplify-step (a) |
318 |
(if (Math-primp a) |
(if (Math-primp a) |
319 |
a |
a |
320 |
(let ((aa (if (or top-only |
(let ((aa (if (or math-top-only |
321 |
(memq (car a) '(calcFunc-quote calcFunc-condition |
(memq (car a) '(calcFunc-quote calcFunc-condition |
322 |
calcFunc-evalto))) |
calcFunc-evalto))) |
323 |
a |
a |
337 |
(defun math-need-std-simps () |
(defun math-need-std-simps () |
338 |
nil) |
nil) |
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 |
|
|
344 |
(math-defsimplify (+ -) |
(math-defsimplify (+ -) |
345 |
(math-simplify-plus)) |
(math-simplify-plus)) |
346 |
|
|
347 |
(defun math-simplify-plus () |
(defun math-simplify-plus () |
348 |
(cond ((and (memq (car-safe (nth 1 expr)) '(+ -)) |
(cond ((and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -)) |
349 |
(Math-numberp (nth 2 (nth 1 expr))) |
(Math-numberp (nth 2 (nth 1 math-simplify-expr))) |
350 |
(not (Math-numberp (nth 2 expr)))) |
(not (Math-numberp (nth 2 math-simplify-expr)))) |
351 |
(let ((x (nth 2 expr)) |
(let ((x (nth 2 math-simplify-expr)) |
352 |
(op (car expr))) |
(op (car math-simplify-expr))) |
353 |
(setcar (cdr (cdr expr)) (nth 2 (nth 1 expr))) |
(setcar (cdr (cdr math-simplify-expr)) (nth 2 (nth 1 math-simplify-expr))) |
354 |
(setcar expr (car (nth 1 expr))) |
(setcar math-simplify-expr (car (nth 1 math-simplify-expr))) |
355 |
(setcar (cdr (cdr (nth 1 expr))) x) |
(setcar (cdr (cdr (nth 1 math-simplify-expr))) x) |
356 |
(setcar (nth 1 expr) op))) |
(setcar (nth 1 math-simplify-expr) op))) |
357 |
((and (eq (car expr) '+) |
((and (eq (car math-simplify-expr) '+) |
358 |
(Math-numberp (nth 1 expr)) |
(Math-numberp (nth 1 math-simplify-expr)) |
359 |
(not (Math-numberp (nth 2 expr)))) |
(not (Math-numberp (nth 2 math-simplify-expr)))) |
360 |
(let ((x (nth 2 expr))) |
(let ((x (nth 2 math-simplify-expr))) |
361 |
(setcar (cdr (cdr expr)) (nth 1 expr)) |
(setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr)) |
362 |
(setcar (cdr expr) x)))) |
(setcar (cdr math-simplify-expr) x)))) |
363 |
(let ((aa expr) |
(let ((aa math-simplify-expr) |
364 |
aaa temp) |
aaa temp) |
365 |
(while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -)) |
(while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -)) |
366 |
(if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 expr) |
(if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr) |
367 |
(eq (car aaa) '-) (eq (car expr) '-) t)) |
(eq (car aaa) '-) |
368 |
|
(eq (car math-simplify-expr) '-) t)) |
369 |
(progn |
(progn |
370 |
(setcar (cdr (cdr expr)) temp) |
(setcar (cdr (cdr math-simplify-expr)) temp) |
371 |
(setcar expr '+) |
(setcar math-simplify-expr '+) |
372 |
(setcar (cdr (cdr aaa)) 0))) |
(setcar (cdr (cdr aaa)) 0))) |
373 |
(setq aa (nth 1 aa))) |
(setq aa (nth 1 aa))) |
374 |
(if (setq temp (math-combine-sum aaa (nth 2 expr) |
(if (setq temp (math-combine-sum aaa (nth 2 math-simplify-expr) |
375 |
nil (eq (car expr) '-) t)) |
nil (eq (car math-simplify-expr) '-) t)) |
376 |
(progn |
(progn |
377 |
(setcar (cdr (cdr expr)) temp) |
(setcar (cdr (cdr math-simplify-expr)) temp) |
378 |
(setcar expr '+) |
(setcar math-simplify-expr '+) |
379 |
(setcar (cdr aa) 0))) |
(setcar (cdr aa) 0))) |
380 |
expr)) |
math-simplify-expr)) |
381 |
|
|
382 |
(math-defsimplify * |
(math-defsimplify * |
383 |
(math-simplify-times)) |
(math-simplify-times)) |
384 |
|
|
385 |
(defun math-simplify-times () |
(defun math-simplify-times () |
386 |
(if (eq (car-safe (nth 2 expr)) '*) |
(if (eq (car-safe (nth 2 math-simplify-expr)) '*) |
387 |
(and (math-beforep (nth 1 (nth 2 expr)) (nth 1 expr)) |
(and (math-beforep (nth 1 (nth 2 math-simplify-expr)) (nth 1 math-simplify-expr)) |
388 |
(or (math-known-scalarp (nth 1 expr) t) |
(or (math-known-scalarp (nth 1 math-simplify-expr) t) |
389 |
(math-known-scalarp (nth 1 (nth 2 expr)) t)) |
(math-known-scalarp (nth 1 (nth 2 math-simplify-expr)) t)) |
390 |
(let ((x (nth 1 expr))) |
(let ((x (nth 1 math-simplify-expr))) |
391 |
(setcar (cdr expr) (nth 1 (nth 2 expr))) |
(setcar (cdr math-simplify-expr) (nth 1 (nth 2 math-simplify-expr))) |
392 |
(setcar (cdr (nth 2 expr)) x))) |
(setcar (cdr (nth 2 math-simplify-expr)) x))) |
393 |
(and (math-beforep (nth 2 expr) (nth 1 expr)) |
(and (math-beforep (nth 2 math-simplify-expr) (nth 1 math-simplify-expr)) |
394 |
(or (math-known-scalarp (nth 1 expr) t) |
(or (math-known-scalarp (nth 1 math-simplify-expr) t) |
395 |
(math-known-scalarp (nth 2 expr) t)) |
(math-known-scalarp (nth 2 math-simplify-expr) t)) |
396 |
(let ((x (nth 2 expr))) |
(let ((x (nth 2 math-simplify-expr))) |
397 |
(setcar (cdr (cdr expr)) (nth 1 expr)) |
(setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr)) |
398 |
(setcar (cdr expr) x)))) |
(setcar (cdr math-simplify-expr) x)))) |
399 |
(let ((aa expr) |
(let ((aa math-simplify-expr) |
400 |
aaa temp |
aaa temp |
401 |
(safe t) (scalar (math-known-scalarp (nth 1 expr)))) |
(safe t) (scalar (math-known-scalarp (nth 1 math-simplify-expr)))) |
402 |
(if (and (Math-ratp (nth 1 expr)) |
(if (and (Math-ratp (nth 1 math-simplify-expr)) |
403 |
(setq temp (math-common-constant-factor (nth 2 expr)))) |
(setq temp (math-common-constant-factor (nth 2 math-simplify-expr)))) |
404 |
(progn |
(progn |
405 |
(setcar (cdr (cdr expr)) |
(setcar (cdr (cdr math-simplify-expr)) |
406 |
(math-cancel-common-factor (nth 2 expr) temp)) |
(math-cancel-common-factor (nth 2 math-simplify-expr) temp)) |
407 |
(setcar (cdr expr) (math-mul (nth 1 expr) temp)))) |
(setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp)))) |
408 |
(while (and (eq (car-safe (setq aaa (nth 2 aa))) '*) |
(while (and (eq (car-safe (setq aaa (nth 2 aa))) '*) |
409 |
safe) |
safe) |
410 |
(if (setq temp (math-combine-prod (nth 1 expr) (nth 1 aaa) nil nil t)) |
(if (setq temp (math-combine-prod (nth 1 math-simplify-expr) |
411 |
|
(nth 1 aaa) nil nil t)) |
412 |
(progn |
(progn |
413 |
(setcar (cdr expr) temp) |
(setcar (cdr math-simplify-expr) temp) |
414 |
(setcar (cdr aaa) 1))) |
(setcar (cdr aaa) 1))) |
415 |
(setq safe (or scalar (math-known-scalarp (nth 1 aaa) t)) |
(setq safe (or scalar (math-known-scalarp (nth 1 aaa) t)) |
416 |
aa (nth 2 aa))) |
aa (nth 2 aa))) |
417 |
(if (and (setq temp (math-combine-prod aaa (nth 1 expr) nil nil t)) |
(if (and (setq temp (math-combine-prod aaa (nth 1 math-simplify-expr) nil nil t)) |
418 |
safe) |
safe) |
419 |
(progn |
(progn |
420 |
(setcar (cdr expr) temp) |
(setcar (cdr math-simplify-expr) temp) |
421 |
(setcar (cdr (cdr aa)) 1))) |
(setcar (cdr (cdr aa)) 1))) |
422 |
(if (and (eq (car-safe (nth 1 expr)) 'frac) |
(if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) |
423 |
(memq (nth 1 (nth 1 expr)) '(1 -1))) |
(memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1))) |
424 |
(math-div (math-mul (nth 2 expr) (nth 1 (nth 1 expr))) |
(math-div (math-mul (nth 2 math-simplify-expr) |
425 |
(nth 2 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
426 |
expr))) |
(nth 2 (nth 1 math-simplify-expr))) |
427 |
|
math-simplify-expr))) |
428 |
|
|
429 |
(math-defsimplify / |
(math-defsimplify / |
430 |
(math-simplify-divide)) |
(math-simplify-divide)) |
431 |
|
|
432 |
(defun math-simplify-divide () |
(defun math-simplify-divide () |
433 |
(let ((np (cdr expr)) |
(let ((np (cdr math-simplify-expr)) |
434 |
(nover nil) |
(nover nil) |
435 |
(nn (and (or (eq (car expr) '/) (not (Math-realp (nth 2 expr)))) |
(nn (and (or (eq (car math-simplify-expr) '/) |
436 |
(math-common-constant-factor (nth 2 expr)))) |
(not (Math-realp (nth 2 math-simplify-expr)))) |
437 |
|
(math-common-constant-factor (nth 2 math-simplify-expr)))) |
438 |
n op) |
n op) |
439 |
(if nn |
(if nn |
440 |
(progn |
(progn |
441 |
(setq n (and (or (eq (car expr) '/) (not (Math-realp (nth 1 expr)))) |
(setq n (and (or (eq (car math-simplify-expr) '/) |
442 |
(math-common-constant-factor (nth 1 expr)))) |
(not (Math-realp (nth 1 math-simplify-expr)))) |
443 |
|
(math-common-constant-factor (nth 1 math-simplify-expr)))) |
444 |
(if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n)) |
(if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n)) |
445 |
(progn |
(progn |
446 |
(setcar (cdr expr) (math-mul (nth 2 nn) (nth 1 expr))) |
(setcar (cdr math-simplify-expr) |
447 |
(setcar (cdr (cdr expr)) |
(math-mul (nth 2 nn) (nth 1 math-simplify-expr))) |
448 |
(math-cancel-common-factor (nth 2 expr) nn)) |
(setcar (cdr (cdr math-simplify-expr)) |
449 |
|
(math-cancel-common-factor (nth 2 math-simplify-expr) nn)) |
450 |
(if (and (math-negp nn) |
(if (and (math-negp nn) |
451 |
(setq op (assq (car expr) calc-tweak-eqn-table))) |
(setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))) |
452 |
(setcar expr (nth 1 op)))) |
(setcar math-simplify-expr (nth 1 op)))) |
453 |
(if (and n (not (eq (setq n (math-frac-gcd n nn)) 1))) |
(if (and n (not (eq (setq n (math-frac-gcd n nn)) 1))) |
454 |
(progn |
(progn |
455 |
(setcar (cdr expr) |
(setcar (cdr math-simplify-expr) |
456 |
(math-cancel-common-factor (nth 1 expr) n)) |
(math-cancel-common-factor (nth 1 math-simplify-expr) n)) |
457 |
(setcar (cdr (cdr expr)) |
(setcar (cdr (cdr math-simplify-expr)) |
458 |
(math-cancel-common-factor (nth 2 expr) n)) |
(math-cancel-common-factor (nth 2 math-simplify-expr) n)) |
459 |
(if (and (math-negp n) |
(if (and (math-negp n) |
460 |
(setq op (assq (car expr) calc-tweak-eqn-table))) |
(setq op (assq (car math-simplify-expr) |
461 |
(setcar expr (nth 1 op)))))))) |
calc-tweak-eqn-table))) |
462 |
|
(setcar math-simplify-expr (nth 1 op)))))))) |
463 |
(if (and (eq (car-safe (car np)) '/) |
(if (and (eq (car-safe (car np)) '/) |
464 |
(math-known-scalarp (nth 2 expr) t)) |
(math-known-scalarp (nth 2 math-simplify-expr) t)) |
465 |
(progn |
(progn |
466 |
(setq np (cdr (nth 1 expr))) |
(setq np (cdr (nth 1 math-simplify-expr))) |
467 |
(while (eq (car-safe (setq n (car np))) '*) |
(while (eq (car-safe (setq n (car np))) '*) |
468 |
(and (math-known-scalarp (nth 2 n) t) |
(and (math-known-scalarp (nth 2 n) t) |
469 |
(math-simplify-divisor (cdr n) (cdr (cdr expr)) nil t)) |
(math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nil t)) |
470 |
(setq np (cdr (cdr n)))) |
(setq np (cdr (cdr n)))) |
471 |
(math-simplify-divisor np (cdr (cdr expr)) nil t) |
(math-simplify-divisor np (cdr (cdr math-simplify-expr)) nil t) |
472 |
(setq nover t |
(setq nover t |
473 |
np (cdr (cdr (nth 1 expr)))))) |
np (cdr (cdr (nth 1 math-simplify-expr)))))) |
474 |
(while (eq (car-safe (setq n (car np))) '*) |
(while (eq (car-safe (setq n (car np))) '*) |
475 |
(and (math-known-scalarp (nth 2 n) t) |
(and (math-known-scalarp (nth 2 n) t) |
476 |
(math-simplify-divisor (cdr n) (cdr (cdr expr)) nover t)) |
(math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nover t)) |
477 |
(setq np (cdr (cdr n)))) |
(setq np (cdr (cdr n)))) |
478 |
(math-simplify-divisor np (cdr (cdr expr)) nover t) |
(math-simplify-divisor np (cdr (cdr math-simplify-expr)) nover t) |
479 |
expr)) |
math-simplify-expr)) |
480 |
|
|
481 |
(defun math-simplify-divisor (np dp nover dover) |
;; 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) |
486 |
|
|
487 |
|
(defun math-simplify-divisor (np dp math-simplify-divisor-nover |
488 |
|
math-simplify-divisor-dover) |
489 |
(cond ((eq (car-safe (car dp)) '/) |
(cond ((eq (car-safe (car dp)) '/) |
490 |
(math-simplify-divisor np (cdr (car dp)) nover dover) |
(math-simplify-divisor np (cdr (car dp)) |
491 |
|
math-simplify-divisor-nover |
492 |
|
math-simplify-divisor-dover) |
493 |
(and (math-known-scalarp (nth 1 (car dp)) t) |
(and (math-known-scalarp (nth 1 (car dp)) t) |
494 |
(math-simplify-divisor np (cdr (cdr (car dp))) |
(math-simplify-divisor np (cdr (cdr (car dp))) |
495 |
nover (not dover)))) |
math-simplify-divisor-nover |
496 |
((or (or (eq (car expr) '/) |
(not math-simplify-divisor-dover)))) |
497 |
|
((or (or (eq (car math-simplify-expr) '/) |
498 |
(let ((signs (math-possible-signs (car np)))) |
(let ((signs (math-possible-signs (car np)))) |
499 |
(or (memq signs '(1 4)) |
(or (memq signs '(1 4)) |
500 |
(and (memq (car expr) '(calcFunc-eq calcFunc-neq)) |
(and (memq (car math-simplify-expr) '(calcFunc-eq calcFunc-neq)) |
501 |
(eq signs 5)) |
(eq signs 5)) |
502 |
math-living-dangerously))) |
math-living-dangerously))) |
503 |
(math-numberp (car np))) |
(math-numberp (car np))) |
504 |
(let ((n (car np)) |
(let ((n (car np)) |
505 |
d dd temp op |
d dd |
506 |
(safe t) (scalar (math-known-scalarp n))) |
(safe t) (scalar (math-known-scalarp n))) |
507 |
(while (and (eq (car-safe (setq d (car dp))) '*) |
(while (and (eq (car-safe (setq d (car dp))) '*) |
508 |
safe) |
safe) |
513 |
(math-simplify-one-divisor np dp)))))) |
(math-simplify-one-divisor np dp)))))) |
514 |
|
|
515 |
(defun math-simplify-one-divisor (np dp) |
(defun math-simplify-one-divisor (np dp) |
516 |
(if (setq temp (math-combine-prod (car np) (car dp) nover dover t)) |
(let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover |
517 |
(progn |
math-simplify-divisor-dover t)) |
518 |
(and (not (memq (car expr) '(/ calcFunc-eq calcFunc-neq))) |
op) |
519 |
(math-known-negp (car dp)) |
(if temp |
520 |
(setq op (assq (car expr) calc-tweak-eqn-table)) |
(progn |
521 |
(setcar expr (nth 1 op))) |
(and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq))) |
522 |
(setcar np (if nover (math-div 1 temp) temp)) |
(math-known-negp (car dp)) |
523 |
(setcar dp 1)) |
(setq op (assq (car math-simplify-expr) calc-tweak-eqn-table)) |
524 |
(and dover (not nover) (eq (car expr) '/) |
(setcar math-simplify-expr (nth 1 op))) |
525 |
(eq (car-safe (car dp)) 'calcFunc-sqrt) |
(setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp)) |
526 |
(Math-integerp (nth 1 (car dp))) |
(setcar dp 1)) |
527 |
(progn |
(and math-simplify-divisor-dover (not math-simplify-divisor-nover) |
528 |
(setcar np (math-mul (car np) |
(eq (car math-simplify-expr) '/) |
529 |
(list 'calcFunc-sqrt (nth 1 (car dp))))) |
(eq (car-safe (car dp)) 'calcFunc-sqrt) |
530 |
(setcar dp (nth 1 (car dp))))))) |
(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)))))))) |
535 |
|
|
536 |
(defun math-common-constant-factor (expr) |
(defun math-common-constant-factor (expr) |
537 |
(if (Math-realp expr) |
(if (Math-realp expr) |
580 |
(math-simplify-mod)) |
(math-simplify-mod)) |
581 |
|
|
582 |
(defun math-simplify-mod () |
(defun math-simplify-mod () |
583 |
(and (Math-realp (nth 2 expr)) |
(and (Math-realp (nth 2 math-simplify-expr)) |
584 |
(Math-posp (nth 2 expr)) |
(Math-posp (nth 2 math-simplify-expr)) |
585 |
(let ((lin (math-is-linear (nth 1 expr))) |
(let ((lin (math-is-linear (nth 1 math-simplify-expr))) |
586 |
t1 t2 t3) |
t1 t2 t3) |
587 |
(or (and lin |
(or (and lin |
588 |
(or (math-negp (car lin)) |
(or (math-negp (car lin)) |
589 |
(not (Math-lessp (car lin) (nth 2 expr)))) |
(not (Math-lessp (car lin) (nth 2 math-simplify-expr)))) |
590 |
(list '% |
(list '% |
591 |
(list '+ |
(list '+ |
592 |
(math-mul (nth 1 lin) (nth 2 lin)) |
(math-mul (nth 1 lin) (nth 2 lin)) |
593 |
(math-mod (car lin) (nth 2 expr))) |
(math-mod (car lin) (nth 2 math-simplify-expr))) |
594 |
(nth 2 expr))) |
(nth 2 math-simplify-expr))) |
595 |
(and lin |
(and lin |
596 |
(not (math-equal-int (nth 1 lin) 1)) |
(not (math-equal-int (nth 1 lin) 1)) |
597 |
(math-num-integerp (nth 1 lin)) |
(math-num-integerp (nth 1 lin)) |
598 |
(math-num-integerp (nth 2 expr)) |
(math-num-integerp (nth 2 math-simplify-expr)) |
599 |
(setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 expr))) |
(setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 math-simplify-expr))) |
600 |
(not (math-equal-int t1 1)) |
(not (math-equal-int t1 1)) |
601 |
(list '* |
(list '* |
602 |
t1 |
t1 |
606 |
(nth 2 lin)) |
(nth 2 lin)) |
607 |
(let ((calc-prefer-frac t)) |
(let ((calc-prefer-frac t)) |
608 |
(math-div (car lin) t1))) |
(math-div (car lin) t1))) |
609 |
(math-div (nth 2 expr) t1)))) |
(math-div (nth 2 math-simplify-expr) t1)))) |
610 |
(and (math-equal-int (nth 2 expr) 1) |
(and (math-equal-int (nth 2 math-simplify-expr) 1) |
611 |
(math-known-integerp (if lin |
(math-known-integerp (if lin |
612 |
(math-mul (nth 1 lin) (nth 2 lin)) |
(math-mul (nth 1 lin) (nth 2 lin)) |
613 |
(nth 1 expr))) |
(nth 1 math-simplify-expr))) |
614 |
(if lin (math-mod (car lin) 1) 0)))))) |
(if lin (math-mod (car lin) 1) 0)))))) |
615 |
|
|
616 |
(math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt |
(math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt |
617 |
calcFunc-gt calcFunc-leq calcFunc-geq) |
calcFunc-gt calcFunc-leq calcFunc-geq) |
618 |
(if (= (length expr) 3) |
(if (= (length math-simplify-expr) 3) |
619 |
(math-simplify-ineq))) |
(math-simplify-ineq))) |
620 |
|
|
621 |
(defun math-simplify-ineq () |
(defun math-simplify-ineq () |
622 |
(let ((np (cdr expr)) |
(let ((np (cdr math-simplify-expr)) |
623 |
n) |
n) |
624 |
(while (memq (car-safe (setq n (car np))) '(+ -)) |
(while (memq (car-safe (setq n (car np))) '(+ -)) |
625 |
(math-simplify-add-term (cdr (cdr n)) (cdr (cdr expr)) |
(math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr)) |
626 |
(eq (car n) '-) nil) |
(eq (car n) '-) nil) |
627 |
(setq np (cdr n))) |
(setq np (cdr n))) |
628 |
(math-simplify-add-term np (cdr (cdr expr)) nil (eq np (cdr expr))) |
(math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil |
629 |
|
(eq np (cdr math-simplify-expr))) |
630 |
(math-simplify-divide) |
(math-simplify-divide) |
631 |
(let ((signs (math-possible-signs (cons '- (cdr expr))))) |
(let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr))))) |
632 |
(or (cond ((eq (car expr) 'calcFunc-eq) |
(or (cond ((eq (car math-simplify-expr) 'calcFunc-eq) |
633 |
(or (and (eq signs 2) 1) |
(or (and (eq signs 2) 1) |
634 |
(and (memq signs '(1 4 5)) 0))) |
(and (memq signs '(1 4 5)) 0))) |
635 |
((eq (car expr) 'calcFunc-neq) |
((eq (car math-simplify-expr) 'calcFunc-neq) |
636 |
(or (and (eq signs 2) 0) |
(or (and (eq signs 2) 0) |
637 |
(and (memq signs '(1 4 5)) 1))) |
(and (memq signs '(1 4 5)) 1))) |
638 |
((eq (car expr) 'calcFunc-lt) |
((eq (car math-simplify-expr) 'calcFunc-lt) |
639 |
(or (and (eq signs 1) 1) |
(or (and (eq signs 1) 1) |
640 |
(and (memq signs '(2 4 6)) 0))) |
(and (memq signs '(2 4 6)) 0))) |
641 |
((eq (car expr) 'calcFunc-gt) |
((eq (car math-simplify-expr) 'calcFunc-gt) |
642 |
(or (and (eq signs 4) 1) |
(or (and (eq signs 4) 1) |
643 |
(and (memq signs '(1 2 3)) 0))) |
(and (memq signs '(1 2 3)) 0))) |
644 |
((eq (car expr) 'calcFunc-leq) |
((eq (car math-simplify-expr) 'calcFunc-leq) |
645 |
(or (and (eq signs 4) 0) |
(or (and (eq signs 4) 0) |
646 |
(and (memq signs '(1 2 3)) 1))) |
(and (memq signs '(1 2 3)) 1))) |
647 |
((eq (car expr) 'calcFunc-geq) |
((eq (car math-simplify-expr) 'calcFunc-geq) |
648 |
(or (and (eq signs 1) 0) |
(or (and (eq signs 1) 0) |
649 |
(and (memq signs '(2 4 6)) 1)))) |
(and (memq signs '(2 4 6)) 1)))) |
650 |
expr)))) |
math-simplify-expr)))) |
651 |
|
|
652 |
(defun math-simplify-add-term (np dp minus lplain) |
(defun math-simplify-add-term (np dp minus lplain) |
653 |
(or (math-vectorp (car np)) |
(or (math-vectorp (car np)) |
679 |
(setcar dp (setq n (math-neg temp))))))))) |
(setcar dp (setq n (math-neg temp))))))))) |
680 |
|
|
681 |
(math-defsimplify calcFunc-sin |
(math-defsimplify calcFunc-sin |
682 |
(or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) |
683 |
(nth 1 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
684 |
(and (math-looks-negp (nth 1 expr)) |
(and (math-looks-negp (nth 1 math-simplify-expr)) |
685 |
(math-neg (list 'calcFunc-sin (math-neg (nth 1 expr))))) |
(math-neg (list 'calcFunc-sin (math-neg (nth 1 math-simplify-expr))))) |
686 |
(and (eq calc-angle-mode 'rad) |
(and (eq calc-angle-mode 'rad) |
687 |
(let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) |
(let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) |
688 |
(and n |
(and n |
689 |
(math-known-sin (car n) (nth 1 n) 120 0)))) |
(math-known-sin (car n) (nth 1 n) 120 0)))) |
690 |
(and (eq calc-angle-mode 'deg) |
(and (eq calc-angle-mode 'deg) |
691 |
(let ((n (math-integer-plus (nth 1 expr)))) |
(let ((n (math-integer-plus (nth 1 math-simplify-expr)))) |
692 |
(and n |
(and n |
693 |
(math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))) |
(math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))) |
694 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) |
695 |
(list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))) |
(list 'calcFunc-sqrt (math-sub 1 (math-sqr |
696 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) |
(nth 1 (nth 1 math-simplify-expr)))))) |
697 |
(math-div (nth 1 (nth 1 expr)) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) |
698 |
|
(math-div (nth 1 (nth 1 math-simplify-expr)) |
699 |
(list 'calcFunc-sqrt |
(list 'calcFunc-sqrt |
700 |
(math-add 1 (math-sqr (nth 1 (nth 1 expr))))))) |
(math-add 1 (math-sqr |
701 |
(let ((m (math-should-expand-trig (nth 1 expr)))) |
(nth 1 (nth 1 math-simplify-expr))))))) |
702 |
|
(let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) |
703 |
(and m (integerp (car m)) |
(and m (integerp (car m)) |
704 |
(let ((n (car m)) (a (nth 1 m))) |
(let ((n (car m)) (a (nth 1 m))) |
705 |
(list '+ |
(list '+ |
709 |
(list 'calcFunc-sin a)))))))) |
(list 'calcFunc-sin a)))))))) |
710 |
|
|
711 |
(math-defsimplify calcFunc-cos |
(math-defsimplify calcFunc-cos |
712 |
(or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) |
713 |
(nth 1 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
714 |
(and (math-looks-negp (nth 1 expr)) |
(and (math-looks-negp (nth 1 math-simplify-expr)) |
715 |
(list 'calcFunc-cos (math-neg (nth 1 expr)))) |
(list 'calcFunc-cos (math-neg (nth 1 math-simplify-expr)))) |
716 |
(and (eq calc-angle-mode 'rad) |
(and (eq calc-angle-mode 'rad) |
717 |
(let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) |
(let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) |
718 |
(and n |
(and n |
719 |
(math-known-sin (car n) (nth 1 n) 120 300)))) |
(math-known-sin (car n) (nth 1 n) 120 300)))) |
720 |
(and (eq calc-angle-mode 'deg) |
(and (eq calc-angle-mode 'deg) |
721 |
(let ((n (math-integer-plus (nth 1 expr)))) |
(let ((n (math-integer-plus (nth 1 math-simplify-expr)))) |
722 |
(and n |
(and n |
723 |
(math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))) |
(math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))) |
724 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) |
725 |
(list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))) |
(list 'calcFunc-sqrt |
726 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) |
(math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))) |
727 |
|
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) |
728 |
(math-div 1 |
(math-div 1 |
729 |
(list 'calcFunc-sqrt |
(list 'calcFunc-sqrt |
730 |
(math-add 1 (math-sqr (nth 1 (nth 1 expr))))))) |
(math-add 1 |
731 |
(let ((m (math-should-expand-trig (nth 1 expr)))) |
(math-sqr (nth 1 (nth 1 math-simplify-expr))))))) |
732 |
|
(let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) |
733 |
(and m (integerp (car m)) |
(and m (integerp (car m)) |
734 |
(let ((n (car m)) (a (nth 1 m))) |
(let ((n (car m)) (a (nth 1 m))) |
735 |
(list '- |
(list '- |
791 |
(t nil)))))) |
(t nil)))))) |
792 |
|
|
793 |
(math-defsimplify calcFunc-tan |
(math-defsimplify calcFunc-tan |
794 |
(or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) |
795 |
(nth 1 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
796 |
(and (math-looks-negp (nth 1 expr)) |
(and (math-looks-negp (nth 1 math-simplify-expr)) |
797 |
(math-neg (list 'calcFunc-tan (math-neg (nth 1 expr))))) |
(math-neg (list 'calcFunc-tan (math-neg (nth 1 math-simplify-expr))))) |
798 |
(and (eq calc-angle-mode 'rad) |
(and (eq calc-angle-mode 'rad) |
799 |
(let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) |
(let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) |
800 |
(and n |
(and n |
801 |
(math-known-tan (car n) (nth 1 n) 120)))) |
(math-known-tan (car n) (nth 1 n) 120)))) |
802 |
(and (eq calc-angle-mode 'deg) |
(and (eq calc-angle-mode 'deg) |
803 |
(let ((n (math-integer-plus (nth 1 expr)))) |
(let ((n (math-integer-plus (nth 1 math-simplify-expr)))) |
804 |
(and n |
(and n |
805 |
(math-known-tan (car n) (nth 1 n) '(frac 2 3))))) |
(math-known-tan (car n) (nth 1 n) '(frac 2 3))))) |
806 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) |
807 |
(math-div (nth 1 (nth 1 expr)) |
(math-div (nth 1 (nth 1 math-simplify-expr)) |
808 |
(list 'calcFunc-sqrt |
(list 'calcFunc-sqrt |
809 |
(math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) |
(math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) |
810 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) |
811 |
(math-div (list 'calcFunc-sqrt |
(math-div (list 'calcFunc-sqrt |
812 |
(math-sub 1 (math-sqr (nth 1 (nth 1 expr))))) |
(math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))) |
813 |
(nth 1 (nth 1 expr)))) |
(nth 1 (nth 1 math-simplify-expr)))) |
814 |
(let ((m (math-should-expand-trig (nth 1 expr)))) |
(let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) |
815 |
(and m |
(and m |
816 |
(if (equal (car m) '(frac 1 2)) |
(if (equal (car m) '(frac 1 2)) |
817 |
(math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m))) |
(math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m))) |
818 |
(list 'calcFunc-sin (nth 1 m))) |
(list 'calcFunc-sin (nth 1 m))) |
819 |
(math-div (list 'calcFunc-sin (nth 1 expr)) |
(math-div (list 'calcFunc-sin (nth 1 math-simplify-expr)) |
820 |
(list 'calcFunc-cos (nth 1 expr)))))))) |
(list 'calcFunc-cos (nth 1 math-simplify-expr)))))))) |
821 |
|
|
822 |
(defun math-known-tan (plus n mul) |
(defun math-known-tan (plus n mul) |
823 |
(setq n (math-mul n mul)) |
(setq n (math-mul n mul)) |
852 |
(t nil)))))) |
(t nil)))))) |
853 |
|
|
854 |
(math-defsimplify calcFunc-sinh |
(math-defsimplify calcFunc-sinh |
855 |
(or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) |
856 |
(nth 1 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
857 |
(and (math-looks-negp (nth 1 expr)) |
(and (math-looks-negp (nth 1 math-simplify-expr)) |
858 |
(math-neg (list 'calcFunc-sinh (math-neg (nth 1 expr))))) |
(math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr))))) |
859 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) |
860 |
math-living-dangerously |
math-living-dangerously |
861 |
(list 'calcFunc-sqrt (math-sub (math-sqr (nth 1 (nth 1 expr))) 1))) |
(list 'calcFunc-sqrt |
862 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) |
(math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) |
863 |
|
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) |
864 |
math-living-dangerously |
math-living-dangerously |
865 |
(math-div (nth 1 (nth 1 expr)) |
(math-div (nth 1 (nth 1 math-simplify-expr)) |
866 |
(list 'calcFunc-sqrt |
(list 'calcFunc-sqrt |
867 |
(math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) |
(math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) |
868 |
(let ((m (math-should-expand-trig (nth 1 expr) t))) |
(let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) |
869 |
(and m (integerp (car m)) |
(and m (integerp (car m)) |
870 |
(let ((n (car m)) (a (nth 1 m))) |
(let ((n (car m)) (a (nth 1 m))) |
871 |
(if (> n 1) |
(if (> n 1) |
876 |
(list 'calcFunc-sinh a))))))))) |
(list 'calcFunc-sinh a))))))))) |
877 |
|
|
878 |
(math-defsimplify calcFunc-cosh |
(math-defsimplify calcFunc-cosh |
879 |
(or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) |
880 |
(nth 1 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
881 |
(and (math-looks-negp (nth 1 expr)) |
(and (math-looks-negp (nth 1 math-simplify-expr)) |
882 |
(list 'calcFunc-cosh (math-neg (nth 1 expr)))) |
(list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr)))) |
883 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) |
884 |
math-living-dangerously |
math-living-dangerously |
885 |
(list 'calcFunc-sqrt (math-add (math-sqr (nth 1 (nth 1 expr))) 1))) |
(list 'calcFunc-sqrt |
886 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) |
(math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) |
887 |
|
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) |
888 |
math-living-dangerously |
math-living-dangerously |
889 |
(math-div 1 |
(math-div 1 |
890 |
(list 'calcFunc-sqrt |
(list 'calcFunc-sqrt |
891 |
(math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) |
(math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) |
892 |
(let ((m (math-should-expand-trig (nth 1 expr) t))) |
(let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) |
893 |
(and m (integerp (car m)) |
(and m (integerp (car m)) |
894 |
(let ((n (car m)) (a (nth 1 m))) |
(let ((n (car m)) (a (nth 1 m))) |
895 |
(if (> n 1) |
(if (> n 1) |
900 |
(list 'calcFunc-sinh a))))))))) |
(list 'calcFunc-sinh a))))))))) |
901 |
|
|
902 |
(math-defsimplify calcFunc-tanh |
(math-defsimplify calcFunc-tanh |
903 |
(or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) |
904 |
(nth 1 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
905 |
(and (math-looks-negp (nth 1 expr)) |
(and (math-looks-negp (nth 1 math-simplify-expr)) |
906 |
(math-neg (list 'calcFunc-tanh (math-neg (nth 1 expr))))) |
(math-neg (list 'calcFunc-tanh (math-neg (nth 1 math-simplify-expr))))) |
907 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) |
908 |
math-living-dangerously |
math-living-dangerously |
909 |
(math-div (nth 1 (nth 1 expr)) |
(math-div (nth 1 (nth 1 math-simplify-expr)) |
910 |
(list 'calcFunc-sqrt |
(list 'calcFunc-sqrt |
911 |
(math-add (math-sqr (nth 1 (nth 1 expr))) 1)))) |
(math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) |
912 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) |
913 |
math-living-dangerously |
math-living-dangerously |
914 |
(math-div (list 'calcFunc-sqrt |
(math-div (list 'calcFunc-sqrt |
915 |
(math-sub (math-sqr (nth 1 (nth 1 expr))) 1)) |
(math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)) |
916 |
(nth 1 (nth 1 expr)))) |
(nth 1 (nth 1 math-simplify-expr)))) |
917 |
(let ((m (math-should-expand-trig (nth 1 expr) t))) |
(let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) |
918 |
(and m |
(and m |
919 |
(if (equal (car m) '(frac 1 2)) |
(if (equal (car m) '(frac 1 2)) |
920 |
(math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1) |
(math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1) |
921 |
(list 'calcFunc-sinh (nth 1 m))) |
(list 'calcFunc-sinh (nth 1 m))) |
922 |
(math-div (list 'calcFunc-sinh (nth 1 expr)) |
(math-div (list 'calcFunc-sinh (nth 1 math-simplify-expr)) |
923 |
(list 'calcFunc-cosh (nth 1 expr)))))))) |
(list 'calcFunc-cosh (nth 1 math-simplify-expr)))))))) |
924 |
|
|
925 |
(math-defsimplify calcFunc-arcsin |
(math-defsimplify calcFunc-arcsin |
926 |
(or (and (math-looks-negp (nth 1 expr)) |
(or (and (math-looks-negp (nth 1 math-simplify-expr)) |
927 |
(math-neg (list 'calcFunc-arcsin (math-neg (nth 1 expr))))) |
(math-neg (list 'calcFunc-arcsin (math-neg (nth 1 math-simplify-expr))))) |
928 |
(and (eq (nth 1 expr) 1) |
(and (eq (nth 1 math-simplify-expr) 1) |
929 |
(math-quarter-circle t)) |
(math-quarter-circle t)) |
930 |
(and (equal (nth 1 expr) '(frac 1 2)) |
(and (equal (nth 1 math-simplify-expr) '(frac 1 2)) |
931 |
(math-div (math-half-circle t) 6)) |
(math-div (math-half-circle t) 6)) |
932 |
(and math-living-dangerously |
(and math-living-dangerously |
933 |
(eq (car-safe (nth 1 expr)) 'calcFunc-sin) |
(eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin) |
934 |
(nth 1 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
935 |
(and math-living-dangerously |
(and math-living-dangerously |
936 |
(eq (car-safe (nth 1 expr)) 'calcFunc-cos) |
(eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) |
937 |
(math-sub (math-quarter-circle t) |
(math-sub (math-quarter-circle t) |
938 |
(nth 1 (nth 1 expr)))))) |
(nth 1 (nth 1 math-simplify-expr)))))) |
939 |
|
|
940 |
(math-defsimplify calcFunc-arccos |
(math-defsimplify calcFunc-arccos |
941 |
(or (and (eq (nth 1 expr) 0) |
(or (and (eq (nth 1 math-simplify-expr) 0) |
942 |
(math-quarter-circle t)) |
(math-quarter-circle t)) |
943 |
(and (eq (nth 1 expr) -1) |
(and (eq (nth 1 math-simplify-expr) -1) |
944 |
(math-half-circle t)) |
(math-half-circle t)) |
945 |
(and (equal (nth 1 expr) '(frac 1 2)) |
(and (equal (nth 1 math-simplify-expr) '(frac 1 2)) |
946 |
(math-div (math-half-circle t) 3)) |
(math-div (math-half-circle t) 3)) |
947 |
(and (equal (nth 1 expr) '(frac -1 2)) |
(and (equal (nth 1 math-simplify-expr) '(frac -1 2)) |
948 |
(math-div (math-mul (math-half-circle t) 2) 3)) |
(math-div (math-mul (math-half-circle t) 2) 3)) |
949 |
(and math-living-dangerously |
(and math-living-dangerously |
950 |
(eq (car-safe (nth 1 expr)) 'calcFunc-cos) |
(eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) |
951 |
(nth 1 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
952 |
(and math-living-dangerously |
(and math-living-dangerously |
953 |
(eq (car-safe (nth 1 expr)) 'calcFunc-sin) |
(eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin) |
954 |
(math-sub (math-quarter-circle t) |
(math-sub (math-quarter-circle t) |
955 |
(nth 1 (nth 1 expr)))))) |
(nth 1 (nth 1 math-simplify-expr)))))) |
956 |
|
|
957 |
(math-defsimplify calcFunc-arctan |
(math-defsimplify calcFunc-arctan |
958 |
(or (and (math-looks-negp (nth 1 expr)) |
(or (and (math-looks-negp (nth 1 math-simplify-expr)) |
959 |
(math-neg (list 'calcFunc-arctan (math-neg (nth 1 expr))))) |
(math-neg (list 'calcFunc-arctan (math-neg (nth 1 math-simplify-expr))))) |
960 |
(and (eq (nth 1 expr) 1) |
(and (eq (nth 1 math-simplify-expr) 1) |
961 |
(math-div (math-half-circle t) 4)) |
(math-div (math-half-circle t) 4)) |
962 |
(and math-living-dangerously |
(and math-living-dangerously |
963 |
(eq (car-safe (nth 1 expr)) 'calcFunc-tan) |
(eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tan) |
964 |
(nth 1 (nth 1 expr))))) |
(nth 1 (nth 1 math-simplify-expr))))) |
965 |
|
|
966 |
(math-defsimplify calcFunc-arcsinh |
(math-defsimplify calcFunc-arcsinh |
967 |
(or (and (math-looks-negp (nth 1 expr)) |
(or (and (math-looks-negp (nth 1 math-simplify-expr)) |
968 |
(math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 expr))))) |
(math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 math-simplify-expr))))) |
969 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-sinh) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sinh) |
970 |
(or math-living-dangerously |
(or math-living-dangerously |
971 |
(math-known-realp (nth 1 (nth 1 expr)))) |
(math-known-realp (nth 1 (nth 1 math-simplify-expr)))) |
972 |
(nth 1 (nth 1 expr))))) |
(nth 1 (nth 1 math-simplify-expr))))) |
973 |
|
|
974 |
(math-defsimplify calcFunc-arccosh |
(math-defsimplify calcFunc-arccosh |
975 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh) |
976 |
(or math-living-dangerously |
(or math-living-dangerously |
977 |
(math-known-realp (nth 1 (nth 1 expr)))) |
(math-known-realp (nth 1 (nth 1 math-simplify-expr)))) |
978 |
(nth 1 (nth 1 expr)))) |
(nth 1 (nth 1 math-simplify-expr)))) |
979 |
|
|
980 |
(math-defsimplify calcFunc-arctanh |
(math-defsimplify calcFunc-arctanh |
981 |
(or (and (math-looks-negp (nth 1 expr)) |
(or (and (math-looks-negp (nth 1 math-simplify-expr)) |
982 |
(math-neg (list 'calcFunc-arctanh (math-neg (nth 1 expr))))) |
(math-neg (list 'calcFunc-arctanh (math-neg (nth 1 math-simplify-expr))))) |
983 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-tanh) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tanh) |
984 |
(or math-living-dangerously |
(or math-living-dangerously |
985 |
(math-known-realp (nth 1 (nth 1 expr)))) |
(math-known-realp (nth 1 (nth 1 math-simplify-expr)))) |
986 |
(nth 1 (nth 1 expr))))) |
(nth 1 (nth 1 math-simplify-expr))))) |
987 |
|
|
988 |
(math-defsimplify calcFunc-sqrt |
(math-defsimplify calcFunc-sqrt |
989 |
(math-simplify-sqrt)) |
(math-simplify-sqrt)) |
990 |
|
|
991 |
(defun math-simplify-sqrt () |
(defun math-simplify-sqrt () |
992 |
(or (and (eq (car-safe (nth 1 expr)) 'frac) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) |
993 |
(math-div (list 'calcFunc-sqrt (math-mul (nth 1 (nth 1 expr)) |
(math-div (list 'calcFunc-sqrt |
994 |
(nth 2 (nth 1 expr)))) |
(math-mul (nth 1 (nth 1 math-simplify-expr)) |
995 |
(nth 2 (nth 1 expr)))) |
(nth 2 (nth 1 math-simplify-expr)))) |
996 |
(let ((fac (if (math-objectp (nth 1 expr)) |
(nth 2 (nth 1 math-simplify-expr)))) |
997 |
(math-squared-factor (nth 1 expr)) |
(let ((fac (if (math-objectp (nth 1 math-simplify-expr)) |
998 |
(math-common-constant-factor (nth 1 expr))))) |
(math-squared-factor (nth 1 math-simplify-expr)) |
999 |
|
(math-common-constant-factor (nth 1 math-simplify-expr))))) |
1000 |
(and fac (not (eq fac 1)) |
(and fac (not (eq fac 1)) |
1001 |
(math-mul (math-normalize (list 'calcFunc-sqrt fac)) |
(math-mul (math-normalize (list 'calcFunc-sqrt fac)) |
1002 |
(math-normalize |
(math-normalize |
1003 |
(list 'calcFunc-sqrt |
(list 'calcFunc-sqrt |
1004 |
(math-cancel-common-factor (nth 1 expr) fac)))))) |
(math-cancel-common-factor |
1005 |
|
(nth 1 math-simplify-expr) fac)))))) |
1006 |
(and math-living-dangerously |
(and math-living-dangerously |
1007 |
(or (and (eq (car-safe (nth 1 expr)) '-) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) '-) |
1008 |
(math-equal-int (nth 1 (nth 1 expr)) 1) |
(math-equal-int (nth 1 (nth 1 math-simplify-expr)) 1) |
1009 |
(eq (car-safe (nth 2 (nth 1 expr))) '^) |
(eq (car-safe (nth 2 (nth 1 math-simplify-expr))) '^) |
1010 |
(math-equal-int (nth 2 (nth 2 (nth 1 expr))) 2) |
(math-equal-int (nth 2 (nth 2 (nth 1 math-simplify-expr))) 2) |
1011 |
(or (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr)))) |
(or (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr)))) |
1012 |
'calcFunc-sin) |
'calcFunc-sin) |
1013 |
(list 'calcFunc-cos |
(list 'calcFunc-cos |
1014 |
(nth 1 (nth 1 (nth 2 (nth 1 expr)))))) |
(nth 1 (nth 1 (nth 2 (nth 1 math-simplify-expr)))))) |
1015 |
(and (eq (car-safe (nth 1 (nth 2 (nth 1 expr)))) |
(and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr)))) |
1016 |
'calcFunc-cos) |
'calcFunc-cos) |
1017 |
(list 'calcFunc-sin |
(list 'calcFunc-sin |
1018 |
(nth 1 (nth 1 (nth 2 (nth 1 expr)))))))) |
(nth 1 (nth 1 (nth 2 |
1019 |
(and (eq (car-safe (nth 1 expr)) '-) |
(nth 1 math-simplify-expr)))))))) |
1020 |
(math-equal-int (nth 2 (nth 1 expr)) 1) |
(and (eq (car-safe (nth 1 math-simplify-expr)) '-) |
1021 |
(eq (car-safe (nth 1 (nth 1 expr))) '^) |
(math-equal-int (nth 2 (nth 1 math-simplify-expr)) 1) |
1022 |
(math-equal-int (nth 2 (nth 1 (nth 1 expr))) 2) |
(eq (car-safe (nth 1 (nth 1 math-simplify-expr))) '^) |
1023 |
(and (eq (car-safe (nth 1 (nth 1 (nth 1 expr)))) |
(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)))) |
1025 |
'calcFunc-cosh) |
'calcFunc-cosh) |
1026 |
(list 'calcFunc-sinh |
(list 'calcFunc-sinh |
1027 |
(nth 1 (nth 1 (nth 1 (nth 1 expr))))))) |
(nth 1 (nth 1 (nth 1 (nth 1 math-simplify-expr))))))) |
1028 |
(and (eq (car-safe (nth 1 expr)) '+) |
(and (eq (car-safe (nth 1 math-simplify-expr)) '+) |
1029 |
(let ((a (nth 1 (nth 1 expr))) |
(let ((a (nth 1 (nth 1 math-simplify-expr))) |
1030 |
(b (nth 2 (nth 1 expr)))) |
(b (nth 2 (nth 1 math-simplify-expr)))) |
1031 |
(and (or (and (math-equal-int a 1) |
(and (or (and (math-equal-int a 1) |
1032 |
(setq a b b (nth 1 (nth 1 expr)))) |
(setq a b b (nth 1 (nth 1 math-simplify-expr)))) |
1033 |
(math-equal-int b 1)) |
(math-equal-int b 1)) |
1034 |
(eq (car-safe a) '^) |
(eq (car-safe a) '^) |
1035 |
(math-equal-int (nth 2 a) 2) |
(math-equal-int (nth 2 a) 2) |
1038 |
(and (eq (car-safe (nth 1 a)) 'calcFunc-tan) |
(and (eq (car-safe (nth 1 a)) 'calcFunc-tan) |
1039 |
(list '/ 1 (list 'calcFunc-cos |
(list '/ 1 (list 'calcFunc-cos |
1040 |
(nth 1 (nth 1 a))))))))) |
(nth 1 (nth 1 a))))))))) |
1041 |
(and (eq (car-safe (nth 1 expr)) '^) |
(and (eq (car-safe (nth 1 math-simplify-expr)) '^) |
1042 |
(list '^ |
(list '^ |
1043 |
(nth 1 (nth 1 expr)) |
(nth 1 (nth 1 math-simplify-expr)) |
1044 |
(math-div (nth 2 (nth 1 expr)) 2))) |
(math-div (nth 2 (nth 1 math-simplify-expr)) 2))) |
1045 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt) |
1046 |
(list '^ (nth 1 (nth 1 expr)) (math-div 1 4))) |
(list '^ (nth 1 (nth 1 math-simplify-expr)) (math-div 1 4))) |
1047 |
(and (memq (car-safe (nth 1 expr)) '(* /)) |
(and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) |
1048 |
(list (car (nth 1 expr)) |
(list (car (nth 1 math-simplify-expr)) |
1049 |
(list 'calcFunc-sqrt (nth 1 (nth 1 expr))) |
(list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr))) |
1050 |
(list 'calcFunc-sqrt (nth 2 (nth 1 expr))))) |
(list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr))))) |
1051 |
(and (memq (car-safe (nth 1 expr)) '(+ -)) |
(and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -)) |
1052 |
(not (math-any-floats (nth 1 expr))) |
(not (math-any-floats (nth 1 math-simplify-expr))) |
1053 |
(let ((f (calcFunc-factors (calcFunc-expand |
(let ((f (calcFunc-factors (calcFunc-expand |
1054 |
(nth 1 expr))))) |
(nth 1 math-simplify-expr))))) |
1055 |
(and (math-vectorp f) |
(and (math-vectorp f) |
1056 |
(or (> (length f) 2) |
(or (> (length f) 2) |
1057 |
(> (nth 2 (nth 1 f)) 1)) |
(> (nth 2 (nth 1 f)) 1)) |
1087 |
fac))) |
fac))) |
1088 |
|
|
1089 |
(math-defsimplify calcFunc-exp |
(math-defsimplify calcFunc-exp |
1090 |
(math-simplify-exp (nth 1 expr))) |
(math-simplify-exp (nth 1 math-simplify-expr))) |
1091 |
|
|
1092 |
(defun math-simplify-exp (x) |
(defun math-simplify-exp (x) |
1093 |
(or (and (eq (car-safe x) 'calcFunc-ln) |
(or (and (eq (car-safe x) 'calcFunc-ln) |
1118 |
(list '+ c (list '* s '(var i var-i)))))))) |
(list '+ c (list '* s '(var i var-i)))))))) |
1119 |
|
|
1120 |
(math-defsimplify calcFunc-ln |
(math-defsimplify calcFunc-ln |
1121 |
(or (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp) |
1122 |
(or math-living-dangerously |
(or math-living-dangerously |
1123 |
(math-known-realp (nth 1 (nth 1 expr)))) |
(math-known-realp (nth 1 (nth 1 math-simplify-expr)))) |
1124 |
(nth 1 (nth 1 expr))) |
(nth 1 (nth 1 math-simplify-expr))) |
1125 |
(and (eq (car-safe (nth 1 expr)) '^) |
(and (eq (car-safe (nth 1 math-simplify-expr)) '^) |
1126 |
(equal (nth 1 (nth 1 expr)) '(var e var-e)) |
(equal (nth 1 (nth 1 math-simplify-expr)) '(var e var-e)) |
1127 |
(or math-living-dangerously |
(or math-living-dangerously |
1128 |
(math-known-realp (nth 2 (nth 1 expr)))) |
(math-known-realp (nth 2 (nth 1 math-simplify-expr)))) |
1129 |
(nth 2 (nth 1 expr))) |
(nth 2 (nth 1 math-simplify-expr))) |
1130 |
(and calc-symbolic-mode |
(and calc-symbolic-mode |
1131 |
(math-known-negp (nth 1 expr)) |
(math-known-negp (nth 1 math-simplify-expr)) |
1132 |
(math-add (list 'calcFunc-ln (math-neg (nth 1 expr))) |
(math-add (list 'calcFunc-ln (math-neg (nth 1 math-simplify-expr))) |
1133 |
'(* (var pi var-pi) (var i var-i)))) |
'(* (var pi var-pi) (var i var-i)))) |
1134 |
(and calc-symbolic-mode |
(and calc-symbolic-mode |
1135 |
(math-known-imagp (nth 1 expr)) |
(math-known-imagp (nth 1 math-simplify-expr)) |
1136 |
(let* ((ip (calcFunc-im (nth 1 expr))) |
(let* ((ip (calcFunc-im (nth 1 math-simplify-expr))) |
1137 |
(ips (math-possible-signs ip))) |
(ips (math-possible-signs ip))) |
1138 |
(or (and (memq ips '(4 6)) |
(or (and (memq ips '(4 6)) |
1139 |
(math-add (list 'calcFunc-ln ip) |
(math-add (list 'calcFunc-ln ip) |
1147 |
|
|
1148 |
(defun math-simplify-pow () |
(defun math-simplify-pow () |
1149 |
(or (and math-living-dangerously |
(or (and math-living-dangerously |
1150 |
(or (and (eq (car-safe (nth 1 expr)) '^) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) '^) |
1151 |
(list '^ |
(list '^ |
1152 |
(nth 1 (nth 1 expr)) |
(nth 1 (nth 1 math-simplify-expr)) |
1153 |
(math-mul (nth 2 expr) (nth 2 (nth 1 expr))))) |
(math-mul (nth 2 math-simplify-expr) |
1154 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt) |
(nth 2 (nth 1 math-simplify-expr))))) |
1155 |
|
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt) |
1156 |
(list '^ |
(list '^ |
1157 |
(nth 1 (nth 1 expr)) |
(nth 1 (nth 1 math-simplify-expr)) |
1158 |
(math-div (nth 2 expr) 2))) |
(math-div (nth 2 math-simplify-expr) 2))) |
1159 |
(and (memq (car-safe (nth 1 expr)) '(* /)) |
(and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) |
1160 |
(list (car (nth 1 expr)) |
(list (car (nth 1 math-simplify-expr)) |
1161 |
(list '^ (nth 1 (nth 1 expr)) (nth 2 expr)) |
(list '^ (nth 1 (nth 1 math-simplify-expr)) |
1162 |
(list '^ (nth 2 (nth 1 expr)) (nth 2 expr)))))) |
(nth 2 math-simplify-expr)) |
1163 |
(and (math-equal-int (nth 1 expr) 10) |
(list '^ (nth 2 (nth 1 math-simplify-expr)) |
1164 |
(eq (car-safe (nth 2 expr)) 'calcFunc-log10) |
(nth 2 math-simplify-expr)))))) |
1165 |
(nth 1 (nth 2 expr))) |
(and (math-equal-int (nth 1 math-simplify-expr) 10) |
1166 |
(and (equal (nth 1 expr) '(var e var-e)) |
(eq (car-safe (nth 2 math-simplify-expr)) 'calcFunc-log10) |
1167 |
(math-simplify-exp (nth 2 expr))) |
(nth 1 (nth 2 math-simplify-expr))) |
1168 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-exp) |
(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) |
1171 |
(not math-integrating) |
(not math-integrating) |
1172 |
(list 'calcFunc-exp (math-mul (nth 1 (nth 1 expr)) (nth 2 expr)))) |
(list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr)) |
1173 |
(and (equal (nth 1 expr) '(var i var-i)) |
(nth 2 math-simplify-expr)))) |
1174 |
|
(and (equal (nth 1 math-simplify-expr) '(var i var-i)) |
1175 |
(math-imaginary-i) |
(math-imaginary-i) |
1176 |
(math-num-integerp (nth 2 expr)) |
(math-num-integerp (nth 2 math-simplify-expr)) |
1177 |
(let ((x (math-mod (math-trunc (nth 2 expr)) 4))) |
(let ((x (math-mod (math-trunc (nth 2 math-simplify-expr)) 4))) |
1178 |
(cond ((eq x 0) 1) |
(cond ((eq x 0) 1) |
1179 |
((eq x 1) (nth 1 expr)) |
((eq x 1) (nth 1 math-simplify-expr)) |
1180 |
((eq x 2) -1) |
((eq x 2) -1) |
1181 |
((eq x 3) (math-neg (nth 1 expr)))))) |
((eq x 3) (math-neg (nth 1 math-simplify-expr)))))) |
1182 |
(and math-integrating |
(and math-integrating |
1183 |
(integerp (nth 2 expr)) |
(integerp (nth 2 math-simplify-expr)) |
1184 |
(>= (nth 2 expr) 2) |
(>= (nth 2 math-simplify-expr) 2) |
1185 |
(or (and (eq (car-safe (nth 1 expr)) 'calcFunc-cos) |
(or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) |
1186 |
(math-mul (math-pow (nth 1 expr) (- (nth 2 expr) 2)) |
(math-mul (math-pow (nth 1 math-simplify-expr) |
1187 |
|
(- (nth 2 math-simplify-expr) 2)) |
1188 |
(math-sub 1 |
(math-sub 1 |
1189 |
(math-sqr |
(math-sqr |
1190 |
(list 'calcFunc-sin |
(list 'calcFunc-sin |
1191 |
(nth 1 (nth 1 expr))))))) |
(nth 1 (nth 1 math-simplify-expr))))))) |
1192 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh) |
1193 |
(math-mul (math-pow (nth 1 expr) (- (nth 2 expr) 2)) |
(math-mul (math-pow (nth 1 math-simplify-expr) |
1194 |
|
(- (nth 2 math-simplify-expr) 2)) |
1195 |
(math-add 1 |
(math-add 1 |
1196 |
(math-sqr |
(math-sqr |
1197 |
(list 'calcFunc-sinh |
(list 'calcFunc-sinh |
1198 |
(nth 1 (nth 1 expr))))))))) |
(nth 1 (nth 1 math-simplify-expr))))))))) |
1199 |
(and (eq (car-safe (nth 2 expr)) 'frac) |
(and (eq (car-safe (nth 2 math-simplify-expr)) 'frac) |
1200 |
(Math-ratp (nth 1 expr)) |
(Math-ratp (nth 1 math-simplify-expr)) |
1201 |
(Math-posp (nth 1 expr)) |
(Math-posp (nth 1 math-simplify-expr)) |
1202 |
(if (equal (nth 2 expr) '(frac 1 2)) |
(if (equal (nth 2 math-simplify-expr) '(frac 1 2)) |
1203 |
(list 'calcFunc-sqrt (nth 1 expr)) |
(list 'calcFunc-sqrt (nth 1 math-simplify-expr)) |
1204 |
(let ((flr (math-floor (nth 2 expr)))) |
(let ((flr (math-floor (nth 2 math-simplify-expr)))) |
1205 |
(and (not (Math-zerop flr)) |
(and (not (Math-zerop flr)) |
1206 |
(list '* (list '^ (nth 1 expr) flr) |
(list '* (list '^ (nth 1 math-simplify-expr) flr) |
1207 |
(list '^ (nth 1 expr) |
(list '^ (nth 1 math-simplify-expr) |
1208 |
(math-sub (nth 2 expr) flr))))))) |
(math-sub (nth 2 math-simplify-expr) flr))))))) |
1209 |
(and (eq (math-quarter-integer (nth 2 expr)) 2) |
(and (eq (math-quarter-integer (nth 2 math-simplify-expr)) 2) |
1210 |
(let ((temp (math-simplify-sqrt))) |
(let ((temp (math-simplify-sqrt))) |
1211 |
(and temp |
(and temp |
1212 |
(list '^ temp (math-mul (nth 2 expr) 2))))))) |
(list '^ temp (math-mul (nth 2 math-simplify-expr) 2))))))) |
1213 |
|
|
1214 |
(math-defsimplify calcFunc-log10 |
(math-defsimplify calcFunc-log10 |
1215 |
(and (eq (car-safe (nth 1 expr)) '^) |
(and (eq (car-safe (nth 1 math-simplify-expr)) '^) |
1216 |
(math-equal-int (nth 1 (nth 1 expr)) 10) |
(math-equal-int (nth 1 (nth 1 math-simplify-expr)) 10) |
1217 |
(or math-living-dangerously |
(or math-living-dangerously |
1218 |
(math-known-realp (nth 2 (nth 1 expr)))) |
(math-known-realp (nth 2 (nth 1 math-simplify-expr)))) |
1219 |
(nth 2 (nth 1 expr)))) |
(nth 2 (nth 1 math-simplify-expr)))) |
1220 |
|
|
1221 |
|
|
1222 |
(math-defsimplify calcFunc-erf |
(math-defsimplify calcFunc-erf |
1223 |
(or (and (math-looks-negp (nth 1 expr)) |
(or (and (math-looks-negp (nth 1 math-simplify-expr)) |
1224 |
(math-neg (list 'calcFunc-erf (math-neg (nth 1 expr))))) |
(math-neg (list 'calcFunc-erf (math-neg (nth 1 math-simplify-expr))))) |
1225 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-conj) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) |
1226 |
(list 'calcFunc-conj (list 'calcFunc-erf (nth 1 (nth 1 expr))))))) |
(list 'calcFunc-conj |
1227 |
|
(list 'calcFunc-erf (nth 1 (nth 1 math-simplify-expr))))))) |
1228 |
|
|
1229 |
(math-defsimplify calcFunc-erfc |
(math-defsimplify calcFunc-erfc |
1230 |
(or (and (math-looks-negp (nth 1 expr)) |
(or (and (math-looks-negp (nth 1 math-simplify-expr)) |
1231 |
(math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 expr))))) |
(math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 math-simplify-expr))))) |
1232 |
(and (eq (car-safe (nth 1 expr)) 'calcFunc-conj) |
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) |
1233 |
(list 'calcFunc-conj (list 'calcFunc-erfc (nth 1 (nth 1 expr))))))) |
(list 'calcFunc-conj |
1234 |
|
(list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr))))))) |
1235 |
|
|
1236 |
|
|
1237 |
(defun math-linear-in (expr term &optional always) |
(defun math-linear-in (expr term &optional always) |
1377 |
thing)) |
thing)) |
1378 |
|
|
1379 |
;;; Substitute all occurrences of old for new in expr (non-destructive). |
;;; Substitute all occurrences of old for new in expr (non-destructive). |
1380 |
(defun math-expr-subst (expr old new) |
|
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) |
1387 |
(math-expr-subst-rec expr)) |
(math-expr-subst-rec expr)) |
1388 |
|
|
1389 |
(defalias 'calcFunc-subst 'math-expr-subst) |
(defalias 'calcFunc-subst 'math-expr-subst) |
1390 |
|
|
1391 |
(defun math-expr-subst-rec (expr) |
(defun math-expr-subst-rec (expr) |
1392 |
(cond ((equal expr old) new) |
(cond ((equal expr math-expr-subst-old) math-expr-subst-new) |
1393 |
((Math-primp expr) expr) |
((Math-primp expr) expr) |
1394 |
((memq (car expr) '(calcFunc-deriv |
((memq (car expr) '(calcFunc-deriv |
1395 |
calcFunc-tderiv)) |
calcFunc-tderiv)) |
1396 |
(if (= (length expr) 2) |
(if (= (length expr) 2) |
1397 |
(if (equal (nth 1 expr) old) |
(if (equal (nth 1 expr) math-expr-subst-old) |
1398 |
(append expr (list new)) |
(append expr (list math-expr-subst-new)) |
1399 |
expr) |
expr) |
1400 |
(list (car expr) (nth 1 expr) |
(list (car expr) (nth 1 expr) |
1401 |
(math-expr-subst-rec (nth 2 expr))))) |
(math-expr-subst-rec (nth 2 expr))))) |
1433 |
expr))) |
expr))) |
1434 |
|
|
1435 |
;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...), |
;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...), |
1436 |
;;; else return nil if not in polynomial form. If "loose", coefficients |
;;; else return nil if not in polynomial form. If "loose" (math-is-poly-loose), |
1437 |
;;; may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x. |
;;; coefficients may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x. |
1438 |
(defun math-is-polynomial (expr var &optional degree loose) |
|
1439 |
(let* ((math-poly-base-variable (if loose |
;; The variables math-is-poly-degree and math-is-poly-loose are local to |
1440 |
(if (eq loose 'gen) var '(var XXX XXX)) |
;; 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)) |
1447 |
math-poly-base-variable)) |
math-poly-base-variable)) |
1448 |
(poly (math-is-poly-rec expr math-poly-neg-powers))) |
(poly (math-is-poly-rec expr math-poly-neg-powers))) |
1449 |
(and (or (null degree) |
(and (or (null math-is-poly-degree) |
1450 |
(<= (length poly) (1+ degree))) |
(<= (length poly) (1+ math-is-poly-degree))) |
1451 |
poly))) |
poly))) |
1452 |
|
|
1453 |
(defun math-is-poly-rec (expr negpow) |
(defun math-is-poly-rec (expr negpow) |
1495 |
(n pow) |
(n pow) |
1496 |
(accum (list 1))) |
(accum (list 1))) |
1497 |
(and p1 |
(and p1 |
1498 |
(or (null degree) |
(or (null math-is-poly-degree) |
1499 |
(<= (* (1- (length p1)) n) degree)) |
(<= (* (1- (length p1)) n) math-is-poly-degree)) |
1500 |
(progn |
(progn |
1501 |
(while (>= n 1) |
(while (>= n 1) |
1502 |
(setq accum (math-poly-mul accum p1) |
(setq accum (math-poly-mul accum p1) |
1524 |
(and p1 |
(and p1 |
1525 |
(let ((p2 (math-is-poly-rec (nth 2 expr) negpow))) |
(let ((p2 (math-is-poly-rec (nth 2 expr) negpow))) |
1526 |
(and p2 |
(and p2 |
1527 |
(or (null degree) |
(or (null math-is-poly-degree) |
1528 |
(<= (- (+ (length p1) (length p2)) 2) degree)) |
(<= (- (+ (length p1) (length p2)) 2) |
1529 |
|
math-is-poly-degree)) |
1530 |
(math-poly-mul p1 p2)))))) |
(math-poly-mul p1 p2)))))) |
1531 |
((eq (car expr) '/) |
((eq (car expr) '/) |
1532 |
(and (or (not (math-poly-depends (nth 2 expr) var)) |
(and (or (not (math-poly-depends (nth 2 expr) var)) |
1546 |
(math-is-poly-rec (list '^ (nth 1 expr) '(frac 1 2)) negpow)) |
(math-is-poly-rec (list '^ (nth 1 expr) '(frac 1 2)) negpow)) |
1547 |
(t nil)) |
(t nil)) |
1548 |
(and (or (not (math-poly-depends expr var)) |
(and (or (not (math-poly-depends expr var)) |
1549 |
loose) |
math-is-poly-loose) |
1550 |
(not (eq (car expr) 'vec)) |
(not (eq (car expr) 'vec)) |
1551 |
(list expr))))) |
(list expr))))) |
1552 |
|
|
1582 |
(math-expr-depends expr var))) |
(math-expr-depends expr var))) |
1583 |
|
|
1584 |
;;; Find the variable (or sub-expression) which is the base of polynomial expr. |
;;; Find the variable (or sub-expression) which is the base of polynomial expr. |
1585 |
(defun math-polynomial-base (mpb-top-expr &optional mpb-pred) |
;; The variables math-poly-base-const-ok and math-poly-base-pred are |
1586 |
(or mpb-pred |
;; local to math-polynomial-base, but are used by math-polynomial-base-rec. |
1587 |
(setq mpb-pred (function (lambda (base) (math-polynomial-p |
(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 |
1593 |
mpb-top-expr base))))) |
mpb-top-expr base))))) |
1594 |
(or (let ((const-ok nil)) |
(or (let ((math-poly-base-const-ok nil)) |
1595 |
(math-polynomial-base-rec mpb-top-expr)) |
(math-polynomial-base-rec mpb-top-expr)) |
1596 |
(let ((const-ok t)) |
(let ((math-poly-base-const-ok t)) |
1597 |
(math-polynomial-base-rec mpb-top-expr)))) |
(math-polynomial-base-rec mpb-top-expr)))) |
1598 |
|
|
1599 |
(defun math-polynomial-base-rec (mpb-expr) |
(defun math-polynomial-base-rec (mpb-expr) |
1607 |
(math-polynomial-base-rec (nth 1 mpb-expr))) |
(math-polynomial-base-rec (nth 1 mpb-expr))) |
1608 |
(and (eq (car mpb-expr) 'calcFunc-exp) |
(and (eq (car mpb-expr) 'calcFunc-exp) |
1609 |
(math-polynomial-base-rec '(var e var-e))) |
(math-polynomial-base-rec '(var e var-e))) |
1610 |
(and (or const-ok (math-expr-contains-vars mpb-expr)) |
(and (or math-poly-base-const-ok (math-expr-contains-vars mpb-expr)) |
1611 |
(funcall mpb-pred mpb-expr) |
(funcall math-poly-base-pred mpb-expr) |
1612 |
mpb-expr)))) |
mpb-expr)))) |
1613 |
|
|
1614 |
;;; Return non-nil if expr refers to any variables. |
;;; Return non-nil if expr refers to any variables. |