『プログラミング言語SCHEME』解答集

まだ解答していない練習問題

2.2.1

a. (+ (* 1.2 (- 2 1/3)) -8.7)
b. (/ (+ 2/3 4/9) (- 5/11 4/3))
c. (+ 1 (/ 1 (+ 2 (/ 1 (+ 1 1/2)))))
d. (* 1 -2 3 -4 5 -6 7)
gosh> (+ (* 1.2 (- 2 1/3)) -8.7)
-6.699999999999999
gosh> (/ (+ 2/3 4/9) (- 5/11 4/3))
-1.2643678160919543
gosh> (+ 1 (/ 1 (+ 2 (/ 1 (+ 1 1/2)))))
1.375
gosh> (* 1 -2 3 -4 5 -6 7)
-5040

2.2.3

a. (car . cdr)
b. (this (is silly))
c. (is this silly?)
d. (+ 2 3)
e. (+ 2 3)
f. +
g. (2 3)
h. #<subr cons>
i. cons
j. 'cons
k. quote
l. 5
m. 5
n. 5
o. 5

2.2.4

(car (cdr (car '((a b) (c d)))))       ; b を返す
(car (car (cdr '((a b) (c d)))))       ; c を返す
(car (cdr (car (cdr '((a b) (c d)))))) ; d を返す

2.2.5

(cdr (cdr '((a b) (c d))))
(cdr (cdr (car (cdr '((a b) (c d))))))
(car (cdr (car (cdr '((a b) (c d))))))
(car (car (cdr '((a b) (c d)))))
(cdr (cdr (car '((a b) (c d)))))
(car (cdr (car '((a b) (c d)))))
(car (car '((a b) (c d))))

2.2.6

(procedure arg1 ... argn)

とあるとき、procedure, arg1 ... argn が評価されます(評価順序は処理系により異なります。つまり評価順序は定義されていません)。そして procedure の値に arg1 .. argn の値を引き渡して適用します。そしてその結果が返されます。

((car (list + - * /)) 2 3)

を例に考えてみますと、

(list + - * /)

list + - * /

が評価されて

#<subr list> #<subr +> #<subr -> #<subr *> #<subr />

となります。

#<subr list>

#<subr +> #<subr -> #<subr *> #<subr /> 

を引き渡して適用します。その結果

(#<subr +> #<subr -> #<subr *> #<subr />)

が返されます。

car 

が評価されて

#<subr car>

となります。これに

(#<subr +> #<subr -> #<subr *> #<subr />) 

を引き渡して適用し

#<subr +> 

が返されます。

2 

が評価されて

2 

となります。

3

が評価されて

3

となります。

#<subr +>

に 2 3 を引き渡して適用すると

5

が返されます。

2.3.1

オブジェクトのリストであるデータとプロシージャの適用とを区別するために、データを斜体にしています。なお式の評価順序がどのように行われるかは処理系によりますので、必ずしも下のような順序で評価されるとは限りません。

a. ((car (cdr (list + - * /))) 17 5)
   => ((car (cdr '''(#<subr +> #<subr -> #<subr *> #<subr />)''')) 17 5)
   => ((car '''(#<subr -> #<subr *> #<subr />)''') 17 5)
   => (#<subr -> 17 5)
   => 12
b. (cons (quote -) (cdr (quote (+ b c))))
   => (cons - (cdr '''(+ b c)'''))
   => (cons - '''(b c)''')
   => '''(- b c)'''
  
c. (cdr (cdr '(a b c)))
   => (cdr '''(b c)''')
   => '''(c)'''
  
d. (cons 'd (cdr (cdr '(a b c d e f))))
   => (cons 'd (cdr '''(b c d e f)'''))
   => (cons 'd '''(c d e f)''')
   => '''(d c d e f)'''
  
e. (cons (+ '2 1/2) (list (- '3 1/3) (+ '4 1/4)))
   => (cons 2.5 (list (- '3 1/3) (+ '4 1/4)))
   => (cons 2.5 (list 2.6666666666666665 (+ '4 1/4)))
   => (cons 2.5 (list 2.6666666666666665 4.25))
   => (cons 2.5 '''(2.6666666666666665 4.25)''')
   => '''(2.5 2.6666666666666665 4.25)'''

2.4.1

a. (let ((x (* 3 a))
     (+ (- x b) (+ x b)))
    
b. (let ((ls (list a b c)))
     (cons (car ls) (cdr ls)))

2.4.2

   
(let ((x 9))
  (* x 
     (let ((x (/ x 3)))
       (+ x x))))

この式からは 54 が返されます。ネストした let 式で同じ名前の変数をバインドした場合、内側の本体から参照できるのは内側の let 式でバインドしたものとなります。

(/ x 3)

の x は外側の let 式でバインドされた値 9 となります。したがって、

(/ 9 3) ;=> 3

が、内側の let 式での x にバインドされます。内側の let 式の本体すなわち

(+ x x)

で参照される x は内側の let 式でバインドされた x となりますから(外側の let 式での x は隠蔽されます)。ここでの x の値は 3 となり、

(+ 3 3) ;=> 6

が返されます。よって

(* 9 6) ;=> 54

となります。

2.4.3

a. (let ((x 'a) (y 'b))
     (list (let ((z 'c)) (cons z y))
           (let ((z 'd)) (cons x z))))
             
b. (let ((x '((a b) c)))
     (cons (let ((y (cdr x)))
             (car y))
           (let ((y (car x)))
             (cons (let ((z (cdr y)))
                     (car z))
                   (cons (let ((q (car y)))
                           q)
                         (cdr y))))))   
gosh> (let ((x 'a) (y 'b))
        (list (let ((x 'c)) (cons x y))
              (let ((y 'd)) (cons x y))))
((c . b) (a . d))
gosh> (let ((x 'a) (y 'b))
        (list (let ((z 'c)) (cons z y))
              (let ((z 'd)) (cons x z))))
((c . b) (a . d))
gosh> (let ((x '((a b) c)))
        (cons (let ((x (cdr x)))
                (car x))
              (let ((x (car x)))
                (cons (let ((x (cdr x)))
                        (car x))
                      (cons (let ((x (car x)))
                              x)
                            (cdr x))))))
(c b a b)
gosh> (let ((x '((a b) c)))
        (cons (let ((y (cdr x)))
                (car y))
              (let ((y (car x)))
                (cons (let ((z (cdr y)))
                        (car z))
                      (cons (let ((z (car y)))
                              z)
                            (cdr y))))))
(c b a b)

2.5.1

gosh での実行例を示します。

gosh> (let ((f (lambda (x) x)))       ; a
        (f 'a))
a
gosh> (let ((f (lambda x x)))         ; b
        (f 'a))
(a)
gosh> (let ((f (lambda (x . y) x)))   ; c
        (f 'a))
a
gosh> (let ((f (lambda (x . y) y)))   ; d
        (f 'a))
()

2.5.2

(define list (lambda x x))

2.5.3

a. なし
b. +
c. f
d. cons, f, y
e. cons, y, list, z

2.6.1

(double-any double-any double-any)

を評価すると、無限ループになります。double-any は、第一引数で与えられた値(プロシージャ)を第二引数で与えられた値を引数として呼び出しています。いま double-any の引数には double-any を与えられているので、自身の中で再び自分自身(double-any)を呼び出していることになります。ですから double-any の本体で再び

(double-any double-any double-any)

が実行されることになり、無限ループとなります。

2.6.2

(define compose
  (lambda (proc1 proc2)
    (lambda (x)
      (proc1 (proc2 x)))))
      
(define -cadr
  (compose car cdr))
(define -cddr
  (compose cdr cdr))

2.6.3

caar, cdar, caaar, caadr を compose プロシージャを使って定義すると次のようになります。

(define -caar
  (compose car car))
(define -cdar
  (compose cdr car))
(define -caaar
  (compose car (compose car car)))
(define -caadr
  (compose car (compose car cdr)))

他のたとえば cddr といったプロシージャも同様にして定義する事が出来ます。

2.7.1

引数がペアであるかどうかはプロシージャ pair? で調べる事が出来ます。

(define atom?
  (lambda (x)
    (not (pair? x))))

2.7.2

(define shorter
  (lambda (ls1 ls2)
    (if (< (length ls1) (length ls2))
        ls1
        ls2)))

2.8.1

tree-copy の定義中にある cons への引数の順序を逆にすると、左の部分木がペアの cdr フィールド、右の部分木がペアの car フィールドに割り当てられることになります。

2.8.2

(define -append
  (lambda (a b)
    (if (null? a)
        b
        (cons (car a) (-append (cdr a) b)))))

上の -append の定義中にある -append 呼び出しへの引数の順序を逆にすると、引数で与えられた 2 つのリストのそれぞれの要素が交互になって現れるリストが返される事になります。

2.8.3

(define -make-list
  (lambda (n obj)
    (if (= n 0)
        (list obj)
        (cons obj (-make-list (- n 1) obj)))))

2.8.4

p.114 より

(define -list-ref
  (lambda (ls n)
    (if (= n 0)
        (car ls)
        (-list-ref (cdr ls) (- n 1)))))
(define -list-tail
  (lambda (ls n)
    (if (= n 0)
        ls
        (-list-tail (cdr ls) (- n 1)))))

2.8.5

;; shorter の補助関数
(define cmp
  (lambda (a b)
    (or (null? a)
        (and (pair? b)
             (cmp (cdr a) (cdr b))))))
(define shorter
  (lambda (a b) 
    (if (cmp a b) a b)))

2.8.6

p.66 より

(define -even?
  (lambda (x)
    (or (= x 0)
        (-odd? (- x 1)))))
        
(define -odd?
  (lambda (x)
    (and (not (= x 0))
         (-even? (- x 1)))))

2.8.7

(define transpose
  (lambda (ls)
    (cons (map car ls) (map cdr ls))))

2.9.1

(define make-counter
  (lambda (init-val inc)
    (let ((next init-val))
      (lambda ()
        (let ((v next))
          (set! next (+ next inc))
          v)))))

2.9.2

(define make-stack
  (lambda ()
    (let ((ls '()))
      (lambda (msg . args)
        (case msg
          ((empty?) (null? ls))
          ((push!)  (set! ls (cons (car args) ls)))
          ((top)    (car ls))
          ((pop!)   (set! ls (cdr ls)))
          (else     "oops"))))))

2.9.3

(define make-stack
   (lambda ()
     (let ((ls '()))
       (lambda (msg . args)
         (case msg
           ((empty?) (null? ls))
           ((push!)  (set! ls (cons (car args) ls)))
           ((top)    (car ls))
           ((pop!)   (set! ls (cdr ls)))
           ((ref)    (list-ref ls (car args)))
           ((set!)   (set-car! (list-tail ls (car args)) (cadr args)))
           (else     "oops"))))))

2.9.4

;; スタック全体のサイズを制限するバージョン
(define make-stack
  (lambda (size)
    (let ((p 0)
          (vec (make-vector size)))
      (lambda (msg . args)
        (case msg
          ((empty?) (= p 0))
          ((push!)
           (vector-set! vec p (car args))
           (set! p (+ p 1)))
          ((top)
           (vector-ref vec (- p 1)))
          ((pop!)
           (set! p (- p 1))
           (vector-ref vec p))
          (else "oops"))))))

2.9.5

gosh> (let ((ls (cons 'a '())))
        (set-cdr! ls ls)
        ls)
#0=(a . #0#)

この章で定義したlengthの場合には無限ループになります。

組み込みプリミティブlengthの場合には次のような結果となります。

gosh> (define lst (let ((ls (cons 'a '())))
                    (set-cdr! ls ls)
                    ls))
lst
gosh> (length lst)
*** ERROR: proper list required, but got #0=(a . #0#)
Stack Trace:
_______________________________________
  0  (length lst)
        At line 25 of "(stdin)"
  1  (length lst)
        At line 25 of "(stdin)"

2.9.6

;; 循環リストを取り扱わないバージョン
(define -list?
  (lambda (x)
    (if (pair? x)
        (-list? (cdr x))
        (null? x))))

p.54 より

;; 循環リストを取り扱えるバージョン
(define -list?
  (lambda (x)
    (race x x)))

(define race
  (lambda (h t)
    (if (pair? h)
        (let ((h (cdr h)))
          (if (pair? h)
              (and (not (eq? h t))
                   (race (cdr h) (cdr t)))
              (null? h)))
        (null? h))))

Scheme