EoPL reading (10) 1.2.4 Exercises

Exercise 1.16-4

これは append で何とかなりそうな予感。
まず試験から。

(use gauche.test)

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

(test-start "flatten")
(test-section "flatten")
(test* "(flatten '(a b c)) should return (a b c)"
       '(a b c)
       (flatten '(a b c))
(test* "(flatten '((a) () (b ()) () (c))) should return (a b c)"
       '(a b c)
       (flatten '((a) () (b ()) () (c))))
(test* "(flatten '((a b) c (((d)) e))) should return (a b c d e)"
       '(a b c d e)
       (flatten '((a b) c (((d)) e))))
(test* "(flatten '(a b (() (c)))) should return (a b c)"
       '(a b c)
       (flatten '(a b (() (c)))))
(test-end)

で空っぽの手続きをナニ。

(define (flatten alist)
  )

試験実行。

$ make
Testing flatten ...                                              failed.
discrepancies found.  Errors are:
test (flatten '(a b c)) should return (a b c): expects (a b c) => got #<undef>
test (flatten '((a) () (b ()) () (c))) should return (a b c): expects (a b c) => got #<undef>
test (flatten '((a b) c (((d)) e))) should return (a b c d e): expects (a b c d e) => got #<undef>
test (flatten '(a b (() (c)))) should return (a b c): expects (a b c) => got #<undef>
$

当たり前。で手続きをでっち上げたんですが微妙。

(define (flatten alist)
  (define (flatten-inner rslt alist)
    (if (null? alist)
	(append rslt '())
	(if (pair? alist)
	    (flatten-inner (append rslt (flatten-inner '() (car alist))) (cdr alist))
	    (append rslt alist)))
    )
  (flatten-inner '() alist)
  )

試験は失敗。

$ make
Testing flatten ...                                              failed.
discrepancies found.  Errors are:
test (flatten '(a b c)) should return (a b c): expects (a b c) => got #<error "list required, but got a\n">
test (flatten '((a) () (b ()) () (c))) should return (a b c): expects (a b c) => got #<error "list required, but got a\n">
test (flatten '((a b) c (((d)) e))) should return (a b c d e): expects (a b c d e) => got #<error "list required, but got a\n">
test (flatten '(a b (() (c)))) should return (a b c): expects (a b c) => got #<error "list required, but got a\n">
$

リストではない要素に対してリストな手続きを適用しようとしている模様。(car alist) がペア? って判定しないと駄目か。
で試験したら以下。

$ make
Testing flatten ...                                              failed.
discrepancies found.  Errors are:
test (flatten '((a) () (b ()) () (c))) should return (a b c): expects (a b c) => got (a () (b ()) () (c))
test (flatten '((a b) c (((d)) e))) should return (a b c d e): expects (a b c d e) => got (a b c (((d)) e))
test (flatten '(a b (() (c)))) should return (a b c): expects (a b c) => got (a b (() (c)))
$

わははは。そのままだし。そりゃそうっちゃそうですな。
ってよく見たら_そのまんま_ではないな。で、手続きをニラんでて微妙な箇所発見。

	(if (pair? (car alist))
	    (flatten-inner (append rslt (flatten-inner '() (car alist))) (cdr alist))
	    (append rslt alist)))

else な append には (car alist) 渡さんとダメか。あ、違う。else では alist はペアではないから良いのか。うーん。一つづつ結果を見てみる。

(flatten '((a) () (b ())( () (c)))
(a () (b ()) () (c)) が戻っている

(flatten '((a b) c (((d)) e)))
(a b c (((d)) e)) が戻っている

(flatten '(a b (() (c))))
(a b (() (c))) が戻っている

ってか、append 使って中に () が残るのが意味不明。ちゃんとイメージできてません。試しに以下な試験も追加してみた。

(test* "(flatten '((a) ())) should return (a)"
       '(a)
       (flatten '((a) ())))

結果は

test (flatten '((a) ())) should return (a): expects (a) => got (a ())

との事。手続きを上記の例にて順に確認してみます。

alist は '((a) ())
null ではない
(car alist) はペア
(flatten-inner '() '(a)) を呼び出す
- alist は '(a)
- null ではない
- (car alist) はペアではない
- (append rslt alist) 呼び出し
- (append '() '(a))

げ。ここかな ..
で、こうしたら

	(if (pair? (car alist))
	    (flatten-inner (append rslt (flatten-inner '() (car alist))) (cdr alist))
	    (append rslt (list (car alist)))))

こうなりました。

 make
Testing flatten ...                                              failed.
discrepancies found.  Errors are:
test (flatten '((a) ())) should return (a): expects (a) => got (a ())
test (flatten '(a b c)) should return (a b c): expects (a b c) => got (a)
test (flatten '((a b c))) should return (a b c): expects (a b c) => got (a)
test (flatten '((a) () (b ()) () (c))) should return (a b c): expects (a b c) => got (a ())
test (flatten '((a b) c (((d)) e))) should return (a b c d e): expects (a b c d e) => got (a c)
test (flatten '(a b (() (c)))) should return (a b c): expects (a b c) => got (a)
$

わははは。else でも cdr に対して flatten-inner しないと駄目だよ。で、以下な形にしてみたら

	(if (pair? (car alist))
	    (flatten-inner (append rslt (flatten-inner '() (car alist))) (cdr alist))
	    (flatten-inner (append rslt (list (car alist))) (cdr alist))))
    )

こうなる。まだまだ先は長い。

$ make
Testing flatten ...                                              failed.
discrepancies found.  Errors are:
test (flatten '((a) ())) should return (a): expects (a) => got (a ())
test (flatten '((a) () (b ()) () (c))) should return (a b c): expects (a b c) => got (a () b () () c)
test (flatten '(a b (() (c)))) should return (a b c): expects (a b c) => got (a b () c)
$

なんとなくいいカンジになってきましたが () が残るな。なるほど

(append rslt (list (car alist)))

ってしてるからだな。とりあえず cond で null をニガす方向で修正してみる。以下で試験全部パス。

(define (flatten alist)
  (define (flatten-inner rslt alist)
    (if (null? alist)
	(append rslt '())
	(cond ((null? (car alist))
	       (flatten-inner rslt (cdr alist)))
	      ((pair? (car alist))
	       (flatten-inner (append rslt (flatten-inner '() (car alist)))
			      (cdr alist)))
	      (else
	       (flatten-inner (append rslt (list (car alist))) (cdr alist)))))
    )
  (flatten-inner '() alist)
  )

なんか簡単かな、って思ってたんですが意外にハマりましたな。