練習問題 (3)

ピアソンの scheme 本の練習問題の続き。調子に乗ってどんどんやってしまう。

練習問題 2.9.1 (make-counter 修正。初期値や増分値を設定可能に)

カウンタの例はどっかに書いたな。例示してあるのは以下。

(define make-counter
  (lambda ()
    (let ((next 0))
      (lambda ()
	(let ((v next))
	  (set! next (+ next 1))
	  v)))))

で、試験。ちょっとボケかましてます。(ナチュラル系

guile> (define my-counter make-counter)
guile> (my-counter)
#<procedure #f ()>
guile> (define my-counter (make-counter))
guile> (my-counter)
0
guile> (my-counter)
1
guile> 

まだ、初心者的カッコの勘違いがあるな。(とほほ

guile> (define your-counter (make-counter))
guile> (your-counter)
0
guile> (my-counter)
2
guile> 

で、問題の要件としては make-counter する時に初期値と増分を指定できれば良いのですな。こんな感じでしょうか。

(define (make-counter2 init inc)
  (let ((next init) (i inc))
    (lambda ()
      (let ((v next))
	(set! next (+ next 1))
	v))))

で、試験。ちなみに 下側の let で括弧の数の間違いをしとります。こんな感じ。

      (let (v next)

試験を。

guile> (define my-counter (make-counter2 0 1))
guile> (my-counter)
0
guile> (my-counter)
1
guile> (my-counter)
2
guile>

を、動いとるな、と思いきや。

guile> (define your-counter (make-counter2 0 3))
guile> (your-counter)
0
guile> (your-counter)
1
guile> 

違うし。よく見りゃ 1 づつ増分させてるし。で、修正なんですが next に i を加える形はセーフですか??

(define (make-counter2 init inc)
  (let ((next init) (i inc))
    (lambda ()
      (let ((v next))
	(set! next (+ next i))
	v))))

動作確認。

guile> (define my-counter (make-counter2 0 1))
guile> (my-counter)
0
guile> (my-counter)
1
guile> (my-counter)
2
guile> (define your-counter (make-counter2 1 3))
guile> (your-counter)
1
guile> (your-counter)
4
guile> (your-counter)
7
guile> 

i は inc になってても大丈夫だよな。この方が良い??

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

上記は next がオブジェクトの属性として存在するのは理解できるんですが、inc もそうなのか。

練習問題 2.9.3 (stack の修正)

元になる stack の実装は以下。

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

pop は pop するだけの単純な実装になっているのね。代わりに top というメソドが用意されているのか。(蛇足

これに stack へのランダムアクセスなメソドを盛り込め、というのが要件。ランダムな読み込みは ref で、ランダムな書き込みは set! で、との事。ヒントとして、ref は list-ref を、set! は list-tail と set-car! を使えば良いとの事。

デフォルトの動作確認は略。ref を盛り込んでみましょう。list-ref か。

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

動作を確認。

guile> (define my-stack (make-stack))
guile> (my-stack 'empty?)
#t
guile> (my-stack 'push! 'a)
guile> (my-stack 'top)
a
guile> (my-stack 'push! 'b)
guile> (my-stack 'push! 'c)
guile> (my-stack 'push! 'd)
guile> (my-stack 'top)
d
guile> (my-stack 'ref 0)
d
guile> (my-stack 'ref 1)
c
guile> (my-stack 'ref 2)
b
guile> (my-stack 'ref 3)
a
guile> (my-stack 'ref 4)
standard input:608:11: In procedure list-ref in expression (list-ref ls (car args)):
standard input:608:11: Argument 2 out of range: 4
ABORT: (out-of-range)
guile> 

本当はエラーチェックをちゃんとしねぇと駄目なんだけどねぇ。とりあえずスルー。
次は set! かな。

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

試験です。

guile> (define my-stack (make-stack))
guile> (my-stack 'push! 'a)
guile> (my-stack 'push! 'b)
guile> (my-stack 'push! 'c)
guile> (my-stack 'push! 'd)
guile> (my-stack 'set! 1 'e)
guile> (my-stack 'ref 1)
e
guile> (my-stack 'top)
d
guile> (my-stack 'ref 0)
d
guile> (my-stack 'ref 1)
e
guile> (my-stack 'ref 2)
b
guile> (my-stack 'ref 3)
a
guile> (my-stack 'set! 4 'f)
standard input:643:11: In procedure set-car! in expression (set-car! (list-tail ls #) (car #)):
standard input:643:11: Wrong type argument in position 1 (expecting CONSP): ()
ABORT: (wrong-type-arg)
guile> 

エラーチェキが足りてませんがスルー。(を

練習問題 2.9.5 (set-cdr! による循環リストの実装といくつかの question)

2.9.4 は面倒なのでスルー (ちょっとヤリかけたんですが)。
で、以下の式は何だ??

(let ((ls (cons 'a '())))
  (set-cdr! ls ls)
  ls)

えーと。

  • ローカルな環境として ls とゆーシンボルに (a . ()) を設定。
    • 便宜上 (a . ()) と書いてますが、(a) です。
  • (set-cdr! ls ls) って何
    • 引数で指定したリストの cdr に引数で指定したオブジェクトを設定
    • _循環リスト_の名の通り、これを手繰り始めると無限ループだな
  • ls を返却

こんなになるのかね。

(a (a (a (a (a .... 無限に続く

試してみます。

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

む。_#0#_って何だ。もう少し確認。

guile> (define x (let ((ls (cons 'a '())))
  (set-cdr! ls ls)
  ls)
)
guile> x
(a . #0#)
guile> (cdr x)
(a . #0#)
guile> (cdr (cdr x))
(a . #0#)
guile> (cdr (cdr (cdr x)))
(a . #0#)
guile> (car (cdr (cdr (cdr x))))
a
guile> (car (cdr (cdr x)))
a
guile> (car (cdr x))
a
guile> 

なんかアレだな。永遠にムケる玉ネギの皮的なソレ。circular list とゆーらしい。色々探してみるに、#0# は最初に戻るけんね、的なナニらしい。アレだよね、最初の要素の値を変えたら (ry

guile> (set-car! x 'b)
guile> x
(b . #0#)
guile> (cdr x)
(b . #0#)
guile> 

プリミティブな length 使ってみるとどうなるか。多分動くはず。具体的にどう動くか、は想像の範囲を超えとりますが。

guile> length
#<primitive-procedure length>
guile> (length x)
standard input:691:1: In procedure length in expression (length x):
standard input:691:1: Wrong type argument in position 1: (b . #0#)
ABORT: (wrong-type-arg)
guile>

ぎゃ。オチた。ちなみにテキストに例示されている length ではどうなるか。以下が実装。

(define length
  (lambda (ls)
    (if (null? ls)
	0
	(+ (length (cdr ls))))))

絶対ダメって感じがするなぁ。

guile> (define length
  (lambda (ls)
    (if (null? ls)
        0
        (+ (length (cdr ls))))))
guile> (length x)
standard input:691:1: In procedure length in expression (length x):
standard input:691:1: Stack overflow
ABORT: (stack-overflow)
guile> 

をー。stack 突き抜けちゃった。再帰バージョンだしな。trace で見たらエライ事になりました。末尾再帰なナニだとどーなるのかな??

(define (length list)
  (let f ((l list))
    (if (null? l)
	0
	(+ (f (cdr l))))))

これも同じでした。そりゃそうだわな。trace してみましたが、再帰バージョンなソレと比較すると出力自体は地味。
循環リストの検出方法については次の問題で出ているようです。

と、言いつつ練習問題 2.9.6 以降は明日だな。