root/trunk/lisp/calc/calcalg2.el

;;; calcalg2.el --- more algebraic functions for Calc

;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.

;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

;; This file is autoloaded from calc-ext.el.

(require 'calc-ext)
(require 'calc-macs)

(defun calc-derivative (var num)
  (interactive "sDifferentiate with respect to: \np")
  (calc-slow-wrapper
   (when (< num 0)
     (error "Order of derivative must be positive"))
   (let ((func (if (calc-is-hyperbolic) 'calcFunc-tderiv 'calcFunc-deriv))
         n expr)
     (if (or (equal var "") (equal var "$"))
         (setq n 2
               expr (calc-top-n 2)
               var (calc-top-n 1))
       (setq var (math-read-expr var))
       (when (eq (car-safe var) 'error)
         (error "Bad format in expression: %s" (nth 1 var)))
       (setq n 1
             expr (calc-top-n 1)))
     (while (>= (setq num (1- num)) 0)
       (setq expr (list func expr var)))
     (calc-enter-result n "derv" expr))))

(defun calc-integral (var &optional arg)
  (interactive "sIntegration variable: \nP")
  (if arg
      (calc-tabular-command 'calcFunc-integ "Integration" "intg" nil var nil nil)
    (calc-slow-wrapper
     (if (or (equal var "") (equal var "$"))
         (calc-enter-result 2 "intg" (list 'calcFunc-integ
                                           (calc-top-n 2)
                                           (calc-top-n 1)))
       (let ((var (math-read-expr var)))
         (if (eq (car-safe var) 'error)
             (error "Bad format in expression: %s" (nth 1 var)))
         (calc-enter-result 1 "intg" (list 'calcFunc-integ
                                           (calc-top-n 1)
                                           var)))))))

(defun calc-num-integral (&optional varname lowname highname)
  (interactive "sIntegration variable: ")
  (calc-tabular-command 'calcFunc-ninteg "Integration" "nint"
                        nil varname lowname highname))

(defun calc-summation (arg &optional varname lowname highname)
  (interactive "P\nsSummation variable: ")
  (calc-tabular-command 'calcFunc-sum "Summation" "sum"
                        arg varname lowname highname))

(defun calc-alt-summation (arg &optional varname lowname highname)
  (interactive "P\nsSummation variable: ")
  (calc-tabular-command 'calcFunc-asum "Summation" "asum"
                        arg varname lowname highname))

(defun calc-product (arg &optional varname lowname highname)
  (interactive "P\nsIndex variable: ")
  (calc-tabular-command 'calcFunc-prod "Index" "prod"
                        arg varname lowname highname))

(defun calc-tabulate (arg &optional varname lowname highname)
  (interactive "P\nsIndex variable: ")
  (calc-tabular-command 'calcFunc-table "Index" "tabl"
                        arg varname lowname highname))

(defun calc-tabular-command (func prompt prefix arg varname lowname highname)
  (calc-slow-wrapper
   (let (var (low nil) (high nil) (step nil) stepname stepnum (num 1) expr)
     (if (consp arg)
         (setq stepnum 1)
       (setq stepnum 0))
     (if (or (equal varname "") (equal varname "$") (null varname))
         (setq high (calc-top-n (+ stepnum 1))
               low (calc-top-n (+ stepnum 2))
               var (calc-top-n (+ stepnum 3))
               num (+ stepnum 4))
       (setq var (if (stringp varname) (math-read-expr varname) varname))
       (if (eq (car-safe var) 'error)
           (error "Bad format in expression: %s" (nth 1 var)))
       (or lowname
           (setq lowname (read-string (concat prompt " variable: " varname
                                              ", from: "))))
       (if (or (equal lowname "") (equal lowname "$"))
           (setq high (calc-top-n (+ stepnum 1))
                 low (calc-top-n (+ stepnum 2))
                 num (+ stepnum 3))
         (setq low (if (stringp lowname) (math-read-expr lowname) lowname))
         (if (eq (car-safe low) 'error)
             (error "Bad format in expression: %s" (nth 1 low)))
         (or highname
             (setq highname (read-string (concat prompt " variable: " varname
                                                 ", from: " lowname
                                                 ", to: "))))
         (if (or (equal highname "") (equal highname "$"))
             (setq high (calc-top-n (+ stepnum 1))
                   num (+ stepnum 2))
           (setq high (if (stringp highname) (math-read-expr highname)
                        highname))
           (if (eq (car-safe high) 'error)
               (error "Bad format in expression: %s" (nth 1 high)))
           (if (consp arg)
               (progn
                 (setq stepname (read-string (concat prompt " variable: "
                                                     varname
                                                     ", from: " lowname
                                                     ", to: " highname
                                                     ", step: ")))
                 (if (or (equal stepname "") (equal stepname "$"))
                     (setq step (calc-top-n 1)
                           num 2)
                   (setq step (math-read-expr stepname))
                   (if (eq (car-safe step) 'error)
                       (error "Bad format in expression: %s"
                              (nth 1 step)))))))))
     (or step
         (if (consp arg)
             (setq step (calc-top-n 1))
           (if arg
               (setq step (prefix-numeric-value arg)))))
     (setq expr (calc-top-n num))
     (calc-enter-result num prefix (append (list func expr var low high)
                                           (and step (list step)))))))

(defun calc-solve-for (var)
  (interactive "sVariable(s) to solve for: ")
  (calc-slow-wrapper
   (let ((func (if (calc-is-inverse)
                   (if (calc-is-hyperbolic) 'calcFunc-ffinv 'calcFunc-finv)
                 (if (calc-is-hyperbolic) 'calcFunc-fsolve 'calcFunc-solve))))
     (if (or (equal var "") (equal var "$"))
         (calc-enter-result 2 "solv" (list func
                                           (calc-top-n 2)
                                           (calc-top-n 1)))
       (let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
                           (not (string-match "\\[" var)))
                      (math-read-expr (concat "[" var "]"))
                    (math-read-expr var))))
         (if (eq (car-safe var) 'error)
             (error "Bad format in expression: %s" (nth 1 var)))
         (calc-enter-result 1 "solv" (list func
                                           (calc-top-n 1)
                                           var)))))))

(defun calc-poly-roots (var)
  (interactive "sVariable to solve for: ")
  (calc-slow-wrapper
   (if (or (equal var "") (equal var "$"))
       (calc-enter-result 2 "prts" (list 'calcFunc-roots
                                         (calc-top-n 2)
                                         (calc-top-n 1)))
     (let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
                         (not (string-match "\\[" var)))
                    (math-read-expr (concat "[" var "]"))
                  (math-read-expr var))))
       (if (eq (car-safe var) 'error)
           (error "Bad format in expression: %s" (nth 1 var)))
       (calc-enter-result 1 "prts" (list 'calcFunc-roots
                                         (calc-top-n 1)
                                         var))))))

(defun calc-taylor (var nterms)
  (interactive "sTaylor expansion variable: \nNNumber of terms: ")
  (calc-slow-wrapper
   (let ((var (math-read-expr var)))
     (if (eq (car-safe var) 'error)
         (error "Bad format in expression: %s" (nth 1 var)))
     (calc-enter-result 1 "tylr" (list 'calcFunc-taylor
                                       (calc-top-n 1)
                                       var
                                       (prefix-numeric-value nterms))))))


;; The following are global variables used by math-derivative and some 
;; related functions
(defvar math-deriv-var)
(defvar math-deriv-total)
(defvar math-deriv-symb)
(defvar math-decls-cache)
(defvar math-decls-all)

(defun math-derivative (expr)
  (cond ((equal expr math-deriv-var)
         1)
        ((or (Math-scalarp expr)
             (eq (car expr) 'sdev)
             (and (eq (car expr) 'var)
                  (or (not math-deriv-total)
                      (math-const-var expr)
                      (progn
                        (math-setup-declarations)
                        (memq 'const (nth 1 (or (assq (nth 2 expr)
                                                      math-decls-cache)
                                                math-decls-all)))))))
         0)
        ((eq (car expr) '+)
         (math-add (math-derivative (nth 1 expr))
                   (math-derivative (nth 2 expr))))
        ((eq (car expr) '-)
         (math-sub (math-derivative (nth 1 expr))
                   (math-derivative (nth 2 expr))))
        ((memq (car expr) '(calcFunc-eq calcFunc-neq calcFunc-lt
                                        calcFunc-gt calcFunc-leq calcFunc-geq))
         (list (car expr)
               (math-derivative (nth 1 expr))
               (math-derivative (nth 2 expr))))
        ((eq (car expr) 'neg)
         (math-neg (math-derivative (nth 1 expr))))
        ((eq (car expr) '*)
         (math-add (math-mul (nth 2 expr)
                             (math-derivative (nth 1 expr)))
                   (math-mul (nth 1 expr)
                             (math-derivative (nth 2 expr)))))
        ((eq (car expr) '/)
         (math-sub (math-div (math-derivative (nth 1 expr))
                             (nth 2 expr))
                   (math-div (math-mul (nth 1 expr)
                                       (math-derivative (nth 2 expr)))
                             (math-sqr (nth 2 expr)))))
        ((eq (car expr) '^)
         (let ((du (math-derivative (nth 1 expr)))
               (dv (math-derivative (nth 2 expr))))
           (or (Math-zerop du)
               (setq du (math-mul (nth 2 expr)
                                  (math-mul (math-normalize
                                             (list '^
                                                   (nth 1 expr)
                                                   (math-add (nth 2 expr) -1)))
                                            du))))
           (or (Math-zerop dv)
               (setq dv (math-mul (math-normalize
                                   (list 'calcFunc-ln (nth 1 expr)))
                                  (math-mul expr dv))))
           (math-add du dv)))
        ((eq (car expr) '%)
         (math-derivative (nth 1 expr)))   ; a reasonable definition
        ((eq (car expr) 'vec)
         (math-map-vec 'math-derivative expr))
        ((and (memq (car expr) '(calcFunc-conj calcFunc-re calcFunc-im))
              (= (length expr) 2))
         (list (car expr) (math-derivative (nth 1 expr))))
        ((and (memq (car expr) '(calcFunc-subscr calcFunc-mrow calcFunc-mcol))
              (= (length expr) 3))
         (let ((d (math-derivative (nth 1 expr))))
           (if (math-numberp d)
               0    ; assume x and x_1 are independent vars
             (list (car expr) d (nth 2 expr)))))
        (t (or (and (symbolp (car expr))
                    (if (= (length expr) 2)
                        (let ((handler (get (car expr) 'math-derivative)))
                          (and handler
                               (let ((deriv (math-derivative (nth 1 expr))))
                                 (if (Math-zerop deriv)
                                     deriv
                                   (math-mul (funcall handler (nth 1 expr))
                                             deriv)))))
                      (let ((handler (get (car expr) 'math-derivative-n)))
                        (and handler
                             (funcall handler expr)))))
               (and (not (eq math-deriv-symb 'pre-expand))
                    (let ((exp (math-expand-formula expr)))
                      (and exp
                           (or (let ((math-deriv-symb 'pre-expand))
                                 (catch 'math-deriv (math-derivative expr)))
                               (math-derivative exp)))))
               (if (or (Math-objvecp expr)
                       (eq (car expr) 'var)
                       (not (symbolp (car expr))))
                   (if math-deriv-symb
                       (throw 'math-deriv nil)
                     (list (if math-deriv-total 'calcFunc-tderiv 'calcFunc-deriv)
                           expr
                           math-deriv-var))
                 (let ((accum 0)
                       (arg expr)
                       (n 1)
                       derv)
                   (while (setq arg (cdr arg))
                     (or (Math-zerop (setq derv (math-derivative (car arg))))
                         (let ((func (intern (concat (symbol-name (car expr))
                                                     "'"
                                                     (if (> n 1)
                                                         (int-to-string n)
                                                       ""))))
                               (prop (cond ((= (length expr) 2)
                                            'math-derivative-1)
                                           ((= (length expr) 3)
                                            'math-derivative-2)
                                           ((= (length expr) 4)
                                            'math-derivative-3)
                                           ((= (length expr) 5)
                                            'math-derivative-4)
                                           ((= (length expr) 6)
                                            'math-derivative-5))))
                           (setq accum
                                 (math-add
                                  accum
                                  (math-mul
                                   derv
                                   (let ((handler (get func prop)))
                                     (or (and prop handler
                                              (apply handler (cdr expr)))
                                         (if (and math-deriv-symb
                                                  (not (get func
                                                            'calc-user-defn)))
                                             (throw 'math-deriv nil)
                                           (cons func (cdr expr))))))))))
                     (setq n (1+ n)))
                   accum))))))

(defun calcFunc-deriv (expr math-deriv-var &optional deriv-value math-deriv-symb)
  (let* ((math-deriv-total nil)
         (res (catch 'math-deriv (math-derivative expr))))
    (or (eq (car-safe res) 'calcFunc-deriv)
        (null res)
        (setq res (math-normalize res)))
    (and res
         (if deriv-value
             (math-expr-subst res math-deriv-var deriv-value)
           res))))

(defun calcFunc-tderiv (expr math-deriv-var &optional deriv-value math-deriv-symb)
  (math-setup-declarations)
  (let* ((math-deriv-total t)
         (res (catch 'math-deriv (math-derivative expr))))
    (or (eq (car-safe res) 'calcFunc-tderiv)
        (null res)
        (setq res (math-normalize res)))
    (and res
         (if deriv-value
             (math-expr-subst res math-deriv-var deriv-value)
           res))))

(put 'calcFunc-inv\' 'math-derivative-1
     (function (lambda (u) (math-neg (math-div 1 (math-sqr u))))))

(put 'calcFunc-sqrt\' 'math-derivative-1
     (function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))))

(put 'calcFunc-deg\' 'math-derivative-1
     (function (lambda (u) (math-div-float '(float 18 1) (math-pi)))))

(put 'calcFunc-rad\' 'math-derivative-1
     (function (lambda (u) (math-pi-over-180))))

(put 'calcFunc-ln\' 'math-derivative-1
     (function (lambda (u) (math-div 1 u))))

(put 'calcFunc-log10\' 'math-derivative-1
     (function (lambda (u)
                 (math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
                           u))))

(put 'calcFunc-lnp1\' 'math-derivative-1
     (function (lambda (u) (math-div 1 (math-add u 1)))))

(put 'calcFunc-log\' 'math-derivative-2
     (function (lambda (x b)
                 (and (not (Math-zerop b))
                      (let ((lnv (math-normalize
                                  (list 'calcFunc-ln b))))
                        (math-div 1 (math-mul lnv x)))))))

(put 'calcFunc-log\'2 'math-derivative-2
     (function (lambda (x b)
                 (let ((lnv (list 'calcFunc-ln b)))
                   (math-neg (math-div (list 'calcFunc-log x b)
                                       (math-mul lnv b)))))))

(put 'calcFunc-exp\' 'math-derivative-1
     (function (lambda (u) (math-normalize (list 'calcFunc-exp u)))))

(put 'calcFunc-expm1\' 'math-derivative-1
     (function (lambda (u) (math-normalize (list 'calcFunc-expm1 u)))))

(put 'calcFunc-sin\' 'math-derivative-1
     (function (lambda (u) (math-to-radians-2 (math-normalize
                                               (list 'calcFunc-cos u))))))

(put 'calcFunc-cos\' 'math-derivative-1
     (function (lambda (u) (math-neg (math-to-radians-2
                                      (math-normalize
                                       (list 'calcFunc-sin u)))))))

(put 'calcFunc-tan\' 'math-derivative-1
     (function (lambda (u) (math-to-radians-2
                            (math-sqr
                             (math-normalize
                              (list 'calcFunc-sec u)))))))

(put 'calcFunc-sec\' 'math-derivative-1
     (function (lambda (u) (math-to-radians-2 
                            (math-mul
                             (math-normalize
                              (list 'calcFunc-sec u))
                             (math-normalize
                              (list 'calcFunc-tan u)))))))

(put 'calcFunc-csc\' 'math-derivative-1
     (function (lambda (u) (math-neg 
                            (math-to-radians-2
                             (math-mul
                              (math-normalize
                               (list 'calcFunc-csc u))
                              (math-normalize
                               (list 'calcFunc-cot u))))))))

(put 'calcFunc-cot\' 'math-derivative-1
     (function (lambda (u) (math-neg
                            (math-to-radians-2
                             (math-sqr
                              (math-normalize
                               (list 'calcFunc-csc u))))))))

(put 'calcFunc-arcsin\' 'math-derivative-1
     (function (lambda (u)
                 (math-from-radians-2
                  (math-div 1 (math-normalize
                               (list 'calcFunc-sqrt
                                     (math-sub 1 (math-sqr u)))))))))

(put 'calcFunc-arccos\' 'math-derivative-1
     (function (lambda (u)
                 (math-from-radians-2
                  (math-div -1 (math-normalize
                                (list 'calcFunc-sqrt
                                      (math-sub 1 (math-sqr u)))))))))

(put 'calcFunc-arctan\' 'math-derivative-1
     (function (lambda (u) (math-from-radians-2
                            (math-div 1 (math-add 1 (math-sqr u)))))))

(put 'calcFunc-sinh\' 'math-derivative-1
     (function (lambda (u) (math-normalize (list 'calcFunc-cosh u)))))

(put 'calcFunc-cosh\' 'math-derivative-1
     (function (lambda (u) (math-normalize (list 'calcFunc-sinh u)))))

(put 'calcFunc-tanh\' 'math-derivative-1
     (function (lambda (u) (math-sqr
                            (math-normalize
                             (list 'calcFunc-sech u))))))

(put 'calcFunc-sech\' 'math-derivative-1
     (function (lambda (u) (math-neg
                            (math-mul
                             (math-normalize (list 'calcFunc-sech u))
                             (math-normalize (list 'calcFunc-tanh u)))))))

(put 'calcFunc-csch\' 'math-derivative-1
     (function (lambda (u) (math-neg
                            (math-mul
                             (math-normalize (list 'calcFunc-csch u))
                             (math-normalize (list 'calcFunc-coth u)))))))

(put 'calcFunc-coth\' 'math-derivative-1
     (function (lambda (u) (math-neg
                            (math-sqr
                             (math-normalize
                              (list 'calcFunc-csch u)))))))

(put 'calcFunc-arcsinh\' 'math-derivative-1
     (function (lambda (u)
                 (math-div 1 (math-normalize
                              (list 'calcFunc-sqrt
                                    (math-add (math-sqr u) 1)))))))

(put 'calcFunc-arccosh\' 'math-derivative-1
     (function (lambda (u)
                  (math-div 1 (math-normalize
                               (list 'calcFunc-sqrt
                                     (math-add (math-sqr u) -1)))))))

(put 'calcFunc-arctanh\' 'math-derivative-1
     (function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u))))))

(put 'calcFunc-bern\'2 'math-derivative-2
     (function (lambda (n x)
                 (math-mul n (list 'calcFunc-bern (math-add n -1) x)))))

(put 'calcFunc-euler\'2 'math-derivative-2
     (function (lambda (n x)
                 (math-mul n (list 'calcFunc-euler (math-add n -1) x)))))

(put 'calcFunc-gammag\'2 'math-derivative-2
     (function (lambda (a x) (math-deriv-gamma a x 1))))

(put 'calcFunc-gammaG\'2 'math-derivative-2
     (function (lambda (a x) (math-deriv-gamma a x -1))))

(put 'calcFunc-gammaP\'2 'math-derivative-2
     (function (lambda (a x) (math-deriv-gamma a x
                                               (math-div
                                                1 (math-normalize
                                                   (list 'calcFunc-gamma
                                                         a)))))))

(put 'calcFunc-gammaQ\'2 'math-derivative-2
     (function (lambda (a x) (math-deriv-gamma a x
                                               (math-div
                                                -1 (math-normalize
                                                    (list 'calcFunc-gamma
                                                          a)))))))

(defun math-deriv-gamma (a x scale)
  (math-mul scale
            (math-mul (math-pow x (math-add a -1))
                      (list 'calcFunc-exp (math-neg x)))))

(put 'calcFunc-betaB\' 'math-derivative-3
     (function (lambda (x a b) (math-deriv-beta x a b 1))))

(put 'calcFunc-betaI\' 'math-derivative-3
     (function (lambda (x a b) (math-deriv-beta x a b
                                                (math-div
                                                 1 (list 'calcFunc-beta
                                                         a b))))))

(defun math-deriv-beta (x a b scale)
  (math-mul (math-mul (math-pow x (math-add a -1))
                      (math-pow (math-sub 1 x) (math-add b -1)))
            scale))

(put 'calcFunc-erf\' 'math-derivative-1
     (function (lambda (x) (math-div 2
                                     (math-mul (list 'calcFunc-exp
                                                     (math-sqr x))
                                               (if calc-symbolic-mode
                                                   '(calcFunc-sqrt
                                                     (var pi var-pi))
                                                 (math-sqrt-pi)))))))

(put 'calcFunc-erfc\' 'math-derivative-1
     (function (lambda (x) (math-div -2
                                     (math-mul (list 'calcFunc-exp
                                                     (math-sqr x))
                                               (if calc-symbolic-mode
                                                   '(calcFunc-sqrt
                                                     (var pi var-pi))
                                                 (math-sqrt-pi)))))))

(put 'calcFunc-besJ\'2 'math-derivative-2
     (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
                                                       (math-add v -1)
                                                       z)
                                                 (list 'calcFunc-besJ
                                                       (math-add v 1)
                                                       z))
                                       2))))

(put 'calcFunc-besY\'2 'math-derivative-2
     (function (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
                                                       (math-add v -1)
                                                       z)
                                                 (list 'calcFunc-besY
                                                       (math-add v 1)
                                                       z))
                                       2))))

(put 'calcFunc-sum 'math-derivative-n
     (function
      (lambda (expr)
        (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
            (throw 'math-deriv nil)
          (cons 'calcFunc-sum
                (cons (math-derivative (nth 1 expr))
                      (cdr (cdr expr))))))))

(put 'calcFunc-prod 'math-derivative-n
     (function
      (lambda (expr)
        (if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
            (throw 'math-deriv nil)
          (math-mul expr
                    (cons 'calcFunc-sum
                          (cons (math-div (math-derivative (nth 1 expr))
                                          (nth 1 expr))
                                (cdr (cdr expr)))))))))

(put 'calcFunc-integ 'math-derivative-n
     (function
      (lambda (expr)
        (if (= (length expr) 3)
            (if (equal (nth 2 expr) math-deriv-var)
                (nth 1 expr)
              (math-normalize
               (list 'calcFunc-integ
                     (math-derivative (nth 1 expr))
                     (nth 2 expr))))
          (if (= (length expr) 5)
              (let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
                                            (nth 3 expr)))
                    (upper (math-expr-subst (nth 1 expr) (nth 2 expr)
                                            (nth 4 expr))))
                (math-add (math-sub (math-mul upper
                                              (math-derivative (nth 4 expr)))
                                    (math-mul lower
                                              (math-derivative (nth 3 expr))))
                          (if (equal (nth 2 expr) math-deriv-var)
                              0
                            (math-normalize
                             (list 'calcFunc-integ
                                   (math-derivative (nth 1 expr)) (nth 2 expr)
                                   (nth 3 expr) (nth 4 expr)))))))))))

(put 'calcFunc-if 'math-derivative-n
     (function
      (lambda (expr)
        (and (= (length expr) 4)
             (list 'calcFunc-if (nth 1 expr)
                   (math-derivative (nth 2 expr))
                   (math-derivative (nth 3 expr)))))))

(put 'calcFunc-subscr 'math-derivative-n
     (function
      (lambda (expr)
        (and (= (length expr) 3)
             (list 'calcFunc-subscr (nth 1 expr)
                   (math-derivative (nth 2 expr)))))))


(defvar math-integ-var '(var X ---))
(defvar math-integ-var-2 '(var Y ---))
(defvar math-integ-vars (list 'f math-integ-var math-integ-var-2))
(defvar math-integ-var-list (list math-integ-var))
(defvar math-integ-var-list-list (list math-integ-var-list))

;; math-integ-depth is a local variable for math-try-integral, but is used
;; by math-integral and math-tracing-integral
;; which are called (directly or indirectly) by math-try-integral.
(defvar math-integ-depth)
;; math-integ-level is a local variable for math-try-integral, but is used
;; by math-integral, math-do-integral, math-tracing-integral, 
;; math-sub-integration, math-integrate-by-parts and 
;; math-integrate-by-substitution, which are called (directly or 
;; indirectly) by math-try-integral.
(defvar math-integ-level)
;; math-integral-limit is a local variable for calcFunc-integ, but is
;; used by math-tracing-integral, math-sub-integration and 
;; math-try-integration. 
(defvar math-integral-limit)

(defmacro math-tracing-integral (&rest parts)
  (list 'and
        'trace-buffer
        (list 'save-excursion
              '(set-buffer trace-buffer)
              '(goto-char (point-max))
              (list 'and
                    '(bolp)
                    '(insert (make-string (- math-integral-limit
                                             math-integ-level) 32)
                             (format "%2d " math-integ-depth)
                             (make-string math-integ-level 32)))
              ;;(list 'condition-case 'err
                    (cons 'insert parts)
                ;;    '(error (insert (prin1-to-string err))))
              '(sit-for 0))))

;;; The following wrapper caches results and avoids infinite recursion.
;;; Each cache entry is: ( A B )          Integral of A is B;
;;;                      ( A N )          Integral of A failed at level N;
;;;                      ( A busy )       Currently working on integral of A;
;;;                      ( A parts )      Currently working, integ-by-parts;
;;;                      ( A parts2 )     Currently working, integ-by-parts;
;;;                      ( A cancelled )  Ignore this cache entry;
;;;                      ( A [B] )        Same result as for math-cur-record = B.

;; math-cur-record is a local variable for math-try-integral, but is used
;; by math-integral, math-replace-integral-parts and math-integrate-by-parts
;; which are called (directly or indirectly) by math-try-integral, as well as
;; by calc-dump-integral-cache
(defvar math-cur-record)
;; math-enable-subst and math-any-substs are local variables for
;; calcFunc-integ, but are used by math-integral and math-try-integral.
(defvar math-enable-subst)
(defvar math-any-substs)

;; math-integ-msg is a local variable for math-try-integral, but is
;; used (both locally and non-locally) by math-integral.
(defvar math-integ-msg)

(defvar math-integral-cache nil)
(defvar math-integral-cache-state nil)

(defun math-integral (expr &optional simplify same-as-above)
  (let* ((simp math-cur-record)
         (math-cur-record (assoc expr math-integral-cache))
         (math-integ-depth (1+ math-integ-depth))
         (val 'cancelled))
    (math-tracing-integral "Integrating "
                           (math-format-value expr 1000)
                           "...\n")
    (and math-cur-record
         (progn
           (math-tracing-integral "Found "
                                  (math-format-value (nth 1 math-cur-record) 1000))
           (and (consp (nth 1 math-cur-record))
                (math-replace-integral-parts math-cur-record))
           (math-tracing-integral " => "
                                  (math-format-value (nth 1 math-cur-record) 1000)
                                  "\n")))
    (or (and math-cur-record
             (not (eq (nth 1 math-cur-record) 'cancelled))
             (or (not (integerp (nth 1 math-cur-record)))
                 (>= (nth 1 math-cur-record) math-integ-level)))
        (and (math-integral-contains-parts expr)
             (progn
               (setq val nil)
               t))
        (unwind-protect
            (progn
              (let (math-integ-msg)
                (if (eq calc-display-working-message 'lots)
                    (progn
                      (calc-set-command-flag 'clear-message)
                      (setq math-integ-msg (format
                                            "Working... Integrating %s"
                                            (math-format-flat-expr expr 0)))
      &nbs