;;;---------------------------------------------------------------
;;; 内挿表現から前置表現への変換 (by 平野 拓一)
;;;---------------------------------------------------------------

;;;---------------------------------------------------------------
;;; Common Lisp の基本関数を定義する
;;;---------------------------------------------------------------

(defun nequal (x y)
    (if (equal x y) nil t)
)

(defun cadr (x)
    (car (cdr x))
)

(defun caddr (x)
    (car (cdr (cdr x)))
)

(defun cdar (x)
    (cdr (car x))
)

(defun caar (x)
    (car (car x))
)

(defun cddr (x)
    (cdr (cdr x))
)

;;;---------------------------------------------------------------
;;; 演算子の重みを定義する
;;; 
;;; 次の例でわかるように、 / は * よりも高い演算順位をもつ
;;; (例) 8/2*4, (8/2)*4=16, 8/(2*4)=1
;;;---------------------------------------------------------------
(defun weight (op)
    (cond
        ((equal op '+) 1)
        ((equal op '-) 1)
        ((equal op '*) 2)
        ((equal op '/) 3)
        ((equal op '^) 4)
        ((equal op 'sin) 6)
        ((equal op 'cos) 6)
        ((equal op 'exp) 6)
        ((equal op 'log) 6)
        (t 9)                  ; 数値とか文字はここ
    )
)

;;;---------------------------------------------------------------
;;; 内挿表現から前置表現への変換
;;;---------------------------------------------------------------

; 内挿表現から前置表現へ変換する関数
(defun in2pre (expr)
    (cond
        ((atom expr) expr)         ; アトムだったらそのまま返す
        (t (in2pre_1 expr nil nil))
    )
)

; 関数の処理か、それ以外の四則演算・冪乗等の処理を振り分ける
(defun in2pre_1 (expr optr opln)
    (cond
        ;---- condition: +,- 単項演算子のとき
        ((eq (weight (car expr)) 1)
         (in2pre_2 expr optr (cons '0 opln)))
        ;---- condition: 四則演算・冪乗等のとき
        ; expr は expr の後ろの部分
        ; optr はそのまま
        ; opln に expr の前の部分を追加
        ((or (< (weight (car expr)) 5)
             (> (weight (car expr)) 7))
         (in2pre_2 (cdr expr) optr (cons (in2pre (car expr)) opln)))
        ;---- condition: 関数のとき
        (t (in2pre_3 (cddr expr)
                     optr
                     (cons (list (car expr) (in2pre (cadr expr))) opln)))
    )
)

; 四則演算・冪乗等の処理
(defun in2pre_2 (expr optr opln)
    (cond
        ;---- condition: ((expr が空) and (optr が空))
        ;
        ; opln の先頭を返す
        ((and (equal expr nil) (equal optr nil))
         (car opln))
        ;---- condition: (expr が空でない) and ((optr が空) or
        ; ((expr 先頭の演算子の重み) > (optr 先頭の演算子の重み)))
        ;
        ; expr は expr の後ろの部分
        ; optr に expr 先頭のオペレータを追加
        ; opln はそのまま
        ((and (nequal expr nil)
              (or (equal optr nil) (> (weight (car expr))
                                      (weight (car optr)))))
         (in2pre_1 (cdr expr) (cons (car expr) optr) opln))
        ;---- condition: それ以外のとき
        ; つまり、前の optr に格納されている演算子よりも
        ; 今から処理する expr 先頭の演算子のが重みが重いとき
        ;
        ; expr はそのまま
        ; optr はスタック先頭を除いた後ろの部分
        ; opln は optr から取り出した 演算子を使って前置表現にする
        (t (in2pre_2 expr
                     (cdr optr)
                     (cons (list (car optr)
                                 (cadr opln)
                                 (car opln))
                           (cddr opln))))
    )
)

; 関数の処理
(defun in2pre_3 (expr optr opln)
    (cond
        ;---- condition: ((expr が空) and (optr が空))
        ;
        ; opln の先頭を返す
        ((and (equal expr nil) (equal optr nil))
         (car opln))
        ;---- condition: ((expr が空でない) and
        ; ((optr が空) or (expr 先頭の演算子の重みがその次のより重い)))
        ;
        ; expr は先頭を取り除く
        ; optr は expr の先頭のものを追加する
        ; opln はそのまま
        ((and (nequal expr nil)
              (or (equal optr nil) (> (weight (car expr))
                                      (weight (cadr expr)))))
         (in2pre_1 (cdr expr) (cons (car expr) optr) opln))
        ;---- condition: その他のとき
        ; expr の先頭の演算子の重みはその次の重みよりも軽いので、
        ;
        ; expr はそのまま
        ; optr はそのまま
        ; opln は opln の前の２つのリスト
        (t (in2pre_2 expr optr opln))
    )
)

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

; 変数 expr に式を代入する
(setq expr '((1 + 3 * x) * 2 + sin (- x ^ 2) * log ( a )))
; 内挿表現を前置表現に変換する
(in2pre expr)
(in2pre '(8 / 2 * 4))

;;
;; End of file
;;