;;;---------------------------------------------------------------
;;; 記号微分 (by 平野 拓一)
;;;---------------------------------------------------------------

;;;---------------------------------------------------------------
;;; 必要ファイル: in2pre.el, pre2in.el
;;;---------------------------------------------------------------

;;;---------------------------------------------------------------
;;; 再帰的に変数依存性を調べる関数
;;;---------------------------------------------------------------

; f は x に依存しているかどうかを調べる
(defun dependq (f x)
    (cond
        ;---- atom
        ((atom f) (if (equal f x) t nil))
        ;---- 関数の処理
        ((eq (length f) 2) (dependq (cadr f) x))
        ;---- 四則演算と冪乗の処理
        ((eq (length f) 3) (or (dependq (cadr f) x)
                               (dependq (caddr f) x)))
        ;---- それ以外の場合
        (t nil)
    )
)

; f は x に依存していないかどうかを調べる
(defun freeq (f x)
    (not (dependq f x))
)

;;;---------------------------------------------------------------
;;; 記号微分する
;;;---------------------------------------------------------------

(defun derive (expr var)
    (cond
        ;---- アトムのときの処理
        ((atom expr) (if (equal expr var) 1 0))
        ;---- 冪関数と指数関数の微分
        ((equal (car expr) '^) (derive_pow_exp expr var))
        ;---- 掛け算の微分
        ((equal (car expr) '*) (derive_mult expr var))
        ;---- 割り算の微分
        ((equal (car expr) '/) (derive_div expr var))
        ;---- 和と差の微分
        ((or (equal (car expr) '+) (equal (car expr) '-))
         (derive_pm expr var))
        ;---- sin の微分
        ((equal (car expr) 'sin) (derive_sin expr var))
        ;---- cos の微分
        ((equal (car expr) 'cos) (derive_cos expr var))
        ;---- exp の微分
        ((equal (car expr) 'exp) (derive_exp expr var))
        ;---- log の微分
        ((equal (car expr) 'log) (derive_log expr var))
        ;---- 多重括弧を外す
        ((not (null expr)) (derive (car expr) var))
        ;---- その他の場合
        (t nil)
    )
)

; 冪関数と指数関数の微分
(defun derive_pow_exp (expr var)
    (cond
        ;---- 冪関数 (f(x)^a)'=a*(f(x)^(a-1))*f'(x)
        ;
        ; f(x)=(cadr expr)
        ; a=(caddr expr)
        ((and (dependq expr var) (freeq (caddr expr) var))
         (list '* (derive (cadr expr) var)
                  (list '* (caddr expr)
                           (list '^ (cadr expr)
                           (list '- (caddr expr) 1)))))
        ;---- 指数関数 (a^f(x))'=(a^f(x))*log(a)*f'(x)
        ;
        ; a=(cadr expr)
        ; f(x)=(caddr expr)
        ((and (dependq expr var) (freeq (cadr expr) var))
         (list '* (derive (caddr expr) var)
                  (list '* (cons (car expr) (cdr expr))
                           (cons 'log (cadr expr)))))
        ;---- 一般の冪乗
        ; (f(x)^g(x))'=(f(x)^g(x))*( (f'(x)*g(x))/f(x)+log(f(x))*g'(x) )
        ; 証明は f^g = h とおいて log を取る
        ;
        ; f(x)=(cadr expr)
        ; g(x)=(caddr expr)
        (t
         (list '* (cons (car expr) (cdr expr))
                  (list '+ (list '/ (list '* (derive (cadr expr) var)
                                             (caddr expr))
                                    (cadr expr))
                           (list '* (cons 'log (cadr expr))
                                    (derive (caddr expr) var)))))
   )
)

; 掛け算の微分公式
; (f*g)'=f'*g+f*g'
;
; f(x)=(cadr expr)
; g(x)=(caddr expr)
(defun derive_mult (expr var)
    (list '+ (list '* (derive (cadr expr) var) (caddr expr))
             (list '* (cadr expr) (derive (caddr expr) var)))
)

; 割り算の微分公式
; (f/g)'=(f'*g-f*g')/(g^2)
;
; f(x)=(cadr expr)
; g(x)=(caddr expr)
(defun derive_div (expr var)
    (list '/ (list '- (list '* (derive (cadr expr) var) (caddr expr))
                      (list '* (cadr expr) (derive (caddr expr) var)))
             (list '^ (caddr expr) 2))
)

; 和と差の微分公式
; (f+g)'=f'+g'
; (f-g)'=f'-g'
;
; f(x)=(cadr expr)
; g(x)=(caddr expr)
(defun derive_pm (expr var)
    (list (car expr) (derive (cadr expr) var)
                     (derive (caddr expr) var))
)

; sin の微分
; sin'(f)=f'*cos(f)
;
; f(x)=(cdr expr)
(defun derive_sin (expr var)
    (list '* (derive (cdr expr) var)
             (cons 'cos (cdr expr)))
)

; cos の微分
; cos'(f)=-f'*sin(f)
;
; f(x)=(cdr expr)
(defun derive_cos (expr var)
    (list '* (derive (cdr expr) var)
             (list '- '0 (cons 'sin (cdr expr))))
)

; exp の微分
; exp'(f)=f'*exp(f)
;
; f(x)=(cdr expr)
(defun derive_exp (expr var)
    (list '* (derive (cdr expr) var)
             (cons (car expr) (cdr expr)))
)

; log の微分
; log'(f)=f'*(1/f)
;
; f(x)=(cdr expr)
(defun derive_log (expr var)
    (list '* (derive (cdr expr) var)
             (list '/ 1 (cadr expr)))
)

;;;---------------------------------------------------------------
;;; 確認テスト
;;;---------------------------------------------------------------

; 微分する関数
;(setq expr '(cos ( 2 * exp ( x ))))
;(setq expr '( x ^ 2 + x + 1 ))
(setq expr '(log( x ^ 3 + 1 ) + x + 1))

; 前置表現に変換
(setq expr (in2pre expr))

; 微分する
(setq expr2 (derive expr 'x))

; 内挿表現に変換
(pre2in expr2)

;;
;; End of file
;;