Lines Matching +defs:math +defs:expr +defs:subst
41 (let ((math-simplify-only nil))
46 (if (= (math-abs arg) 2)
48 (if (>= (math-abs arg) 3)
57 (calc-enter-result 1 "simp" (math-simplify (calc-top-n 1))))))
63 (calc-enter-result 1 "esmp" (math-simplify-extended (calc-top-n 1))))))
69 (let ((math-simplify-only nil))
73 (let ((math-expand-formulas t))
76 (or (math-expand-formula top)
95 (defun calcFunc-powerexpand (expr)
96 (math-normalize (math-map-tree 'math-powerexpand expr)))
98 (defun math-powerexpand (expr)
99 (if (eq (car-safe expr) '^)
100 (let ((n (nth 2 expr)))
104 (a (nth 1 expr))
105 (prod (nth 1 expr)))
107 (setq prod (math-mul prod a))
113 (a (math-pow (nth 1 expr) -1))
114 (prod (math-pow (nth 1 expr) -1)))
116 (setq prod (math-mul a prod))
120 expr)))
121 expr))
135 (let ((var (math-read-expr var)))
169 (math-format-flat-expr calc-poly-div-remainder 0))
187 (let (old new (num 1) expr)
191 expr (calc-top-n 3)
201 expr (calc-top-n 2)
203 (setq new (if (stringp newname) (math-read-expr newname) newname))
206 (setq expr (calc-top-n 1)))
207 (setq old (if (stringp oldname) (math-read-expr oldname) oldname))
210 (or (math-expr-contains expr old)
212 (calc-enter-result num "sbst" (math-expr-subst expr old new)))))
221 ;; math-eval-rules-cache and math-eval-rules-cache-other are
222 ;; declared in calc.el, but are used here by math-recompile-eval-rules.
223 (defvar math-eval-rules-cache)
224 (defvar math-eval-rules-cache-other)
226 (defun math-recompile-eval-rules ()
227 (setq math-eval-rules-cache (and (calc-has-rules 'var-EvalRules)
228 (math-compile-rewrites
230 math-eval-rules-cache-other (assq nil math-eval-rules-cache)
231 math-eval-rules-cache-tag (calc-var-value 'var-EvalRules)))
235 (defun math-expand-formula (expr)
236 (and (consp expr)
237 (symbolp (car expr))
238 (or (get (car expr) 'calc-user-defn)
239 (get (car expr) 'math-expandable))
240 (let ((res (let ((math-expand-formulas t))
241 (apply (car expr) (cdr expr)))))
242 (and (not (eq (car-safe res) (car expr)))
249 (defun math-beforep (a b) ; [Public]
251 (let ((comp (math-compare a b)))
264 (if (and (eq (car-safe b) 'intv) (math-intv-constp b))
265 (if (or (math-beforep a (nth 2 b)) (Math-equal a (nth 2 b)))
270 (if (and (eq (car-safe a) 'intv) (math-intv-constp a))
271 (if (math-beforep (nth 2 a) b)
276 (math-intv-constp a) (math-intv-constp b))
277 (let ((comp (math-compare (nth 2 a) (nth 2 b))))
282 ((eq (setq comp (math-compare (nth 3 a) (nth 3 b))) -1) t)
298 (math-beforep (car a) (car b)))))
302 (defsubst math-simplify-extended (a)
303 (let ((math-living-dangerously t))
304 (math-simplify a)))
306 (defalias 'calcFunc-esimplify 'math-simplify-extended)
308 ;; math-top-only is local to math-simplify, but is used by
309 ;; math-simplify-step, which is called by math-simplify.
310 (defvar math-top-only)
312 (defun math-simplify (top-expr)
313 (let ((math-simplifying t)
314 (math-top-only (consp calc-simplify-mode))
317 (and math-living-dangerously
320 (and math-simplifying-units
323 (and math-integrating
327 (if math-top-only
329 (setq res (math-simplify-step (math-normalize top-expr))
331 top-expr (math-normalize res))
333 (setq top-expr (math-rewrite top-expr (car r)
338 (setq res (math-normalize top-expr))
340 (setq res (math-rewrite res (car r))
342 (not (equal top-expr (setq res (math-simplify-step res)))))
343 (setq top-expr res)))))
344 top-expr)
346 (defalias 'calcFunc-simplify 'math-simplify)
350 ;;; matter, since math-simplify-step is iterated to a fixed point anyway.
351 (defun math-simplify-step (a)
354 (let ((aa (if (or math-top-only
358 (cons (car a) (mapcar 'math-simplify-step (cdr a))))))
360 (let ((handler (get (car aa) 'math-simplify)))
370 (defmacro math-defsimplify (funcs &rest code)
374 (list 'put (list 'quote func) ''math-simplify
376 (list 'get (list 'quote func) ''math-simplify)
379 (append '(lambda (math-simplify-expr))
382 (put 'math-defsimplify 'lisp-indent-hook 1)
384 ;; The function created by math-defsimplify uses the variable
385 ;; math-simplify-expr, and so is used by functions in math-defsimplify
386 (defvar math-simplify-expr)
388 (math-defsimplify (+ -)
389 (math-simplify-plus))
391 (defun math-simplify-plus ()
392 (cond ((and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -))
393 (Math-numberp (nth 2 (nth 1 math-simplify-expr)))
394 (not (Math-numberp (nth 2 math-simplify-expr))))
395 (let ((x (nth 2 math-simplify-expr))
396 (op (car math-simplify-expr)))
397 (setcar (cdr (cdr math-simplify-expr)) (nth 2 (nth 1 math-simplify-expr)))
398 (setcar math-simplify-expr (car (nth 1 math-simplify-expr)))
399 (setcar (cdr (cdr (nth 1 math-simplify-expr))) x)
400 (setcar (nth 1 math-simplify-expr) op)))
401 ((and (eq (car math-simplify-expr) '+)
402 (Math-numberp (nth 1 math-simplify-expr))
403 (not (Math-numberp (nth 2 math-simplify-expr))))
404 (let ((x (nth 2 math-simplify-expr)))
405 (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr))
406 (setcar (cdr math-simplify-expr) x))))
407 (let ((aa math-simplify-expr)
410 (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr)
412 (eq (car math-simplify-expr) '-) t))
414 (setcar (cdr (cdr math-simplify-expr)) temp)
415 (setcar math-simplify-expr '+)
418 (if (setq temp (math-combine-sum aaa (nth 2 math-simplify-expr)
419 nil (eq (car math-simplify-expr) '-) t))
421 (setcar (cdr (cdr math-simplify-expr)) temp)
422 (setcar math-simplify-expr '+)
424 math-simplify-expr))
426 (math-defsimplify *
427 (math-simplify-times))
429 (defun math-simplify-times ()
430 (if (eq (car-safe (nth 2 math-simplify-expr)) '*)
431 (and (math-beforep (nth 1 (nth 2 math-simplify-expr)) (nth 1 math-simplify-expr))
432 (or (math-known-scalarp (nth 1 math-simplify-expr) t)
433 (math-known-scalarp (nth 1 (nth 2 math-simplify-expr)) t))
434 (let ((x (nth 1 math-simplify-expr)))
435 (setcar (cdr math-simplify-expr) (nth 1 (nth 2 math-simplify-expr)))
436 (setcar (cdr (nth 2 math-simplify-expr)) x)))
437 (and (math-beforep (nth 2 math-simplify-expr) (nth 1 math-simplify-expr))
438 (or (math-known-scalarp (nth 1 math-simplify-expr) t)
439 (math-known-scalarp (nth 2 math-simplify-expr) t))
440 (let ((x (nth 2 math-simplify-expr)))
441 (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr))
442 (setcar (cdr math-simplify-expr) x))))
443 (let ((aa math-simplify-expr)
445 (safe t) (scalar (math-known-scalarp (nth 1 math-simplify-expr))))
446 (if (and (Math-ratp (nth 1 math-simplify-expr))
447 (setq temp (math-common-constant-factor (nth 2 math-simplify-expr))))
449 (setcar (cdr (cdr math-simplify-expr))
450 (math-cancel-common-factor (nth 2 math-simplify-expr) temp))
451 (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp))))
454 (if (setq temp (math-combine-prod (nth 1 math-simplify-expr)
457 (setcar (cdr math-simplify-expr) temp)
459 (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t))
461 (if (and (setq temp (math-combine-prod aaa (nth 1 math-simplify-expr) nil nil t))
464 (setcar (cdr math-simplify-expr) temp)
466 (if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac)
467 (memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1)))
468 (math-div (math-mul (nth 2 math-simplify-expr)
469 (nth 1 (nth 1 math-simplify-expr)))
470 (nth 2 (nth 1 math-simplify-expr)))
471 math-simplify-expr)))
473 (math-defsimplify /
474 (math-simplify-divide))
476 (defun math-simplify-divide ()
477 (let ((np (cdr math-simplify-expr))
479 (nn (and (or (eq (car math-simplify-expr) '/)
480 (not (Math-realp (nth 2 math-simplify-expr))))
481 (math-common-constant-factor (nth 2 math-simplify-expr))))
485 (setq n (and (or (eq (car math-simplify-expr) '/)
486 (not (Math-realp (nth 1 math-simplify-expr))))
487 (math-common-constant-factor (nth 1 math-simplify-expr))))
490 (setcar (cdr math-simplify-expr)
491 (math-mul (nth 2 nn) (nth 1 math-simplify-expr)))
492 (setcar (cdr (cdr math-simplify-expr))
493 (math-cancel-common-factor (nth 2 math-simplify-expr) nn))
494 (if (and (math-negp nn)
495 (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table)))
496 (setcar math-simplify-expr (nth 1 op))))
497 (if (and n (not (eq (setq n (math-frac-gcd n nn)) 1)))
499 (setcar (cdr math-simplify-expr)
500 (math-cancel-common-factor (nth 1 math-simplify-expr) n))
501 (setcar (cdr (cdr math-simplify-expr))
502 (math-cancel-common-factor (nth 2 math-simplify-expr) n))
503 (if (and (math-negp n)
504 (setq op (assq (car math-simplify-expr)
506 (setcar math-simplify-expr (nth 1 op))))))))
508 (math-known-scalarp (nth 2 math-simplify-expr) t))
510 (setq np (cdr (nth 1 math-simplify-expr)))
512 (and (math-known-scalarp (nth 2 n) t)
513 (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nil t))
515 (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nil t)
517 np (cdr (cdr (nth 1 math-simplify-expr))))))
519 (and (math-known-scalarp (nth 2 n) t)
520 (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nover t))
522 (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nover t)
523 math-simplify-expr))
525 ;; The variables math-simplify-divisor-nover and math-simplify-divisor-dover
526 ;; are local variables for math-simplify-divisor, but are used by
527 ;; math-simplify-one-divisor.
528 (defvar math-simplify-divisor-nover)
529 (defvar math-simplify-divisor-dover)
531 (defun math-simplify-divisor (np dp math-simplify-divisor-nover
532 math-simplify-divisor-dover)
534 (math-simplify-divisor np (cdr (car dp))
535 math-simplify-divisor-nover
536 math-simplify-divisor-dover)
537 (and (math-known-scalarp (nth 1 (car dp)) t)
538 (math-simplify-divisor np (cdr (cdr (car dp)))
539 math-simplify-divisor-nover
540 (not math-simplify-divisor-dover))))
541 ((or (or (eq (car math-simplify-expr) '/)
542 (let ((signs (math-possible-signs (car np))))
544 (and (memq (car math-simplify-expr) '(calcFunc-eq calcFunc-neq))
546 math-living-dangerously)))
547 (math-numberp (car np)))
550 (scalar (math-known-scalarp (car np))))
553 (math-simplify-one-divisor np (cdr d))
554 (setq safe (or scalar (math-known-scalarp (nth 1 d) t))
557 (math-simplify-one-divisor np dp))))))
559 (defun math-simplify-one-divisor (np dp)
560 (let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover
561 math-simplify-divisor-dover t))
565 (and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq)))
566 (math-known-negp (car dp))
567 (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))
568 (setcar math-simplify-expr (nth 1 op)))
569 (setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp))
571 (and math-simplify-divisor-dover (not math-simplify-divisor-nover)
572 (eq (car math-simplify-expr) '/)
576 (setcar np (math-mul (car np)
580 (defun math-common-constant-factor (expr)
581 (if (Math-realp expr)
582 (if (Math-ratp expr)
583 (and (not (memq expr '(0 1 -1)))
584 (math-abs expr))
585 (if (math-ratp (setq expr (math-to-simple-fraction expr)))
586 (math-common-constant-factor expr)))
587 (if (memq (car expr) '(+ - cplx sdev))
588 (let ((f1 (math-common-constant-factor (nth 1 expr)))
589 (f2 (math-common-constant-factor (nth 2 expr))))
591 (not (eq (setq f1 (math-frac-gcd f1 f2)) 1))
593 (if (memq (car expr) '(* polar))
594 (math-common-constant-factor (nth 1 expr))
595 (if (eq (car expr) '/)
596 (or (math-common-constant-factor (nth 1 expr))
597 (and (Math-integerp (nth 2 expr))
598 (list 'frac 1 (math-abs (nth 2 expr))))))))))
600 (defun math-cancel-common-factor (expr val)
601 (if (memq (car-safe expr) '(+ - cplx sdev))
603 (setcar (cdr expr) (math-cancel-common-factor (nth 1 expr) val))
604 (setcar (cdr (cdr expr)) (math-cancel-common-factor (nth 2 expr) val))
605 expr)
606 (if (eq (car-safe expr) '*)
607 (math-mul (math-cancel-common-factor (nth 1 expr) val) (nth 2 expr))
608 (math-div expr val))))
610 (defun math-frac-gcd (a b)
617 (math-gcd a b)
620 (math-make-frac (math-gcd (nth 1 a) (nth 1 b))
621 (math-gcd (nth 2 a) (nth 2 b)))))))
623 (math-defsimplify %
624 (math-simplify-mod))
626 (defun math-simplify-mod ()
627 (and (Math-realp (nth 2 math-simplify-expr))
628 (Math-posp (nth 2 math-simplify-expr))
629 (let ((lin (math-is-linear (nth 1 math-simplify-expr)))
632 (or (math-negp (car lin))
633 (not (Math-lessp (car lin) (nth 2 math-simplify-expr))))
636 (math-mul (nth 1 lin) (nth 2 lin))
637 (math-mod (car lin) (nth 2 math-simplify-expr)))
638 (nth 2 math-simplify-expr)))
640 (not (math-equal-int (nth 1 lin) 1))
641 (math-num-integerp (nth 1 lin))
642 (math-num-integerp (nth 2 math-simplify-expr))
643 (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 math-simplify-expr)))
644 (not (math-equal-int t1 1))
649 (math-mul (math-div (nth 1 lin) t1)
652 (math-div (car lin) t1)))
653 (math-div (nth 2 math-simplify-expr) t1))))
654 (and (math-equal-int (nth 2 math-simplify-expr) 1)
655 (math-known-integerp (if lin
656 (math-mul (nth 1 lin) (nth 2 lin))
657 (nth 1 math-simplify-expr)))
658 (if lin (math-mod (car lin) 1) 0))))))
660 (math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt
662 (if (= (length math-simplify-expr) 3)
663 (math-simplify-ineq)))
665 (defun math-simplify-ineq ()
666 (let ((np (cdr math-simplify-expr))
669 (math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr))
672 (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil
673 (eq np (cdr math-simplify-expr)))
674 (math-simplify-divide)
675 (let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr)))))
676 (or (cond ((eq (car math-simplify-expr) 'calcFunc-eq)
679 ((eq (car math-simplify-expr) 'calcFunc-neq)
682 ((eq (car math-simplify-expr) 'calcFunc-lt)
685 ((eq (car math-simplify-expr) 'calcFunc-gt)
688 ((eq (car math-simplify-expr) 'calcFunc-leq)
691 ((eq (car math-simplify-expr) 'calcFunc-geq)
694 math-simplify-expr))))
696 (defun math-simplify-add-term (np dp minus lplain)
697 (or (math-vectorp (car np))
702 (if (setq temp (math-combine-sum n (nth 2 d)
704 (if (or lplain (eq (math-looks-negp temp) minus))
706 (setcar np (setq n (if minus (math-neg temp) temp)))
711 (math-neg temp)
714 (if (setq temp (math-combine-sum n d minus t t))
717 (eq (math-looks-negp temp) minus)))
719 (setcar np (setq n (if minus (math-neg temp) temp)))
723 (setcar dp (setq n (math-neg temp)))))))))
725 (math-defsimplify calcFunc-sin
726 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
727 (nth 1 (nth 1 math-simplify-expr)))
728 (and (math-looks-negp (nth 1 math-simplify-expr))
729 (math-neg (list 'calcFunc-sin (math-neg (nth 1 math-simplify-expr)))))
731 (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
733 (math-known-sin (car n) (nth 1 n) 120 0))))
735 (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
737 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0))))
738 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
739 (list 'calcFunc-sqrt (math-sub 1 (math-sqr
740 (nth 1 (nth 1 math-simplify-expr))))))
741 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
742 (math-div (nth 1 (nth 1 math-simplify-expr))
744 (math-add 1 (math-sqr
745 (nth 1 (nth 1 math-simplify-expr)))))))
746 (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
755 (math-defsimplify calcFunc-cos
756 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
757 (nth 1 (nth 1 math-simplify-expr)))
758 (and (math-looks-negp (nth 1 math-simplify-expr))
759 (list 'calcFunc-cos (math-neg (nth 1 math-simplify-expr))))
761 (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
763 (math-known-sin (car n) (nth 1 n) 120 300))))
765 (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
767 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))
768 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
770 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))
771 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
772 (math-div 1
774 (math-add 1
775 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
776 (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
785 (math-defsimplify calcFunc-sec
786 (or (and (math-looks-negp (nth 1 math-simplify-expr))
787 (list 'calcFunc-sec (math-neg (nth 1 math-simplify-expr))))
789 (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
791 (math-div 1 (math-known-sin (car n) (nth 1 n) 120 300)))))
793 (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
795 (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))))
796 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
797 (math-div
800 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
801 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
802 (math-div
804 (nth 1 (nth 1 math-simplify-expr))))
805 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
807 (math-add 1
808 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))))
810 (math-defsimplify calcFunc-csc
811 (or (and (math-looks-negp (nth 1 math-simplify-expr))
812 (math-neg (list 'calcFunc-csc (math-neg (nth 1 math-simplify-expr)))))
814 (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
816 (math-div 1 (math-known-sin (car n) (nth 1 n) 120 0)))))
818 (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
820 (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))))
821 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
822 (math-div 1 (nth 1 (nth 1 math-simplify-expr))))
823 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
824 (math-div
826 (list 'calcFunc-sqrt (math-sub 1 (math-sqr
827 (nth 1 (nth 1 math-simplify-expr)))))))
828 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
829 (math-div (list 'calcFunc-sqrt
830 (math-add 1 (math-sqr
831 (nth 1 (nth 1 math-simplify-expr)))))
832 (nth 1 (nth 1 math-simplify-expr))))))
834 (defun math-should-expand-trig (x &optional hyperbolic)
835 (let ((m (math-is-multiple x)))
836 (and math-living-dangerously
839 (or math-integrating
848 (defun math-known-sin (plus n mul off)
849 (setq n (math-mul n mul))
850 (and (math-num-integerp n)
851 (setq n (math-mod (math-add (math-trunc n) off) 240))
853 (and (setq n (math-known-sin plus (- n 120) 1 0))
854 (math-neg n))
857 (if (math-zerop plus)
882 (cond ((eq n 0) (math-normalize (list 'calcFunc-sin plus)))
883 ((eq n 60) (math-normalize (list 'calcFunc-cos plus)))
886 (math-defsimplify calcFunc-tan
887 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
888 (nth 1 (nth 1 math-simplify-expr)))
889 (and (math-looks-negp (nth 1 math-simplify-expr))
890 (math-neg (list 'calcFunc-tan (math-neg (nth 1 math-simplify-expr)))))
892 (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
894 (math-known-tan (car n) (nth 1 n) 120))))
896 (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
898 (math-known-tan (car n) (nth 1 n) '(frac 2 3)))))
899 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
900 (math-div (nth 1 (nth 1 math-simplify-expr))
902 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
903 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
904 (math-div (list 'calcFunc-sqrt
905 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
906 (nth 1 (nth 1 math-simplify-expr))))
907 (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
910 (math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m)))
912 (math-div (list 'calcFunc-sin (nth 1 math-simplify-expr))
913 (list 'calcFunc-cos (nth 1 math-simplify-expr))))))))
915 (math-defsimplify calcFunc-cot
916 (or (and (math-looks-negp (nth 1 math-simplify-expr))
917 (math-neg (list 'calcFunc-cot (math-neg (nth 1 math-simplify-expr)))))
919 (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
921 (math-div 1 (math-known-tan (car n) (nth 1 n) 120)))))
923 (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
925 (math-div 1 (math-known-tan (car n) (nth 1 n) '(frac 2 3))))))
926 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
927 (math-div (list 'calcFunc-sqrt
928 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
929 (nth 1 (nth 1 math-simplify-expr))))
930 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
931 (math-div (nth 1 (nth 1 math-simplify-expr))
933 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
934 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
935 (math-div 1 (nth 1 (nth 1 math-simplify-expr))))))
937 (defun math-known-tan (plus n mul)
938 (setq n (math-mul n mul))
939 (and (math-num-integerp n)
940 (setq n (math-mod (math-trunc n) 120))
942 (and (setq n (math-known-tan plus (- 120 n) 1))
943 (math-neg n))
944 (if (math-zerop plus)
964 (cond ((eq n 0) (math-normalize (list 'calcFunc-tan plus)))
965 ((eq n 60) (math-normalize (list '/ -1
969 (math-defsimplify calcFunc-sinh
970 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
971 (nth 1 (nth 1 math-simplify-expr)))
972 (and (math-looks-negp (nth 1 math-simplify-expr))
973 (math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr)))))
974 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
975 math-living-dangerously
977 (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))
978 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
979 math-living-dangerously
980 (math-div (nth 1 (nth 1 math-simplify-expr))
982 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
983 (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
993 (math-defsimplify calcFunc-cosh
994 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
995 (nth 1 (nth 1 math-simplify-expr)))
996 (and (math-looks-negp (nth 1 math-simplify-expr))
997 (list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr))))
998 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
999 math-living-dangerously
1001 (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))
1002 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
1003 math-living-dangerously
1004 (math-div 1
1006 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
1007 (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
1017 (math-defsimplify calcFunc-tanh
1018 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
1019 (nth 1 (nth 1 math-simplify-expr)))
1020 (and (math-looks-negp (nth 1 math-simplify-expr))
1021 (math-neg (list 'calcFunc-tanh (math-neg (nth 1 math-simplify-expr)))))
1022 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
1023 math-living-dangerously
1024 (math-div (nth 1 (nth 1 math-simplify-expr))
1026 (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
1027 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
1028 math-living-dangerously
1029 (math-div (list 'calcFunc-sqrt
1030 (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))
1031 (nth 1 (nth 1 math-simplify-expr))))
1032 (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
1035 (math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1)
1037 (math-div (list 'calcFunc-sinh (nth 1 math-simplify-expr))
1038 (list 'calcFunc-cosh (nth 1 math-simplify-expr))))))))
1040 (math-defsimplify calcFunc-sech
1041 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1042 (list 'calcFunc-sech (math-neg (nth 1 math-simplify-expr))))
1043 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
1044 math-living-dangerously
1045 (math-div
1048 (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
1049 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
1050 math-living-dangerously
1051 (math-div 1 (nth 1 (nth 1 math-simplify-expr))) 1)
1052 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
1053 math-living-dangerously
1055 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))))
1057 (math-defsimplify calcFunc-csch
1058 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1059 (math-neg (list 'calcFunc-csch (math-neg (nth 1 math-simplify-expr)))))
1060 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
1061 math-living-dangerously
1062 (math-div 1 (nth 1 (nth 1 math-simplify-expr))))
1063 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
1064 math-living-dangerously
1065 (math-div
1068 (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
1069 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
1070 math-living-dangerously
1071 (math-div (list 'calcFunc-sqrt
1072 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
1073 (nth 1 (nth 1 math-simplify-expr))))))
1075 (math-defsimplify calcFunc-coth
1076 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1077 (math-neg (list 'calcFunc-coth (math-neg (nth 1 math-simplify-expr)))))
1078 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
1079 math-living-dangerously
1080 (math-div (list 'calcFunc-sqrt
1081 (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))
1082 (nth 1 (nth 1 math-simplify-expr))))
1083 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
1084 math-living-dangerously
1085 (math-div (nth 1 (nth 1 math-simplify-expr))
1087 (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
1088 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
1089 math-living-dangerously
1090 (math-div 1 (nth 1 (nth 1 math-simplify-expr))))))
1092 (math-defsimplify calcFunc-arcsin
1093 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1094 (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 math-simplify-expr)))))
1095 (and (eq (nth 1 math-simplify-expr) 1)
1096 (math-quarter-circle t))
1097 (and (equal (nth 1 math-simplify-expr) '(frac 1 2))
1098 (math-div (math-half-circle t) 6))
1099 (and math-living-dangerously
1100 (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin)
1101 (nth 1 (nth 1 math-simplify-expr)))
1102 (and math-living-dangerously
1103 (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos)
1104 (math-sub (math-quarter-circle t)
1105 (nth 1 (nth 1 math-simplify-expr))))))
1107 (math-defsimplify calcFunc-arccos
1108 (or (and (eq (nth 1 math-simplify-expr) 0)
1109 (math-quarter-circle t))
1110 (and (eq (nth 1 math-simplify-expr) -1)
1111 (math-half-circle t))
1112 (and (equal (nth 1 math-simplify-expr) '(frac 1 2))
1113 (math-div (math-half-circle t) 3))
1114 (and (equal (nth 1 math-simplify-expr) '(frac -1 2))
1115 (math-div (math-mul (math-half-circle t) 2) 3))
1116 (and math-living-dangerously
1117 (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos)
1118 (nth 1 (nth 1 math-simplify-expr)))
1119 (and math-living-dangerously
1120 (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin)
1121 (math-sub (math-quarter-circle t)
1122 (nth 1 (nth 1 math-simplify-expr))))))
1124 (math-defsimplify calcFunc-arctan
1125 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1126 (math-neg (list 'calcFunc-arctan (math-neg (nth 1 math-simplify-expr)))))
1127 (and (eq (nth 1 math-simplify-expr) 1)
1128 (math-div (math-half-circle t) 4))
1129 (and math-living-dangerously
1130 (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tan)
1131 (nth 1 (nth 1 math-simplify-expr)))))
1133 (math-defsimplify calcFunc-arcsinh
1134 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1135 (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 math-simplify-expr)))))
1136 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sinh)
1137 (or math-living-dangerously
1138 (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
1139 (nth 1 (nth 1 math-simplify-expr)))))
1141 (math-defsimplify calcFunc-arccosh
1142 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh)
1143 (or math-living-dangerously
1144 (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
1145 (nth 1 (nth 1 math-simplify-expr))))
1147 (math-defsimplify calcFunc-arctanh
1148 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1149 (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 math-simplify-expr)))))
1150 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tanh)
1151 (or math-living-dangerously
1152 (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
1153 (nth 1 (nth 1 math-simplify-expr)))))
1155 (math-defsimplify calcFunc-sqrt
1156 (math-simplify-sqrt))
1158 (defun math-simplify-sqrt ()
1159 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac)
1160 (math-div (list 'calcFunc-sqrt
1161 (math-mul (nth 1 (nth 1 math-simplify-expr))
1162 (nth 2 (nth 1 math-simplify-expr))))
1163 (nth 2 (nth 1 math-simplify-expr))))
1164 (let ((fac (if (math-objectp (nth 1 math-simplify-expr))
1165 (math-squared-factor (nth 1 math-simplify-expr))
1166 (math-common-constant-factor (nth 1 math-simplify-expr)))))
1168 (math-mul (math-normalize (list 'calcFunc-sqrt fac))
1169 (math-normalize
1171 (math-cancel-common-factor
1172 (nth 1 math-simplify-expr) fac))))))
1173 (and math-living-dangerously
1174 (or (and (eq (car-safe (nth 1 math-simplify-expr)) '-)
1175 (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 1)
1176 (eq (car-safe (nth 2 (nth 1 math-simplify-expr))) '^)
1177 (math-equal-int (nth 2 (nth 2 (nth 1 math-simplify-expr))) 2)
1178 (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr))))
1181 (nth 1 (nth 1 (nth 2 (nth 1 math-simplify-expr))))))
1182 (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr))))
1186 (nth 1 math-simplify-expr))))))))
1187 (and (eq (car-safe (nth 1 math-simplify-expr)) '-)
1188 (math-equal-int (nth 2 (nth 1 math-simplify-expr)) 1)
1189 (eq (car-safe (nth 1 (nth 1 math-simplify-expr))) '^)
1190 (math-equal-int (nth 2 (nth 1 (nth 1 math-simplify-expr))) 2)
1191 (and (eq (car-safe (nth 1 (nth 1 (nth 1 math-simplify-expr))))
1194 (nth 1 (nth 1 (nth 1 (nth 1 math-simplify-expr)))))))
1195 (and (eq (car-safe (nth 1 math-simplify-expr)) '+)
1196 (let ((a (nth 1 (nth 1 math-simplify-expr)))
1197 (b (nth 2 (nth 1 math-simplify-expr))))
1198 (and (or (and (math-equal-int a 1)
1199 (setq a b b (nth 1 (nth 1 math-simplify-expr))))
1200 (math-equal-int b 1))
1202 (math-equal-int (nth 2 a) 2)
1213 (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
1215 (nth 1 (nth 1 math-simplify-expr))
1216 (math-div (nth 2 (nth 1 math-simplify-expr)) 2)))
1217 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt)
1218 (list '^ (nth 1 (nth 1 math-simplify-expr)) (math-div 1 4)))
1219 (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
1220 (list (car (nth 1 math-simplify-expr))
1221 (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr)))
1222 (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr)))))
1223 (and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -))
1224 (not (math-any-floats (nth 1 math-simplify-expr)))
1226 (nth 1 math-simplify-expr)))))
1227 (and (math-vectorp f)
1235 (setq out (math-mul out (math-pow
1240 (setq sums (math-mul-thru sums fac))
1241 (setq rest (math-mul rest fac)))))
1243 (math-mul
1246 (math-mul sums rest))))))))))))
1249 (defun math-squared-factor (x)
1255 (if (eq (cdr (setq res (math-idivmod x (car prsqr)))) 0)
1257 fac (math-mul fac (car prsqr)))
1261 (math-defsimplify calcFunc-exp
1262 (math-simplify-exp (nth 1 math-simplify-expr)))
1264 (defun math-simplify-exp (x)
1267 (and math-living-dangerously
1269 (math-add (nth 1 x)
1271 (math-add (math-sqr (nth 1 x)) 1))))
1273 (math-add (nth 1 x)
1275 (math-sub (math-sqr (nth 1 x)) 1))))
1277 (math-div (list 'calcFunc-sqrt (math-add 1 (nth 1 x)))
1278 (list 'calcFunc-sqrt (math-sub 1 (nth 1 x)))))
1279 (let ((m (math-should-expand-trig x 'exp)))
1283 (math-known-imagp x)
1285 (n (math-linear-in ip '(var pi var-pi)))
1288 (setq s (math-known-sin (car n) (nth 1 n) 120 0))
1289 (setq c (math-known-sin (car n) (nth 1 n) 120 300))
1292 (math-defsimplify calcFunc-ln
1293 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp)
1294 (or math-living-dangerously
1295 (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
1296 (nth 1 (nth 1 math-simplify-expr)))
1297 (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
1298 (equal (nth 1 (nth 1 math-simplify-expr)) '(var e var-e))
1299 (or math-living-dangerously
1300 (math-known-realp (nth 2 (nth 1 math-simplify-expr))))
1301 (nth 2 (nth 1 math-simplify-expr)))
1303 (math-known-negp (nth 1 math-simplify-expr))
1304 (math-add (list 'calcFunc-ln (math-neg (nth 1 math-simplify-expr)))
1307 (math-known-imagp (nth 1 math-simplify-expr))
1308 (let* ((ip (calcFunc-im (nth 1 math-simplify-expr)))
1309 (ips (math-possible-signs ip)))
1311 (math-add (list 'calcFunc-ln ip)
1314 (math-sub (list 'calcFunc-ln (math-neg ip))
1317 (math-defsimplify ^
1318 (math-simplify-pow))
1320 (defun math-simplify-pow ()
1321 (or (and math-living-dangerously
1322 (or (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
1324 (nth 1 (nth 1 math-simplify-expr))
1325 (math-mul (nth 2 math-simplify-expr)
1326 (nth 2 (nth 1 math-simplify-expr)))))
1327 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt)
1329 (nth 1 (nth 1 math-simplify-expr))
1330 (math-div (nth 2 math-simplify-expr) 2)))
1331 (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
1332 (list (car (nth 1 math-simplify-expr))
1333 (list '^ (nth 1 (nth 1 math-simplify-expr))
1334 (nth 2 math-simplify-expr))
1335 (list '^ (nth 2 (nth 1 math-simplify-expr))
1336 (nth 2 math-simplify-expr))))))
1337 (and (math-equal-int (nth 1 math-simplify-expr) 10)
1338 (eq (car-safe (nth 2 math-simplify-expr)) 'calcFunc-log10)
1339 (nth 1 (nth 2 math-simplify-expr)))
1340 (and (equal (nth 1 math-simplify-expr) '(var e var-e))
1341 (math-simplify-exp (nth 2 math-simplify-expr)))
1342 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp)
1343 (not math-integrating)
1344 (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr))
1345 (nth 2 math-simplify-expr))))
1346 (and (equal (nth 1 math-simplify-expr) '(var i var-i))
1347 (math-imaginary-i)
1348 (math-num-integerp (nth 2 math-simplify-expr))
1349 (let ((x (math-mod (math-trunc (nth 2 math-simplify-expr)) 4)))
1351 ((eq x 1) (nth 1 math-simplify-expr))
1353 ((eq x 3) (math-neg (nth 1 math-simplify-expr))))))
1354 (and math-integrating
1355 (integerp (nth 2 math-simplify-expr))
1356 (>= (nth 2 math-simplify-expr) 2)
1357 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos)
1358 (math-mul (math-pow (nth 1 math-simplify-expr)
1359 (- (nth 2 math-simplify-expr) 2))
1360 (math-sub 1
1361 (math-sqr
1363 (nth 1 (nth 1 math-simplify-expr)))))))
1364 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh)
1365 (math-mul (math-pow (nth 1 math-simplify-expr)
1366 (- (nth 2 math-simplify-expr) 2))
1367 (math-add 1
1368 (math-sqr
1370 (nth 1 (nth 1 math-simplify-expr)))))))))
1371 (and (eq (car-safe (nth 2 math-simplify-expr)) 'frac)
1372 (Math-ratp (nth 1 math-simplify-expr))
1373 (Math-posp (nth 1 math-simplify-expr))
1374 (if (equal (nth 2 math-simplify-expr) '(frac 1 2))
1375 (list 'calcFunc-sqrt (nth 1 math-simplify-expr))
1376 (let ((flr (math-floor (nth 2 math-simplify-expr))))
1378 (list '* (list '^ (nth 1 math-simplify-expr) flr)
1379 (list '^ (nth 1 math-simplify-expr)
1380 (math-sub (nth 2 math-simplify-expr) flr)))))))
1381 (and (eq (math-quarter-integer (nth 2 math-simplify-expr)) 2)
1382 (let ((temp (math-simplify-sqrt)))
1384 (list '^ temp (math-mul (nth 2 math-simplify-expr) 2)))))))
1386 (math-defsimplify calcFunc-log10
1387 (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
1388 (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 10)
1389 (or math-living-dangerously
1390 (math-known-realp (nth 2 (nth 1 math-simplify-expr))))
1391 (nth 2 (nth 1 math-simplify-expr))))
1394 (math-defsimplify calcFunc-erf
1395 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1396 (math-neg (list 'calcFunc-erf (math-neg (nth 1 math-simplify-expr)))))
1397 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj)
1399 (list 'calcFunc-erf (nth 1 (nth 1 math-simplify-expr)))))))
1401 (math-defsimplify calcFunc-erfc
1402 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1403 (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 math-simplify-expr)))))
1404 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj)
1406 (list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr)))))))
1409 (defun math-linear-in (expr term &optional always)
1410 (if (math-expr-contains expr term)
1412 (p (math-is-polynomial expr term 1)))
1415 (and always (list expr 0))))
1417 (defun math-multiple-of (expr term)
1418 (let ((p (math-linear-in expr term)))
1420 (math-zerop (car p))
1424 (defun math-integer-plus (expr)
1425 (cond ((Math-integerp expr)
1426 (list 0 expr))
1427 ((and (memq (car expr) '(+ -))
1428 (Math-integerp (nth 1 expr)))
1429 (list (if (eq (car expr) '+) (nth 2 expr) (math-neg (nth 2 expr)))
1430 (nth 1 expr)))
1431 ((and (memq (car expr) '(+ -))
1432 (Math-integerp (nth 2 expr)))
1433 (list (nth 1 expr)
1434 (if (eq (car expr) '+) (nth 2 expr) (math-neg (nth 2 expr)))))
1437 (defun math-is-linear (expr &optional always)
1440 (if (eq (car-safe expr) '+)
1441 (if (Math-objectp (nth 1 expr))
1442 (setq offset (nth 1 expr)
1443 expr (nth 2 expr))
1444 (if (Math-objectp (nth 2 expr))
1445 (setq offset (nth 2 expr)
1446 expr (nth 1 expr))))
1447 (if (eq (car-safe expr) '-)
1448 (if (Math-objectp (nth 1 expr))
1449 (setq offset (nth 1 expr)
1450 expr (math-neg (nth 2 expr)))
1451 (if (Math-objectp (nth 2 expr))
1452 (setq offset (math-neg (nth 2 expr))
1453 expr (nth 1 expr))))))
1454 (setq coef (math-is-multiple expr always))
1456 (list offset (or (car coef) 1) (or (nth 1 coef) expr))
1460 (defun math-is-multiple (expr &optional always)
1461 (or (if (eq (car-safe expr) '*)
1462 (if (Math-objectp (nth 1 expr))
1463 (list (nth 1 expr) (nth 2 expr)))
1464 (if (eq (car-safe expr) '/)
1465 (if (and (Math-objectp (nth 1 expr))
1466 (not (math-equal-int (nth 1 expr) 1)))
1467 (list (nth 1 expr) (math-div 1 (nth 2 expr)))
1468 (if (Math-objectp (nth 2 expr))
1469 (list (math-div 1 (nth 2 expr)) (nth 1 expr))
1470 (let ((res (math-is-multiple (nth 1 expr))))
1473 (math-div (nth 2 (nth 1 expr)) (nth 2 expr)))
1474 (setq res (math-is-multiple (nth 2 expr)))
1476 (list (math-div 1 (car res))
1477 (math-div (nth 1 expr)
1478 (nth 2 (nth 2 expr)))))))))
1479 (if (eq (car-safe expr) 'neg)
1480 (list -1 (nth 1 expr)))))
1481 (if (Math-objvecp expr)
1483 (list expr 1))
1485 (list 1 expr)))))
1487 (defun calcFunc-lin (expr &optional var)
1489 (let ((res (math-linear-in expr var t)))
1490 (or res (math-reject-arg expr "Linear term expected"))
1492 (let ((res (math-is-linear expr t)))
1493 (or res (math-reject-arg expr "Linear term expected"))
1496 (defun calcFunc-linnt (expr &optional var)
1498 (let ((res (math-linear-in expr var)))
1499 (or res (math-reject-arg expr "Linear term expected"))
1501 (let ((res (math-is-linear expr)))
1502 (or res (math-reject-arg expr "Linear term expected"))
1505 (defun calcFunc-islin (expr &optional var)
1506 (if (and (Math-objvecp expr) (not var))
1508 (calcFunc-lin expr var)
1511 (defun calcFunc-islinnt (expr &optional var)
1512 (if (Math-objvecp expr)
1514 (calcFunc-linnt expr var)
1522 ;;; Return number of occurrences of thing in expr, or nil if none.
1523 (defun math-expr-contains-count (expr thing)
1524 (cond ((equal expr thing) 1)
1525 ((Math-primp expr) nil)
1528 (while (setq expr (cdr expr))
1529 (setq num (+ num (or (math-expr-contains-count
1530 (car expr) thing) 0))))
1534 (defun math-expr-contains (expr thing)
1535 (cond ((equal expr thing) 1)
1536 ((Math-primp expr) nil)
1538 (while (and (setq expr (cdr expr))
1539 (not (math-expr-contains (car expr) thing))))
1540 expr)))
1542 ;;; Return non-nil if any variable of thing occurs in expr.
1543 (defun math-expr-depends (expr thing)
1546 (math-expr-contains expr thing))
1548 (not (math-expr-depends expr (car thing)))))
1551 ;;; Substitute all occurrences of old for new in expr (non-destructive).
1553 ;; The variables math-expr-subst-old and math-expr-subst-new are local
1554 ;; for math-expr-subst, but used by math-expr-subst-rec.
1555 (defvar math-expr-subst-old)
1556 (defvar math-expr-subst-new)
1558 (defun math-expr-subst (expr math-expr-subst-old math-expr-subst-new)
1559 (math-expr-subst-rec expr))
1561 (defalias 'calcFunc-subst 'math-expr-subst)
1563 (defun math-expr-subst-rec (expr)
1564 (cond ((equal expr math-expr-subst-old) math-expr-subst-new)
1565 ((Math-primp expr) expr)
1566 ((memq (car expr) '(calcFunc-deriv
1568 (if (= (length expr) 2)
1569 (if (equal (nth 1 expr) math-expr-subst-old)
1570 (append expr (list math-expr-subst-new))
1571 expr)
1572 (list (car expr) (nth 1 expr)
1573 (math-expr-subst-rec (nth 2 expr)))))
1575 (cons (car expr)
1576 (mapcar 'math-expr-subst-rec (cdr expr))))))
1579 (defun math-expr-weight (expr)
1580 (if (Math-primp expr)
1583 (while (setq expr (cdr expr))
1584 (setq w (+ w (math-expr-weight (car expr)))))
1587 (defun math-expr-height (expr)
1588 (if (Math-primp expr)
1591 (while (setq expr (cdr expr))
1592 (setq h (max h (math-expr-height (car expr)))))
1600 (defun calcFunc-collect (expr base)
1601 (let ((p (math-is-polynomial expr base 50 t)))
1603 (math-normalize ; fix selection bug
1604 (math-build-polynomial-expr p base))
1605 expr)))
1607 ;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...),
1608 ;;; else return nil if not in polynomial form. If "loose" (math-is-poly-loose),
1611 ;; The variables math-is-poly-degree and math-is-poly-loose are local to
1612 ;; math-is-polynomial, but are used by math-is-poly-rec
1613 (defvar math-is-poly-degree)
1614 (defvar math-is-poly-loose)
1616 (defun math-is-polynomial (expr var &optional math-is-poly-degree math-is-poly-loose)
1617 (let* ((math-poly-base-variable (if math-is-poly-loose
1618 (if (eq math-is-poly-loose 'gen) var '(var XXX XXX))
1619 math-poly-base-variable))
1620 (poly (math-is-poly-rec expr math-poly-neg-powers)))
1621 (and (or (null math-is-poly-degree)
1622 (<= (length poly) (1+ math-is-poly-degree)))
1625 (defun math-is-poly-rec (expr negpow)
1626 (math-poly-simplify
1627 (or (cond ((or (equal expr var)
1628 (eq (car-safe expr) '^))
1630 (expr expr))
1631 (or (equal expr var)
1632 (setq pow (nth 2 expr)
1633 expr (nth 1 expr)))
1634 (or (eq math-poly-mult-powers 1)
1635 (setq pow (let ((m (math-is-multiple pow 1)))
1639 (math-mul (nth 1 m)
1641 (and (if math-poly-mult-powers
1642 (equal math-poly-mult-powers
1644 (setq math-poly-mult-powers (nth 1 m)))
1645 (or (equal expr var)
1646 (eq math-poly-mult-powers 1))
1650 (setq pow (math-to-simple-fraction pow))
1652 math-poly-frac-powers
1653 (equal expr var)
1654 (setq math-poly-frac-powers
1655 (calcFunc-lcm math-poly-frac-powers
1657 (or (memq math-poly-frac-powers '(1 nil))
1658 (setq pow (math-mul pow math-poly-frac-powers)))
1661 (equal expr var))
1664 (let ((p1 (if (equal expr var)
1666 (math-is-poly-rec expr nil)))
1670 (or (null math-is-poly-degree)
1671 (<= (* (1- (length p1)) n) math-is-poly-degree))
1674 (setq accum (math-poly-mul accum p1)
1678 (math-is-poly-rec expr nil)
1679 (setq math-poly-neg-powers
1680 (cons (math-pow expr (- pow))
1681 math-poly-neg-powers))
1682 (list (list '^ expr pow))))))))
1683 ((Math-objectp expr)
1684 (list expr))
1685 ((memq (car expr) '(+ -))
1686 (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
1688 (let ((p2 (math-is-poly-rec (nth 2 expr) negpow)))
1690 (math-poly-mix p1 1 p2
1691 (if (eq (car expr) '+) 1 -1)))))))
1692 ((eq (car expr) 'neg)
1693 (mapcar 'math-neg (math-is-poly-rec (nth 1 expr) negpow)))
1694 ((eq (car expr) '*)
1695 (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
1697 (let ((p2 (math-is-poly-rec (nth 2 expr) negpow)))
1699 (or (null math-is-poly-degree)
1701 math-is-poly-degree))
1702 (math-poly-mul p1 p2))))))
1703 ((eq (car expr) '/)
1704 (and (or (not (math-poly-depends (nth 2 expr) var))
1706 (math-is-poly-rec (nth 2 expr) nil)
1707 (setq math-poly-neg-powers
1708 (cons (nth 2 expr) math-poly-neg-powers))))
1709 (not (Math-zerop (nth 2 expr)))
1710 (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
1711 (mapcar (function (lambda (x) (math-div x (nth 2 expr))))
1713 ((and (eq (car expr) 'calcFunc-exp)
1715 (math-is-poly-rec (list '^ var (nth 1 expr)) negpow))
1716 ((and (eq (car expr) 'calcFunc-sqrt)
1717 math-poly-frac-powers)
1718 (math-is-poly-rec (list '^ (nth 1 expr) '(frac 1 2)) negpow))
1720 (and (or (not (math-poly-depends expr var))
1721 math-is-poly-loose)
1722 (not (eq (car expr) 'vec))
1723 (list expr)))))
1725 ;;; Check if expr is a polynomial in var; if so, return its degree.
1726 (defun math-polynomial-p (expr var)
1727 (cond ((equal expr var) 1)
1728 ((Math-primp expr) 0)
1729 ((memq (car expr) '(+ -))
1730 (let ((p1 (math-polynomial-p (nth 1 expr) var))
1732 (and p1 (setq p2 (math-polynomial-p (nth 2 expr) var))
1734 ((eq (car expr) '*)
1735 (let ((p1 (math-polynomial-p (nth 1 expr) var))
1737 (and p1 (setq p2 (math-polynomial-p (nth 2 expr) var))
1739 ((eq (car expr) 'neg)
1740 (math-polynomial-p (nth 1 expr) var))
1741 ((and (eq (car expr) '/)
1742 (not (math-poly-depends (nth 2 expr) var)))
1743 (math-polynomial-p (nth 1 expr) var))
1744 ((and (eq (car expr) '^)
1745 (natnump (nth 2 expr)))
1746 (let ((p1 (math-polynomial-p (nth 1 expr) var)))
1747 (and p1 (* p1 (nth 2 expr)))))
1748 ((math-poly-depends expr var) nil)
1751 (defun math-poly-depends (expr var)
1752 (if math-poly-base-variable
1753 (math-expr-contains expr math-poly-base-variable)
1754 (math-expr-depends expr var)))
1756 ;;; Find the variable (or sub-expression) which is the base of polynomial expr.
1757 ;; The variables math-poly-base-const-ok and math-poly-base-pred are
1758 ;; local to math-polynomial-base, but are used by math-polynomial-base-rec.
1759 (defvar math-poly-base-const-ok)
1760 (defvar math-poly-base-pred)
1762 ;; The variable math-poly-base-top-expr is local to math-polynomial-base,
1763 ;; but is used by math-polynomial-p1 in calc-poly.el, which is called
1764 ;; by math-polynomial-base.
1766 (defun math-polynomial-base (math-poly-base-top-expr &optional math-poly-base-pred)
1767 (or math-poly-base-pred
1768 (setq math-poly-base-pred (function (lambda (base) (math-polynomial-p
1769 math-poly-base-top-expr base)))))
1770 (or (let ((math-poly-base-const-ok nil))
1771 (math-polynomial-base-rec math-poly-base-top-expr))
1772 (let ((math-poly-base-const-ok t))
1773 (math-polynomial-base-rec math-poly-base-top-expr))))
1775 (defun math-polynomial-base-rec (mpb-expr)
1776 (and (not (Math-objvecp mpb-expr))
1777 (or (and (memq (car mpb-expr) '(+ - *))
1778 (or (math-polynomial-base-rec (nth 1 mpb-expr))
1779 (math-polynomial-base-rec (nth 2 mpb-expr))))
1780 (and (memq (car mpb-expr) '(/ neg))
1781 (math-polynomial-base-rec (nth 1 mpb-expr)))
1782 (and (eq (car mpb-expr) '^)
1783 (math-polynomial-base-rec (nth 1 mpb-expr)))
1784 (and (eq (car mpb-expr) 'calcFunc-exp)
1785 (math-polynomial-base-rec '(var e var-e)))
1786 (and (or math-poly-base-const-ok (math-expr-contains-vars mpb-expr))
1787 (funcall math-poly-base-pred mpb-expr)
1788 mpb-expr))))
1790 ;;; Return non-nil if expr refers to any variables.
1791 (defun math-expr-contains-vars (expr)
1792 (or (eq (car-safe expr) 'var)
1793 (and (not (Math-primp expr))
1795 (while (and (setq expr (cdr expr))
1796 (not (math-expr-contains-vars (car expr)))))
1797 expr))))
1801 (defun math-poly-simplify (p)
1813 (defun math-poly-mix (a ac b bc)
1815 (cons (math-add (math-mul (or (car a) 0) ac)
1816 (math-mul (or (car b) 0) bc))
1817 (math-poly-mix (cdr a) ac (cdr b) bc))))
1819 (defun math-poly-zerop (a)
1824 (defun math-poly-mul (a b)
1826 (math-poly-mix b (car a)
1827 (math-poly-mul (cdr a) (cons 0 b)) 1)))
1830 (defun math-build-polynomial-expr (p var)
1833 (math-with-extra-prec 1
1837 (setq accum (math-add (car rp) (math-mul accum var))))
1841 (accum (math-mul (car rp) (math-pow var n)))
1845 (or (math-zerop (car rp))
1846 (setq accum (list (if (math-looks-negp (car rp)) '- '+)
1848 (math-mul (if (math-looks-negp (car rp))
1849 (math-neg (car rp))
1851 (math-pow var n))))))
1856 (defun math-to-simple-fraction (f)
1859 (math-scale-int (nth 1 f) (nth 2 f)))
1863 (math-make-frac (nth 1 f)
1864 (math-scale-int 1 (- (nth 2 f)))))))