aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJay Belanger2004-11-15 06:16:21 +0000
committerJay Belanger2004-11-15 06:16:21 +0000
commitf7adda541101b11ce237bde262f99bcf0e5958ba (patch)
tree0e11c8e926b443b1a88acf93b9253a7525be098f
parent853e2e5e2982770364fc8208febcaf5c27e97d20 (diff)
downloademacs-f7adda541101b11ce237bde262f99bcf0e5958ba.tar.gz
emacs-f7adda541101b11ce237bde262f99bcf0e5958ba.zip
(math-integrate-by-parts): Removed unused variable var-thing.
(math-integ-depth, math-integ-level, math-integral-limit) (math-enable-subst, math-any-substs, math-integ-msg) (math-prev-parts-v, math-good-parts, math-max-integral-limit) (math-int-threshold, math-int-factors, math-double-roots) (math-solve-simplifying, var-IntegLimit, math-solve-sign) (var-GenCount): Declared these variables. (calcFunc-integ): Don't check if var-IntegLimit is bound. (math-integral-cache, math-integral-cache-state): Move declarations to earlier in the file. (math-deriv-var, math-deriv-total, math-deriv-symb): New variables. (math-derivative, calcFunc-deriv, calcFunc-tderiv): Replace variables deriv-var, deriv-total and deriv-symb by declared variables math-deriv-var, math-deriv-total and math-deriv-symb. (math-cur-record): New variable. (math-integral, math-replace-integral-parts, math-integrate-by-parts) (calc-dump-integral-cache, math-try-integral): Replace variable cur-record by declared variable math-cur-record. (math-has-rules): New variable. (math-try-integral, math-do-integral): Use declared variable math-has-rules instead of has-rules. (math-t1, math-t2, math-t3): New variables. (math-do-integral, math-do-integral-methods, math-try-solve-for) (math-try-solve-prod, math-solve-poly-funny-powers) (math-solve-crunch-poly, math-decompose-poly) (math-solve-find-root-term, math-find-root-in-prod): Replace variables t1, t2, t3 by declared variables math-t1, math-t2, math-t3. (math-so-far, math-integ-expr): New variables. (math-do-integral-methods, math-integ-try-linear-substitutions) (math-integ-try-substitutions): Replace variables so-far and expr by declared variables math-so-far and math-integ-expr. (math-expr-parts): New variable. (math-expr-rational-in, math-expr-rational-in-rec): Replace variable parts by declared variable math-expr-parts. (calc-low, calc-high): New variables. (calcFunc-table, math-scan-for-limits): Replaced variable low and high with the declared variable calc-low and calc-high. (math-solve-var, math-solve-full): New variables. (math-try-solve-for, math-try-solve-prod, math-solve-prod) (math-decompose-poly, math-solve-quartic, math-poly-all-roots) (math-solve-find-root-in-prod, math-solve-for, math-solve-system) (math-solve-system-rec, math-solve-get-sign, math-solve-get-int): Replace variables solve-var and solve-full with declared variables math-solve-var and math-solve-full. (math-solve-vars): New variable. (math-solve-system, math-solve-system-rec): Replace variable solve-vars with declared variable math-solve-vars. (math-try-solve-sign): New variable. (math-try-solve-for, math-try-solve-prod): Replace variable sign by declared variable math-try-solve-sign. (math-solve-b): New variable. (math-solve-poly-funny-powers, math-decompose-poly): Replace variable b by declared variable math-solve-b. (math-solve-system-vv, math-solve-res): New variables (math-solve-system-rec, math-solve-system-subst): Replaced variables vv and res with declared variables math-solve-system-vv and math-solve-system-res.
Diffstat
-rw-r--r--lisp/calc/calcalg2.el1052
1 files changed, 604 insertions, 448 deletions
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index ff23c3e5421..b7c837c7b4f 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -201,13 +201,19 @@
201 (prefix-numeric-value nterms)))))) 201 (prefix-numeric-value nterms))))))
202 202
203 203
204(defun math-derivative (expr) ; uses global values: deriv-var, deriv-total. 204;; The following are global variables used by math-derivative and some
205 (cond ((equal expr deriv-var) 205;; related functions
206(defvar math-deriv-var)
207(defvar math-deriv-total)
208(defvar math-deriv-symb)
209
210(defun math-derivative (expr)
211 (cond ((equal expr math-deriv-var)
206 1) 212 1)
207 ((or (Math-scalarp expr) 213 ((or (Math-scalarp expr)
208 (eq (car expr) 'sdev) 214 (eq (car expr) 'sdev)
209 (and (eq (car expr) 'var) 215 (and (eq (car expr) 'var)
210 (or (not deriv-total) 216 (or (not math-deriv-total)
211 (math-const-var expr) 217 (math-const-var expr)
212 (progn 218 (progn
213 (math-setup-declarations) 219 (math-setup-declarations)
@@ -279,20 +285,20 @@
279 (let ((handler (get (car expr) 'math-derivative-n))) 285 (let ((handler (get (car expr) 'math-derivative-n)))
280 (and handler 286 (and handler
281 (funcall handler expr))))) 287 (funcall handler expr)))))
282 (and (not (eq deriv-symb 'pre-expand)) 288 (and (not (eq math-deriv-symb 'pre-expand))
283 (let ((exp (math-expand-formula expr))) 289 (let ((exp (math-expand-formula expr)))
284 (and exp 290 (and exp
285 (or (let ((deriv-symb 'pre-expand)) 291 (or (let ((math-deriv-symb 'pre-expand))
286 (catch 'math-deriv (math-derivative expr))) 292 (catch 'math-deriv (math-derivative expr)))
287 (math-derivative exp))))) 293 (math-derivative exp)))))
288 (if (or (Math-objvecp expr) 294 (if (or (Math-objvecp expr)
289 (eq (car expr) 'var) 295 (eq (car expr) 'var)
290 (not (symbolp (car expr)))) 296 (not (symbolp (car expr))))
291 (if deriv-symb 297 (if math-deriv-symb
292 (throw 'math-deriv nil) 298 (throw 'math-deriv nil)
293 (list (if deriv-total 'calcFunc-tderiv 'calcFunc-deriv) 299 (list (if math-deriv-total 'calcFunc-tderiv 'calcFunc-deriv)
294 expr 300 expr
295 deriv-var)) 301 math-deriv-var))
296 (let ((accum 0) 302 (let ((accum 0)
297 (arg expr) 303 (arg expr)
298 (n 1) 304 (n 1)
@@ -322,7 +328,7 @@
322 (let ((handler (get func prop))) 328 (let ((handler (get func prop)))
323 (or (and prop handler 329 (or (and prop handler
324 (apply handler (cdr expr))) 330 (apply handler (cdr expr)))
325 (if (and deriv-symb 331 (if (and math-deriv-symb
326 (not (get func 332 (not (get func
327 'calc-user-defn))) 333 'calc-user-defn)))
328 (throw 'math-deriv nil) 334 (throw 'math-deriv nil)
@@ -330,27 +336,27 @@
330 (setq n (1+ n))) 336 (setq n (1+ n)))
331 accum)))))) 337 accum))))))
332 338
333(defun calcFunc-deriv (expr deriv-var &optional deriv-value deriv-symb) 339(defun calcFunc-deriv (expr math-deriv-var &optional deriv-value math-deriv-symb)
334 (let* ((deriv-total nil) 340 (let* ((math-deriv-total nil)
335 (res (catch 'math-deriv (math-derivative expr)))) 341 (res (catch 'math-deriv (math-derivative expr))))
336 (or (eq (car-safe res) 'calcFunc-deriv) 342 (or (eq (car-safe res) 'calcFunc-deriv)
337 (null res) 343 (null res)
338 (setq res (math-normalize res))) 344 (setq res (math-normalize res)))
339 (and res 345 (and res
340 (if deriv-value 346 (if deriv-value
341 (math-expr-subst res deriv-var deriv-value) 347 (math-expr-subst res math-deriv-var deriv-value)
342 res)))) 348 res))))
343 349
344(defun calcFunc-tderiv (expr deriv-var &optional deriv-value deriv-symb) 350(defun calcFunc-tderiv (expr math-deriv-var &optional deriv-value math-deriv-symb)
345 (math-setup-declarations) 351 (math-setup-declarations)
346 (let* ((deriv-total t) 352 (let* ((math-deriv-total t)
347 (res (catch 'math-deriv (math-derivative expr)))) 353 (res (catch 'math-deriv (math-derivative expr))))
348 (or (eq (car-safe res) 'calcFunc-tderiv) 354 (or (eq (car-safe res) 'calcFunc-tderiv)
349 (null res) 355 (null res)
350 (setq res (math-normalize res))) 356 (setq res (math-normalize res)))
351 (and res 357 (and res
352 (if deriv-value 358 (if deriv-value
353 (math-expr-subst res deriv-var deriv-value) 359 (math-expr-subst res math-deriv-var deriv-value)
354 res)))) 360 res))))
355 361
356(put 'calcFunc-inv\' 'math-derivative-1 362(put 'calcFunc-inv\' 'math-derivative-1
@@ -540,7 +546,7 @@
540(put 'calcFunc-sum 'math-derivative-n 546(put 'calcFunc-sum 'math-derivative-n
541 (function 547 (function
542 (lambda (expr) 548 (lambda (expr)
543 (if (math-expr-contains (cons 'vec (cdr (cdr expr))) deriv-var) 549 (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
544 (throw 'math-deriv nil) 550 (throw 'math-deriv nil)
545 (cons 'calcFunc-sum 551 (cons 'calcFunc-sum
546 (cons (math-derivative (nth 1 expr)) 552 (cons (math-derivative (nth 1 expr))
@@ -549,7 +555,7 @@
549(put 'calcFunc-prod 'math-derivative-n 555(put 'calcFunc-prod 'math-derivative-n
550 (function 556 (function
551 (lambda (expr) 557 (lambda (expr)
552 (if (math-expr-contains (cons 'vec (cdr (cdr expr))) deriv-var) 558 (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
553 (throw 'math-deriv nil) 559 (throw 'math-deriv nil)
554 (math-mul expr 560 (math-mul expr
555 (cons 'calcFunc-sum 561 (cons 'calcFunc-sum
@@ -561,7 +567,7 @@
561 (function 567 (function
562 (lambda (expr) 568 (lambda (expr)
563 (if (= (length expr) 3) 569 (if (= (length expr) 3)
564 (if (equal (nth 2 expr) deriv-var) 570 (if (equal (nth 2 expr) math-deriv-var)
565 (nth 1 expr) 571 (nth 1 expr)
566 (math-normalize 572 (math-normalize
567 (list 'calcFunc-integ 573 (list 'calcFunc-integ
@@ -576,7 +582,7 @@
576 (math-derivative (nth 4 expr))) 582 (math-derivative (nth 4 expr)))
577 (math-mul lower 583 (math-mul lower
578 (math-derivative (nth 3 expr)))) 584 (math-derivative (nth 3 expr))))
579 (if (equal (nth 2 expr) deriv-var) 585 (if (equal (nth 2 expr) math-deriv-var)
580 0 586 0
581 (math-normalize 587 (math-normalize
582 (list 'calcFunc-integ 588 (list 'calcFunc-integ
@@ -605,6 +611,21 @@
605(defvar math-integ-var-list (list math-integ-var)) 611(defvar math-integ-var-list (list math-integ-var))
606(defvar math-integ-var-list-list (list math-integ-var-list)) 612(defvar math-integ-var-list-list (list math-integ-var-list))
607 613
614;; math-integ-depth is a local variable for math-try-integral, but is used
615;; by math-integral and math-tracing-integral
616;; which are called (directly or indirectly) by math-try-integral.
617(defvar math-integ-depth)
618;; math-integ-level is a local variable for math-try-integral, but is used
619;; by math-integral, math-do-integral, math-tracing-integral,
620;; math-sub-integration, math-integrate-by-parts and
621;; math-integrate-by-substitution, which are called (directly or
622;; indirectly) by math-try-integral.
623(defvar math-integ-level)
624;; math-integral-limit is a local variable for calcFunc-integ, but is
625;; used by math-tracing-integral, math-sub-integration and
626;; math-try-integration.
627(defvar math-integral-limit)
628
608(defmacro math-tracing-integral (&rest parts) 629(defmacro math-tracing-integral (&rest parts)
609 (list 'and 630 (list 'and
610 'trace-buffer 631 'trace-buffer
@@ -629,28 +650,46 @@
629;;; ( A parts ) Currently working, integ-by-parts; 650;;; ( A parts ) Currently working, integ-by-parts;
630;;; ( A parts2 ) Currently working, integ-by-parts; 651;;; ( A parts2 ) Currently working, integ-by-parts;
631;;; ( A cancelled ) Ignore this cache entry; 652;;; ( A cancelled ) Ignore this cache entry;
632;;; ( A [B] ) Same result as for cur-record = B. 653;;; ( A [B] ) Same result as for math-cur-record = B.
654
655;; math-cur-record is a local variable for math-try-integral, but is used
656;; by math-integral, math-replace-integral-parts and math-integrate-by-parts
657;; which are called (directly or indirectly) by math-try-integral, as well as
658;; by calc-dump-integral-cache
659(defvar math-cur-record)
660;; math-enable-subst and math-any-substs are local variables for
661;; calcFunc-integ, but are used by math-integral and math-try-integral.
662(defvar math-enable-subst)
663(defvar math-any-substs)
664
665;; math-integ-msg is a local variable for math-try-integral, but is
666;; used (both locally and non-locally) by math-integral.
667(defvar math-integ-msg)
668
669(defvar math-integral-cache nil)
670(defvar math-integral-cache-state nil)
671
633(defun math-integral (expr &optional simplify same-as-above) 672(defun math-integral (expr &optional simplify same-as-above)
634 (let* ((simp cur-record) 673 (let* ((simp math-cur-record)
635 (cur-record (assoc expr math-integral-cache)) 674 (math-cur-record (assoc expr math-integral-cache))
636 (math-integ-depth (1+ math-integ-depth)) 675 (math-integ-depth (1+ math-integ-depth))
637 (val 'cancelled)) 676 (val 'cancelled))
638 (math-tracing-integral "Integrating " 677 (math-tracing-integral "Integrating "
639 (math-format-value expr 1000) 678 (math-format-value expr 1000)
640 "...\n") 679 "...\n")
641 (and cur-record 680 (and math-cur-record
642 (progn 681 (progn
643 (math-tracing-integral "Found " 682 (math-tracing-integral "Found "
644 (math-format-value (nth 1 cur-record) 1000)) 683 (math-format-value (nth 1 math-cur-record) 1000))
645 (and (consp (nth 1 cur-record)) 684 (and (consp (nth 1 math-cur-record))
646 (math-replace-integral-parts cur-record)) 685 (math-replace-integral-parts math-cur-record))
647 (math-tracing-integral " => " 686 (math-tracing-integral " => "
648 (math-format-value (nth 1 cur-record) 1000) 687 (math-format-value (nth 1 math-cur-record) 1000)
649 "\n"))) 688 "\n")))
650 (or (and cur-record 689 (or (and math-cur-record
651 (not (eq (nth 1 cur-record) 'cancelled)) 690 (not (eq (nth 1 math-cur-record) 'cancelled))
652 (or (not (integerp (nth 1 cur-record))) 691 (or (not (integerp (nth 1 math-cur-record)))
653 (>= (nth 1 cur-record) math-integ-level))) 692 (>= (nth 1 math-cur-record) math-integ-level)))
654 (and (math-integral-contains-parts expr) 693 (and (math-integral-contains-parts expr)
655 (progn 694 (progn
656 (setq val nil) 695 (setq val nil)
@@ -665,12 +704,12 @@
665 "Working... Integrating %s" 704 "Working... Integrating %s"
666 (math-format-flat-expr expr 0))) 705 (math-format-flat-expr expr 0)))
667 (message math-integ-msg))) 706 (message math-integ-msg)))
668 (if cur-record 707 (if math-cur-record
669 (setcar (cdr cur-record) 708 (setcar (cdr math-cur-record)
670 (if same-as-above (vector simp) 'busy)) 709 (if same-as-above (vector simp) 'busy))
671 (setq cur-record 710 (setq math-cur-record
672 (list expr (if same-as-above (vector simp) 'busy)) 711 (list expr (if same-as-above (vector simp) 'busy))
673 math-integral-cache (cons cur-record 712 math-integral-cache (cons math-cur-record
674 math-integral-cache))) 713 math-integral-cache)))
675 (if (eq simplify 'yes) 714 (if (eq simplify 'yes)
676 (progn 715 (progn
@@ -692,12 +731,12 @@
692 (setq val (math-integral simp 'no t)))))))) 731 (setq val (math-integral simp 'no t))))))))
693 (if (eq calc-display-working-message 'lots) 732 (if (eq calc-display-working-message 'lots)
694 (message math-integ-msg))) 733 (message math-integ-msg)))
695 (setcar (cdr cur-record) (or val 734 (setcar (cdr math-cur-record) (or val
696 (if (or math-enable-subst 735 (if (or math-enable-subst
697 (not math-any-substs)) 736 (not math-any-substs))
698 math-integ-level 737 math-integ-level
699 'cancelled))))) 738 'cancelled)))))
700 (setq val cur-record) 739 (setq val math-cur-record)
701 (while (vectorp (nth 1 val)) 740 (while (vectorp (nth 1 val))
702 (setq val (aref (nth 1 val) 0))) 741 (setq val (aref (nth 1 val) 0)))
703 (setq val (if (memq (nth 1 val) '(parts parts2)) 742 (setq val (if (memq (nth 1 val) '(parts parts2))
@@ -712,8 +751,6 @@
712 (math-format-value val 1000) 751 (math-format-value val 1000)
713 "\n") 752 "\n")
714 val)) 753 val))
715(defvar math-integral-cache nil)
716(defvar math-integral-cache-state nil)
717 754
718(defun math-integral-contains-parts (expr) 755(defun math-integral-contains-parts (expr)
719 (if (Math-primp expr) 756 (if (Math-primp expr)
@@ -735,37 +772,58 @@
735 (progn 772 (progn
736 (setcar expr (nth 1 (nth 2 (car expr)))) 773 (setcar expr (nth 1 (nth 2 (car expr))))
737 (math-replace-integral-parts (cons 'foo expr))) 774 (math-replace-integral-parts (cons 'foo expr)))
738 (setcar (cdr cur-record) 'cancelled))) 775 (setcar (cdr math-cur-record) 'cancelled)))
739 (math-replace-integral-parts (car expr))))))) 776 (math-replace-integral-parts (car expr)))))))
740 777
741(defvar math-linear-subst-tried t 778(defvar math-linear-subst-tried t
742 "Non-nil means that a linear substitution has been tried.") 779 "Non-nil means that a linear substitution has been tried.")
743 780
781;; The variable math-has-rules is a local variable for math-try-integral,
782;; but is used by math-do-integral, which is called (non-directly) by
783;; math-try-integral.
784(defvar math-has-rules)
785
786;; math-old-integ is a local variable for math-do-integral, but is
787;; used by math-sub-integration.
788(defvar math-old-integ)
789
790;; The variables math-t1, math-t2 and math-t3 are local to
791;; math-do-integral, math-try-solve-for and math-decompose-poly, but
792;; are used by functions they call (directly or indirectly);
793;; math-do-integral calls math-do-integral-methods;
794;; math-try-solve-for calls math-try-solve-prod,
795;; math-solve-find-root-term and math-solve-find-root-in-prod;
796;; math-decompose-poly calls math-solve-poly-funny-powers and
797;; math-solve-crunch-poly.
798(defvar math-t1)
799(defvar math-t2)
800(defvar math-t3)
801
744(defun math-do-integral (expr) 802(defun math-do-integral (expr)
745 (let ((math-linear-subst-tried nil) 803 (let ((math-linear-subst-tried nil)
746 t1 t2) 804 math-t1 math-t2)
747 (or (cond ((not (math-expr-contains expr math-integ-var)) 805 (or (cond ((not (math-expr-contains expr math-integ-var))
748 (math-mul expr math-integ-var)) 806 (math-mul expr math-integ-var))
749 ((equal expr math-integ-var) 807 ((equal expr math-integ-var)
750 (math-div (math-sqr expr) 2)) 808 (math-div (math-sqr expr) 2))
751 ((eq (car expr) '+) 809 ((eq (car expr) '+)
752 (and (setq t1 (math-integral (nth 1 expr))) 810 (and (setq math-t1 (math-integral (nth 1 expr)))
753 (setq t2 (math-integral (nth 2 expr))) 811 (setq math-t2 (math-integral (nth 2 expr)))
754 (math-add t1 t2))) 812 (math-add math-t1 math-t2)))
755 ((eq (car expr) '-) 813 ((eq (car expr) '-)
756 (and (setq t1 (math-integral (nth 1 expr))) 814 (and (setq math-t1 (math-integral (nth 1 expr)))
757 (setq t2 (math-integral (nth 2 expr))) 815 (setq math-t2 (math-integral (nth 2 expr)))
758 (math-sub t1 t2))) 816 (math-sub math-t1 math-t2)))
759 ((eq (car expr) 'neg) 817 ((eq (car expr) 'neg)
760 (and (setq t1 (math-integral (nth 1 expr))) 818 (and (setq math-t1 (math-integral (nth 1 expr)))
761 (math-neg t1))) 819 (math-neg math-t1)))
762 ((eq (car expr) '*) 820 ((eq (car expr) '*)
763 (cond ((not (math-expr-contains (nth 1 expr) math-integ-var)) 821 (cond ((not (math-expr-contains (nth 1 expr) math-integ-var))
764 (and (setq t1 (math-integral (nth 2 expr))) 822 (and (setq math-t1 (math-integral (nth 2 expr)))
765 (math-mul (nth 1 expr) t1))) 823 (math-mul (nth 1 expr) math-t1)))
766 ((not (math-expr-contains (nth 2 expr) math-integ-var)) 824 ((not (math-expr-contains (nth 2 expr) math-integ-var))
767 (and (setq t1 (math-integral (nth 1 expr))) 825 (and (setq math-t1 (math-integral (nth 1 expr)))
768 (math-mul t1 (nth 2 expr)))) 826 (math-mul math-t1 (nth 2 expr))))
769 ((memq (car-safe (nth 1 expr)) '(+ -)) 827 ((memq (car-safe (nth 1 expr)) '(+ -))
770 (math-integral (list (car (nth 1 expr)) 828 (math-integral (list (car (nth 1 expr))
771 (math-mul (nth 1 (nth 1 expr)) 829 (math-mul (nth 1 (nth 1 expr))
@@ -784,39 +842,39 @@
784 (cond ((and (not (math-expr-contains (nth 1 expr) 842 (cond ((and (not (math-expr-contains (nth 1 expr)
785 math-integ-var)) 843 math-integ-var))
786 (not (math-equal-int (nth 1 expr) 1))) 844 (not (math-equal-int (nth 1 expr) 1)))
787 (and (setq t1 (math-integral (math-div 1 (nth 2 expr)))) 845 (and (setq math-t1 (math-integral (math-div 1 (nth 2 expr))))
788 (math-mul (nth 1 expr) t1))) 846 (math-mul (nth 1 expr) math-t1)))
789 ((not (math-expr-contains (nth 2 expr) math-integ-var)) 847 ((not (math-expr-contains (nth 2 expr) math-integ-var))
790 (and (setq t1 (math-integral (nth 1 expr))) 848 (and (setq math-t1 (math-integral (nth 1 expr)))
791 (math-div t1 (nth 2 expr)))) 849 (math-div math-t1 (nth 2 expr))))
792 ((and (eq (car-safe (nth 1 expr)) '*) 850 ((and (eq (car-safe (nth 1 expr)) '*)
793 (not (math-expr-contains (nth 1 (nth 1 expr)) 851 (not (math-expr-contains (nth 1 (nth 1 expr))
794 math-integ-var))) 852 math-integ-var)))
795 (and (setq t1 (math-integral 853 (and (setq math-t1 (math-integral
796 (math-div (nth 2 (nth 1 expr)) 854 (math-div (nth 2 (nth 1 expr))
797 (nth 2 expr)))) 855 (nth 2 expr))))
798 (math-mul t1 (nth 1 (nth 1 expr))))) 856 (math-mul math-t1 (nth 1 (nth 1 expr)))))
799 ((and (eq (car-safe (nth 1 expr)) '*) 857 ((and (eq (car-safe (nth 1 expr)) '*)
800 (not (math-expr-contains (nth 2 (nth 1 expr)) 858 (not (math-expr-contains (nth 2 (nth 1 expr))
801 math-integ-var))) 859 math-integ-var)))
802 (and (setq t1 (math-integral 860 (and (setq math-t1 (math-integral
803 (math-div (nth 1 (nth 1 expr)) 861 (math-div (nth 1 (nth 1 expr))
804 (nth 2 expr)))) 862 (nth 2 expr))))
805 (math-mul t1 (nth 2 (nth 1 expr))))) 863 (math-mul math-t1 (nth 2 (nth 1 expr)))))
806 ((and (eq (car-safe (nth 2 expr)) '*) 864 ((and (eq (car-safe (nth 2 expr)) '*)
807 (not (math-expr-contains (nth 1 (nth 2 expr)) 865 (not (math-expr-contains (nth 1 (nth 2 expr))
808 math-integ-var))) 866 math-integ-var)))
809 (and (setq t1 (math-integral 867 (and (setq math-t1 (math-integral
810 (math-div (nth 1 expr) 868 (math-div (nth 1 expr)
811 (nth 2 (nth 2 expr))))) 869 (nth 2 (nth 2 expr)))))
812 (math-div t1 (nth 1 (nth 2 expr))))) 870 (math-div math-t1 (nth 1 (nth 2 expr)))))
813 ((and (eq (car-safe (nth 2 expr)) '*) 871 ((and (eq (car-safe (nth 2 expr)) '*)
814 (not (math-expr-contains (nth 2 (nth 2 expr)) 872 (not (math-expr-contains (nth 2 (nth 2 expr))
815 math-integ-var))) 873 math-integ-var)))
816 (and (setq t1 (math-integral 874 (and (setq math-t1 (math-integral
817 (math-div (nth 1 expr) 875 (math-div (nth 1 expr)
818 (nth 1 (nth 2 expr))))) 876 (nth 1 (nth 2 expr)))))
819 (math-div t1 (nth 2 (nth 2 expr))))) 877 (math-div math-t1 (nth 2 (nth 2 expr)))))
820 ((eq (car-safe (nth 2 expr)) 'calcFunc-exp) 878 ((eq (car-safe (nth 2 expr)) 'calcFunc-exp)
821 (math-integral 879 (math-integral
822 (math-mul (nth 1 expr) 880 (math-mul (nth 1 expr)
@@ -824,10 +882,10 @@
824 (math-neg (nth 1 (nth 2 expr))))))))) 882 (math-neg (nth 1 (nth 2 expr)))))))))
825 ((eq (car expr) '^) 883 ((eq (car expr) '^)
826 (cond ((not (math-expr-contains (nth 1 expr) math-integ-var)) 884 (cond ((not (math-expr-contains (nth 1 expr) math-integ-var))
827 (or (and (setq t1 (math-is-polynomial (nth 2 expr) 885 (or (and (setq math-t1 (math-is-polynomial (nth 2 expr)
828 math-integ-var 1)) 886 math-integ-var 1))
829 (math-div expr 887 (math-div expr
830 (math-mul (nth 1 t1) 888 (math-mul (nth 1 math-t1)
831 (math-normalize 889 (math-normalize
832 (list 'calcFunc-ln 890 (list 'calcFunc-ln
833 (nth 1 expr)))))) 891 (nth 1 expr))))))
@@ -843,12 +901,12 @@
843 (math-integral 901 (math-integral
844 (list '/ 1 (math-pow (nth 1 expr) (- (nth 2 expr)))) 902 (list '/ 1 (math-pow (nth 1 expr) (- (nth 2 expr))))
845 nil t) 903 nil t)
846 (or (and (setq t1 (math-is-polynomial (nth 1 expr) 904 (or (and (setq math-t1 (math-is-polynomial (nth 1 expr)
847 math-integ-var 905 math-integ-var
848 1)) 906 1))
849 (setq t2 (math-add (nth 2 expr) 1)) 907 (setq math-t2 (math-add (nth 2 expr) 1))
850 (math-div (math-pow (nth 1 expr) t2) 908 (math-div (math-pow (nth 1 expr) math-t2)
851 (math-mul t2 (nth 1 t1)))) 909 (math-mul math-t2 (nth 1 math-t1))))
852 (and (Math-negp (nth 2 expr)) 910 (and (Math-negp (nth 2 expr))
853 (math-integral 911 (math-integral
854 (math-div 1 912 (math-div 1
@@ -859,49 +917,49 @@
859 nil)))))) 917 nil))))))
860 918
861 ;; Integral of a polynomial. 919 ;; Integral of a polynomial.
862 (and (setq t1 (math-is-polynomial expr math-integ-var 20)) 920 (and (setq math-t1 (math-is-polynomial expr math-integ-var 20))
863 (let ((accum 0) 921 (let ((accum 0)
864 (n 1)) 922 (n 1))
865 (while t1 923 (while math-t1
866 (if (setq accum (math-add accum 924 (if (setq accum (math-add accum
867 (math-div (math-mul (car t1) 925 (math-div (math-mul (car math-t1)
868 (math-pow 926 (math-pow
869 math-integ-var 927 math-integ-var
870 n)) 928 n))
871 n)) 929 n))
872 t1 (cdr t1)) 930 math-t1 (cdr math-t1))
873 (setq n (1+ n)))) 931 (setq n (1+ n))))
874 accum)) 932 accum))
875 933
876 ;; Try looking it up! 934 ;; Try looking it up!
877 (cond ((= (length expr) 2) 935 (cond ((= (length expr) 2)
878 (and (symbolp (car expr)) 936 (and (symbolp (car expr))
879 (setq t1 (get (car expr) 'math-integral)) 937 (setq math-t1 (get (car expr) 'math-integral))
880 (progn 938 (progn
881 (while (and t1 939 (while (and math-t1
882 (not (setq t2 (funcall (car t1) 940 (not (setq math-t2 (funcall (car math-t1)
883 (nth 1 expr))))) 941 (nth 1 expr)))))
884 (setq t1 (cdr t1))) 942 (setq math-t1 (cdr math-t1)))
885 (and t2 (math-normalize t2))))) 943 (and math-t2 (math-normalize math-t2)))))
886 ((= (length expr) 3) 944 ((= (length expr) 3)
887 (and (symbolp (car expr)) 945 (and (symbolp (car expr))
888 (setq t1 (get (car expr) 'math-integral-2)) 946 (setq math-t1 (get (car expr) 'math-integral-2))
889 (progn 947 (progn
890 (while (and t1 948 (while (and math-t1
891 (not (setq t2 (funcall (car t1) 949 (not (setq math-t2 (funcall (car math-t1)
892 (nth 1 expr) 950 (nth 1 expr)
893 (nth 2 expr))))) 951 (nth 2 expr)))))
894 (setq t1 (cdr t1))) 952 (setq math-t1 (cdr math-t1)))
895 (and t2 (math-normalize t2)))))) 953 (and math-t2 (math-normalize math-t2))))))
896 954
897 ;; Integral of a rational function. 955 ;; Integral of a rational function.
898 (and (math-ratpoly-p expr math-integ-var) 956 (and (math-ratpoly-p expr math-integ-var)
899 (setq t1 (calcFunc-apart expr math-integ-var)) 957 (setq math-t1 (calcFunc-apart expr math-integ-var))
900 (not (equal t1 expr)) 958 (not (equal math-t1 expr))
901 (math-integral t1)) 959 (math-integral math-t1))
902 960
903 ;; Try user-defined integration rules. 961 ;; Try user-defined integration rules.
904 (and has-rules 962 (and math-has-rules
905 (let ((math-old-integ (symbol-function 'calcFunc-integ)) 963 (let ((math-old-integ (symbol-function 'calcFunc-integ))
906 (input (list 'calcFunc-integtry expr math-integ-var)) 964 (input (list 'calcFunc-integtry expr math-integ-var))
907 res part) 965 res part)
@@ -975,17 +1033,27 @@
975 res))) 1033 res)))
976 (list 'calcFunc-integfailed expr))) 1034 (list 'calcFunc-integfailed expr)))
977 1035
978(defun math-do-integral-methods (expr) 1036;; math-so-far is a local variable for math-do-integral-methods, but
979 (let ((so-far math-integ-var-list-list) 1037;; is used by math-integ-try-linear-substitutions and
1038;; math-integ-try-substitutions.
1039(defvar math-so-far)
1040
1041;; math-integ-expr is a local variable for math-do-integral-methods,
1042;; but is used by math-integ-try-linear-substitutions and
1043;; math-integ-try-substitutions.
1044(defvar math-integ-expr)
1045
1046(defun math-do-integral-methods (math-integ-expr)
1047 (let ((math-so-far math-integ-var-list-list)
980 rat-in) 1048 rat-in)
981 1049
982 ;; Integration by substitution, for various likely sub-expressions. 1050 ;; Integration by substitution, for various likely sub-expressions.
983 ;; (In first pass, we look only for sub-exprs that are linear in X.) 1051 ;; (In first pass, we look only for sub-exprs that are linear in X.)
984 (or (math-integ-try-linear-substitutions expr) 1052 (or (math-integ-try-linear-substitutions math-integ-expr)
985 (math-integ-try-substitutions expr) 1053 (math-integ-try-substitutions math-integ-expr)
986 1054
987 ;; If function has sines and cosines, try tan(x/2) substitution. 1055 ;; If function has sines and cosines, try tan(x/2) substitution.
988 (and (let ((p (setq rat-in (math-expr-rational-in expr)))) 1056 (and (let ((p (setq rat-in (math-expr-rational-in math-integ-expr))))
989 (while (and p 1057 (while (and p
990 (memq (car (car p)) '(calcFunc-sin 1058 (memq (car (car p)) '(calcFunc-sin
991 calcFunc-cos 1059 calcFunc-cos
@@ -993,10 +1061,10 @@
993 (equal (nth 1 (car p)) math-integ-var)) 1061 (equal (nth 1 (car p)) math-integ-var))
994 (setq p (cdr p))) 1062 (setq p (cdr p)))
995 (null p)) 1063 (null p))
996 (or (and (math-integ-parts-easy expr) 1064 (or (and (math-integ-parts-easy math-integ-expr)
997 (math-integ-try-parts expr t)) 1065 (math-integ-try-parts math-integ-expr t))
998 (math-integrate-by-good-substitution 1066 (math-integrate-by-good-substitution
999 expr (list 'calcFunc-tan (math-div math-integ-var 2))))) 1067 math-integ-expr (list 'calcFunc-tan (math-div math-integ-var 2)))))
1000 1068
1001 ;; If function has sinh and cosh, try tanh(x/2) substitution. 1069 ;; If function has sinh and cosh, try tanh(x/2) substitution.
1002 (and (let ((p rat-in)) 1070 (and (let ((p rat-in))
@@ -1008,55 +1076,55 @@
1008 (equal (nth 1 (car p)) math-integ-var)) 1076 (equal (nth 1 (car p)) math-integ-var))
1009 (setq p (cdr p))) 1077 (setq p (cdr p)))
1010 (null p)) 1078 (null p))
1011 (or (and (math-integ-parts-easy expr) 1079 (or (and (math-integ-parts-easy math-integ-expr)
1012 (math-integ-try-parts expr t)) 1080 (math-integ-try-parts math-integ-expr t))
1013 (math-integrate-by-good-substitution 1081 (math-integrate-by-good-substitution
1014 expr (list 'calcFunc-tanh (math-div math-integ-var 2))))) 1082 math-integ-expr (list 'calcFunc-tanh (math-div math-integ-var 2)))))
1015 1083
1016 ;; If function has square roots, try sin, tan, or sec substitution. 1084 ;; If function has square roots, try sin, tan, or sec substitution.
1017 (and (let ((p rat-in)) 1085 (and (let ((p rat-in))
1018 (setq t1 nil) 1086 (setq math-t1 nil)
1019 (while (and p 1087 (while (and p
1020 (or (equal (car p) math-integ-var) 1088 (or (equal (car p) math-integ-var)
1021 (and (eq (car (car p)) 'calcFunc-sqrt) 1089 (and (eq (car (car p)) 'calcFunc-sqrt)
1022 (setq t1 (math-is-polynomial 1090 (setq math-t1 (math-is-polynomial
1023 (nth 1 (setq t2 (car p))) 1091 (nth 1 (setq math-t2 (car p)))
1024 math-integ-var 2))))) 1092 math-integ-var 2)))))
1025 (setq p (cdr p))) 1093 (setq p (cdr p)))
1026 (and (null p) t1)) 1094 (and (null p) math-t1))
1027 (if (cdr (cdr t1)) 1095 (if (cdr (cdr math-t1))
1028 (if (math-guess-if-neg (nth 2 t1)) 1096 (if (math-guess-if-neg (nth 2 math-t1))
1029 (let* ((c (math-sqrt (math-neg (nth 2 t1)))) 1097 (let* ((c (math-sqrt (math-neg (nth 2 math-t1))))
1030 (d (math-div (nth 1 t1) (math-mul -2 c))) 1098 (d (math-div (nth 1 math-t1) (math-mul -2 c)))
1031 (a (math-sqrt (math-add (car t1) (math-sqr d))))) 1099 (a (math-sqrt (math-add (car math-t1) (math-sqr d)))))
1032 (math-integrate-by-good-substitution 1100 (math-integrate-by-good-substitution
1033 expr (list 'calcFunc-arcsin 1101 math-integ-expr (list 'calcFunc-arcsin
1034 (math-div-thru 1102 (math-div-thru
1035 (math-add (math-mul c math-integ-var) d) 1103 (math-add (math-mul c math-integ-var) d)
1036 a)))) 1104 a))))
1037 (let* ((c (math-sqrt (nth 2 t1))) 1105 (let* ((c (math-sqrt (nth 2 math-t1)))
1038 (d (math-div (nth 1 t1) (math-mul 2 c))) 1106 (d (math-div (nth 1 math-t1) (math-mul 2 c)))
1039 (aa (math-sub (car t1) (math-sqr d)))) 1107 (aa (math-sub (car math-t1) (math-sqr d))))
1040 (if (and nil (not (and (eq d 0) (eq c 1)))) 1108 (if (and nil (not (and (eq d 0) (eq c 1))))
1041 (math-integrate-by-good-substitution 1109 (math-integrate-by-good-substitution
1042 expr (math-add (math-mul c math-integ-var) d)) 1110 math-integ-expr (math-add (math-mul c math-integ-var) d))
1043 (if (math-guess-if-neg aa) 1111 (if (math-guess-if-neg aa)
1044 (math-integrate-by-good-substitution 1112 (math-integrate-by-good-substitution
1045 expr (list 'calcFunc-arccosh 1113 math-integ-expr (list 'calcFunc-arccosh
1046 (math-div-thru 1114 (math-div-thru
1047 (math-add (math-mul c math-integ-var) 1115 (math-add (math-mul c math-integ-var)
1048 d) 1116 d)
1049 (math-sqrt (math-neg aa))))) 1117 (math-sqrt (math-neg aa)))))
1050 (math-integrate-by-good-substitution 1118 (math-integrate-by-good-substitution
1051 expr (list 'calcFunc-arcsinh 1119 math-integ-expr (list 'calcFunc-arcsinh
1052 (math-div-thru 1120 (math-div-thru
1053 (math-add (math-mul c math-integ-var) 1121 (math-add (math-mul c math-integ-var)
1054 d) 1122 d)
1055 (math-sqrt aa)))))))) 1123 (math-sqrt aa))))))))
1056 (math-integrate-by-good-substitution expr t2)) ) 1124 (math-integrate-by-good-substitution math-integ-expr math-t2)) )
1057 1125
1058 ;; Try integration by parts. 1126 ;; Try integration by parts.
1059 (math-integ-try-parts expr) 1127 (math-integ-try-parts math-integ-expr)
1060 1128
1061 ;; Give up. 1129 ;; Give up.
1062 nil))) 1130 nil)))
@@ -1076,6 +1144,15 @@
1076 (math-integ-parts-easy (nth 1 expr))) 1144 (math-integ-parts-easy (nth 1 expr)))
1077 (t t))) 1145 (t t)))
1078 1146
1147;; math-prev-parts-v is local to calcFunc-integ (as well as
1148;; math-integrate-by-parts), but is used by math-integ-try-parts.
1149(defvar math-prev-parts-v)
1150
1151;; math-good-parts is local to calcFunc-integ (as well as
1152;; math-integ-try-parts), but is used by math-integrate-by-parts.
1153(defvar math-good-parts)
1154
1155
1079(defun math-integ-try-parts (expr &optional math-good-parts) 1156(defun math-integ-try-parts (expr &optional math-good-parts)
1080 ;; Integration by parts: 1157 ;; Integration by parts:
1081 ;; integ(f(x) g(x),x) = f(x) h(x) - integ(h(x) f'(x),x) 1158 ;; integ(f(x) g(x),x) = f(x) h(x) - integ(h(x) f'(x),x)
@@ -1112,7 +1189,7 @@
1112 (and (>= math-integ-level 0) 1189 (and (>= math-integ-level 0)
1113 (unwind-protect 1190 (unwind-protect
1114 (progn 1191 (progn
1115 (setcar (cdr cur-record) 'parts) 1192 (setcar (cdr math-cur-record) 'parts)
1116 (math-tracing-integral "Integrating by parts, u = " 1193 (math-tracing-integral "Integrating by parts, u = "
1117 (math-format-value u 1000) 1194 (math-format-value u 1000)
1118 ", v' = " 1195 ", v' = "
@@ -1123,15 +1200,14 @@
1123 (setq temp (let ((math-prev-parts-v v)) 1200 (setq temp (let ((math-prev-parts-v v))
1124 (math-integral (math-mul v temp) 'yes))) 1201 (math-integral (math-mul v temp) 'yes)))
1125 (setq temp (math-sub (math-mul u v) temp)) 1202 (setq temp (math-sub (math-mul u v) temp))
1126 (if (eq (nth 1 cur-record) 'parts) 1203 (if (eq (nth 1 math-cur-record) 'parts)
1127 (calcFunc-expand temp) 1204 (calcFunc-expand temp)
1128 (setq v (list 'var 'PARTS cur-record) 1205 (setq v (list 'var 'PARTS math-cur-record)
1129 var-thing (list 'vec (math-sub v temp) v)
1130 temp (let (calc-next-why) 1206 temp (let (calc-next-why)
1131 (math-solve-for (math-sub v temp) 0 v nil))) 1207 (math-solve-for (math-sub v temp) 0 v nil)))
1132 (and temp (not (integerp temp)) 1208 (and temp (not (integerp temp))
1133 (math-simplify-extended temp))))) 1209 (math-simplify-extended temp)))))
1134 (setcar (cdr cur-record) 'busy))))) 1210 (setcar (cdr math-cur-record) 'busy)))))
1135 1211
1136;;; This tries two different formulations, hoping the algebraic simplifier 1212;;; This tries two different formulations, hoping the algebraic simplifier
1137;;; will be strong enough to handle at least one. 1213;;; will be strong enough to handle at least one.
@@ -1202,13 +1278,13 @@
1202 (while (and (setq sub-expr (cdr sub-expr)) 1278 (while (and (setq sub-expr (cdr sub-expr))
1203 (or (not (math-linear-in (car sub-expr) 1279 (or (not (math-linear-in (car sub-expr)
1204 math-integ-var)) 1280 math-integ-var))
1205 (assoc (car sub-expr) so-far) 1281 (assoc (car sub-expr) math-so-far)
1206 (progn 1282 (progn
1207 (setq so-far (cons (list (car sub-expr)) 1283 (setq math-so-far (cons (list (car sub-expr))
1208 so-far)) 1284 math-so-far))
1209 (not (setq res 1285 (not (setq res
1210 (math-integrate-by-substitution 1286 (math-integrate-by-substitution
1211 expr (car sub-expr)))))))) 1287 math-integ-expr (car sub-expr))))))))
1212 res)) 1288 res))
1213 (let ((res nil)) 1289 (let ((res nil))
1214 (while (and (setq sub-expr (cdr sub-expr)) 1290 (while (and (setq sub-expr (cdr sub-expr))
@@ -1219,15 +1295,15 @@
1219;;; Recursively try different substitutions based on various sub-expressions. 1295;;; Recursively try different substitutions based on various sub-expressions.
1220(defun math-integ-try-substitutions (sub-expr &optional allow-rat) 1296(defun math-integ-try-substitutions (sub-expr &optional allow-rat)
1221 (and (not (Math-primp sub-expr)) 1297 (and (not (Math-primp sub-expr))
1222 (not (assoc sub-expr so-far)) 1298 (not (assoc sub-expr math-so-far))
1223 (math-expr-contains sub-expr math-integ-var) 1299 (math-expr-contains sub-expr math-integ-var)
1224 (or (and (if (and (not (memq (car sub-expr) '(+ - * / neg))) 1300 (or (and (if (and (not (memq (car sub-expr) '(+ - * / neg)))
1225 (not (and (eq (car sub-expr) '^) 1301 (not (and (eq (car sub-expr) '^)
1226 (integerp (nth 2 sub-expr))))) 1302 (integerp (nth 2 sub-expr)))))
1227 (setq allow-rat t) 1303 (setq allow-rat t)
1228 (prog1 allow-rat (setq allow-rat nil))) 1304 (prog1 allow-rat (setq allow-rat nil)))
1229 (not (eq sub-expr expr)) 1305 (not (eq sub-expr math-integ-expr))
1230 (or (math-integrate-by-substitution expr sub-expr) 1306 (or (math-integrate-by-substitution math-integ-expr sub-expr)
1231 (and (eq (car sub-expr) '^) 1307 (and (eq (car sub-expr) '^)
1232 (integerp (nth 2 sub-expr)) 1308 (integerp (nth 2 sub-expr))
1233 (< (nth 2 sub-expr) 0) 1309 (< (nth 2 sub-expr) 0)
@@ -1235,22 +1311,25 @@
1235 (math-pow (nth 1 sub-expr) (- (nth 2 sub-expr))) 1311 (math-pow (nth 1 sub-expr) (- (nth 2 sub-expr)))
1236 t)))) 1312 t))))
1237 (let ((res nil)) 1313 (let ((res nil))
1238 (setq so-far (cons (list sub-expr) so-far)) 1314 (setq math-so-far (cons (list sub-expr) math-so-far))
1239 (while (and (setq sub-expr (cdr sub-expr)) 1315 (while (and (setq sub-expr (cdr sub-expr))
1240 (not (setq res (math-integ-try-substitutions 1316 (not (setq res (math-integ-try-substitutions
1241 (car sub-expr) allow-rat))))) 1317 (car sub-expr) allow-rat)))))
1242 res)))) 1318 res))))
1243 1319
1320;; The variable math-expr-parts is local to math-expr-rational-in,
1321;; but is used by math-expr-rational-in-rec
1322
1244(defun math-expr-rational-in (expr) 1323(defun math-expr-rational-in (expr)
1245 (let ((parts nil)) 1324 (let ((math-expr-parts nil))
1246 (math-expr-rational-in-rec expr) 1325 (math-expr-rational-in-rec expr)
1247 (mapcar 'car parts))) 1326 (mapcar 'car math-expr-parts)))
1248 1327
1249(defun math-expr-rational-in-rec (expr) 1328(defun math-expr-rational-in-rec (expr)
1250 (cond ((Math-primp expr) 1329 (cond ((Math-primp expr)
1251 (and (equal expr math-integ-var) 1330 (and (equal expr math-integ-var)
1252 (not (assoc expr parts)) 1331 (not (assoc expr math-expr-parts))
1253 (setq parts (cons (list expr) parts)))) 1332 (setq math-expr-parts (cons (list expr) math-expr-parts))))
1254 ((or (memq (car expr) '(+ - * / neg)) 1333 ((or (memq (car expr) '(+ - * / neg))
1255 (and (eq (car expr) '^) (integerp (nth 2 expr)))) 1334 (and (eq (car expr) '^) (integerp (nth 2 expr))))
1256 (math-expr-rational-in-rec (nth 1 expr)) 1335 (math-expr-rational-in-rec (nth 1 expr))
@@ -1259,9 +1338,9 @@
1259 (eq (math-quarter-integer (nth 2 expr)) 2)) 1338 (eq (math-quarter-integer (nth 2 expr)) 2))
1260 (math-expr-rational-in-rec (list 'calcFunc-sqrt (nth 1 expr)))) 1339 (math-expr-rational-in-rec (list 'calcFunc-sqrt (nth 1 expr))))
1261 (t 1340 (t
1262 (and (not (assoc expr parts)) 1341 (and (not (assoc expr math-expr-parts))
1263 (math-expr-contains expr math-integ-var) 1342 (math-expr-contains expr math-integ-var)
1264 (setq parts (cons (list expr) parts)))))) 1343 (setq math-expr-parts (cons (list expr) math-expr-parts))))))
1265 1344
1266(defun math-expr-calls (expr funcs &optional arg-contains) 1345(defun math-expr-calls (expr funcs &optional arg-contains)
1267 (if (consp expr) 1346 (if (consp expr)
@@ -1295,32 +1374,36 @@
1295 (let ((buf (current-buffer))) 1374 (let ((buf (current-buffer)))
1296 (unwind-protect 1375 (unwind-protect
1297 (let ((p math-integral-cache) 1376 (let ((p math-integral-cache)
1298 cur-record) 1377 math-cur-record)
1299 (display-buffer (get-buffer-create "*Integral Cache*")) 1378 (display-buffer (get-buffer-create "*Integral Cache*"))
1300 (set-buffer (get-buffer "*Integral Cache*")) 1379 (set-buffer (get-buffer "*Integral Cache*"))
1301 (erase-buffer) 1380 (erase-buffer)
1302 (while p 1381 (while p
1303 (setq cur-record (car p)) 1382 (setq math-cur-record (car p))
1304 (or arg (math-replace-integral-parts cur-record)) 1383 (or arg (math-replace-integral-parts math-cur-record))
1305 (insert (math-format-flat-expr (car cur-record) 0) 1384 (insert (math-format-flat-expr (car math-cur-record) 0)
1306 " --> " 1385 " --> "
1307 (if (symbolp (nth 1 cur-record)) 1386 (if (symbolp (nth 1 math-cur-record))
1308 (concat "(" (symbol-name (nth 1 cur-record)) ")") 1387 (concat "(" (symbol-name (nth 1 math-cur-record)) ")")
1309 (math-format-flat-expr (nth 1 cur-record) 0)) 1388 (math-format-flat-expr (nth 1 math-cur-record) 0))
1310 "\n") 1389 "\n")
1311 (setq p (cdr p))) 1390 (setq p (cdr p)))
1312 (goto-char (point-min))) 1391 (goto-char (point-min)))
1313 (set-buffer buf)))) 1392 (set-buffer buf))))
1314 1393
1394;; The variable math-max-integral-limit is local to calcFunc-integ,
1395;; but is used by math-try-integral.
1396(defvar math-max-integral-limit)
1397
1315(defun math-try-integral (expr) 1398(defun math-try-integral (expr)
1316 (let ((math-integ-level math-integral-limit) 1399 (let ((math-integ-level math-integral-limit)
1317 (math-integ-depth 0) 1400 (math-integ-depth 0)
1318 (math-integ-msg "Working...done") 1401 (math-integ-msg "Working...done")
1319 (cur-record nil) ; a technicality 1402 (math-cur-record nil) ; a technicality
1320 (math-integrating t) 1403 (math-integrating t)
1321 (calc-prefer-frac t) 1404 (calc-prefer-frac t)
1322 (calc-symbolic-mode t) 1405 (calc-symbolic-mode t)
1323 (has-rules (calc-has-rules 'var-IntegRules))) 1406 (math-has-rules (calc-has-rules 'var-IntegRules)))
1324 (or (math-integral expr 'yes) 1407 (or (math-integral expr 'yes)
1325 (and math-any-substs 1408 (and math-any-substs
1326 (setq math-enable-subst t) 1409 (setq math-enable-subst t)
@@ -1330,6 +1413,8 @@
1330 math-integ-level math-integral-limit) 1413 math-integ-level math-integral-limit)
1331 (math-integral expr 'yes))))) 1414 (math-integral expr 'yes)))))
1332 1415
1416(defvar var-IntegLimit nil)
1417
1333(defun calcFunc-integ (expr var &optional low high) 1418(defun calcFunc-integ (expr var &optional low high)
1334 (cond 1419 (cond
1335 ;; Do these even if the parts turn out not to be integrable. 1420 ;; Do these even if the parts turn out not to be integrable.
@@ -1392,8 +1477,7 @@
1392 (or (equal state math-integral-cache-state) 1477 (or (equal state math-integral-cache-state)
1393 (setq math-integral-cache-state state 1478 (setq math-integral-cache-state state
1394 math-integral-cache nil))) 1479 math-integral-cache nil)))
1395 (let* ((math-max-integral-limit (or (and (boundp 'var-IntegLimit) 1480 (let* ((math-max-integral-limit (or (and (natnump var-IntegLimit)
1396 (natnump var-IntegLimit)
1397 var-IntegLimit) 1481 var-IntegLimit)
1398 3)) 1482 3))
1399 (math-integral-limit 1) 1483 (math-integral-limit 1)
@@ -1714,22 +1798,29 @@
1714 1798
1715(defvar math-tabulate-initial nil) 1799(defvar math-tabulate-initial nil)
1716(defvar math-tabulate-function nil) 1800(defvar math-tabulate-function nil)
1717(defun calcFunc-table (expr var &optional low high step) 1801
1718 (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf))) 1802;; The variables calc-low and calc-high are local to calcFunc-table,
1719 (or high (setq high low low 1)) 1803;; but are used by math-scan-for-limits.
1720 (and (or (math-infinitep low) (math-infinitep high)) 1804(defvar calc-low)
1805(defvar calc-high)
1806
1807(defun calcFunc-table (expr var &optional calc-low calc-high step)
1808 (or calc-low
1809 (setq calc-low '(neg (var inf var-inf)) calc-high '(var inf var-inf)))
1810 (or calc-high (setq calc-high calc-low calc-low 1))
1811 (and (or (math-infinitep calc-low) (math-infinitep calc-high))
1721 (not step) 1812 (not step)
1722 (math-scan-for-limits expr)) 1813 (math-scan-for-limits expr))
1723 (and step (math-zerop step) (math-reject-arg step 'nonzerop)) 1814 (and step (math-zerop step) (math-reject-arg step 'nonzerop))
1724 (let ((known (+ (if (Math-objectp low) 1 0) 1815 (let ((known (+ (if (Math-objectp calc-low) 1 0)
1725 (if (Math-objectp high) 1 0) 1816 (if (Math-objectp calc-high) 1 0)
1726 (if (or (null step) (Math-objectp step)) 1 0))) 1817 (if (or (null step) (Math-objectp step)) 1 0)))
1727 (count '(var inf var-inf)) 1818 (count '(var inf var-inf))
1728 vec) 1819 vec)
1729 (or (= known 2) ; handy optimization 1820 (or (= known 2) ; handy optimization
1730 (equal high '(var inf var-inf)) 1821 (equal calc-high '(var inf var-inf))
1731 (progn 1822 (progn
1732 (setq count (math-div (math-sub high low) (or step 1))) 1823 (setq count (math-div (math-sub calc-high calc-low) (or step 1)))
1733 (or (Math-objectp count) 1824 (or (Math-objectp count)
1734 (setq count (math-simplify count))) 1825 (setq count (math-simplify count)))
1735 (if (Math-messy-integerp count) 1826 (if (Math-messy-integerp count)
@@ -1745,30 +1836,30 @@
1745 (math-expr-subst expr var '(var DUMMY var-DUMMY)))) 1836 (math-expr-subst expr var '(var DUMMY var-DUMMY))))
1746 (while (>= count 0) 1837 (while (>= count 0)
1747 (setq math-working-step (1+ math-working-step) 1838 (setq math-working-step (1+ math-working-step)
1748 var-DUMMY low 1839 var-DUMMY calc-low
1749 vec (cond ((eq math-tabulate-function 'calcFunc-sum) 1840 vec (cond ((eq math-tabulate-function 'calcFunc-sum)
1750 (math-add vec (math-evaluate-expr expr))) 1841 (math-add vec (math-evaluate-expr expr)))
1751 ((eq math-tabulate-function 'calcFunc-prod) 1842 ((eq math-tabulate-function 'calcFunc-prod)
1752 (math-mul vec (math-evaluate-expr expr))) 1843 (math-mul vec (math-evaluate-expr expr)))
1753 (t 1844 (t
1754 (cons (math-evaluate-expr expr) vec))) 1845 (cons (math-evaluate-expr expr) vec)))
1755 low (math-add low (or step 1)) 1846 calc-low (math-add calc-low (or step 1))
1756 count (1- count))) 1847 count (1- count)))
1757 (if math-tabulate-function 1848 (if math-tabulate-function
1758 vec 1849 vec
1759 (cons 'vec (nreverse vec)))) 1850 (cons 'vec (nreverse vec))))
1760 (if (Math-integerp count) 1851 (if (Math-integerp count)
1761 (calc-record-why 'fixnump high) 1852 (calc-record-why 'fixnump calc-high)
1762 (if (Math-num-integerp low) 1853 (if (Math-num-integerp calc-low)
1763 (if (Math-num-integerp high) 1854 (if (Math-num-integerp calc-high)
1764 (calc-record-why 'integerp step) 1855 (calc-record-why 'integerp step)
1765 (calc-record-why 'integerp high)) 1856 (calc-record-why 'integerp calc-high))
1766 (calc-record-why 'integerp low))) 1857 (calc-record-why 'integerp calc-low)))
1767 (append (list (or math-tabulate-function 'calcFunc-table) 1858 (append (list (or math-tabulate-function 'calcFunc-table)
1768 expr var) 1859 expr var)
1769 (and (not (and (equal low '(neg (var inf var-inf))) 1860 (and (not (and (equal calc-low '(neg (var inf var-inf)))
1770 (equal high '(var inf var-inf)))) 1861 (equal calc-high '(var inf var-inf))))
1771 (list low high)) 1862 (list calc-low calc-high))
1772 (and step (list step)))))) 1863 (and step (list step))))))
1773 1864
1774(defun math-scan-for-limits (x) 1865(defun math-scan-for-limits (x)
@@ -1785,8 +1876,8 @@
1785 high-val (math-realp high-val)) 1876 high-val (math-realp high-val))
1786 (and (Math-lessp high-val low-val) 1877 (and (Math-lessp high-val low-val)
1787 (setq temp low-val low-val high-val high-val temp)) 1878 (setq temp low-val low-val high-val high-val temp))
1788 (setq low (math-max low (math-ceiling low-val)) 1879 (setq calc-low (math-max calc-low (math-ceiling low-val))
1789 high (math-min high (math-floor high-val))))) 1880 calc-high (math-min calc-high (math-floor high-val)))))
1790 (t 1881 (t
1791 (while (setq x (cdr x)) 1882 (while (setq x (cdr x))
1792 (math-scan-for-limits (car x)))))) 1883 (math-scan-for-limits (car x))))))
@@ -2173,15 +2264,29 @@
2173 2264
2174 2265
2175(defvar math-solve-ranges nil) 2266(defvar math-solve-ranges nil)
2176;;; Attempt to reduce lhs = rhs to solve-var = rhs', where solve-var appears 2267(defvar math-solve-sign)
2177;;; in lhs but not in rhs or rhs'; return rhs'. 2268;;; Attempt to reduce math-solve-lhs = math-solve-rhs to
2178;;; Uses global values: solve-*. 2269;;; math-solve-var = math-solve-rhs', where math-solve-var appears
2179(defun math-try-solve-for (lhs rhs &optional sign no-poly) 2270;;; in math-solve-lhs but not in math-solve-rhs or math-solve-rhs';
2180 (let (t1 t2 t3) 2271;;; return math-solve-rhs'.
2181 (cond ((equal lhs solve-var) 2272;;; Uses global values: math-solve-var, math-solve-full.
2182 (setq math-solve-sign sign) 2273(defvar math-solve-var)
2183 (if (eq solve-full 'all) 2274(defvar math-solve-full)
2184 (let ((vec (list 'vec (math-evaluate-expr rhs))) 2275
2276;; The variables math-solve-lhs, math-solve-rhs and math-try-solve-sign
2277;; are local to math-try-solve-for, but are used by math-try-solve-prod.
2278;; (math-solve-lhs and math-solve-rhs are is also local to
2279;; math-decompose-poly, but used by math-solve-poly-funny-powers.)
2280(defvar math-solve-lhs)
2281(defvar math-solve-rhs)
2282
2283(defun math-try-solve-for
2284 (math-solve-lhs math-solve-rhs &optional math-try-solve-sign no-poly)
2285 (let (math-t1 math-t2 math-t3)
2286 (cond ((equal math-solve-lhs math-solve-var)
2287 (setq math-solve-sign math-try-solve-sign)
2288 (if (eq math-solve-full 'all)
2289 (let ((vec (list 'vec (math-evaluate-expr math-solve-rhs)))
2185 newvec var p) 2290 newvec var p)
2186 (while math-solve-ranges 2291 (while math-solve-ranges
2187 (setq p (car math-solve-ranges) 2292 (setq p (car math-solve-ranges)
@@ -2194,238 +2299,253 @@
2194 (setq vec newvec 2299 (setq vec newvec
2195 math-solve-ranges (cdr math-solve-ranges))) 2300 math-solve-ranges (cdr math-solve-ranges)))
2196 (math-normalize vec)) 2301 (math-normalize vec))
2197 rhs)) 2302 math-solve-rhs))
2198 ((Math-primp lhs) 2303 ((Math-primp math-solve-lhs)
2199 nil) 2304 nil)
2200 ((and (eq (car lhs) '-) 2305 ((and (eq (car math-solve-lhs) '-)
2201 (eq (car-safe (nth 1 lhs)) (car-safe (nth 2 lhs))) 2306 (eq (car-safe (nth 1 math-solve-lhs)) (car-safe (nth 2 math-solve-lhs)))
2202 (Math-zerop rhs) 2307 (Math-zerop math-solve-rhs)
2203 (= (length (nth 1 lhs)) 2) 2308 (= (length (nth 1 math-solve-lhs)) 2)
2204 (= (length (nth 2 lhs)) 2) 2309 (= (length (nth 2 math-solve-lhs)) 2)
2205 (setq t1 (get (car (nth 1 lhs)) 'math-inverse)) 2310 (setq math-t1 (get (car (nth 1 math-solve-lhs)) 'math-inverse))
2206 (setq t2 (funcall t1 '(var SOLVEDUM SOLVEDUM))) 2311 (setq math-t2 (funcall math-t1 '(var SOLVEDUM SOLVEDUM)))
2207 (eq (math-expr-contains-count t2 '(var SOLVEDUM SOLVEDUM)) 1) 2312 (eq (math-expr-contains-count math-t2 '(var SOLVEDUM SOLVEDUM)) 1)
2208 (setq t3 (math-solve-above-dummy t2)) 2313 (setq math-t3 (math-solve-above-dummy math-t2))
2209 (setq t1 (math-try-solve-for (math-sub (nth 1 (nth 1 lhs)) 2314 (setq math-t1 (math-try-solve-for
2210 (math-expr-subst 2315 (math-sub (nth 1 (nth 1 math-solve-lhs))
2211 t2 t3 2316 (math-expr-subst
2212 (nth 1 (nth 2 lhs)))) 2317 math-t2 math-t3
2213 0))) 2318 (nth 1 (nth 2 math-solve-lhs))))
2214 t1) 2319 0)))
2215 ((eq (car lhs) 'neg) 2320 math-t1)
2216 (math-try-solve-for (nth 1 lhs) (math-neg rhs) 2321 ((eq (car math-solve-lhs) 'neg)
2217 (and sign (- sign)))) 2322 (math-try-solve-for (nth 1 math-solve-lhs) (math-neg math-solve-rhs)
2218 ((and (not (eq solve-full 't)) (math-try-solve-prod))) 2323 (and math-try-solve-sign (- math-try-solve-sign))))
2324 ((and (not (eq math-solve-full 't)) (math-try-solve-prod)))
2219 ((and (not no-poly) 2325 ((and (not no-poly)
2220 (setq t2 (math-decompose-poly lhs solve-var 15 rhs))) 2326 (setq math-t2
2221 (setq t1 (cdr (nth 1 t2)) 2327 (math-decompose-poly math-solve-lhs
2222 t1 (let ((math-solve-ranges math-solve-ranges)) 2328 math-solve-var 15 math-solve-rhs)))
2223 (cond ((= (length t1) 5) 2329 (setq math-t1 (cdr (nth 1 math-t2))
2224 (apply 'math-solve-quartic (car t2) t1)) 2330 math-t1 (let ((math-solve-ranges math-solve-ranges))
2225 ((= (length t1) 4) 2331 (cond ((= (length math-t1) 5)
2226 (apply 'math-solve-cubic (car t2) t1)) 2332 (apply 'math-solve-quartic (car math-t2) math-t1))
2227 ((= (length t1) 3) 2333 ((= (length math-t1) 4)
2228 (apply 'math-solve-quadratic (car t2) t1)) 2334 (apply 'math-solve-cubic (car math-t2) math-t1))
2229 ((= (length t1) 2) 2335 ((= (length math-t1) 3)
2230 (apply 'math-solve-linear (car t2) sign t1)) 2336 (apply 'math-solve-quadratic (car math-t2) math-t1))
2231 (solve-full 2337 ((= (length math-t1) 2)
2232 (math-poly-all-roots (car t2) t1)) 2338 (apply 'math-solve-linear
2339 (car math-t2) math-try-solve-sign math-t1))
2340 (math-solve-full
2341 (math-poly-all-roots (car math-t2) math-t1))
2233 (calc-symbolic-mode nil) 2342 (calc-symbolic-mode nil)
2234 (t 2343 (t
2235 (math-try-solve-for 2344 (math-try-solve-for
2236 (car t2) 2345 (car math-t2)
2237 (math-poly-any-root (reverse t1) 0 t) 2346 (math-poly-any-root (reverse math-t1) 0 t)
2238 nil t))))) 2347 nil t)))))
2239 (if t1 2348 (if math-t1
2240 (if (eq (nth 2 t2) 1) 2349 (if (eq (nth 2 math-t2) 1)
2241 t1 2350 math-t1
2242 (math-solve-prod t1 (math-try-solve-for (nth 2 t2) 0 nil t))) 2351 (math-solve-prod math-t1 (math-try-solve-for (nth 2 math-t2) 0 nil t)))
2243 (calc-record-why "*Unable to find a symbolic solution") 2352 (calc-record-why "*Unable to find a symbolic solution")
2244 nil)) 2353 nil))
2245 ((and (math-solve-find-root-term lhs nil) 2354 ((and (math-solve-find-root-term math-solve-lhs nil)
2246 (eq (math-expr-contains-count lhs t1) 1)) ; just in case 2355 (eq (math-expr-contains-count math-solve-lhs math-t1) 1)) ; just in case
2247 (math-try-solve-for (math-simplify 2356 (math-try-solve-for (math-simplify
2248 (math-sub (if (or t3 (math-evenp t2)) 2357 (math-sub (if (or math-t3 (math-evenp math-t2))
2249 (math-pow t1 t2) 2358 (math-pow math-t1 math-t2)
2250 (math-neg (math-pow t1 t2))) 2359 (math-neg (math-pow math-t1 math-t2)))
2251 (math-expand-power 2360 (math-expand-power
2252 (math-sub (math-normalize 2361 (math-sub (math-normalize
2253 (math-expr-subst 2362 (math-expr-subst
2254 lhs t1 0)) 2363 math-solve-lhs math-t1 0))
2255 rhs) 2364 math-solve-rhs)
2256 t2 solve-var))) 2365 math-t2 math-solve-var)))
2257 0)) 2366 0))
2258 ((eq (car lhs) '+) 2367 ((eq (car math-solve-lhs) '+)
2259 (cond ((not (math-expr-contains (nth 1 lhs) solve-var)) 2368 (cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
2260 (math-try-solve-for (nth 2 lhs) 2369 (math-try-solve-for (nth 2 math-solve-lhs)
2261 (math-sub rhs (nth 1 lhs)) 2370 (math-sub math-solve-rhs (nth 1 math-solve-lhs))
2262 sign)) 2371 math-try-solve-sign))
2263 ((not (math-expr-contains (nth 2 lhs) solve-var)) 2372 ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
2264 (math-try-solve-for (nth 1 lhs) 2373 (math-try-solve-for (nth 1 math-solve-lhs)
2265 (math-sub rhs (nth 2 lhs)) 2374 (math-sub math-solve-rhs (nth 2 math-solve-lhs))
2266 sign)))) 2375 math-try-solve-sign))))
2267 ((eq (car lhs) 'calcFunc-eq) 2376 ((eq (car math-solve-lhs) 'calcFunc-eq)
2268 (math-try-solve-for (math-sub (nth 1 lhs) (nth 2 lhs)) 2377 (math-try-solve-for (math-sub (nth 1 math-solve-lhs) (nth 2 math-solve-lhs))
2269 rhs sign no-poly)) 2378 math-solve-rhs math-try-solve-sign no-poly))
2270 ((eq (car lhs) '-) 2379 ((eq (car math-solve-lhs) '-)
2271 (cond ((or (and (eq (car-safe (nth 1 lhs)) 'calcFunc-sin) 2380 (cond ((or (and (eq (car-safe (nth 1 math-solve-lhs)) 'calcFunc-sin)
2272 (eq (car-safe (nth 2 lhs)) 'calcFunc-cos)) 2381 (eq (car-safe (nth 2 math-solve-lhs)) 'calcFunc-cos))
2273 (and (eq (car-safe (nth 1 lhs)) 'calcFunc-cos) 2382 (and (eq (car-safe (nth 1 math-solve-lhs)) 'calcFunc-cos)
2274 (eq (car-safe (nth 2 lhs)) 'calcFunc-sin))) 2383 (eq (car-safe (nth 2 math-solve-lhs)) 'calcFunc-sin)))
2275 (math-try-solve-for (math-sub (nth 1 lhs) 2384 (math-try-solve-for (math-sub (nth 1 math-solve-lhs)
2276 (list (car (nth 1 lhs)) 2385 (list (car (nth 1 math-solve-lhs))
2277 (math-sub 2386 (math-sub
2278 (math-quarter-circle t) 2387 (math-quarter-circle t)
2279 (nth 1 (nth 2 lhs))))) 2388 (nth 1 (nth 2 math-solve-lhs)))))
2280 rhs)) 2389 math-solve-rhs))
2281 ((not (math-expr-contains (nth 1 lhs) solve-var)) 2390 ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
2282 (math-try-solve-for (nth 2 lhs) 2391 (math-try-solve-for (nth 2 math-solve-lhs)
2283 (math-sub (nth 1 lhs) rhs) 2392 (math-sub (nth 1 math-solve-lhs) math-solve-rhs)
2284 (and sign (- sign)))) 2393 (and math-try-solve-sign
2285 ((not (math-expr-contains (nth 2 lhs) solve-var)) 2394 (- math-try-solve-sign))))
2286 (math-try-solve-for (nth 1 lhs) 2395 ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
2287 (math-add rhs (nth 2 lhs)) 2396 (math-try-solve-for (nth 1 math-solve-lhs)
2288 sign)))) 2397 (math-add math-solve-rhs (nth 2 math-solve-lhs))
2289 ((and (eq solve-full 't) (math-try-solve-prod))) 2398 math-try-solve-sign))))
2290 ((and (eq (car lhs) '%) 2399 ((and (eq math-solve-full 't) (math-try-solve-prod)))
2291 (not (math-expr-contains (nth 2 lhs) solve-var))) 2400 ((and (eq (car math-solve-lhs) '%)
2292 (math-try-solve-for (nth 1 lhs) (math-add rhs 2401 (not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var)))
2402 (math-try-solve-for (nth 1 math-solve-lhs) (math-add math-solve-rhs
2293 (math-solve-get-int 2403 (math-solve-get-int
2294 (nth 2 lhs))))) 2404 (nth 2 math-solve-lhs)))))
2295 ((eq (car lhs) 'calcFunc-log) 2405 ((eq (car math-solve-lhs) 'calcFunc-log)
2296 (cond ((not (math-expr-contains (nth 2 lhs) solve-var)) 2406 (cond ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
2297 (math-try-solve-for (nth 1 lhs) (math-pow (nth 2 lhs) rhs))) 2407 (math-try-solve-for (nth 1 math-solve-lhs)
2298 ((not (math-expr-contains (nth 1 lhs) solve-var)) 2408 (math-pow (nth 2 math-solve-lhs) math-solve-rhs)))
2299 (math-try-solve-for (nth 2 lhs) (math-pow 2409 ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
2300 (nth 1 lhs) 2410 (math-try-solve-for (nth 2 math-solve-lhs) (math-pow
2301 (math-div 1 rhs)))))) 2411 (nth 1 math-solve-lhs)
2302 ((and (= (length lhs) 2) 2412 (math-div 1 math-solve-rhs))))))
2303 (symbolp (car lhs)) 2413 ((and (= (length math-solve-lhs) 2)
2304 (setq t1 (get (car lhs) 'math-inverse)) 2414 (symbolp (car math-solve-lhs))
2305 (setq t2 (funcall t1 rhs))) 2415 (setq math-t1 (get (car math-solve-lhs) 'math-inverse))
2306 (setq t1 (get (car lhs) 'math-inverse-sign)) 2416 (setq math-t2 (funcall math-t1 math-solve-rhs)))
2307 (math-try-solve-for (nth 1 lhs) (math-normalize t2) 2417 (setq math-t1 (get (car math-solve-lhs) 'math-inverse-sign))
2308 (and sign t1 2418 (math-try-solve-for (nth 1 math-solve-lhs) (math-normalize math-t2)
2309 (if (integerp t1) 2419 (and math-try-solve-sign math-t1
2310 (* t1 sign) 2420 (if (integerp math-t1)
2311 (funcall t1 lhs sign))))) 2421 (* math-t1 math-try-solve-sign)
2312 ((and (symbolp (car lhs)) 2422 (funcall math-t1 math-solve-lhs
2313 (setq t1 (get (car lhs) 'math-inverse-n)) 2423 math-try-solve-sign)))))
2314 (setq t2 (funcall t1 lhs rhs))) 2424 ((and (symbolp (car math-solve-lhs))
2315 t2) 2425 (setq math-t1 (get (car math-solve-lhs) 'math-inverse-n))
2316 ((setq t1 (math-expand-formula lhs)) 2426 (setq math-t2 (funcall math-t1 math-solve-lhs math-solve-rhs)))
2317 (math-try-solve-for t1 rhs sign)) 2427 math-t2)
2428 ((setq math-t1 (math-expand-formula math-solve-lhs))
2429 (math-try-solve-for math-t1 math-solve-rhs math-try-solve-sign))
2318 (t 2430 (t
2319 (calc-record-why "*No inverse known" lhs) 2431 (calc-record-why "*No inverse known" math-solve-lhs)
2320 nil)))) 2432 nil))))
2321 2433
2322 2434
2323(defun math-try-solve-prod () 2435(defun math-try-solve-prod ()
2324 (cond ((eq (car lhs) '*) 2436 (cond ((eq (car math-solve-lhs) '*)
2325 (cond ((not (math-expr-contains (nth 1 lhs) solve-var)) 2437 (cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
2326 (math-try-solve-for (nth 2 lhs) 2438 (math-try-solve-for (nth 2 math-solve-lhs)
2327 (math-div rhs (nth 1 lhs)) 2439 (math-div math-solve-rhs (nth 1 math-solve-lhs))
2328 (math-solve-sign sign (nth 1 lhs)))) 2440 (math-solve-sign math-try-solve-sign
2329 ((not (math-expr-contains (nth 2 lhs) solve-var)) 2441 (nth 1 math-solve-lhs))))
2330 (math-try-solve-for (nth 1 lhs) 2442 ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
2331 (math-div rhs (nth 2 lhs)) 2443 (math-try-solve-for (nth 1 math-solve-lhs)
2332 (math-solve-sign sign (nth 2 lhs)))) 2444 (math-div math-solve-rhs (nth 2 math-solve-lhs))
2333 ((Math-zerop rhs) 2445 (math-solve-sign math-try-solve-sign
2446 (nth 2 math-solve-lhs))))
2447 ((Math-zerop math-solve-rhs)
2334 (math-solve-prod (let ((math-solve-ranges math-solve-ranges)) 2448 (math-solve-prod (let ((math-solve-ranges math-solve-ranges))
2335 (math-try-solve-for (nth 2 lhs) 0)) 2449 (math-try-solve-for (nth 2 math-solve-lhs) 0))
2336 (math-try-solve-for (nth 1 lhs) 0))))) 2450 (math-try-solve-for (nth 1 math-solve-lhs) 0)))))
2337 ((eq (car lhs) '/) 2451 ((eq (car math-solve-lhs) '/)
2338 (cond ((not (math-expr-contains (nth 1 lhs) solve-var)) 2452 (cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
2339 (math-try-solve-for (nth 2 lhs) 2453 (math-try-solve-for (nth 2 math-solve-lhs)
2340 (math-div (nth 1 lhs) rhs) 2454 (math-div (nth 1 math-solve-lhs) math-solve-rhs)
2341 (math-solve-sign sign (nth 1 lhs)))) 2455 (math-solve-sign math-try-solve-sign
2342 ((not (math-expr-contains (nth 2 lhs) solve-var)) 2456 (nth 1 math-solve-lhs))))
2343 (math-try-solve-for (nth 1 lhs) 2457 ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
2344 (math-mul rhs (nth 2 lhs)) 2458 (math-try-solve-for (nth 1 math-solve-lhs)
2345 (math-solve-sign sign (nth 2 lhs)))) 2459 (math-mul math-solve-rhs (nth 2 math-solve-lhs))
2346 ((setq t1 (math-try-solve-for (math-sub (nth 1 lhs) 2460 (math-solve-sign math-try-solve-sign
2347 (math-mul (nth 2 lhs) 2461 (nth 2 math-solve-lhs))))
2348 rhs)) 2462 ((setq math-t1 (math-try-solve-for (math-sub (nth 1 math-solve-lhs)
2463 (math-mul (nth 2 math-solve-lhs)
2464 math-solve-rhs))
2349 0)) 2465 0))
2350 t1))) 2466 math-t1)))
2351 ((eq (car lhs) '^) 2467 ((eq (car math-solve-lhs) '^)
2352 (cond ((not (math-expr-contains (nth 1 lhs) solve-var)) 2468 (cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
2353 (math-try-solve-for 2469 (math-try-solve-for
2354 (nth 2 lhs) 2470 (nth 2 math-solve-lhs)
2355 (math-add (math-normalize 2471 (math-add (math-normalize
2356 (list 'calcFunc-log rhs (nth 1 lhs))) 2472 (list 'calcFunc-log math-solve-rhs (nth 1 math-solve-lhs)))
2357 (math-div 2473 (math-div
2358 (math-mul 2 2474 (math-mul 2
2359 (math-mul '(var pi var-pi) 2475 (math-mul '(var pi var-pi)
2360 (math-solve-get-int 2476 (math-solve-get-int
2361 '(var i var-i)))) 2477 '(var i var-i))))
2362 (math-normalize 2478 (math-normalize
2363 (list 'calcFunc-ln (nth 1 lhs))))))) 2479 (list 'calcFunc-ln (nth 1 math-solve-lhs)))))))
2364 ((not (math-expr-contains (nth 2 lhs) solve-var)) 2480 ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
2365 (cond ((and (integerp (nth 2 lhs)) 2481 (cond ((and (integerp (nth 2 math-solve-lhs))
2366 (>= (nth 2 lhs) 2) 2482 (>= (nth 2 math-solve-lhs) 2)
2367 (setq t1 (math-integer-log2 (nth 2 lhs)))) 2483 (setq math-t1 (math-integer-log2 (nth 2 math-solve-lhs))))
2368 (setq t2 rhs) 2484 (setq math-t2 math-solve-rhs)
2369 (if (and (eq solve-full t) 2485 (if (and (eq math-solve-full t)
2370 (math-known-realp (nth 1 lhs))) 2486 (math-known-realp (nth 1 math-solve-lhs)))
2371 (progn 2487 (progn
2372 (while (>= (setq t1 (1- t1)) 0) 2488 (while (>= (setq math-t1 (1- math-t1)) 0)
2373 (setq t2 (list 'calcFunc-sqrt t2))) 2489 (setq math-t2 (list 'calcFunc-sqrt math-t2)))
2374 (setq t2 (math-solve-get-sign t2))) 2490 (setq math-t2 (math-solve-get-sign math-t2)))
2375 (while (>= (setq t1 (1- t1)) 0) 2491 (while (>= (setq math-t1 (1- math-t1)) 0)
2376 (setq t2 (math-solve-get-sign 2492 (setq math-t2 (math-solve-get-sign
2377 (math-normalize 2493 (math-normalize
2378 (list 'calcFunc-sqrt t2)))))) 2494 (list 'calcFunc-sqrt math-t2))))))
2379 (math-try-solve-for 2495 (math-try-solve-for
2380 (nth 1 lhs) 2496 (nth 1 math-solve-lhs)
2381 (math-normalize t2))) 2497 (math-normalize math-t2)))
2382 ((math-looks-negp (nth 2 lhs)) 2498 ((math-looks-negp (nth 2 math-solve-lhs))
2383 (math-try-solve-for 2499 (math-try-solve-for
2384 (list '^ (nth 1 lhs) (math-neg (nth 2 lhs))) 2500 (list '^ (nth 1 math-solve-lhs)
2385 (math-div 1 rhs))) 2501 (math-neg (nth 2 math-solve-lhs)))
2386 ((and (eq solve-full t) 2502 (math-div 1 math-solve-rhs)))
2387 (Math-integerp (nth 2 lhs)) 2503 ((and (eq math-solve-full t)
2388 (math-known-realp (nth 1 lhs))) 2504 (Math-integerp (nth 2 math-solve-lhs))
2389 (setq t1 (math-normalize 2505 (math-known-realp (nth 1 math-solve-lhs)))
2390 (list 'calcFunc-nroot rhs (nth 2 lhs)))) 2506 (setq math-t1 (math-normalize
2391 (if (math-evenp (nth 2 lhs)) 2507 (list 'calcFunc-nroot math-solve-rhs
2392 (setq t1 (math-solve-get-sign t1))) 2508 (nth 2 math-solve-lhs))))
2509 (if (math-evenp (nth 2 math-solve-lhs))
2510 (setq math-t1 (math-solve-get-sign math-t1)))
2393 (math-try-solve-for 2511 (math-try-solve-for
2394 (nth 1 lhs) t1 2512 (nth 1 math-solve-lhs) math-t1
2395 (and sign 2513 (and math-try-solve-sign
2396 (math-oddp (nth 2 lhs)) 2514 (math-oddp (nth 2 math-solve-lhs))
2397 (math-solve-sign sign (nth 2 lhs))))) 2515 (math-solve-sign math-try-solve-sign
2516 (nth 2 math-solve-lhs)))))
2398 (t (math-try-solve-for 2517 (t (math-try-solve-for
2399 (nth 1 lhs) 2518 (nth 1 math-solve-lhs)
2400 (math-mul 2519 (math-mul
2401 (math-normalize 2520 (math-normalize
2402 (list 'calcFunc-exp 2521 (list 'calcFunc-exp
2403 (if (Math-realp (nth 2 lhs)) 2522 (if (Math-realp (nth 2 math-solve-lhs))
2404 (math-div (math-mul 2523 (math-div (math-mul
2405 '(var pi var-pi) 2524 '(var pi var-pi)
2406 (math-solve-get-int 2525 (math-solve-get-int
2407 '(var i var-i) 2526 '(var i var-i)
2408 (and (integerp (nth 2 lhs)) 2527 (and (integerp (nth 2 math-solve-lhs))
2409 (math-abs 2528 (math-abs
2410 (nth 2 lhs))))) 2529 (nth 2 math-solve-lhs)))))
2411 (math-div (nth 2 lhs) 2)) 2530 (math-div (nth 2 math-solve-lhs) 2))
2412 (math-div (math-mul 2531 (math-div (math-mul
2413 2 2532 2
2414 (math-mul 2533 (math-mul
2415 '(var pi var-pi) 2534 '(var pi var-pi)
2416 (math-solve-get-int 2535 (math-solve-get-int
2417 '(var i var-i) 2536 '(var i var-i)
2418 (and (integerp (nth 2 lhs)) 2537 (and (integerp (nth 2 math-solve-lhs))
2419 (math-abs 2538 (math-abs
2420 (nth 2 lhs)))))) 2539 (nth 2 math-solve-lhs))))))
2421 (nth 2 lhs))))) 2540 (nth 2 math-solve-lhs)))))
2422 (math-normalize 2541 (math-normalize
2423 (list 'calcFunc-nroot 2542 (list 'calcFunc-nroot
2424 rhs 2543 math-solve-rhs
2425 (nth 2 lhs)))) 2544 (nth 2 math-solve-lhs))))
2426 (and sign 2545 (and math-try-solve-sign
2427 (math-oddp (nth 2 lhs)) 2546 (math-oddp (nth 2 math-solve-lhs))
2428 (math-solve-sign sign (nth 2 lhs))))))))) 2547 (math-solve-sign math-try-solve-sign
2548 (nth 2 math-solve-lhs)))))))))
2429 (t nil))) 2549 (t nil)))
2430 2550
2431(defun math-solve-prod (lsoln rsoln) 2551(defun math-solve-prod (lsoln rsoln)
@@ -2433,9 +2553,9 @@
2433 rsoln) 2553 rsoln)
2434 ((null rsoln) 2554 ((null rsoln)
2435 lsoln) 2555 lsoln)
2436 ((eq solve-full 'all) 2556 ((eq math-solve-full 'all)
2437 (cons 'vec (append (cdr lsoln) (cdr rsoln)))) 2557 (cons 'vec (append (cdr lsoln) (cdr rsoln))))
2438 (solve-full 2558 (math-solve-full
2439 (list 'calcFunc-if 2559 (list 'calcFunc-if
2440 (list 'calcFunc-gt (math-solve-get-sign 1) 0) 2560 (list 'calcFunc-gt (math-solve-get-sign 1) 0)
2441 lsoln 2561 lsoln
@@ -2443,34 +2563,38 @@
2443 (t lsoln))) 2563 (t lsoln)))
2444 2564
2445;;; This deals with negative, fractional, and symbolic powers of "x". 2565;;; This deals with negative, fractional, and symbolic powers of "x".
2566;; The variable math-solve-b is local to math-decompose-poly,
2567;; but is used by math-solve-poly-funny-powers.
2568
2446(defun math-solve-poly-funny-powers (sub-rhs) ; uses "t1", "t2" 2569(defun math-solve-poly-funny-powers (sub-rhs) ; uses "t1", "t2"
2447 (setq t1 lhs) 2570 (setq math-t1 math-solve-lhs)
2448 (let ((pp math-poly-neg-powers) 2571 (let ((pp math-poly-neg-powers)
2449 fac) 2572 fac)
2450 (while pp 2573 (while pp
2451 (setq fac (math-pow (car pp) (or math-poly-mult-powers 1)) 2574 (setq fac (math-pow (car pp) (or math-poly-mult-powers 1))
2452 t1 (math-mul t1 fac) 2575 math-t1 (math-mul math-t1 fac)
2453 rhs (math-mul rhs fac) 2576 math-solve-rhs (math-mul math-solve-rhs fac)
2454 pp (cdr pp)))) 2577 pp (cdr pp))))
2455 (if sub-rhs (setq t1 (math-sub t1 rhs))) 2578 (if sub-rhs (setq math-t1 (math-sub math-t1 math-solve-rhs)))
2456 (let ((math-poly-neg-powers nil)) 2579 (let ((math-poly-neg-powers nil))
2457 (setq t2 (math-mul (or math-poly-mult-powers 1) 2580 (setq math-t2 (math-mul (or math-poly-mult-powers 1)
2458 (let ((calc-prefer-frac t)) 2581 (let ((calc-prefer-frac t))
2459 (math-div 1 math-poly-frac-powers))) 2582 (math-div 1 math-poly-frac-powers)))
2460 t1 (math-is-polynomial (math-simplify (calcFunc-expand t1)) b 50)))) 2583 math-t1 (math-is-polynomial
2584 (math-simplify (calcFunc-expand math-t1)) math-solve-b 50))))
2461 2585
2462;;; This converts "a x^8 + b x^5 + c x^2" to "(a (x^3)^2 + b (x^3) + c) * x^2". 2586;;; This converts "a x^8 + b x^5 + c x^2" to "(a (x^3)^2 + b (x^3) + c) * x^2".
2463(defun math-solve-crunch-poly (max-degree) ; uses "t1", "t3" 2587(defun math-solve-crunch-poly (max-degree) ; uses "t1", "t3"
2464 (let ((count 0)) 2588 (let ((count 0))
2465 (while (and t1 (Math-zerop (car t1))) 2589 (while (and math-t1 (Math-zerop (car math-t1)))
2466 (setq t1 (cdr t1) 2590 (setq math-t1 (cdr math-t1)
2467 count (1+ count))) 2591 count (1+ count)))
2468 (and t1 2592 (and math-t1
2469 (let* ((degree (1- (length t1))) 2593 (let* ((degree (1- (length math-t1)))
2470 (scale degree)) 2594 (scale degree))
2471 (while (and (> scale 1) (= (car t3) 1)) 2595 (while (and (> scale 1) (= (car math-t3) 1))
2472 (and (= (% degree scale) 0) 2596 (and (= (% degree scale) 0)
2473 (let ((p t1) 2597 (let ((p math-t1)
2474 (n 0) 2598 (n 0)
2475 (new-t1 nil) 2599 (new-t1 nil)
2476 (okay t)) 2600 (okay t))
@@ -2482,11 +2606,12 @@
2482 (setq p (cdr p) 2606 (setq p (cdr p)
2483 n (1+ n))) 2607 n (1+ n)))
2484 (if okay 2608 (if okay
2485 (setq t3 (cons scale (cdr t3)) 2609 (setq math-t3 (cons scale (cdr math-t3))
2486 t1 new-t1)))) 2610 math-t1 new-t1))))
2487 (setq scale (1- scale))) 2611 (setq scale (1- scale)))
2488 (setq t3 (list (math-mul (car t3) t2) (math-mul count t2))) 2612 (setq math-t3 (list (math-mul (car math-t3) math-t2)
2489 (<= (1- (length t1)) max-degree))))) 2613 (math-mul count math-t2)))
2614 (<= (1- (length math-t1)) max-degree)))))
2490 2615
2491(defun calcFunc-poly (expr var &optional degree) 2616(defun calcFunc-poly (expr var &optional degree)
2492 (if degree 2617 (if degree
@@ -2509,37 +2634,38 @@
2509 (cons 'vec d) 2634 (cons 'vec d)
2510 (math-reject-arg expr "Expected a polynomial")))) 2635 (math-reject-arg expr "Expected a polynomial"))))
2511 2636
2512(defun math-decompose-poly (lhs solve-var degree sub-rhs) 2637(defun math-decompose-poly (math-solve-lhs math-solve-var degree sub-rhs)
2513 (let ((rhs (or sub-rhs 1)) 2638 (let ((math-solve-rhs (or sub-rhs 1))
2514 t1 t2 t3) 2639 math-t1 math-t2 math-t3)
2515 (setq t2 (math-polynomial-base 2640 (setq math-t2 (math-polynomial-base
2516 lhs 2641 math-solve-lhs
2517 (function 2642 (function
2518 (lambda (b) 2643 (lambda (math-solve-b)
2519 (let ((math-poly-neg-powers '(1)) 2644 (let ((math-poly-neg-powers '(1))
2520 (math-poly-mult-powers nil) 2645 (math-poly-mult-powers nil)
2521 (math-poly-frac-powers 1) 2646 (math-poly-frac-powers 1)
2522 (math-poly-exp-base t)) 2647 (math-poly-exp-base t))
2523 (and (not (equal b lhs)) 2648 (and (not (equal math-solve-b math-solve-lhs))
2524 (or (not (memq (car-safe b) '(+ -))) sub-rhs) 2649 (or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
2525 (setq t3 '(1 0) t2 1 2650 (setq math-t3 '(1 0) math-t2 1
2526 t1 (math-is-polynomial lhs b 50)) 2651 math-t1 (math-is-polynomial math-solve-lhs
2652 math-solve-b 50))
2527 (if (and (equal math-poly-neg-powers '(1)) 2653 (if (and (equal math-poly-neg-powers '(1))
2528 (memq math-poly-mult-powers '(nil 1)) 2654 (memq math-poly-mult-powers '(nil 1))
2529 (eq math-poly-frac-powers 1) 2655 (eq math-poly-frac-powers 1)
2530 sub-rhs) 2656 sub-rhs)
2531 (setq t1 (cons (math-sub (car t1) rhs) 2657 (setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
2532 (cdr t1))) 2658 (cdr math-t1)))
2533 (math-solve-poly-funny-powers sub-rhs)) 2659 (math-solve-poly-funny-powers sub-rhs))
2534 (math-solve-crunch-poly degree) 2660 (math-solve-crunch-poly degree)
2535 (or (math-expr-contains b solve-var) 2661 (or (math-expr-contains math-solve-b math-solve-var)
2536 (math-expr-contains (car t3) solve-var)))))))) 2662 (math-expr-contains (car math-t3) math-solve-var))))))))
2537 (if t2 2663 (if math-t2
2538 (list (math-pow t2 (car t3)) 2664 (list (math-pow math-t2 (car math-t3))
2539 (cons 'vec t1) 2665 (cons 'vec math-t1)
2540 (if sub-rhs 2666 (if sub-rhs
2541 (math-pow t2 (nth 1 t3)) 2667 (math-pow math-t2 (nth 1 math-t3))
2542 (math-div (math-pow t2 (nth 1 t3)) rhs)))))) 2668 (math-div (math-pow math-t2 (nth 1 math-t3)) math-solve-rhs))))))
2543 2669
2544(defun math-solve-linear (var sign b a) 2670(defun math-solve-linear (var sign b a)
2545 (math-try-solve-for var 2671 (math-try-solve-for var
@@ -2623,9 +2749,9 @@
2623 var 2749 var
2624 (let* ((asqr (math-sqr a)) 2750 (let* ((asqr (math-sqr a))
2625 (asqr4 (math-div asqr 4)) 2751 (asqr4 (math-div asqr 4))
2626 (y (let ((solve-full nil) 2752 (y (let ((math-solve-full nil)
2627 calc-next-why) 2753 calc-next-why)
2628 (math-solve-cubic solve-var 2754 (math-solve-cubic math-solve-var
2629 (math-sub (math-sub 2755 (math-sub (math-sub
2630 (math-mul 4 (math-mul b d)) 2756 (math-mul 4 (math-mul b d))
2631 (math-mul asqr d)) 2757 (math-mul asqr d))
@@ -2665,6 +2791,14 @@
2665 2791
2666(defvar math-symbolic-solve nil) 2792(defvar math-symbolic-solve nil)
2667(defvar math-int-coefs nil) 2793(defvar math-int-coefs nil)
2794
2795;; The variable math-int-threshold is local to math-poly-all-roots,
2796;; but is used by math-poly-newton-root.
2797(defvar math-int-threshold)
2798;; The variables math-int-scale, math-int-factors and math-double-roots
2799;; are local to math-poly-all-roots, but are used by math-poly-integer-root.
2800(defvar math-int-scale)
2801
2668(defun math-poly-all-roots (var p &optional math-factoring) 2802(defun math-poly-all-roots (var p &optional math-factoring)
2669 (catch 'ouch 2803 (catch 'ouch
2670 (let* ((math-symbolic-solve calc-symbolic-mode) 2804 (let* ((math-symbolic-solve calc-symbolic-mode)
@@ -2718,10 +2852,10 @@
2718 deg (1- deg)))) 2852 deg (1- deg))))
2719 (setq p (reverse def-p)))) 2853 (setq p (reverse def-p))))
2720 (if (> deg 1) 2854 (if (> deg 1)
2721 (let ((solve-var '(var DUMMY var-DUMMY)) 2855 (let ((math-solve-var '(var DUMMY var-DUMMY))
2722 (math-solve-sign nil) 2856 (math-solve-sign nil)
2723 (math-solve-ranges nil) 2857 (math-solve-ranges nil)
2724 (solve-full 'all)) 2858 (math-solve-full 'all))
2725 (if (= (length p) (length math-int-coefs)) 2859 (if (= (length p) (length math-int-coefs))
2726 (setq p (reverse math-int-coefs))) 2860 (setq p (reverse math-int-coefs)))
2727 (setq roots (append (cdr (apply (cond ((= deg 2) 2861 (setq roots (append (cdr (apply (cond ((= deg 2)
@@ -2730,7 +2864,7 @@
2730 'math-solve-cubic) 2864 'math-solve-cubic)
2731 (t 2865 (t
2732 'math-solve-quartic)) 2866 'math-solve-quartic))
2733 solve-var p)) 2867 math-solve-var p))
2734 roots))) 2868 roots)))
2735 (if (> deg 0) 2869 (if (> deg 0)
2736 (setq roots (cons (math-div (math-neg (car p)) (nth 1 p)) 2870 (setq roots (cons (math-div (math-neg (car p)) (nth 1 p))
@@ -2744,7 +2878,7 @@
2744 (let ((vec nil) res) 2878 (let ((vec nil) res)
2745 (while roots 2879 (while roots
2746 (let ((root (car roots)) 2880 (let ((root (car roots))
2747 (solve-full (and solve-full 'all))) 2881 (math-solve-full (and math-solve-full 'all)))
2748 (if (math-floatp root) 2882 (if (math-floatp root)
2749 (setq root (math-poly-any-root orig-p root t))) 2883 (setq root (math-poly-any-root orig-p root t)))
2750 (setq vec (append vec 2884 (setq vec (append vec
@@ -2754,7 +2888,7 @@
2754 (setq vec (cons 'vec (nreverse vec))) 2888 (setq vec (cons 'vec (nreverse vec)))
2755 (if math-symbolic-solve 2889 (if math-symbolic-solve
2756 (setq vec (math-normalize vec))) 2890 (setq vec (math-normalize vec)))
2757 (if (eq solve-full t) 2891 (if (eq math-solve-full t)
2758 (list 'calcFunc-subscr 2892 (list 'calcFunc-subscr
2759 vec 2893 vec
2760 (math-solve-get-int 1 (1- (length orig-p)) 1)) 2894 (math-solve-get-int 1 (1- (length orig-p)) 1))
@@ -2972,8 +3106,8 @@
2972 3106
2973(defun math-solve-find-root-term (x neg) ; sets "t2", "t3" 3107(defun math-solve-find-root-term (x neg) ; sets "t2", "t3"
2974 (if (math-solve-find-root-in-prod x) 3108 (if (math-solve-find-root-in-prod x)
2975 (setq t3 neg 3109 (setq math-t3 neg
2976 t1 x) 3110 math-t1 x)
2977 (and (memq (car-safe x) '(+ -)) 3111 (and (memq (car-safe x) '(+ -))
2978 (or (math-solve-find-root-term (nth 1 x) neg) 3112 (or (math-solve-find-root-term (nth 1 x) neg)
2979 (math-solve-find-root-term (nth 2 x) 3113 (math-solve-find-root-term (nth 2 x)
@@ -2981,33 +3115,39 @@
2981 3115
2982(defun math-solve-find-root-in-prod (x) 3116(defun math-solve-find-root-in-prod (x)
2983 (and (consp x) 3117 (and (consp x)
2984 (math-expr-contains x solve-var) 3118 (math-expr-contains x math-solve-var)
2985 (or (and (eq (car x) 'calcFunc-sqrt) 3119 (or (and (eq (car x) 'calcFunc-sqrt)
2986 (setq t2 2)) 3120 (setq math-t2 2))
2987 (and (eq (car x) '^) 3121 (and (eq (car x) '^)
2988 (or (and (memq (math-quarter-integer (nth 2 x)) '(1 2 3)) 3122 (or (and (memq (math-quarter-integer (nth 2 x)) '(1 2 3))
2989 (setq t2 2)) 3123 (setq math-t2 2))
2990 (and (eq (car-safe (nth 2 x)) 'frac) 3124 (and (eq (car-safe (nth 2 x)) 'frac)
2991 (eq (nth 2 (nth 2 x)) 3) 3125 (eq (nth 2 (nth 2 x)) 3)
2992 (setq t2 3)))) 3126 (setq math-t2 3))))
2993 (and (memq (car x) '(* /)) 3127 (and (memq (car x) '(* /))
2994 (or (and (not (math-expr-contains (nth 1 x) solve-var)) 3128 (or (and (not (math-expr-contains (nth 1 x) math-solve-var))
2995 (math-solve-find-root-in-prod (nth 2 x))) 3129 (math-solve-find-root-in-prod (nth 2 x)))
2996 (and (not (math-expr-contains (nth 2 x) solve-var)) 3130 (and (not (math-expr-contains (nth 2 x) math-solve-var))
2997 (math-solve-find-root-in-prod (nth 1 x)))))))) 3131 (math-solve-find-root-in-prod (nth 1 x))))))))
2998 3132
3133;; The variable math-solve-vars is local to math-solve-system,
3134;; but is used by math-solve-system-rec.
3135(defvar math-solve-vars)
2999 3136
3000(defun math-solve-system (exprs solve-vars solve-full) 3137;; The variable math-solve-simplifying is local to math-solve-system
3138;; and math-solve-system-rec, but is used by math-solve-system-subst.
3139
3140(defun math-solve-system (exprs math-solve-vars math-solve-full)
3001 (setq exprs (mapcar 'list (if (Math-vectorp exprs) 3141 (setq exprs (mapcar 'list (if (Math-vectorp exprs)
3002 (cdr exprs) 3142 (cdr exprs)
3003 (list exprs))) 3143 (list exprs)))
3004 solve-vars (if (Math-vectorp solve-vars) 3144 math-solve-vars (if (Math-vectorp math-solve-vars)
3005 (cdr solve-vars) 3145 (cdr math-solve-vars)
3006 (list solve-vars))) 3146 (list math-solve-vars)))
3007 (or (let ((math-solve-simplifying nil)) 3147 (or (let ((math-solve-simplifying nil))
3008 (math-solve-system-rec exprs solve-vars nil)) 3148 (math-solve-system-rec exprs math-solve-vars nil))
3009 (let ((math-solve-simplifying t)) 3149 (let ((math-solve-simplifying t))
3010 (math-solve-system-rec exprs solve-vars nil)))) 3150 (math-solve-system-rec exprs math-solve-vars nil))))
3011 3151
3012;;; The following backtracking solver works by choosing a variable 3152;;; The following backtracking solver works by choosing a variable
3013;;; and equation, and trying to solve the equation for the variable. 3153;;; and equation, and trying to solve the equation for the variable.
@@ -3020,20 +3160,26 @@
3020;;; To support calcFunc-roots, entries in eqn-list and solns are 3160;;; To support calcFunc-roots, entries in eqn-list and solns are
3021;;; actually lists of equations. 3161;;; actually lists of equations.
3022 3162
3163;; The variables math-solve-system-res and math-solve-system-vv are
3164;; local to math-solve-system-rec, but are used by math-solve-system-subst.
3165(defvar math-solve-system-vv)
3166(defvar math-solve-system-res)
3167
3168
3023(defun math-solve-system-rec (eqn-list var-list solns) 3169(defun math-solve-system-rec (eqn-list var-list solns)
3024 (if var-list 3170 (if var-list
3025 (let ((v var-list) 3171 (let ((v var-list)
3026 (res nil)) 3172 (math-solve-system-res nil))
3027 3173
3028 ;; Try each variable in turn. 3174 ;; Try each variable in turn.
3029 (while 3175 (while
3030 (and 3176 (and
3031 v 3177 v
3032 (let* ((vv (car v)) 3178 (let* ((math-solve-system-vv (car v))
3033 (e eqn-list) 3179 (e eqn-list)
3034 (elim (eq (car-safe vv) 'calcFunc-elim))) 3180 (elim (eq (car-safe math-solve-system-vv) 'calcFunc-elim)))
3035 (if elim 3181 (if elim
3036 (setq vv (nth 1 vv))) 3182 (setq math-solve-system-vv (nth 1 math-solve-system-vv)))
3037 3183
3038 ;; Try each equation in turn. 3184 ;; Try each equation in turn.
3039 (while 3185 (while
@@ -3042,26 +3188,27 @@
3042 (let ((e2 (car e)) 3188 (let ((e2 (car e))
3043 (eprev nil) 3189 (eprev nil)
3044 res2) 3190 res2)
3045 (setq res nil) 3191 (setq math-solve-system-res nil)
3046 3192
3047 ;; Try to solve for vv the list of equations e2. 3193 ;; Try to solve for math-solve-system-vv the list of equations e2.
3048 (while (and e2 3194 (while (and e2
3049 (setq res2 (or (and (eq (car e2) eprev) 3195 (setq res2 (or (and (eq (car e2) eprev)
3050 res2) 3196 res2)
3051 (math-solve-for (car e2) 0 vv 3197 (math-solve-for (car e2) 0
3052 solve-full)))) 3198 math-solve-system-vv
3199 math-solve-full))))
3053 (setq eprev (car e2) 3200 (setq eprev (car e2)
3054 res (cons (if (eq solve-full 'all) 3201 math-solve-system-res (cons (if (eq math-solve-full 'all)
3055 (cdr res2) 3202 (cdr res2)
3056 (list res2)) 3203 (list res2))
3057 res) 3204 math-solve-system-res)
3058 e2 (cdr e2))) 3205 e2 (cdr e2)))
3059 (if e2 3206 (if e2
3060 (setq res nil) 3207 (setq math-solve-system-res nil)
3061 3208
3062 ;; Found a solution. Now try other variables. 3209 ;; Found a solution. Now try other variables.
3063 (setq res (nreverse res) 3210 (setq math-solve-system-res (nreverse math-solve-system-res)
3064 res (math-solve-system-rec 3211 math-solve-system-res (math-solve-system-rec
3065 (mapcar 3212 (mapcar
3066 'math-solve-system-subst 3213 'math-solve-system-subst
3067 (delq (car e) 3214 (delq (car e)
@@ -3078,20 +3225,22 @@
3078 solns))) 3225 solns)))
3079 (if elim 3226 (if elim
3080 s 3227 s
3081 (cons (cons vv (apply 'append res)) 3228 (cons (cons
3229 math-solve-system-vv
3230 (apply 'append math-solve-system-res))
3082 s))))) 3231 s)))))
3083 (not res)))) 3232 (not math-solve-system-res))))
3084 (setq e (cdr e))) 3233 (setq e (cdr e)))
3085 (not res))) 3234 (not math-solve-system-res)))
3086 (setq v (cdr v))) 3235 (setq v (cdr v)))
3087 res) 3236 math-solve-system-res)
3088 3237
3089 ;; Eliminated all variables, so now put solution into the proper format. 3238 ;; Eliminated all variables, so now put solution into the proper format.
3090 (setq solns (sort solns 3239 (setq solns (sort solns
3091 (function 3240 (function
3092 (lambda (x y) 3241 (lambda (x y)
3093 (not (memq (car x) (memq (car y) solve-vars))))))) 3242 (not (memq (car x) (memq (car y) math-solve-vars)))))))
3094 (if (eq solve-full 'all) 3243 (if (eq math-solve-full 'all)
3095 (math-transpose 3244 (math-transpose
3096 (math-normalize 3245 (math-normalize
3097 (cons 'vec 3246 (cons 'vec
@@ -3106,21 +3255,26 @@
3106 3255
3107(defun math-solve-system-subst (x) ; uses "res" and "v" 3256(defun math-solve-system-subst (x) ; uses "res" and "v"
3108 (let ((accum nil) 3257 (let ((accum nil)
3109 (res2 res)) 3258 (res2 math-solve-system-res))
3110 (while x 3259 (while x
3111 (setq accum (nconc accum 3260 (setq accum (nconc accum
3112 (mapcar (function 3261 (mapcar (function
3113 (lambda (r) 3262 (lambda (r)
3114 (if math-solve-simplifying 3263 (if math-solve-simplifying
3115 (math-simplify 3264 (math-simplify
3116 (math-expr-subst (car x) vv r)) 3265 (math-expr-subst
3117 (math-expr-subst (car x) vv r)))) 3266 (car x) math-solve-system-vv r))
3267 (math-expr-subst
3268 (car x) math-solve-system-vv r))))
3118 (car res2))) 3269 (car res2)))
3119 x (cdr x) 3270 x (cdr x)
3120 res2 (cdr res2))) 3271 res2 (cdr res2)))
3121 accum)) 3272 accum))
3122 3273
3123 3274
3275;; calc-command-flags is declared in calc.el
3276(defvar calc-command-flags)
3277
3124(defun math-get-from-counter (name) 3278(defun math-get-from-counter (name)
3125 (let ((ctr (assq name calc-command-flags))) 3279 (let ((ctr (assq name calc-command-flags)))
3126 (if ctr 3280 (if ctr
@@ -3129,6 +3283,8 @@
3129 calc-command-flags (cons ctr calc-command-flags))) 3283 calc-command-flags (cons ctr calc-command-flags)))
3130 (cdr ctr))) 3284 (cdr ctr)))
3131 3285
3286(defvar var-GenCount)
3287
3132(defun math-solve-get-sign (val) 3288(defun math-solve-get-sign (val)
3133 (setq val (math-simplify val)) 3289 (setq val (math-simplify val))
3134 (if (and (eq (car-safe val) '*) 3290 (if (and (eq (car-safe val) '*)
@@ -3139,17 +3295,17 @@
3139 (setq val (math-normalize (list '^ 3295 (setq val (math-normalize (list '^
3140 (nth 1 (nth 1 val)) 3296 (nth 1 (nth 1 val))
3141 (math-div (nth 2 (nth 1 val)) 2))))) 3297 (math-div (nth 2 (nth 1 val)) 2)))))
3142 (if solve-full 3298 (if math-solve-full
3143 (if (and (calc-var-value 'var-GenCount) 3299 (if (and (calc-var-value 'var-GenCount)
3144 (Math-natnump var-GenCount) 3300 (Math-natnump var-GenCount)
3145 (not (eq solve-full 'all))) 3301 (not (eq math-solve-full 'all)))
3146 (prog1 3302 (prog1
3147 (math-mul (list 'calcFunc-as var-GenCount) val) 3303 (math-mul (list 'calcFunc-as var-GenCount) val)
3148 (setq var-GenCount (math-add var-GenCount 1)) 3304 (setq var-GenCount (math-add var-GenCount 1))
3149 (calc-refresh-evaltos 'var-GenCount)) 3305 (calc-refresh-evaltos 'var-GenCount))
3150 (let* ((var (concat "s" (int-to-string (math-get-from-counter 'solve-sign)))) 3306 (let* ((var (concat "s" (int-to-string (math-get-from-counter 'solve-sign))))
3151 (var2 (list 'var (intern var) (intern (concat "var-" var))))) 3307 (var2 (list 'var (intern var) (intern (concat "var-" var)))))
3152 (if (eq solve-full 'all) 3308 (if (eq math-solve-full 'all)
3153 (setq math-solve-ranges (cons (list var2 1 -1) 3309 (setq math-solve-ranges (cons (list var2 1 -1)
3154 math-solve-ranges))) 3310 math-solve-ranges)))
3155 (math-mul var2 val))) 3311 (math-mul var2 val)))
@@ -3157,10 +3313,10 @@
3157 val))) 3313 val)))
3158 3314
3159(defun math-solve-get-int (val &optional range first) 3315(defun math-solve-get-int (val &optional range first)
3160 (if solve-full 3316 (if math-solve-full
3161 (if (and (calc-var-value 'var-GenCount) 3317 (if (and (calc-var-value 'var-GenCount)
3162 (Math-natnump var-GenCount) 3318 (Math-natnump var-GenCount)
3163 (not (eq solve-full 'all))) 3319 (not (eq math-solve-full 'all)))
3164 (prog1 3320 (prog1
3165 (math-mul val (list 'calcFunc-an var-GenCount)) 3321 (math-mul val (list 'calcFunc-an var-GenCount))
3166 (setq var-GenCount (math-add var-GenCount 1)) 3322 (setq var-GenCount (math-add var-GenCount 1))
@@ -3168,7 +3324,7 @@
3168 (let* ((var (concat "n" (int-to-string 3324 (let* ((var (concat "n" (int-to-string
3169 (math-get-from-counter 'solve-int)))) 3325 (math-get-from-counter 'solve-int))))
3170 (var2 (list 'var (intern var) (intern (concat "var-" var))))) 3326 (var2 (list 'var (intern var) (intern (concat "var-" var)))))
3171 (if (and range (eq solve-full 'all)) 3327 (if (and range (eq math-solve-full 'all))
3172 (setq math-solve-ranges (cons (cons var2 3328 (setq math-solve-ranges (cons (cons var2
3173 (cdr (calcFunc-index 3329 (cdr (calcFunc-index
3174 range (or first 0)))) 3330 range (or first 0))))
@@ -3191,15 +3347,15 @@
3191 (if (memq (car expr) '(* /)) 3347 (if (memq (car expr) '(* /))
3192 (math-looks-evenp (nth 1 expr))))) 3348 (math-looks-evenp (nth 1 expr)))))
3193 3349
3194(defun math-solve-for (lhs rhs solve-var solve-full &optional sign) 3350(defun math-solve-for (lhs rhs math-solve-var math-solve-full &optional sign)
3195 (if (math-expr-contains rhs solve-var) 3351 (if (math-expr-contains rhs math-solve-var)
3196 (math-solve-for (math-sub lhs rhs) 0 solve-var solve-full) 3352 (math-solve-for (math-sub lhs rhs) 0 math-solve-var math-solve-full)
3197 (and (math-expr-contains lhs solve-var) 3353 (and (math-expr-contains lhs math-solve-var)
3198 (math-with-extra-prec 1 3354 (math-with-extra-prec 1
3199 (let* ((math-poly-base-variable solve-var) 3355 (let* ((math-poly-base-variable math-solve-var)
3200 (res (math-try-solve-for lhs rhs sign))) 3356 (res (math-try-solve-for lhs rhs sign)))
3201 (if (and (eq solve-full 'all) 3357 (if (and (eq math-solve-full 'all)
3202 (math-known-realp solve-var)) 3358 (math-known-realp math-solve-var))
3203 (let ((old-len (length res)) 3359 (let ((old-len (length res))
3204 new-len) 3360 new-len)
3205 (setq res (delq nil 3361 (setq res (delq nil
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-02 17:28:22 +0000