Function: math-do-integral

math-do-integral is a byte-compiled function defined in calcalg2.el.gz.

Signature

(math-do-integral EXPR)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calcalg2.el.gz
(defun math-do-integral (expr)
  (let ((math-linear-subst-tried nil)
        math-t1 math-t2)
    (or (cond ((not (math-expr-contains expr math-integ-var))
	       (math-mul expr math-integ-var))
	      ((equal expr math-integ-var)
	       (math-div (math-sqr expr) 2))
	      ((eq (car expr) '+)
	       (and (setq math-t1 (math-integral (nth 1 expr)))
		    (setq math-t2 (math-integral (nth 2 expr)))
		    (math-add math-t1 math-t2)))
	      ((eq (car expr) '-)
	       (and (setq math-t1 (math-integral (nth 1 expr)))
		    (setq math-t2 (math-integral (nth 2 expr)))
		    (math-sub math-t1 math-t2)))
	      ((eq (car expr) 'neg)
	       (and (setq math-t1 (math-integral (nth 1 expr)))
		    (math-neg math-t1)))
	      ((eq (car expr) '*)
	       (cond ((not (math-expr-contains (nth 1 expr) math-integ-var))
		      (and (setq math-t1 (math-integral (nth 2 expr)))
			   (math-mul (nth 1 expr) math-t1)))
		     ((not (math-expr-contains (nth 2 expr) math-integ-var))
		      (and (setq math-t1 (math-integral (nth 1 expr)))
			   (math-mul math-t1 (nth 2 expr))))
		     ((memq (car-safe (nth 1 expr)) '(+ -))
		      (math-integral (list (car (nth 1 expr))
					   (math-mul (nth 1 (nth 1 expr))
						     (nth 2 expr))
					   (math-mul (nth 2 (nth 1 expr))
						     (nth 2 expr)))
				     'yes t))
		     ((memq (car-safe (nth 2 expr)) '(+ -))
		      (math-integral (list (car (nth 2 expr))
					   (math-mul (nth 1 (nth 2 expr))
						     (nth 1 expr))
					   (math-mul (nth 2 (nth 2 expr))
						     (nth 1 expr)))
				     'yes t))))
	      ((eq (car expr) '/)
	       (cond ((and (not (math-expr-contains (nth 1 expr)
						    math-integ-var))
			   (not (math-equal-int (nth 1 expr) 1)))
		      (and (setq math-t1 (math-integral (math-div 1 (nth 2 expr))))
			   (math-mul (nth 1 expr) math-t1)))
		     ((not (math-expr-contains (nth 2 expr) math-integ-var))
		      (and (setq math-t1 (math-integral (nth 1 expr)))
			   (math-div math-t1 (nth 2 expr))))
		     ((and (eq (car-safe (nth 1 expr)) '*)
			   (not (math-expr-contains (nth 1 (nth 1 expr))
						    math-integ-var)))
		      (and (setq math-t1 (math-integral
				     (math-div (nth 2 (nth 1 expr))
					       (nth 2 expr))))
			   (math-mul math-t1 (nth 1 (nth 1 expr)))))
		     ((and (eq (car-safe (nth 1 expr)) '*)
			   (not (math-expr-contains (nth 2 (nth 1 expr))
						    math-integ-var)))
		      (and (setq math-t1 (math-integral
				     (math-div (nth 1 (nth 1 expr))
					       (nth 2 expr))))
			   (math-mul math-t1 (nth 2 (nth 1 expr)))))
		     ((and (eq (car-safe (nth 2 expr)) '*)
			   (not (math-expr-contains (nth 1 (nth 2 expr))
						    math-integ-var)))
		      (and (setq math-t1 (math-integral
				     (math-div (nth 1 expr)
					       (nth 2 (nth 2 expr)))))
			   (math-div math-t1 (nth 1 (nth 2 expr)))))
		     ((and (eq (car-safe (nth 2 expr)) '*)
			   (not (math-expr-contains (nth 2 (nth 2 expr))
						    math-integ-var)))
		      (and (setq math-t1 (math-integral
				     (math-div (nth 1 expr)
					       (nth 1 (nth 2 expr)))))
			   (math-div math-t1 (nth 2 (nth 2 expr)))))
		     ((eq (car-safe (nth 2 expr)) 'calcFunc-exp)
		      (math-integral
		       (math-mul (nth 1 expr)
				 (list 'calcFunc-exp
				       (math-neg (nth 1 (nth 2 expr)))))))))
	      ((eq (car expr) '^)
	       (cond ((not (math-expr-contains (nth 1 expr) math-integ-var))
		      (or (and (setq math-t1 (math-is-polynomial (nth 2 expr)
							    math-integ-var 1))
			       (math-div expr
					 (math-mul (nth 1 math-t1)
						   (math-normalize
						    (list 'calcFunc-ln
							  (nth 1 expr))))))
			  (math-integral
			   (list 'calcFunc-exp
				 (math-mul (nth 2 expr)
					   (math-normalize
					    (list 'calcFunc-ln
						  (nth 1 expr)))))
			   'yes t)))
		     ((not (math-expr-contains (nth 2 expr) math-integ-var))
		      (if (and (integerp (nth 2 expr)) (< (nth 2 expr) 0))
			  (math-integral
			   (list '/ 1 (math-pow (nth 1 expr) (- (nth 2 expr))))
			   nil t)
			(or (and (setq math-t1 (math-is-polynomial (nth 1 expr)
							      math-integ-var
							      1))
				 (setq math-t2 (math-add (nth 2 expr) 1))
				 (math-div (math-pow (nth 1 expr) math-t2)
					   (math-mul math-t2 (nth 1 math-t1))))
			    (and (Math-negp (nth 2 expr))
				 (math-integral
				  (math-div 1
					    (math-pow (nth 1 expr)
						      (math-neg
						       (nth 2 expr))))
				  nil t))
			    nil))))))

	;; Integral of a polynomial.
	(and (setq math-t1 (math-is-polynomial expr math-integ-var 20))
	     (let ((accum 0)
		   (n 1))
	       (while math-t1
		 (if (setq accum (math-add accum
					   (math-div (math-mul (car math-t1)
							       (math-pow
								math-integ-var
								n))
						     n))
			   math-t1 (cdr math-t1))
		     (setq n (1+ n))))
	       accum))

	;; Try looking it up!
	(cond ((= (length expr) 2)
	       (and (symbolp (car expr))
		    (setq math-t1 (get (car expr) 'math-integral))
		    (progn
		      (while (and math-t1
				  (not (setq math-t2 (funcall (car math-t1)
							 (nth 1 expr)))))
			(setq math-t1 (cdr math-t1)))
		      (and math-t2 (math-normalize math-t2)))))
	      ((= (length expr) 3)
	       (and (symbolp (car expr))
		    (setq math-t1 (get (car expr) 'math-integral-2))
		    (progn
		      (while (and math-t1
				  (not (setq math-t2 (funcall (car math-t1)
							 (nth 1 expr)
							 (nth 2 expr)))))
			(setq math-t1 (cdr math-t1)))
		      (and math-t2 (math-normalize math-t2))))))

	;; Integral of a rational function.
	(and (math-ratpoly-p expr math-integ-var)
	     (setq math-t1 (calcFunc-apart expr math-integ-var))
	     (not (equal math-t1 expr))
	     (math-integral math-t1))

	;; Try user-defined integration rules.
	(and math-has-rules
	     (let ((math-old-integ (symbol-function 'calcFunc-integ))
		   (input (list 'calcFunc-integtry expr math-integ-var))
		   res part)
	       (unwind-protect
		   (progn
		     (fset 'calcFunc-integ 'math-sub-integration)
		     (setq res (math-rewrite input
					     '(var IntegRules var-IntegRules)
					     1))
		     (fset 'calcFunc-integ math-old-integ)
		     (and (not (equal res input))
			  (if (setq part (math-expr-calls
					  res '(calcFunc-integsubst)))
			      (and (memq (length part) '(3 4 5))
				   (let ((parts (mapcar
                                                 (lambda (x)
                                                   (math-expr-subst
                                                    x (nth 2 part)
                                                    math-integ-var))
						 (cdr part))))
				     (math-integrate-by-substitution
				      expr (car parts) t
				      (or (nth 2 parts)
					  (list 'calcFunc-integfailed
						math-integ-var))
				      (nth 3 parts))))
			    (if (not (math-expr-calls res
						      '(calcFunc-integtry
							calcFunc-integfailed)))
				res))))
		 (fset 'calcFunc-integ math-old-integ))))

	;; See if the function is a symbolic derivative.
	(and (string-search "'" (symbol-name (car expr)))
	     (let ((name (symbol-name (car expr)))
		   (p expr) (n 0) (which nil) (bad nil))
	       (while (setq n (1+ n) p (cdr p))
		 (if (equal (car p) math-integ-var)
		     (if which (setq bad t) (setq which n))
		   (if (math-expr-contains (car p) math-integ-var)
		       (setq bad t))))
	       (and which (not bad)
		    (let ((prime (if (= which 1) "'" (format "'%d" which))))
		      (and (string-match (concat prime "\\('['0-9]*\\|$\\)")
					 name)
			   (cons (intern
				  (concat
				   (substring name 0 (match-beginning 0))
				   (substring name (+ (match-beginning 0)
						      (length prime)))))
				 (cdr expr)))))))

	;; Try transformation methods (parts, substitutions).
	(and (> math-integ-level 0)
	     (math-do-integral-methods expr))

	;; Try expanding the function's definition.
	(let ((res (math-expand-formula expr)))
	  (and res
	       (math-integral res))))))