;;;---------------------------------------------------------------
;;; 多項式の表現変換 (by 平野 拓一)
;;;---------------------------------------------------------------

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

;;; リストを1レベル平にする
(defun flatten1 (lis)
    (cond
        ; nil のとき
        ((null lis) nil)
        ; アトムのとき
        ; 次に nconc で要素連結するために list にしておく
        ((atom lis) (list lis))
        ; lis の先頭要素がアトムのとき
        ((atom (car lis))
         (nconc (list (car lis)) (flatten1 (cdr lis))))
        ; それ以外のとき
        (t (nconc (car lis) (flatten1 (cdr lis))))
    )
)

;;;---------------------------------------------------------------
;;; 多項式の表現変換をする
;;;---------------------------------------------------------------

;-----------------------------------------------------------------
; 展開された多項式の前置表現を連想リスト表現に変換する
;
; [Input]
; expr: 前置表現
; var: 多項式の文字
;
; [Return]
; 多項式の連想リスト表現
;-----------------------------------------------------------------
(defun pre2alist (expr var)
    (cond
        ; var のとき
        ; x → ((1 . 1))
        ((equal expr var) (list (list 1 1)))
        ; var でないアトムのとき
        ((atom expr) (list (list 0 expr)))
        ; + 演算子の処理
        ((equal (car expr) '+)
         (sort_collect (pre2alist_plus expr var)))
        ; * 演算子の処理
        ((equal (car expr) '*)
         (sort_collect (pre2alist_mult expr var)))
        ; ^ 演算子の処理
        ((equal (car expr) '^)
         (sort_collect (pre2alist_pow expr var)))
    )
)

(defun pre2alist_plus (expr var)
    (cond
        ; (+ a b) → ((alist a) (alist b))
        ; a=(cadr expr)
        ; b=(caddr expr)
        (t
         (append (pre2alist (cadr expr) var)
                 (pre2alist (caddr expr) var)))
    )
)

; p,q は多項式の連想リスト表現
(defun alist_mult (p q)
    (cond
        ; pi * qj → (i+j . (+ (pi の係数) (qj の係数)))
        ; pi=(cadr expr)
        ; qj=(caddr expr)
        ((and (eq (length p) 1)
              (eq (length q) 1))
         (list (list (simplify (list '+ (caar p) (caar q)))
                     (simplify (list '* (cdar p) (cdar q))))))
        ; pi * q → (+ (* pi q1) (* pi q2) ... (* pi qn))
        ((eq (length p) 1)
         (mapcar '(lambda (qj) (car (alist_mult p (list qj)))) q))
        ; p * qj → (+ (* p1 qj) (* p2 qj) ... (* pn qj))
        ((eq (length q) 1)
         (mapcar '(lambda (pi) (car (alist_mult (list pi) q))) p))
        ; p * q → (+ (* p1 q) (* p2 q) ... (* pn q))
        (t
         (flatten1 (mapcar '(lambda (pi) (alist_mult (list pi) q)) p)))
    )
)

; * 演算子の処理
(defun pre2alist_mult (expr var)
    (cond
        ; (* a b)
        ; a=(cadr expr)
        ; b=(caddr expr)
        (t (alist_mult (pre2alist (cadr expr) var)
                       (pre2alist (caddr expr) var)))
    )
)

(defun pre2alist_pow (expr var)
    (cond
        ; (^ x n) → ((n . 1))
        ;
        ; (^ a b)
        ; a=(cadr expr)
        ; b=(caddr expr)
        ((and (equal (cadr expr) var)
              (integerp (caddr expr)))
         (list (list (caddr expr) 1)))
        ; (^ p 1) → p
        ;
        ; (^ a b)
        ; a=(cadr expr)
        ; b=(caddr expr)
        ((eq (caddr expr) 1)
         (pre2alist (cadr expr) var))
        ; (^ p n) → (* p (^ p (- n 1)))
        ;
        ; (^ a b)
        ; a=(cadr expr)
        ; b=(caddr expr)
        ((and (> (length (cadr expr)) 1)
              (natnump (caddr expr)))
         (alist_mult (pre2alist (cadr expr) var)
                     (pre2alist (list '^
                                      (cadr expr)
                                      (simplify (list '-
                                                      (caddr expr)
                                                      1))) var)))
        ; その他の場合
        (t expr)
    )
)

;-----------------------------------------------------------------
; ソートして x^n の項はまとめる
;
; [Input]
; expr: 連想リスト表現
;-----------------------------------------------------------------
(defun sort_collect (expr)
    (let ((ord_prev -1) (p (sort expr 'sort_down_ord)) (expr2 ()))

         (while (not (null p))
             (if (equal (caar p) ord_prev)
                 ;---- true: 前と指数部が同じとき
                 (setq expr2
                       (append (list (list ord_prev
                                           ; 係数部の表現は簡単化しておく
                                           (simplify (list '+ (cdar expr2)
                                                              (cdar p)))))
                               (cdr expr2)))
                 ;---- false: 違う時
                 (setq expr2 (append (list (car p)) expr2))
             )

             (setq ord_prev (caar p))    ; 指数部の値を更新
             (setq p (cdr p))            ; 次のコンスセル
         )
         expr2
    )
)

; 降べきの順に並べるための比較関数
(defun sort_down_ord (cons1 cons2)
    (if (< (car cons1) (car cons2))
        t
        nil
    )
)

;-----------------------------------------------------------------
; 多項式の連想リスト表現を前置表現をに変換する
;
; [Input]
; expr: 多項式の連想リスト表現
; var: 多項式の文字
;
; [Return]
; 多項式の前置表現
;-----------------------------------------------------------------
(defun alist2pre (expr var)
    (cond
        ; 最後の項のとき
        ;
        ; ((a b))
        ; a=(caar expr)
        ; b=(car (cdar expr))
        ((eq (length expr) 1)
         (list '* (car (cdar expr))
                  (list '^ var (caar expr))))
        ; 項が２つ以上あるとき
        (t
         (list '+ (list '* (car (cdar expr))
                           (list '^ var (caar expr)))
                  (alist2pre (cdr expr) var)))
    )
)

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

; テスト関数

;(setq expr (in2pre '((x + a) ^ 2 + x * x)))
;(setq expr (in2pre '(a * x ^ 1 + b + x ^ 3)))
(setq expr (in2pre '((a * x + 1) ^ 2 + 1)))

; 多項式の前置表現から連想リスト表現へ
(pre2alist expr 'x)

; 多項式の連想リスト表現から前置表現へ
(pre2in (simplify (alist2pre (pre2alist expr 'x) 'y)))

;;
;; End of file
;;