ITコンサルの日常

ITコンサル会社に勤務する普通のITエンジニアの日常です。

「Ansi Common Lisp」5章練習問題

1. 以下の式をletや*letを使わないで、しかも1つの式が2度評価されることがないような等価な式に書き換えよ。

(a) (let ((x (car y)))
      (cons x x))

letはlambdaで置き換えられるので、

(setf y '(a b c))

(let ((x (car y)))
  (cons x x))

((lambda (y) (cons y y)) (car y))

結果はこう。

* Warning:  Declaring Y special.

(A B C)
*
(A . A)
*
(A . A)
* 
(b) (let* ((w (car x))
           (y (+ w z)))
      (cons w y))
(setf x '(5 4 3))
(setf z 8)

(let* ((w (car x))
       (y (+ w z)))
  (cons w y))

((lambda (w z) (cons w (+ w z))) (car x) z)

結果はこう。

* Warning:  Declaring X special.

(5 4 3)
* Warning:  Declaring Z special.

8
*
(5 . 13)
*
(5 . 13)
* 

2. 26ページのmysteryをcondを使って書き換えよ。

(defun mystery (x y)
  (if (null y)
    nil
    (if (eql (car y) x)
      0
      (let ((z (mystery x (cdr y))))
        (and z (+ z 1))))))

(defun mystery-cond-ver (x y)
  (cond ((null y) nil)
        ((eql (car y) x) 0)
        (t (let ((z (mystery x (cdr y))))
           (and z (+ z 1))))))

(mystery 2 '(1 2 3))
(mystery-cond-ver 2 '(1 2 3))

ifをcondに置き換えただけ。
結果はこう。

*
MYSTERY
*
MYSTERY-COND-VER
*
1
*
1
*

3. 引数の平方を返す関数を定義せよ。ただし、引数が5以下の正の整数である場合は平方の計算を行わないものとする。

なんか、ひっかけ問題(っていう言葉も懐かしいけど)っぽいですね。
0 <= x <= 5の範囲は平方の計算を行わないのですが、x < 0の範囲は平方の計算を行うわけです。

(defun my-square (x)
  (if (numberp x)
    (if (or (< x 0)
            (> x 5))
      (* x x)
      x)))


(my-square 0)
(my-square 5)
(my-square -5)
(my-square 6)

結果はこう。

*
MY-SQUARE
*
0
*
5
*
25
*
36
* 

4. 図5.1のmonth-numをsvrefのかわりにcaseを使って書き換えよ。

ちなみにmonth-num関数は、指定年月の始まるまでの日数を返す関数だったりします。

(defconstant month
  #(0 31 59 90 120 151 181 212 243 273 304 334 365))

(defun leap? (y)
  (and (zerop (mod y 4))
       (or (zerop (mod y 400))
           (not (zerop (mod y 100))))))

(defun month-num (m y)
  (+ (svref month (- m 1))
     (if (and (> m 2) (leap? y)) 1 0)))

(defun my-month-num (m y)
  (+ (case m
       ((1) 0) ((2) 31) ((3) 59) ((4) 90) ((5) 120) ((6) 151)
       ((7) 181) ((8) 212) ((9) 243) ((10) 273) ((11) 304) ((12) 334))
     (if (and (> m 2) (leap? y)) 1 0)))

(month-num 8 2008)
(my-month-num 8 2008)

むちゃくちゃゴリ押し。つか、素直にsvref使った方がきれいな気がします。
結果はこう。

*
MONTH
*
LEAP?
*
MONTH-NUM
*
MY-MONTH-NUM
*
213
*
213
* 

5. オブジェクトxとベクタvを引数として、vの中でxの直前にくる全オブジェクトを返すような関数を定義せよ。

(defun precedes (x v)
  (if (or (null v)
          (eql 1 (length v)))
    nil
    (let ((result (precedes x (subseq v 1))))
      (if (eql x (elt v 1))
        (if (member (elt v 0) result)
          result
          (cons (elt v 0) result))
        result))))

(precedes #\a "abracadabra")

ベクタなので、carとかcdrは使えないんですね。代わりにeltとsubseq使ってます。
結果はこう。

*
PRECEDES
*
(#\c #\d #\r)
* 

6. 1つのオブジェクトと1つのリストを引数として、このリストの要素間にオブジェクトを挿入した新しいリストを返す関数を、反復と再帰の両方の方法で定義せよ。

(defun intersperse-recursive (x lst)
  (if (eql (cdr lst) nil)
    (list (car lst))
    (cons (car lst) (cons x (intersperse-recursive x (cdr lst))))))

(defun intersperse-loop (x lst)
  (let ((result nil))
    (dolist (obj lst result)
      (if (null result)
        (setf result (list obj))
        (setf result (append result (list x) (list obj)))))))

(intersperse-recursive '- '(a b c d))
(intersperse-loop '- '(a b c d))

結果はこう。

*
INTERSPERSE-RECURSIVE
*
INTERSPERSE-LOOP
*
(A - B - C - D)
*
(A - B - C - D)
* 

7. 数のリストを引数として、連続するペアの差が1となる場合に真を返す関数を以下の3つの方法で定義せよ。

; (a) 再帰
(defun test-list-diff-is-1-recursive (lst)
  (if (null lst)
    nil
    (if (eql (cdr lst) nil)
      t
      (and (or (eql (- (car lst) (cadr lst)) 1)
               (eql (- (cadr lst) (car lst)) 1))
         (test-list-diff-is-1-recursive (cdr lst))))))

; (b) do
(defun test-list-diff-is-1-loop (lst)
  (let ((result t))
    (dotimes (x (length lst) result)
      (if (eql x 0)
        t
        (if (or (eql (- (nth x lst) (nth (- x 1) lst)) 1)
                (eql (- (nth (- x 1) lst) (nth x lst)) 1))
          t
          (setf result nil))))))

; (c) mapcとreturn
(defun test-list-diff-is-1-mapc-return (lst)
  (block nil
    (mapc #'(lambda (x y)
      (if (or (eql (- x y) 1)
              (eql (- y x) 1))
        t
        (return nil))) lst (cdr lst)) t))

(test-list-diff-is-1-recursive '(1 2 3))
(test-list-diff-is-1-recursive '(3 2 1))
(test-list-diff-is-1-recursive '(3 1 2))
(test-list-diff-is-1-recursive '(3 2 3))
(test-list-diff-is-1-recursive '(3 3 2))

(test-list-diff-is-1-loop '(1 2 3))
(test-list-diff-is-1-loop '(3 2 1))
(test-list-diff-is-1-loop '(3 1 2))
(test-list-diff-is-1-loop '(3 2 3))
(test-list-diff-is-1-loop '(3 3 2))

(test-list-diff-is-1-mapc-return '(1 2 3))
(test-list-diff-is-1-mapc-return '(3 2 1))
(test-list-diff-is-1-mapc-return '(3 1 2))
(test-list-diff-is-1-mapc-return '(3 2 3))
(test-list-diff-is-1-mapc-return '(3 3 2))

結果はこう。

*
TEST-LIST-DIFF-IS-1-RECURSIVE
*
TEST-LIST-DIFF-IS-1-LOOP
*
TEST-LIST-DIFF-IS-1-MAPC-RETURN
*
T
*
T
*
NIL
*
T
*
NIL
*
T
*
T
*
NIL
*
T
*
NIL
*
T
*
T
*
NIL
*
T
*
NIL
*

mapcとreturnのやつは出来てるけど、なんかイマイチ意味が分かってない。。

8. ベクタの要素の最大・最小の2値を返す(二重でない)再帰関数を定義せよ。

(defun vector-max-min (vec)
  (if (null vec)
    nil
    (let ((elem (elt vec 0)))
      (if (eql (length vec) 1)
        (list elem elem)
        (let ((result (vector-max-min (subseq vec 1))))
          (if (> elem (car result))
            (list elem (cadr result))
            (if (< elem (cadr result))
              (list (car result) elem)
              result)))))))

(vector-max-min #(3 1 2 5 4))

結果はこう。

*
VECTOR-MAX-MIN
*
(5 1)
* 

#'>とか、#'<とかって、文字にも使えるかと思ったら、
#\E is not of type REAL
とか出てエラーになっちゃうんですね。
意外と柔軟性がないというか。。

9. 図3.12のプログラムと同様にして、最初に完全な経路が見つかり次第すぐにそれを返すプログラムを書け。

多分returnを使うのだろうけど、経路問題は前回パスしているので、今回もパス。(よわ)