Mercurial > emacs

comparison lisp/calc/calc-alg.el @ 105116:a7d7a357c195

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(var): Define for compiler. Delete trailing whitespace.
author Glenn Morris <rgm@gnu.org>
date Sat, 19 Sep 2009 21:11:40 +0000
parents 209d73c6ff96
children 1d1d5d9bd884
comparison
equal deleted inserted replaced
105115:0c03b224b071 105116:a7d7a357c195
51 (defun calc-simplify () 51 (defun calc-simplify ()
52 (interactive) 52 (interactive)
53 (calc-slow-wrapper 53 (calc-slow-wrapper
54 (let ((top (calc-top-n 1))) 54 (let ((top (calc-top-n 1)))
55 (if (calc-is-inverse) 55 (if (calc-is-inverse)
56 (setq top 56 (setq top
57 (let ((calc-simplify-mode nil)) 57 (let ((calc-simplify-mode nil))
58 (math-normalize (math-trig-rewrite top))))) 58 (math-normalize (math-trig-rewrite top)))))
59 (if (calc-is-hyperbolic) 59 (if (calc-is-hyperbolic)
60 (setq top 60 (setq top
61 (let ((calc-simplify-mode nil)) 61 (let ((calc-simplify-mode nil))
62 (math-normalize (math-hyperbolic-trig-rewrite top))))) 62 (math-normalize (math-hyperbolic-trig-rewrite top)))))
63 (calc-with-default-simplification 63 (calc-with-default-simplification
64 (calc-enter-result 1 "simp" (math-simplify top)))))) 64 (calc-enter-result 1 "simp" (math-simplify top))))))
65 65
351 (list '/ (cons 'calcFunc-cosh newfn) 351 (list '/ (cons 'calcFunc-cosh newfn)
352 (cons 'calcFunc-sinh newfn)))) 352 (cons 'calcFunc-sinh newfn))))
353 (t 353 (t
354 (mapcar 'math-hyperbolic-trig-rewrite fn)))) 354 (mapcar 'math-hyperbolic-trig-rewrite fn))))
355 355
356 ;; math-top-only is local to math-simplify, but is used by 356 ;; math-top-only is local to math-simplify, but is used by
357 ;; math-simplify-step, which is called by math-simplify. 357 ;; math-simplify-step, which is called by math-simplify.
358 (defvar math-top-only) 358 (defvar math-top-only)
359 359
360 (defun math-simplify (top-expr) 360 (defun math-simplify (top-expr)
361 (let ((math-simplifying t) 361 (let ((math-simplifying t)
454 (setcar (cdr math-simplify-expr) x)))) 454 (setcar (cdr math-simplify-expr) x))))
455 (let ((aa math-simplify-expr) 455 (let ((aa math-simplify-expr)
456 aaa temp) 456 aaa temp)
457 (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -)) 457 (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -))
458 (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr) 458 (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr)
459 (eq (car aaa) '-) 459 (eq (car aaa) '-)
460 (eq (car math-simplify-expr) '-) t)) 460 (eq (car math-simplify-expr) '-) t))
461 (progn 461 (progn
462 (setcar (cdr (cdr math-simplify-expr)) temp) 462 (setcar (cdr (cdr math-simplify-expr)) temp)
463 (setcar math-simplify-expr '+) 463 (setcar math-simplify-expr '+)
464 (setcar (cdr (cdr aaa)) 0))) 464 (setcar (cdr (cdr aaa)) 0)))
497 (setcar (cdr (cdr math-simplify-expr)) 497 (setcar (cdr (cdr math-simplify-expr))
498 (math-cancel-common-factor (nth 2 math-simplify-expr) temp)) 498 (math-cancel-common-factor (nth 2 math-simplify-expr) temp))
499 (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp)))) 499 (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp))))
500 (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*) 500 (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*)
501 safe) 501 safe)
502 (if (setq temp (math-combine-prod (nth 1 math-simplify-expr) 502 (if (setq temp (math-combine-prod (nth 1 math-simplify-expr)
503 (nth 1 aaa) nil nil t)) 503 (nth 1 aaa) nil nil t))
504 (progn 504 (progn
505 (setcar (cdr math-simplify-expr) temp) 505 (setcar (cdr math-simplify-expr) temp)
506 (setcar (cdr aaa) 1))) 506 (setcar (cdr aaa) 1)))
507 (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t)) 507 (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t))
511 (progn 511 (progn
512 (setcar (cdr math-simplify-expr) temp) 512 (setcar (cdr math-simplify-expr) temp)
513 (setcar (cdr (cdr aa)) 1))) 513 (setcar (cdr (cdr aa)) 1)))
514 (if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) 514 (if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac)
515 (memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1))) 515 (memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1)))
516 (math-div (math-mul (nth 2 math-simplify-expr) 516 (math-div (math-mul (nth 2 math-simplify-expr)
517 (nth 1 (nth 1 math-simplify-expr))) 517 (nth 1 (nth 1 math-simplify-expr)))
518 (nth 2 (nth 1 math-simplify-expr))) 518 (nth 2 (nth 1 math-simplify-expr)))
519 math-simplify-expr))) 519 math-simplify-expr)))
520 520
521 (math-defsimplify / 521 (math-defsimplify /
522 (math-simplify-divide)) 522 (math-simplify-divide))
523 523
524 (defun math-simplify-divide () 524 (defun math-simplify-divide ()
525 (let ((np (cdr math-simplify-expr)) 525 (let ((np (cdr math-simplify-expr))
526 (nover nil) 526 (nover nil)
527 (nn (and (or (eq (car math-simplify-expr) '/) 527 (nn (and (or (eq (car math-simplify-expr) '/)
528 (not (Math-realp (nth 2 math-simplify-expr)))) 528 (not (Math-realp (nth 2 math-simplify-expr))))
529 (math-common-constant-factor (nth 2 math-simplify-expr)))) 529 (math-common-constant-factor (nth 2 math-simplify-expr))))
530 n op) 530 n op)
531 (if nn 531 (if nn
532 (progn 532 (progn
533 (setq n (and (or (eq (car math-simplify-expr) '/) 533 (setq n (and (or (eq (car math-simplify-expr) '/)
534 (not (Math-realp (nth 1 math-simplify-expr)))) 534 (not (Math-realp (nth 1 math-simplify-expr))))
535 (math-common-constant-factor (nth 1 math-simplify-expr)))) 535 (math-common-constant-factor (nth 1 math-simplify-expr))))
536 (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n)) 536 (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))
537 (progn 537 (progn
538 (setcar (cdr math-simplify-expr) 538 (setcar (cdr math-simplify-expr)
539 (math-mul (nth 2 nn) (nth 1 math-simplify-expr))) 539 (math-mul (nth 2 nn) (nth 1 math-simplify-expr)))
540 (setcar (cdr (cdr math-simplify-expr)) 540 (setcar (cdr (cdr math-simplify-expr))
541 (math-cancel-common-factor (nth 2 math-simplify-expr) nn)) 541 (math-cancel-common-factor (nth 2 math-simplify-expr) nn))
542 (if (and (math-negp nn) 542 (if (and (math-negp nn)
543 (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))) 543 (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table)))
547 (setcar (cdr math-simplify-expr) 547 (setcar (cdr math-simplify-expr)
548 (math-cancel-common-factor (nth 1 math-simplify-expr) n)) 548 (math-cancel-common-factor (nth 1 math-simplify-expr) n))
549 (setcar (cdr (cdr math-simplify-expr)) 549 (setcar (cdr (cdr math-simplify-expr))
550 (math-cancel-common-factor (nth 2 math-simplify-expr) n)) 550 (math-cancel-common-factor (nth 2 math-simplify-expr) n))
551 (if (and (math-negp n) 551 (if (and (math-negp n)
552 (setq op (assq (car math-simplify-expr) 552 (setq op (assq (car math-simplify-expr)
553 calc-tweak-eqn-table))) 553 calc-tweak-eqn-table)))
554 (setcar math-simplify-expr (nth 1 op)))))))) 554 (setcar math-simplify-expr (nth 1 op))))))))
555 (if (and (eq (car-safe (car np)) '/) 555 (if (and (eq (car-safe (car np)) '/)
556 (math-known-scalarp (nth 2 math-simplify-expr) t)) 556 (math-known-scalarp (nth 2 math-simplify-expr) t))
557 (progn 557 (progn
574 ;; are local variables for math-simplify-divisor, but are used by 574 ;; are local variables for math-simplify-divisor, but are used by
575 ;; math-simplify-one-divisor. 575 ;; math-simplify-one-divisor.
576 (defvar math-simplify-divisor-nover) 576 (defvar math-simplify-divisor-nover)
577 (defvar math-simplify-divisor-dover) 577 (defvar math-simplify-divisor-dover)
578 578
579 (defun math-simplify-divisor (np dp math-simplify-divisor-nover 579 (defun math-simplify-divisor (np dp math-simplify-divisor-nover
580 math-simplify-divisor-dover) 580 math-simplify-divisor-dover)
581 (cond ((eq (car-safe (car dp)) '/) 581 (cond ((eq (car-safe (car dp)) '/)
582 (math-simplify-divisor np (cdr (car dp)) 582 (math-simplify-divisor np (cdr (car dp))
583 math-simplify-divisor-nover 583 math-simplify-divisor-nover
584 math-simplify-divisor-dover) 584 math-simplify-divisor-dover)
585 (and (math-known-scalarp (nth 1 (car dp)) t) 585 (and (math-known-scalarp (nth 1 (car dp)) t)
586 (math-simplify-divisor np (cdr (cdr (car dp))) 586 (math-simplify-divisor np (cdr (cdr (car dp)))
587 math-simplify-divisor-nover 587 math-simplify-divisor-nover
588 (not math-simplify-divisor-dover)))) 588 (not math-simplify-divisor-dover))))
589 ((or (or (eq (car math-simplify-expr) '/) 589 ((or (or (eq (car math-simplify-expr) '/)
590 (let ((signs (math-possible-signs (car np)))) 590 (let ((signs (math-possible-signs (car np))))
591 (or (memq signs '(1 4)) 591 (or (memq signs '(1 4))
592 (and (memq (car math-simplify-expr) '(calcFunc-eq calcFunc-neq)) 592 (and (memq (car math-simplify-expr) '(calcFunc-eq calcFunc-neq))
593 (eq signs 5)) 593 (eq signs 5))
594 math-living-dangerously))) 594 math-living-dangerously)))
595 (math-numberp (car np))) 595 (math-numberp (car np)))
596 (let (d 596 (let (d
597 (safe t) 597 (safe t)
598 (scalar (math-known-scalarp (car np)))) 598 (scalar (math-known-scalarp (car np))))
599 (while (and (eq (car-safe (setq d (car dp))) '*) 599 (while (and (eq (car-safe (setq d (car dp))) '*)
600 safe) 600 safe)
601 (math-simplify-one-divisor np (cdr d)) 601 (math-simplify-one-divisor np (cdr d))
602 (setq safe (or scalar (math-known-scalarp (nth 1 d) t)) 602 (setq safe (or scalar (math-known-scalarp (nth 1 d) t))
603 dp (cdr (cdr d)))) 603 dp (cdr (cdr d))))
604 (if safe 604 (if safe
605 (math-simplify-one-divisor np dp)))))) 605 (math-simplify-one-divisor np dp))))))
606 606
607 (defun math-simplify-one-divisor (np dp) 607 (defun math-simplify-one-divisor (np dp)
608 (let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover 608 (let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover
609 math-simplify-divisor-dover t)) 609 math-simplify-divisor-dover t))
610 op) 610 op)
611 (if temp 611 (if temp
612 (progn 612 (progn
613 (and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq))) 613 (and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq)))
614 (math-known-negp (car dp)) 614 (math-known-negp (car dp))
615 (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table)) 615 (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))
616 (setcar math-simplify-expr (nth 1 op))) 616 (setcar math-simplify-expr (nth 1 op)))
617 (setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp)) 617 (setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp))
618 (setcar dp 1)) 618 (setcar dp 1))
619 (and math-simplify-divisor-dover (not math-simplify-divisor-nover) 619 (and math-simplify-divisor-dover (not math-simplify-divisor-nover)
620 (eq (car math-simplify-expr) '/) 620 (eq (car math-simplify-expr) '/)
621 (eq (car-safe (car dp)) 'calcFunc-sqrt) 621 (eq (car-safe (car dp)) 'calcFunc-sqrt)
622 (Math-integerp (nth 1 (car dp))) 622 (Math-integerp (nth 1 (car dp)))
623 (progn 623 (progn
624 (setcar np (math-mul (car np) 624 (setcar np (math-mul (car np)
715 n) 715 n)
716 (while (memq (car-safe (setq n (car np))) '(+ -)) 716 (while (memq (car-safe (setq n (car np))) '(+ -))
717 (math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr)) 717 (math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr))
718 (eq (car n) '-) nil) 718 (eq (car n) '-) nil)
719 (setq np (cdr n))) 719 (setq np (cdr n)))
720 (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil 720 (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil
721 (eq np (cdr math-simplify-expr))) 721 (eq np (cdr math-simplify-expr)))
722 (math-simplify-divide) 722 (math-simplify-divide)
723 (let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr))))) 723 (let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr)))))
724 (or (cond ((eq (car math-simplify-expr) 'calcFunc-eq) 724 (or (cond ((eq (car math-simplify-expr) 'calcFunc-eq)
725 (or (and (eq signs 2) 1) 725 (or (and (eq signs 2) 1)
782 (and (eq calc-angle-mode 'deg) 782 (and (eq calc-angle-mode 'deg)
783 (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) 783 (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
784 (and n 784 (and n
785 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))) 785 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0))))
786 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) 786 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
787 (list 'calcFunc-sqrt (math-sub 1 (math-sqr 787 (list 'calcFunc-sqrt (math-sub 1 (math-sqr
788 (nth 1 (nth 1 math-simplify-expr)))))) 788 (nth 1 (nth 1 math-simplify-expr))))))
789 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) 789 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
790 (math-div (nth 1 (nth 1 math-simplify-expr)) 790 (math-div (nth 1 (nth 1 math-simplify-expr))
791 (list 'calcFunc-sqrt 791 (list 'calcFunc-sqrt
792 (math-add 1 (math-sqr 792 (math-add 1 (math-sqr
793 (nth 1 (nth 1 math-simplify-expr))))))) 793 (nth 1 (nth 1 math-simplify-expr)))))))
794 (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) 794 (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
795 (and m (integerp (car m)) 795 (and m (integerp (car m))
796 (let ((n (car m)) (a (nth 1 m))) 796 (let ((n (car m)) (a (nth 1 m)))
797 (list '+ 797 (list '+
812 (and (eq calc-angle-mode 'deg) 812 (and (eq calc-angle-mode 'deg)
813 (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) 813 (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
814 (and n 814 (and n
815 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))) 815 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))
816 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) 816 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
817 (list 'calcFunc-sqrt 817 (list 'calcFunc-sqrt
818 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))) 818 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))
819 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) 819 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
820 (math-div 1 820 (math-div 1
821 (list 'calcFunc-sqrt 821 (list 'calcFunc-sqrt
822 (math-add 1 822 (math-add 1
823 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) 823 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
824 (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) 824 (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
825 (and m (integerp (car m)) 825 (and m (integerp (car m))
826 (let ((n (car m)) (a (nth 1 m))) 826 (let ((n (car m)) (a (nth 1 m)))
827 (list '- 827 (list '-
840 (and (eq calc-angle-mode 'deg) 840 (and (eq calc-angle-mode 'deg)
841 (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) 841 (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
842 (and n 842 (and n
843 (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))) 843 (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))))
844 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) 844 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
845 (math-div 845 (math-div
846 1 846 1
847 (list 'calcFunc-sqrt 847 (list 'calcFunc-sqrt
848 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) 848 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
849 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) 849 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
850 (math-div 850 (math-div
851 1 851 1
852 (nth 1 (nth 1 math-simplify-expr)))) 852 (nth 1 (nth 1 math-simplify-expr))))
853 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) 853 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
854 (list 'calcFunc-sqrt 854 (list 'calcFunc-sqrt
855 (math-add 1 855 (math-add 1
856 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))) 856 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))))
857 857
858 (math-defsimplify calcFunc-csc 858 (math-defsimplify calcFunc-csc
859 (or (and (math-looks-negp (nth 1 math-simplify-expr)) 859 (or (and (math-looks-negp (nth 1 math-simplify-expr))
860 (math-neg (list 'calcFunc-csc (math-neg (nth 1 math-simplify-expr))))) 860 (math-neg (list 'calcFunc-csc (math-neg (nth 1 math-simplify-expr)))))
867 (and n 867 (and n
868 (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0))))) 868 (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))))
869 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) 869 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
870 (math-div 1 (nth 1 (nth 1 math-simplify-expr)))) 870 (math-div 1 (nth 1 (nth 1 math-simplify-expr))))
871 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) 871 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
872 (math-div 872 (math-div
873 1 873 1
874 (list 'calcFunc-sqrt (math-sub 1 (math-sqr 874 (list 'calcFunc-sqrt (math-sub 1 (math-sqr
875 (nth 1 (nth 1 math-simplify-expr))))))) 875 (nth 1 (nth 1 math-simplify-expr)))))))
876 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) 876 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
877 (math-div (list 'calcFunc-sqrt 877 (math-div (list 'calcFunc-sqrt
878 (math-add 1 (math-sqr 878 (math-add 1 (math-sqr
879 (nth 1 (nth 1 math-simplify-expr))))) 879 (nth 1 (nth 1 math-simplify-expr)))))
880 (nth 1 (nth 1 math-simplify-expr)))))) 880 (nth 1 (nth 1 math-simplify-expr))))))
881 881
882 (defun math-should-expand-trig (x &optional hyperbolic) 882 (defun math-should-expand-trig (x &optional hyperbolic)
883 (let ((m (math-is-multiple x))) 883 (let ((m (math-is-multiple x)))
1019 (nth 1 (nth 1 math-simplify-expr))) 1019 (nth 1 (nth 1 math-simplify-expr)))
1020 (and (math-looks-negp (nth 1 math-simplify-expr)) 1020 (and (math-looks-negp (nth 1 math-simplify-expr))
1021 (math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr))))) 1021 (math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr)))))
1022 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) 1022 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
1023 math-living-dangerously 1023 math-living-dangerously
1024 (list 'calcFunc-sqrt 1024 (list 'calcFunc-sqrt
1025 (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) 1025 (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))
1026 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) 1026 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
1027 math-living-dangerously 1027 math-living-dangerously
1028 (math-div (nth 1 (nth 1 math-simplify-expr)) 1028 (math-div (nth 1 (nth 1 math-simplify-expr))
1029 (list 'calcFunc-sqrt 1029 (list 'calcFunc-sqrt
1043 (nth 1 (nth 1 math-simplify-expr))) 1043 (nth 1 (nth 1 math-simplify-expr)))
1044 (and (math-looks-negp (nth 1 math-simplify-expr)) 1044 (and (math-looks-negp (nth 1 math-simplify-expr))
1045 (list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr)))) 1045 (list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr))))
1046 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) 1046 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
1047 math-living-dangerously 1047 math-living-dangerously
1048 (list 'calcFunc-sqrt 1048 (list 'calcFunc-sqrt
1049 (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) 1049 (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))
1050 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) 1050 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
1051 math-living-dangerously 1051 math-living-dangerously
1052 (math-div 1 1052 (math-div 1
1053 (list 'calcFunc-sqrt 1053 (list 'calcFunc-sqrt
1088 (math-defsimplify calcFunc-sech 1088 (math-defsimplify calcFunc-sech
1089 (or (and (math-looks-negp (nth 1 math-simplify-expr)) 1089 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1090 (list 'calcFunc-sech (math-neg (nth 1 math-simplify-expr)))) 1090 (list 'calcFunc-sech (math-neg (nth 1 math-simplify-expr))))
1091 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) 1091 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
1092 math-living-dangerously 1092 math-living-dangerously
1093 (math-div 1093 (math-div
1094 1 1094 1
1095 (list 'calcFunc-sqrt 1095 (list 'calcFunc-sqrt
1096 (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) 1096 (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
1097 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) 1097 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
1098 math-living-dangerously 1098 math-living-dangerously
1099 (math-div 1 (nth 1 (nth 1 math-simplify-expr))) 1) 1099 (math-div 1 (nth 1 (nth 1 math-simplify-expr))) 1)
1100 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) 1100 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
1108 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) 1108 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
1109 math-living-dangerously 1109 math-living-dangerously
1110 (math-div 1 (nth 1 (nth 1 math-simplify-expr)))) 1110 (math-div 1 (nth 1 (nth 1 math-simplify-expr))))
1111 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) 1111 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
1112 math-living-dangerously 1112 math-living-dangerously
1113 (math-div 1113 (math-div
1114 1 1114 1
1115 (list 'calcFunc-sqrt 1115 (list 'calcFunc-sqrt
1116 (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) 1116 (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
1117 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) 1117 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
1118 math-living-dangerously 1118 math-living-dangerously
1119 (math-div (list 'calcFunc-sqrt 1119 (math-div (list 'calcFunc-sqrt
1120 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))) 1120 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
1203 (math-defsimplify calcFunc-sqrt 1203 (math-defsimplify calcFunc-sqrt
1204 (math-simplify-sqrt)) 1204 (math-simplify-sqrt))
1205 1205
1206 (defun math-simplify-sqrt () 1206 (defun math-simplify-sqrt ()
1207 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) 1207 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac)
1208 (math-div (list 'calcFunc-sqrt 1208 (math-div (list 'calcFunc-sqrt
1209 (math-mul (nth 1 (nth 1 math-simplify-expr)) 1209 (math-mul (nth 1 (nth 1 math-simplify-expr))
1210 (nth 2 (nth 1 math-simplify-expr)))) 1210 (nth 2 (nth 1 math-simplify-expr))))
1211 (nth 2 (nth 1 math-simplify-expr)))) 1211 (nth 2 (nth 1 math-simplify-expr))))
1212 (let ((fac (if (math-objectp (nth 1 math-simplify-expr)) 1212 (let ((fac (if (math-objectp (nth 1 math-simplify-expr))
1213 (math-squared-factor (nth 1 math-simplify-expr)) 1213 (math-squared-factor (nth 1 math-simplify-expr))
1214 (math-common-constant-factor (nth 1 math-simplify-expr))))) 1214 (math-common-constant-factor (nth 1 math-simplify-expr)))))
1215 (and fac (not (eq fac 1)) 1215 (and fac (not (eq fac 1))
1216 (math-mul (math-normalize (list 'calcFunc-sqrt fac)) 1216 (math-mul (math-normalize (list 'calcFunc-sqrt fac))
1217 (math-normalize 1217 (math-normalize
1218 (list 'calcFunc-sqrt 1218 (list 'calcFunc-sqrt
1219 (math-cancel-common-factor 1219 (math-cancel-common-factor
1220 (nth 1 math-simplify-expr) fac)))))) 1220 (nth 1 math-simplify-expr) fac))))))
1221 (and math-living-dangerously 1221 (and math-living-dangerously
1222 (or (and (eq (car-safe (nth 1 math-simplify-expr)) '-) 1222 (or (and (eq (car-safe (nth 1 math-simplify-expr)) '-)
1223 (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 1) 1223 (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 1)
1224 (eq (car-safe (nth 2 (nth 1 math-simplify-expr))) '^) 1224 (eq (car-safe (nth 2 (nth 1 math-simplify-expr))) '^)
1228 (list 'calcFunc-cos 1228 (list 'calcFunc-cos
1229 (nth 1 (nth 1 (nth 2 (nth 1 math-simplify-expr)))))) 1229 (nth 1 (nth 1 (nth 2 (nth 1 math-simplify-expr))))))
1230 (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr)))) 1230 (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr))))
1231 'calcFunc-cos) 1231 'calcFunc-cos)
1232 (list 'calcFunc-sin 1232 (list 'calcFunc-sin
1233 (nth 1 (nth 1 (nth 2 1233 (nth 1 (nth 1 (nth 2
1234 (nth 1 math-simplify-expr)))))))) 1234 (nth 1 math-simplify-expr))))))))
1235 (and (eq (car-safe (nth 1 math-simplify-expr)) '-) 1235 (and (eq (car-safe (nth 1 math-simplify-expr)) '-)
1236 (math-equal-int (nth 2 (nth 1 math-simplify-expr)) 1) 1236 (math-equal-int (nth 2 (nth 1 math-simplify-expr)) 1)
1237 (eq (car-safe (nth 1 (nth 1 math-simplify-expr))) '^) 1237 (eq (car-safe (nth 1 (nth 1 math-simplify-expr))) '^)
1238 (math-equal-int (nth 2 (nth 1 (nth 1 math-simplify-expr))) 2) 1238 (math-equal-int (nth 2 (nth 1 (nth 1 math-simplify-expr))) 2)
1368 (defun math-simplify-pow () 1368 (defun math-simplify-pow ()
1369 (or (and math-living-dangerously 1369 (or (and math-living-dangerously
1370 (or (and (eq (car-safe (nth 1 math-simplify-expr)) '^) 1370 (or (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
1371 (list '^ 1371 (list '^
1372 (nth 1 (nth 1 math-simplify-expr)) 1372 (nth 1 (nth 1 math-simplify-expr))
1373 (math-mul (nth 2 math-simplify-expr) 1373 (math-mul (nth 2 math-simplify-expr)
1374 (nth 2 (nth 1 math-simplify-expr))))) 1374 (nth 2 (nth 1 math-simplify-expr)))))
1375 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt) 1375 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt)
1376 (list '^ 1376 (list '^
1377 (nth 1 (nth 1 math-simplify-expr)) 1377 (nth 1 (nth 1 math-simplify-expr))
1378 (math-div (nth 2 math-simplify-expr) 2))) 1378 (math-div (nth 2 math-simplify-expr) 2)))
1379 (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) 1379 (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
1380 (list (car (nth 1 math-simplify-expr)) 1380 (list (car (nth 1 math-simplify-expr))
1381 (list '^ (nth 1 (nth 1 math-simplify-expr)) 1381 (list '^ (nth 1 (nth 1 math-simplify-expr))
1382 (nth 2 math-simplify-expr)) 1382 (nth 2 math-simplify-expr))
1383 (list '^ (nth 2 (nth 1 math-simplify-expr)) 1383 (list '^ (nth 2 (nth 1 math-simplify-expr))
1384 (nth 2 math-simplify-expr)))))) 1384 (nth 2 math-simplify-expr))))))
1385 (and (math-equal-int (nth 1 math-simplify-expr) 10) 1385 (and (math-equal-int (nth 1 math-simplify-expr) 10)
1386 (eq (car-safe (nth 2 math-simplify-expr)) 'calcFunc-log10) 1386 (eq (car-safe (nth 2 math-simplify-expr)) 'calcFunc-log10)
1387 (nth 1 (nth 2 math-simplify-expr))) 1387 (nth 1 (nth 2 math-simplify-expr)))
1388 (and (equal (nth 1 math-simplify-expr) '(var e var-e)) 1388 (and (equal (nth 1 math-simplify-expr) '(var e var-e))
1389 (math-simplify-exp (nth 2 math-simplify-expr))) 1389 (math-simplify-exp (nth 2 math-simplify-expr)))
1390 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp) 1390 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp)
1391 (not math-integrating) 1391 (not math-integrating)
1392 (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr)) 1392 (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr))
1393 (nth 2 math-simplify-expr)))) 1393 (nth 2 math-simplify-expr))))
1394 (and (equal (nth 1 math-simplify-expr) '(var i var-i)) 1394 (and (equal (nth 1 math-simplify-expr) '(var i var-i))
1395 (math-imaginary-i) 1395 (math-imaginary-i)
1396 (math-num-integerp (nth 2 math-simplify-expr)) 1396 (math-num-integerp (nth 2 math-simplify-expr))
1397 (let ((x (math-mod (math-trunc (nth 2 math-simplify-expr)) 4))) 1397 (let ((x (math-mod (math-trunc (nth 2 math-simplify-expr)) 4)))
1401 ((eq x 3) (math-neg (nth 1 math-simplify-expr)))))) 1401 ((eq x 3) (math-neg (nth 1 math-simplify-expr))))))
1402 (and math-integrating 1402 (and math-integrating
1403 (integerp (nth 2 math-simplify-expr)) 1403 (integerp (nth 2 math-simplify-expr))
1404 (>= (nth 2 math-simplify-expr) 2) 1404 (>= (nth 2 math-simplify-expr) 2)
1405 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) 1405 (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos)
1406 (math-mul (math-pow (nth 1 math-simplify-expr) 1406 (math-mul (math-pow (nth 1 math-simplify-expr)
1407 (- (nth 2 math-simplify-expr) 2)) 1407 (- (nth 2 math-simplify-expr) 2))
1408 (math-sub 1 1408 (math-sub 1
1409 (math-sqr 1409 (math-sqr
1410 (list 'calcFunc-sin 1410 (list 'calcFunc-sin
1411 (nth 1 (nth 1 math-simplify-expr))))))) 1411 (nth 1 (nth 1 math-simplify-expr)))))))
1412 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh) 1412 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh)
1413 (math-mul (math-pow (nth 1 math-simplify-expr) 1413 (math-mul (math-pow (nth 1 math-simplify-expr)
1414 (- (nth 2 math-simplify-expr) 2)) 1414 (- (nth 2 math-simplify-expr) 2))
1415 (math-add 1 1415 (math-add 1
1416 (math-sqr 1416 (math-sqr
1417 (list 'calcFunc-sinh 1417 (list 'calcFunc-sinh
1418 (nth 1 (nth 1 math-simplify-expr))))))))) 1418 (nth 1 (nth 1 math-simplify-expr)))))))))
1441 1441
1442 (math-defsimplify calcFunc-erf 1442 (math-defsimplify calcFunc-erf
1443 (or (and (math-looks-negp (nth 1 math-simplify-expr)) 1443 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1444 (math-neg (list 'calcFunc-erf (math-neg (nth 1 math-simplify-expr))))) 1444 (math-neg (list 'calcFunc-erf (math-neg (nth 1 math-simplify-expr)))))
1445 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) 1445 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj)
1446 (list 'calcFunc-conj 1446 (list 'calcFunc-conj
1447 (list 'calcFunc-erf (nth 1 (nth 1 math-simplify-expr))))))) 1447 (list 'calcFunc-erf (nth 1 (nth 1 math-simplify-expr)))))))
1448 1448
1449 (math-defsimplify calcFunc-erfc 1449 (math-defsimplify calcFunc-erfc
1450 (or (and (math-looks-negp (nth 1 math-simplify-expr)) 1450 (or (and (math-looks-negp (nth 1 math-simplify-expr))
1451 (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 math-simplify-expr))))) 1451 (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 math-simplify-expr)))))
1452 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) 1452 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj)
1453 (list 'calcFunc-conj 1453 (list 'calcFunc-conj
1454 (list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr))))))) 1454 (list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr)))))))
1455 1455
1456 1456
1457 (defun math-linear-in (expr term &optional always) 1457 (defun math-linear-in (expr term &optional always)
1458 (if (math-expr-contains expr term) 1458 (if (math-expr-contains expr term)
1650 (if (cdr p) 1650 (if (cdr p)
1651 (math-build-polynomial-expr (mapcar 'math-normalize p) base) 1651 (math-build-polynomial-expr (mapcar 'math-normalize p) base)
1652 (car p)))) 1652 (car p))))
1653 1653
1654 ;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...), 1654 ;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...),
1655 ;;; else return nil if not in polynomial form. If "loose" (math-is-poly-loose), 1655 ;;; else return nil if not in polynomial form. If "loose" (math-is-poly-loose),
1656 ;;; coefficients may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x. 1656 ;;; coefficients may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x.
1657 1657
1658 ;; The variables math-is-poly-degree and math-is-poly-loose are local to 1658 ;; These variables are local to math-is-polynomial, but are used by
1659 ;; math-is-polynomial, but are used by math-is-poly-rec 1659 ;; math-is-poly-rec.
1660 (defvar math-is-poly-degree) 1660 (defvar math-is-poly-degree)
1661 (defvar math-is-poly-loose) 1661 (defvar math-is-poly-loose)
1662 (defvar var)
1662 1663
1663 (defun math-is-polynomial (expr var &optional math-is-poly-degree math-is-poly-loose) 1664 (defun math-is-polynomial (expr var &optional math-is-poly-degree math-is-poly-loose)
1664 (let* ((math-poly-base-variable (if math-is-poly-loose 1665 (let* ((math-poly-base-variable (if math-is-poly-loose
1665 (if (eq math-is-poly-loose 'gen) var '(var XXX XXX)) 1666 (if (eq math-is-poly-loose 'gen) var '(var XXX XXX))
1666 math-poly-base-variable)) 1667 math-poly-base-variable))
1742 (let ((p1 (math-is-poly-rec (nth 1 expr) negpow))) 1743 (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
1743 (and p1 1744 (and p1
1744 (let ((p2 (math-is-poly-rec (nth 2 expr) negpow))) 1745 (let ((p2 (math-is-poly-rec (nth 2 expr) negpow)))
1745 (and p2 1746 (and p2
1746 (or (null math-is-poly-degree) 1747 (or (null math-is-poly-degree)
1747 (<= (- (+ (length p1) (length p2)) 2) 1748 (<= (- (+ (length p1) (length p2)) 2)
1748 math-is-poly-degree)) 1749 math-is-poly-degree))
1749 (math-poly-mul p1 p2)))))) 1750 (math-poly-mul p1 p2))))))
1750 ((eq (car expr) '/) 1751 ((eq (car expr) '/)
1751 (and (or (not (math-poly-depends (nth 2 expr) var)) 1752 (and (or (not (math-poly-depends (nth 2 expr) var))
1752 (and negpow 1753 (and negpow