「Ansi Common Lisp」9章練習問題

1. 実数のリストを引数として、このリストが降順でない並びになっている場合に真を返す関数を定義せよ。

(defun is-not-descending-order (real-lst)
  (not (apply #'> real-lst)))

(is-not-descending-order '(0.3 0.2 0.1))
(is-not-descending-order '(0.1 0.2 0.3))
(is-not-descending-order '(0.3 0.1 0.2))

結果はこう。

*
IS-NOT-DESCENDING-ORDER
*
NIL
*
T
*
T
* 

2. 整数のセントを引数とし、その金額とするための4種類のコイン(25セント、10セント、5セント、1セント)の組み合わせ(コインの数は最小になるように)を示す4つの値を返す関数を定義せよ。

(defun cents (cent)
  (let* ((quarter (truncate (/ cent 25)))
         (quarter-mod (mod cent 25))
         (ten (truncate (/ quarter-mod 10)))
         (ten-mod (mod quarter-mod 10))
         (five (truncate (/ ten-mod 5)))
         (one (mod ten-mod 5)))
    (values quarter ten five one)))

(cents 100)
(cents 123)
(cents 41)

力ずくですが、結果はこう。

*
4
0
0
0
*
4
2
0
3
*
1
1
1
1
* 

3. はるかかなたの惑星に2種類の生物(wiggliesとwobblies)が住んでいるとする。wiggliesもwobbliesも同じ程度に歌うのがうまい。毎年、シンガーのベスト10を選ぶ大がかりなコンテストがもよおされる。以下の表は過去10年間の結果である。このようなコンテストをシミュレートするプログラムを書け。その結果から、審査委員は毎年、本当にベスト10を選んでいると言えるだろうか。

年	1	2	3	4	5	6	7	8	9	10
WIGGLIES	6	5	6	4	5	5	4	5	6	5
WOBBLIES	4	5	4	6	5	5	6	5	4	5

; 1から100までのランダムなスコアを返す
(defun score ()
  (+ (random 100) 1))

; n人分のスコアをリストにして返す
(defun scores (n name)
  (if (eql n 0)
    nil
    (cons (list (score) name) (scores (- n 1) name))))

; 結果をサマリする
(defun summarize (lst)
  (if (null lst)
    '(0 0)
    (let ((result (summarize (cdr lst))))
      (if (eql (cadr (car lst)) 'wigglies)
        (list (+ (car result) 1) (cadr result))
        (list (car result) (+ (cadr result) 1))))))

; WIGGLIESのスコア
(setf wigglies-scores (scores 100 'wigglies))

; WOBBLIESのスコア
(setf wobblies-scores (scores 100 'wobblies))

; コンテスト開催
; スコアをマージ
(setf all-scores (append wigglies-scores wobblies-scores))

; 成績の良い順に並べてトップ10を抽出
(setf top-ten (subseq (sort all-scores #'> :key #'car) 0 10))

; 結果を表示
(setf summarize-result (summarize top-ten))
(format t "wigglies = ~A~%" (car summarize-result))
(format t "wobblies = ~A~%" (cadr summarize-result))

なんか全然関数型言語っぽくない。。
けど、一応動いた。

* wigglies = 6
NIL
* wobblies = 4
NIL
* 

その結果から、審査委員は毎年、本当にベスト10を選んでいると言えるだろうか。

については、同点10位になった場合の考慮がないので、本当にベスト10を選んでいるとは言えないような気がします。(まあ、たまたま10年間同点10位がなかったのかも知れませんが。。)

4. 2次元平面における2つの線分の両端の点を示す8つの実数を引数として、線分が交わらないときはnilを返し、交わるときはx,yの座標の対を示す2値を返す関数を定義せよ。

うわ、数学の問題だよこれ。。
まず傾きを求める。
a = (y2 - y1) / (x2 - x1)

で、次に切片を求める
y = ax + bだから、b = y - ax。
aは上で求めたやつを代入、xとyはどっちか一つの座標を代入。
これで、y = ax + bの式が二つ出来上がるので、連立二元方程式として解けば交点が求まる。

; 傾きを求める
(defun calc-a (x1 y1 x2 y2)
  (/ (- y2 y1) (- x2 x1)))

; 切片を求める
(defun calc-b (x1 y1 a)
  (- y1 (* a x1)))

; 傾きと切片を求めてリストとして返す
(defun calc-ab (x1 y1 x2 y2)
  (let* ((a (calc-a x1 y1 x2 y2))
         (b (calc-b x1 y1 a)))
    (list a b)))

; 2つの線分の交点を求める
(defun calc-cross-point (x1 y1 x2 y2 x3 y3 x4 y4)
  (let* ((ab1 (calc-ab x1 y1 x2 y2))
         (ab2 (calc-ab x3 y3 x4 y4)))
    (if (eql (car ab1) (car ab2))
      ; 傾きが同じ＝平行な直線なので交わらない
      nil
      (calc-cross-point-from-ab ab1 ab2))))

(defun calc-cross-point-from-ab (ab1 ab2)
  (let* ((x (/ (- (cadr ab2) (cadr ab1)) (- (car ab1) (car ab2))))
         (y (+ (* (car ab1) x) (cadr ab1))))
    (list x y)))

; 交わる
(calc-cross-point 2 1 6 6 2 6 6 1)

; 平行
(calc-cross-point 2 1 4 2 2 4 4 5)

; 線分を延長すると交わる。。
(calc-cross-point 2 6 6 1 2 -4 6 -1)

結果はこう。

*
(4 7/2)
*
NIL
*
(7 -1/4)
* 

ただ、上の考え方だと、線分の上に無い点(延長するとぶつかる点)が求まってしまうのと、
座標(0,0)と(0,2)で構成されるような線分(y軸に平行)の場合、傾きが無限大になってしまうのでうまくいかないですね。。

http://questionbox.jp.msn.com/qa672905.html?StatusCheck=ON

に、交差判定をやる方法が載ってました。
これやれば、最初の問題は解決するかも?
割り算出てこないし、無限大の問題も回避している??

5. fは1つの実数を引数とする関数で、f(min)とf(max)は異符号のゼロでない実数であり、fはmin < i < maxの根を一つもつ(引数iでfを呼ぶとゼロが返る)。f, min, max, epsilonの4引数をとり、±epsilonの精度で近似したiを返す関数を定義せよ(逐次二分法による方程式の解法)

6. Horner法は多項式を効率的に評価するためのテクニックである。たとえばax^3 + bx^2 + cx + dを解くのにx(x(ax + b) + c) + dを評価する。複数の引数(xの値と(n - 1)次の多項式の係数を示すn個の実数の並び)をとり、Horner法で多項式の値を計算する関数を定義せよ。

うーん、パスｗ

7. 自分の使っている処理系では、固定数を表現するのに、どのくらいのビットを使用しているか推定せよ。

* (log most-positive-fixnum 2)

29.0

だから、マイナスも考慮すると30bitsですか?

8. 自分の使っている処理系では、いくつの型の浮動小数点数が用意されているか。

http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/html/cltl/clm/node134.htmlによれば、いくつかあるのですが、

* most-positive-short-float

3.4028235e+38
* most-positive-single-float

3.4028235e+38
* most-positive-double-float

1.7976931348623157d+308
* most-positive-long-float

1.7976931348623157d+308
*

実質は2つしかないですね。