조립제법(Horner의 방법) 예제 for Common Lisp

다항식 p(x) 를 1차 다항식 x - a 로 나눌 때의 몫과 나머지를 구하는 조립제법을
Common Lisp 언어로 구현해 보았다. 조립제법은 일명 Horner의 방법이라고도 불리우는데, 이는 x = a 에서 다항식 p(x)의 값 p(a)을 계산하는 가장 빠른 알고리즘이기도 하다.

         p(x) = (x - a)q(x) + r

여기서 r은 나머지이며 r = p(a) 이다. 또 q(x)는 몫이다.

[참고]
    * 온라인으로 조립제법 표 만들기 손으로 계산하는 조립제법 표 
    * 온라인으로 구하는 다항식의 도함수: 조립제법을 이용한 다항식의 도함수


아래의 소스파일은 Python용 소스파일 testSyntheticDivision.py를 Common Lisp용으로 수정한 것이다. 

실행은 CLisp을 사용한다.

1. #!/usr/bin/env clisp
3. ;;  Filename: testSyntheticDivision.lsp
4. ;;
5. ;;  Purpose:  Find the quotient and remainder when some polynomial is
6. ;;            divided by a monic polynomial of the first degree.
7. ;;
8. ;;  Execute:  clisp testSyntheticDivision.lsp -2 1 3 3 1
9. ;;
10. ;;  Date: 201. 8. 31.
12. ;; 사용법 표시
13. (defun printUsage()
14.     (format t "사용법: python testSyntheticDivision.py [수] [피제식의 계수들]~%")
15.     (format t "조립제법(synthetic method)에 의한 다항식 나눗셈 결과를 보여준다.~%"))
17. ;; 스트링을 부동소수점수로 변환하는 함수
18. (defun parse-number (v)
19.      (with-input-from-string (s v) (read s)))
21. ;; 부동소수점수의 표현이 .0 으로 끝나는 경우 이를 잘라낸다.
22. ;; 전체 문자열 표시 너비는 매개변수 width 로 전달받아 처리한다.
23. (defun simplify(v width)
24.     (setf tt (format nil "~F" v))
25.     (setf tlen (length tt))
26.     (if (> tlen 1) (progn
27.         (if (equal (substring tt (- tlen 2) tlen) ".0") (progn
28.             (setf tt (substring tt 0 (- tlen 2)))
29.             (setf tlen (length tt))
30.             )
31.           )
32.     ))
33.     (if (not (equal width nil)) (progn
34.         (if (< tlen width) (progn
35.             (setf tt (concatenate 'string (substring "              " 0 (- width tlen)) tt)) ))
36.         )
37.     )
38.     tt )
40. ;; 다항식을 내림차순의 스트링 표현으로 반환
41. (defun toPolyString(c)
42.     (setf ttt "")
43.     (setf sc0 (simplify (nth 0 c) nil ))
44.     (setf sc0 (simplify (nth 0 c) nil ))
45.     (if (> (length c) 2)
46.         (cond
47.            ((equal sc0 "1") (setf ttt (concatenate 'string ttt (format nil "x^~D" (- (length c) 1)))))
48.            ((equal sc0 "-1") (setf ttt (concatenate 'string ttt (format nil "-x^~D" (- (length c) 1)))))
49.            (t (setf ttt (concatenate 'string ttt sc0 (format nil " x^~D" (- (length c) 1)))))
50.         )
51.     )
53.     (if (= (length c) 2)
54.         (cond
55.            ((equal sc0 "1") (setf ttt (concatenate 'string ttt "x")))
56.            ((equal sc0 "-1") (setf ttt (concatenate 'string ttt "-x")))
57.            (t (setf ttt (concatenate 'string ttt sc0 " x")))
58.         )
59.     )
60.     (if (= (length c) 1)
61.            (setf ttt (concatenate 'string ttt sc0))
62.     )
64.     (loop for i from 1 below (length c) do
65.         (setf k (- (length c) 1 i))
66.         (setf sc (simplify (nth i c) nil))
67.         (if (> k 1) (progn
68.             (cond
69.                 ((> (nth i c) 0.0)
70.                     (if (equal sc "1")
71.                         (setf ttt (concatenate 'string ttt " + " (format nil "x^~D" k)))
72.                         (setf ttt (concatenate 'string ttt " + " sc (format nil " x^~D" k)))
73.                     ) )
74.                 ((< (nth i c) 0.0)
75.                     (if (equal sc "-1")
76.                         (setf ttt (concatenate 'string ttt " - " (format nil "x^~D" k)))
77.                         (setf ttt (concatenate 'string ttt " - " (simplify (abs (nth i c)) nil) (format nil " x^~D" k)))
78.                     ) )
79.                 )
80.             )
81.         )
82.         (if (= k 1)
83.             (cond
84.                 ((> (nth i c) 0.0)
85.                     (if (equal sc "1")
86.                         (setf ttt (concatenate 'string ttt " + " "x"))
87.                         (setf ttt (concatenate 'string ttt " + " sc " x"))
88.                     ) )
89.                 ((< (nth i c) 0.0)
90.                     (if (equal sc "-1")
91.                         (setf ttt (concatenate 'string ttt " - " "x"))
92.                         (setf ttt (concatenate 'string ttt " - " (simplify (abs (nth i c)) nil) " x"))
93.                     ) )
94.             )
95.         )
97.         (if (= k 0)
98.             (cond
99.                 ( (> (nth i c) 0.0) (setf ttt (concatenate 'string ttt " + " sc)) )
100.                 ( (< (nth i c) 0.0) (setf ttt (concatenate 'string ttt " - " (simplify (abs (nth i c)) nil) )) )
101.             )
102.         )
103.     )
106. ;; 다항식 나눗셈 결과를
107. ;;     (피제식) = (제식)(몫) + (나머지)
108. ;; 형태로 출력
109. (defun printDivisionResult(a c b)
110.     (setf strLine (concatenate 'string "  " (toPolyString c)))
111.     (format t "~A~%" strLine)
112.     (setf strLine (concatenate 'string "    = ( " (toPolyString (list 1.0 (- a))) " )"))
113.     (setf tmp (make-list (- (length b) 1) :initial-element 0.0)) 
114.     (loop for i from 0 below (length tmp) do
115.         (setf (nth i tmp) (nth i b)) )
116.     (setf strLine (concatenate 'string strLine "( " (toPolyString tmp) " )"))
117.     (setf r (nth (- (length b) 1) b))
118.     (cond
119.        ((> r 0.0)  (setf strLine (concatenate 'string strLine " + " (simplify r nil) )))
120.        ((< r 0.0)  (setf strLine (concatenate 'string strLine " - " (simplify (abs r) nil) )))
121.     )
122.     (format t "~A~%" strLine)
123. )
125. ;; 조립제법 계산표 출력 함수
126. (defun printSyntheticTable(a c s q)
127.     (setf strLine "       | ")
128.     (setf strLine (concatenate 'string strLine (simplify (nth 0 c) 6) ))
130.     (loop for i from 1 below (length c) do
131.         (setf strLine (concatenate 'string strLine "  " (simplify (nth i c) 6) )))
133.     (format t "~A~%" strLine)
134.     (setf strLine (concatenate 'string (simplify a 6) " |"))
135.     (setf strLine (concatenate 'string strLine "         "))
136.     (setf strLine (concatenate 'string strLine (simplify (nth 1 s) 6)))
138.     (loop for i from 2 below (length s) do
139.         (setf strLine (concatenate 'string strLine "  " (simplify (nth i s) 6) )))
141.     (format t "~A~%" strLine)
142.     (setf strLine "       |")
144.     (loop for i from 0 below (length q) do
145.         (setf strLine (concatenate 'string strLine "--------")))
147.     (format t "~A~%" strLine)
149.     (setf strLine "         ")
150.     (setf strLine (concatenate 'string strLine (simplify (nth 0 q) 6)))
152.     (loop for i from 1 below (length q) do
153.         (setf strLine (concatenate 'string strLine "  " (simplify (nth i q) 6) )))
155.     (format t "~A~%" strLine)
156. )
159. ;; 실행 시작 지점
160. (if (< (length ext:*args*) 3) (progn
161.     (printUsage)
162.     (quit) ))
164. ;; ----------------------------------------------------
165. ;; 피제식은 c_0 x^n +  c_1 x^(n -1) + ... + c_n
166. ;; 제식은 x -  a
167. (setf a (parse-number (nth 0 ext:*args*)) )
168. (setf c (make-list (- (length ext:*args*) 1) :initial-element 0.0) )
169. (setf s (make-list (- (length ext:*args*) 1) :initial-element 0.0) )
170. (setf b (make-list (- (length ext:*args*) 1) :initial-element 0.0) )
172. (loop for i from 0 below (length c) do
173.     (setf (nth i c) (parse-number (nth (+ i 1) ext:*args*))))
175. ;; ----------------------------------------------------
176. ;; 조립제법의 주요 부분
177. (setf (nth 0 s) 0.0)
178. (setf (nth 0 b) (nth 0 c))
179. (loop for i from 1 below (length c) do
180.     (setf (nth i s) (* (nth (- i 1) b) a))
181.     (setf (nth i b) (+ (nth i c) (nth i s))) )
183. ;; ----------------------------------------------------
184. ;; 몫의 계수와 나머지를 출력한다.
185. (format t "몫의 계수는 ")
186. (loop for i from 0 below (- (length b) 2) do
187.     (format t (concatenate 'string (simplify (nth i b) nil) ",  ")))
188. (format t (concatenate 'string (simplify (nth (- (length b) 2) b) nil) " "))
189. (format t (concatenate 'string "이고, 나머지는 " (simplify (nth (- (length b) 1) b) nil) " 이다.~%"))
190. (terpri)
192. ;; ----------------------------------------------------
193. ;; 조립제법 표를 출력한다.
194. (printSyntheticTable a c s b)
195. (terpri)
197. ;; ----------------------------------------------------
198. ;; (피제식) = (제식) x (몫) + (나머지)
199. (printDivisionResult a c b)

실행> clisp testSyntheticDivision.lsp 1 2 3 4 5
몫의 계수는 2, 5, 9 이고, 나머지는 14 이다.

       |      2       3       4       5
     1 |              2       5       9
       |---------------------------------
              2       5       9      14

  2 x^3 + 3 x^2 + 4 x + 5
    = ( x - 1 )( 2 x^2 + 5 x + 9 ) + 14