EoPL reading (11) 1.2.4 Exercises

Exercise 1.16-5

これはリストのマージソートな問題な模様。
いつもの如く試験を書く。

(use gauche.test)

(add-load-path ".")
(load "merge")

(test-start "merge")
(test-section "merge")
(test* "(merge '(1 4) '(1 2 8)) should return (1 1 2 4 8)"
       '(1 1 2 4 8)
       (merge '(1 4) '(1 2 8)))
(test* "(merge '(35 62 81 90 91) '(3 83 85 90)) should return (3 35 62 81 83 85 90 90 91)"
       '(3 35 62 81 83 85 90 90 91)
       (merge ''(35 62 81 90 91) '(3 83 85 90)))
(test-end)

で、ガワのみ記述。

(define (merge lon1 lon2)
  )

試験実行。出力は長いので略しますが当たり前に failed.
中身を考えましょう。これは繰り返しで考えた方が良さげ。と言いつつでっち上がったのが以下。

(define (merge lon1 lon2)
  (define (sort-inner i1 i2)
    (if (>= i1 i2)
	(list i1 i2)
	(list i2 i1))
    )
  (define (merge-inner rslt l1 l2)
    (cond ((and (null? l1) (null? l2)) rslt)
	  ((null? l1) (append rslt l2))
	  ((null? l2) (append rslt l1))
	  (else
	   (merge-inner (append rslt (sort-inner (car l1) (car l2)))
			(cdr l1) (cdr l2))))
    )
  (merge-inner '() lon1 lon2)
  )

試験は失敗。よく考えたら一つづつヤらないと駄目じゃん。ってか sort-inner 手続きの比較も微妙。
で、以下の手続きがでっち上がってなんとなくイケそう、と思ってたんですが

(define (merge lon1 lon2)
  (define (merge-inner rslt l1 l2)
    (cond ((and (null? l1) (null? l2)) rslt)
	  ((null? l1) (append rslt l2))
	  ((null? l2) (append rslt l1))
	  ((<= (car l1) (car l2))
	   (merge-inner (append rslt (list (car l1))) (cdr l1) l2))
	  (else
	   (merge-inner (append rslt (list (car l2))) l1 (cdr l2))))
    )
  (merge-inner '() lon1 lon2)
  )

なんとなくマージソートじゃん、と思ってたら試験失敗。

$ make
Testing merge ...                                                failed.
discrepancies found.  Errors are:
test (merge '(35 62 81 90 91) '(3 83 85 90)) should return (3 35 62 81 83 85 90 90 91): expects (3 35 62 81 83 85 90 90 91) => got #<error "real number required: quote">
$

あらら? と言いつつ試験を見てみたら

(test* "(merge '(35 62 81 90 91) '(3 83 85 90)) should return (3 35 62 81 83 85 90 90 91)"
       '(3 35 62 81 83 85 90 90 91)
       (merge ''(35 62 81 90 91) '(3 83 85 90)))

ってなってました (汗
げ。見返してみたら上の引用でもそうなってますな。正しい試験は以下です。

(use gauche.test)

(add-load-path ".")
(load "merge")

(test-start "merge")
(test-section "merge")
(test* "(merge '(1 4) '(1 2 8)) should return (1 1 2 4 8)"
       '(1 1 2 4 8)
       (merge '(1 4) '(1 2 8)))
(test* "(merge '(35 62 81 90 91) '(3 83 85 90)) should return (3 35 62 81 83 85 90 90 91)"
       '(3 35 62 81 83 85 90 90 91)
       (merge '(35 62 81 90 91) '(3 83 85 90)))
(test-end)

いやはや。