SICP 読み (21)
修行より戻り、問題 2.27 以降に着手。
問題 2.27
2.18 の reverse を修正、との事。reverse は以下。
(define (reverse l)
(let f ((l l) (result '()))
(if (null? l)
result
(f (cdr l) (cons (car l) result)))))再帰にすると話が早そうだな。そういえば試験ドリブンだった。何がチェックできれば良いかな、というと逆になってるコト、なんですが。
- () は () に
- (1) は (1) に
- (1 2) は (2 1) に
- ((1 2) 3 4) なら (4 3 (2 1)) に
- ((1 2) (3 4)) なら ((4 3) (2 1)) に
- (1 2 3 (4 5) 6 (7 8)) なら ((8 7) 6 (5 4) 3 2 1) に
- (1 (2 3 (4 5)) 6 (7 (8))) は (((8) 7) 6 ((5 4) 3 2) 1) か
なんか試験として、とっても微妙な気がするんですが気のせいですか??
ま、いいや。とりあえずやってみよう。
まず試験を書いてみた。以下。
#!/usr/bin/env gosh
(use test.unit)
(require "2.27")
(define-test-case "'() reverse"
("'() reverse"
(assert-equal '() (deep-reverse '()))))このままでは動かんので、本体も試験を通る形で書いてみる。
(define (deep-reverse l) '() )
これは酷い。
$ test/run-test.scm -vv - (test suite) Default test suite -- (test case) '() reverse test: . 1 tests, 1 assertions, 1 successes, 0 failures, 0 errors Testing time: 1.85e-4 $
がしかし、通れば良いのだ。(ってをぃ
もう少し試験の追加を。
#!/usr/bin/env gosh
(use test.unit)
(require "2.27")
(define-test-case "'() reverse"
("'() reverse"
(assert-equal '() (deep-reverse '()))))
(define-test-case "'(1) reverse"
("'() reverse"
(assert-equal '(1) (deep-reverse '(1)))))
(define-test-case "'(1 2) reverse"
("'() reverse"
(assert-equal '(2 1) (deep-reverse '(1 2)))))この位までなら 2.18 な reverse でも通る。
(define (deep-reverse l)
(let f ((l l) (result '()))
(if (null? l)
result
(f (cdr l) (cons (car l) result))))
)試験。
$ test/run-test.scm -vv - (test suite) Default test suite -- (test case) '(1 2) reverse: . -- (test case) '(1) reverse: . -- (test case) '() reverse: . 3 tests, 3 assertions, 3 successes, 0 failures, 0 errors Testing time: 3.4599999999999995e-4
オヤツでも食いたい所ではありますが、ぐっと我慢して続行。試験を全部追加します。以下、差分のみを。
(define-test-case "'((1 2) 3 4) reverse"
("'((1 2) 3 4) reverse"
(assert-equal '(4 3 (2 1)) (deep-reverse '((1 2) 3 4)))))
(define-test-case "'((1 2) (3 4))reverse"
("'((1 2) (3 4)) reverse"
(assert-equal '((4 3) (2 1)) (deep-reverse '((1 2) (3 4))))))
(define-test-case "'(1 2 3 (4 5) 6 (7 8)) reverse"
("'(1 2 3 (4 5) 6 (7 8)) reverse"
(assert-equal '((8 7) 6 (5 4) 3 2 1) (deep-reverse '(1 2 3 (4 5) 6 (7 8))))))
(define-test-case "'(1 (2 3 (4 5)) 6 (7 (8))) reverse"
("'(1 (2 3 (4 5)) 6 (7 (8))) reverse"
(assert-equal '(((8) 7) 6 ((5 4) 3 2) 1) (deep-reverse '(1 (2 3 (4 5)) 6 (7 (8)))))))このまま試験しても無論通らん。
$ test/run-test.scm -vv - (test suite) Default test suite -- (test case) '(1 (2 3 (4 5)) 6 (7 (8))) reverse: F expected:<(((8) 7) 6 ((5 4) 3 2) 1)> but was:<((7 (8)) 6 (2 3 (4 5)) 1)> in '() reverse -- (test case) '(1 2 3 (4 5) 6 (7 8)) reverse: F expected:<((8 7) 6 (5 4) 3 2 1)> but was:<((7 8) 6 (4 5) 3 2 1)> in '() reverse -- (test case) '((1 2) (3 4))reverse: F expected:<((4 3) (2 1))> but was:<((3 4) (1 2))> in '() reverse -- (test case) '((1 2) 3 4) reverse: F expected:<(4 3 (2 1))> but was:<(4 3 (1 2))> in '() reverse -- (test case) '(1 2) reverse: . -- (test case) '(1) reverse: . -- (test case) '() reverse: . 7 tests, 7 assertions, 3 successes, 4 failures, 0 errors Testing time: 0.002408 $
結果を見ると中のリストが reverse してません。で、実装としては、cons してる (car l)
がペアかどうかを判断すれば良いかな。まずは単純に再帰的に解決してみる。
(define (deep-reverse l)
(let f ((l l) (result '()))
(if (null? l)
result
(f (cdr l) (cons
; (car l)
(if (pair? (car l))
(deep-reverse (car l))
(car l))
result))))
)で、試験を。
$ test/run-test.scm -vv - (test suite) Default test suite -- (test case) '(1 (2 3 (4 5)) 6 (7 (8))) reverse: . -- (test case) '(1 2 3 (4 5) 6 (7 8)) reverse: . -- (test case) '((1 2) (3 4)) reverse: . -- (test case) '((1 2) 3 4) reverse: . -- (test case) '(1 2) reverse: . -- (test case) '(1) reverse: . -- (test case) '() reverse: . 7 tests, 7 assertions, 7 successes, 0 failures, 0 errors Testing time: 0.0015040000000000001
うむ。(何
しかし、今まで assert-equal しか使ったコト無いってものナニ。
問題 2.28
この問題は修行の時に経験したような気がなんとなくするが、試験ドリブンでやってみましょうね。試験のナニとしては以下か。
- (fringe '()) ;; => ()
- (fringe '(1)) ;; => (1)
- (fringe '(1 2 3)) ;; => (1 2 3)
- (fringe '(1 (2 3)) ;; => (1 2 3)
- (fringe '((1 2) (3 4)) ;; => (1 2 3 4)
- (fringe '((((1))))) ;; => (1)
- (fringe '(1 (2 (3 (4 (5) 6) 7) 8) 9)) ;; => (1 2 3 4 5 6 7 8 9)
で、以下の試験は
#!/usr/bin/env gosh
(use test.unit)
(require "2.28")
(define-test-case "(fringe '())"
("(fringe '())"
(assert-equal '() (fringe '()))))
(define-test-case "(fringe '(1))"
("(fringe '(1))"
(assert-equal '(1) (fringe '(1)))))
(define-test-case "(fringe '(1 2 3))"
("(fringe '(1 2 3))"
(assert-equal '(1 2 3) (fringe '(1 2 3)))))こんな感じの実装でも通る。
(define (fringe l) l )
がしかし、これはそろそろ NG ですな。
(define-test-case "(fringe '(1 (2 3)))"
("(fringe '(1 (2 3)))"
(assert-equal '(1 2 3) (fringe '(1 (2 3))))))という事でこんな実装を。
(define (fringe l)
(if (null? l)
'()
(append
(if (pair? (car l))
(car l)
(list (car l)))
(fringe (cdr l)))))で、試験を。
$ test/run-test.scm -vv - (test suite) Default test suite -- (test case) (fringe '(1 (2 3))): . -- (test case) (fringe '(1 2 3)): . -- (test case) (fringe '(1)): . -- (test case) (fringe '()): . 4 tests, 4 assertions, 4 successes, 0 failures, 0 errors Testing time: 4.4199999999999996e-4 $
以下のテストケースも盛り込んでみる。
(define-test-case "(fringe '((1 2) (3 4)))"
("(fringe '((1 2) (3 4)))"
(assert-equal '(1 2 3 4) (fringe '((1 2) (3 4))))))
(define-test-case "(fringe '((((1)))))"
("(fringe '((((1)))))"
(assert-equal '(1) (fringe '((((1))))))))
(define-test-case "(fringe '(1 (2 (3 (4 (5) 6) 7) 8) 9))"
("(fringe '(1 (2 (3 (4 (5) 6) 7) 8) 9))"
(assert-equal '(1 2 3 4 5 6 7 8 9) (fringe '(1 (2 (3 (4 (5) 6) 7) 8) 9)))))で実行。
$ test/run-test.scm -vv - (test suite) Default test suite -- (test case) (fringe '(1 (2 (3 (4 (5) 6) 7) 8) 9)): F expected:<(1 2 3 4 5 6 7 8 9)> but was:<(1 2 (3 (4 (5) 6) 7) 8 9)> in (fringe '(1 (2 (3 (4 (5) 6) 7) 8) 9)) -- (test case) (fringe '((((1))))): F expected:<(1)> but was:<(((1)))> in (fringe '((((1))))) -- (test case) (fringe '((1 2) (3 4))): . -- (test case) (fringe '(1 (2 3))): . -- (test case) (fringe '(1 2 3)): . -- (test case) (fringe '(1)): . -- (test case) (fringe '()): . 7 tests, 7 assertions, 5 successes, 2 failures, 0 errors Testing time: 0.0018760000000000003
あいやー。失敗。よく考えたら list をぱくっと返しちゃ駄目じゃん。ってコトは修行なナニもダウトかも。
で、以下のように修正。どっかで見たような感じ。
(define (fringe l) (cond ((null? l) '()) ((not (pair? l)) (list l)) (else (append (fringe (car l)) (fringe (cdr l))))))
試験も通りました。
$ test/run-test.scm -vv - (test suite) Default test suite -- (test case) (fringe '(1 (2 (3 (4 (5) 6) 7) 8) 9)): . -- (test case) (fringe '((((1))))): . -- (test case) (fringe '((1 2) (3 4))): . -- (test case) (fringe '(1 (2 3))): . -- (test case) (fringe '(1 2 3)): . -- (test case) (fringe '(1)): . -- (test case) (fringe '()): . 7 tests, 7 assertions, 7 successes, 0 failures, 0 errors Testing time: 8.510000000000001e-4 $
うーん。とりあえず次はハードル高そうなのできちんと考えよう。
