Lisp の問題がわかりません

質問

次の問題のプログラムを教えてください。

《多項式のかけ算》
１つの変数を含む線形多項式のかけ算を行なう関数 poly-times を定義する.

多項式は例えば
2x^4 - x^3 + x^2 + x-1 →
(+ (* 2 X X X X) (* -1 X X X) (* X X) X -1)

2x4 - x3 + x2 + x-1 →
(+ (* 2 X X X X) (* -1 X X X) (* X X) X -1)

のように LISP の式で表現するものとする. すなわち, 第1要素が " +", 第2要素以降が項であるようなリストである. 演算子は +, * のみとし, -, / は使わない. 変数には X というシンボルを用いる. 項は, 整数, シンボル X, あるいは, 第1要素が "*" であるリストのいずれかであり, リストの場合, 第2要素に整数が入り第3要素以降は X, あるいは, 第2要素以降が X であるものとする.

（実行例）

>(poly-times '(+ X 2) '(+ X -2))
(+ (* X X) -4)

>(poly-times '(+ (* 2 X X) X 5) '(+ (* X X) (* -5 X) 3))
(+ (* 2 X X X X) (* -9 X X X) (* 6 X X) (* -22 X) 15)

各項をかけ合わせてそれらの和をとればよいので, 2つの項をかける関数とか, 多項式と項を足す関数などを作って組み合わせれば できそうです.

たとえば,

(defun poly-times (x y &aux z)
(dotimes (i (length (cdr x))) (dotimes (j (length (cdr y)))
(setf z (embed-term (term-times (nth i (cdr x)) (nth j (cdr y))) z))))
(cons '+ z))

などと定義しておいて, 項同士のかけ算を実行する関数 term-times と, 1つの項を多項式に加える関数 embed-term をうまく定義してやれば 完成です.

自分でも試してみましたが、場合分けなどが多く、解けませんでした。
わかる方の御協力をお願いいたします。

回答No.2

hpsk

とりあえず実行効率は無視ですが、以下のような感じでどうでしょう。
文字はxのみと仮定して良いのですよね？

(+ x 1) -> (+ (* 1 x) (* 5))
(* x x) -> (+ (* 1 x x))
などのように、一旦すべての式を
(+ (* <num> <x-list>) ... )
の形に直してやる(normalize)ことで、場合わけの必要を無くします。
計算が終ったら、元に戻します(denormalize)

kaitoumanさんが示されたような中間表現のほうが
実行効率はいいですが、プログラムが見にくくなるので、
速度を気にしないのであれば、これで良いかと思います。

;;;;;;

(defun term-normalize (term)
(cond
((symbolp term) `(* 1 ,term))
((numberp term) `(* ,term))
((eq '* (car term))
(if (numberp (second term))
term
`(* 1 ,@(cdr term))))
(t (error "Syntax error"))))

(defun poly-normalize (poly)
(if (and (consp poly)
(eq '+ (car poly)))
`(+ ,@(mapcar #'term-normalize (cdr poly)))
`(+ ,(term-normalize poly))))

(defun term-denormalize (n-term)
(cond
((endp (cddr n-term)) (second n-term))
((= 1 (second n-term))
(if (endp (cdddr n-term))
(third n-term)
`(* ,@(cddr n-term))))
(t n-term)))

(defun poly-denormalize (n-poly)
(cond
((endp (cdr n-poly)) 0)
((endp (cddr n-poly)) (term-denormalize (second n-poly)))
(t `(+ ,@(mapcar #'term-denormalize (cdr n-poly))))))

(defun n-poly-plus (&rest poly-list)
(let ((term-list (reduce #'append (mapcar #'cdr poly-list))))
(setq term-list (sort term-list #'> :key #'length))
`(+ ,@(remove 0 (reduce-term term-list) :test #'= :key #'second))))

(defun reduce-term (sorted-term-list)
(if (endp sorted-term-list)
'()
(reduce-term2 (car sorted-term-list)
(reduce-term (cdr sorted-term-list)))))

(defun reduce-term2 (term rem-term)
(let ((len1 (length term))
(len2 (length (car rem-term))))
(if (= len1 len2)
(let ((num1 (second term))
(num2 (second (car rem-term))))
(cons `(* ,(+ num1 num2) ,@(cddr term))
(cdr rem-term)))
(cons term rem-term))))

(defun n-poly-times (&rest poly-list)
(if (endp poly-list)
'(+ (* 1))
(n-poly-times2 (car poly-list)
(apply #'n-poly-times (cdr poly-list)))))

(defun n-poly-times2 (poly1 poly2)
(if (endp (cdr poly1))
'(+)
(apply #'n-poly-plus
(n-poly-times2 `(+ ,@(cddr poly1)) poly2)
(mapcar #'(lambda (term2)
`(+ ,(n-term-times2 (cadr poly1) term2)))
(cdr poly2)))))

(defun n-term-times2 (term1 term2)
`(* ,(* (second term1) (second term2))
,@(cddr term1) ,@(cddr term2)))

(defun poly-plus (&rest poly-list)
(poly-denormalize
(apply #'n-poly-plus (mapcar #'poly-normalize poly-list))))

(defun poly-times (&rest poly-list)
(poly-denormalize
(apply #'n-poly-times (mapcar #'poly-normalize poly-list))))

回答No.1

kaitou-man

見通しよく作ろうとするなら、もっと細かく分けるべきでしょう。特に場合分けが複雑そうですので、場合分けのいらないような中間表現を考えて採用すべきです。

例えば、
(+ (* 2 X X X X) (* -1 X X X) (* X X) X -1)
ならば、((2 4) (-1 3) (1 2) (1 1) (-1 0)) とか、もっと省略するなら係数のリストをX^0の項から順に並べた形式 (-1 1 1 -1 2) でも同じものを表現できるし、これならかけ算も元のままよりかなり単純化できます。

後者の方式を使うとするなら、(+ (* 2 X X X X) (* -1 X X X) (* X X) X -1) の形式を (-1 1 1 -1 2) に変換する関数が必要です。(* 2 X X X X) を (0 0 0 0 2) に変換するような関数を各項について呼び出して、(0 0 0 0 2) と (-1) の和として (-1 0 0 0 2) とかを作っていけばできます。さらにその逆変換をする関数もいりますが、これはできますよね。

かけ算は、(-1 1 1 -1 2) x (0 0 3 0) なら (0 0 -3 3 3 -3 6) というようなのを、繰り返して、合計を出せばいいですね。