6章 式の簡単化

5章 の記号微分をやってみるとわかるが、結果の式は簡単な表現になっていないので、 見やすくするためにも簡単化を行う必要がある。 この章では式の簡単化について説明する。

sin(0) → 0 などの簡単化もあるが、ここでは上の表に基づいて簡単化を行う。

また、数同士の演算は簡単化したいのでその処理も行う。 次の変換規則は複雑に分数が入り組んでいる場合の簡単化などにも対処できる。 自分で手計算で複雑に入れ子構造になっている分数などを簡単化していくときの 手順を思い浮かべればわかるだろう。

"^" の場合は面倒なのでここでは省略する。 基本的には数の部分と文字の部分を分離して簡単化していく。 表2-2 の規則を使って数字を前の方に出し、 3,4,6,7 のように結合規則を適用して数字を前の方に出してまとめる。 5 の規則より、引き算 - の表現は +,* で表現されるようになる。 9,10 の規則より、数を含む割り算は全て始めが掛け算の演算表現になる。
このような規則は列挙されると複雑でわからないかもしれないが、 自分で計算することを考え、プログラムするときには少しずつ足りない規則 を追加していくのである。

このように、再帰的に処理をするプログラムを書いていると慣れないうちは、 「このプログラムは無限ループに陥らないだろうか？」 と思うものであるが、一方通行になるような変換を繰り返していればそのようなことは 絶対にない。

式の簡単化を行う Lisp プログラム

プログラムリスト: simplify.el

;;;---------------------------------------------------------------
;;; 式の簡単化 (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
;;

実行例

(* a (/ 1 b)) の表示処理が不完全だが、 それは pre2in 関数で対応すればよく、 前の表現は簡単化されているのがわかる。