;;;---------------------------------------------------------------
;;; 式の簡単化 (by 平野 拓一)
;;;---------------------------------------------------------------

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

;;;---------------------------------------------------------------
;;; 式を簡単化する関数
;;;---------------------------------------------------------------

; 表現が変化しなくなるまで繰り返して簡単化する
(defun simplify (expr)
    (let (expr2)
         (setq expr2 (simp expr))
         (if (equal expr expr2)
             ;---- true: 表現が変わらなくなったとき
             expr
             ;---- false: まだ表現が変わるとき
             (simplify expr2)
         )
    )
)

; 簡単化する
(defun simp (expr)
    (cond
        ; アトム
        ((atom expr) expr)
        ; 括弧だけのとき、括弧を外す
        ((eq (length expr) 1) (car expr))
        ; + 演算子
        ((equal (car expr) '+) (simp_plus expr))
        ; - 演算子
        ((equal (car expr) '-) (simp_minus expr))
        ; * 演算子
        ((equal (car expr) '*) (simp_mult expr))
        ; / 演算子
        ((equal (car expr) '/) (simp_div expr))
        ; ^ 演算子
        ((equal (car expr) '^) (simp_pow expr))
        ; 関数のとき
        ((eq (weight (car expr)) 6)
         (list (car expr) (simp (cadr expr))))
        ; その他のとき
        (t expr)
    )
)

; + 演算子
;
; (+ a b)
; a=(cadr expr)
; b=(caddr expr)
(defun simp_plus (expr)
    (cond
        ; (+ 0 b) → b
        ((eq (cadr expr) 0) (simp (caddr expr)))
        ; (+ a 0) → a
        ((eq (caddr expr) 0) (simp (cadr expr)))
        ; (+ a a) → (* 2 a)
        ((equal (cadr expr) (caddr expr)) (list '* 2 (cadr expr)))
        ; (+ 数 数)
        ((and (integerp (cadr expr)) (integerp (caddr expr)))
         (+ (cadr expr) (caddr expr)))
        ; (+ a 数) → (+ 数 a)
        ((rationalq (caddr expr))
         (list '+ (caddr expr) (cadr expr)))
        ; (+ 数a (+ 数b c)) → (+ (+ 数a 数b) c)
        ;
        ; 数a=(cadr expr)
        ; (+ 数b c)=(caddr expr)
        ; 数b=(cadr (caddr expr))
        ; 数c=(caddr (caddr expr))
        ((and (listp (caddr expr))
              (rationalq (cadr expr))
              (equal (car (caddr expr)) '+)
              (rationalq (cadr (caddr expr))))
         (list '+
               (list '+
                     (cadr expr)
                     (cadr (caddr expr)))
               (caddr (caddr expr))))
        ; (+ (+ 数a b) (+ 数c d)) → (+ (+ 数a 数c) (+ b d))
        ;
        ; (+ 数a b)=(cadr expr)
        ; (+ 数c d)=(caddr expr)
        ; 数a=(cadr (cadr expr))
        ; b  =(caddr (cadr expr))
        ; 数c=(cadr (caddr expr))
        ; d  =(caddr (caddr expr))
        ((and (listp (cadr expr))
              (equal (car (cadr expr)) '+)
              (rationalq (cadr (cadr expr)))
              (listp (caddr expr))
              (equal (car (caddr expr)) '+)
              (rationalq (cadr (caddr expr))))
         (list '+
               (list '+
                     (cadr (cadr expr))
                     (cadr (caddr expr)))
               (list '+
                     (caddr (cadr expr))
                     (caddr (caddr expr)))))
        ; その他のとき
        (t (list '+ (simp (cadr expr)) (simp (caddr expr))))
    )
)

; - 演算子
;
; (- a b)
; a=(cadr expr)
; b=(caddr expr)
(defun simp_minus (expr)
    (cond
        ; (- a 0) → a
        ((eq (caddr expr) 0) (simp (cadr expr)))
        ; (- a a) → 0
        ((equal (cadr expr) (caddr expr)) 0)
        ; (- 数 数)
        ((and (integerp (cadr expr)) (integerp (caddr expr)))
         (- (cadr expr) (caddr expr)))
        ; (- a 数) → (- 数 a)
        ((rationalq (caddr expr))
         (list '- (caddr expr) (cadr expr)))
        ; その他のとき
        ; (- a b) → (+ a (* -1 b))
        ; この規則を使うことによって、 - の表現は無くなる
        (t (list '+
                 (simp (cadr expr))
                 (list '* -1 (simp (caddr expr)))))
    )
)

; * 演算子
;
; (* a b)
; a=(cadr expr)
; b=(caddr expr)
(defun simp_mult (expr)
    (cond
        ; (* 0 b) → 0
        ((eq (cadr expr) 0) 0)
        ; (* a 0) → 0
        ((eq (caddr expr) 0) 0)
        ; (* 1 b) → b
        ((eq (cadr expr) 1) (simp (caddr expr)))
        ; (* a 1) → a
        ((eq (caddr expr) 1) (simp (cadr expr)))
        ; (* 数 数)
        ((and (integerp (cadr expr)) (integerp (caddr expr)))
         (* (cadr expr) (caddr expr)))
        ; (* a 数) → (* 数 a)
        ((rationalq (caddr expr))
         (list '* (caddr expr) (cadr expr)))
        ; (* a a) → (^ a 2)
        ((and (atom (cadr expr))
              (equal (cadr expr) (caddr expr)))
         (list '^ (cadr expr) 2))
        ; (* 数a (+ 数b c)) → (* (* 数a 数b) c)
        ;
        ; 数a=(cadr expr)
        ; (* 数b c)=(caddr expr)
        ; 数b=(cadr (caddr expr))
        ; 数c=(caddr (caddr expr))
        ((and (listp (caddr expr))
              (rationalq (cadr expr))
              (equal (car (caddr expr)) '*)
              (rationalq (cadr (caddr expr))))
         (list '*
               (list '*
                     (cadr expr)
                     (cadr (caddr expr)))
               (caddr (caddr expr))))
        ; (* (* 数a b) (* 数c d)) → (* (* 数a 数c) (* b d))
        ;
        ; (* 数a b)=(cadr expr)
        ; (* 数c d)=(caddr expr)
        ; 数a=(cadr (cadr expr))
        ; b  =(caddr (cadr expr))
        ; 数c=(cadr (caddr expr))
        ; d  =(caddr (caddr expr))
        ((and (listp (cadr expr))
              (equal (car (cadr expr)) '*)
              (rationalq (cadr (cadr expr)))
              (listp (caddr expr))
              (equal (car (caddr expr)) '*)
              (rationalq (cadr (caddr expr))))
         (list '*
               (list '*
                     (cadr (cadr expr))
                     (cadr (caddr expr)))
               (list '*
                     (caddr (cadr expr))
                     (caddr (caddr expr)))))
        ; その他のとき
        (t (list '* (simp (cadr expr)) (simp (caddr expr))))
    )
)

; / 演算子
;
; (/ a b)
; a=(cadr expr)
; b=(caddr expr)
(defun simp_div (expr)
    (cond
        ; (/ 0 b) → 0
        ((eq (cadr expr) 0) 0)
        ; (/ a 1) → a
        ((eq (caddr expr) 1) (cadr expr))
        ; (/ a a) → 1
        ((equal (cadr expr) (caddr expr)) 1)
        ; (/ 数 数)
        ((and (integerp (cadr expr)) (integerp (caddr expr)))
         (let (g)
              (setq g (gcd (cadr expr) (caddr expr)))
              (list '/ (/ (cadr expr) g) (/ (caddr expr) g))
         )
        )
        ; その他のとき
        (t (list '/ (simp (cadr expr)) (simp (caddr expr))))
    )
)

; ^ 演算子
;
; (^ a b)
; a=(cadr expr)
; b=(caddr expr)
(defun simp_pow (expr)
    (cond
        ; (^ a 0) → 1
        ((eq (caddr expr) 0) 1)
        ; (^ a 1) → a
        ((eq (caddr expr) 1) (cadr expr))
        ; その他のとき
        (t (list '^ (simp (cadr expr)) (simp (caddr expr))))
    )
)

; 2整数 m,n の最大公約数を求める(ユークリッドの互除法)
(defun gcd (m n)
    ; ローカル変数 a,b,r を用意
    (let ((a m) (b n) r)
         (if (< a b)
             ; a と b の値を交換
             (let (tmp)
                  (setq tmp a)
                  (setq a b)
                  (setq b tmp)
             )
         )

         (setq r (% a b))    ; r ← a % b
         (setq a b)
         (setq b r)
         (if (eq r 0)
             a
             (gcd a b)
         )
    )
)

; expr (/ a b) が (/ 数 数) の形か整数のとき t それ以外は nil
;
; a=(cadr expr)
; b=(caddr expr)
(defun rationalq (expr)
    (if (or (integerp expr)
            (and (listp expr)
                 (equal (car expr) '/)
                 (integerp (cadr expr))
                 (integerp (caddr expr))))
        t
        nil
    )
)

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

; expr に式を代入する
;(setq expr '(cos ( 2 * exp ( x ))))
;(setq expr '(log( x ^ 2 )))
;(setq expr '( (2 * x + a) ^ 2 + x + 1 ))
;(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)

; 簡単化する
(simplify expr2)
(pre2in (simplify expr2))

;;
;; End of file
;;