EoPL reading (7) 1.2.4 Exercises

scheme EoPL

Exercise 1.16 着手。
とりあえず以下な試験を作った。

(use gauche.test)

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

(test-start "up")
(test-section "up")
(test* "(up '((1 2) (3 4))) should return (1 2 3 4)"
       '(1 2 3 4)
       (up '((1 2) (3 4))))
(test* "(up '((x (y)) z)) should return (x (y) z)"
       '(x (y) z)
       (up '((x (y)) z)))
(test-end)

でテストファーストってコトで実行してみる。以下。

$ make
gosh: "error": cannot find file "up" in *load-path* ("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.13/lib")
make: *** [test] 
$ touch up.scm
$ make
Testing up ...                                                   failed.
discrepancies found.  Errors are:
test (up '((1 2) (3 4))) should return (1 2 3 4): expects (1 2 3 4) => got #<error "unbound variable: up">
test (up '((x (y)) z)) should return (x (y) z): expects (x (y) z) => got #<error "unbound variable: up">
$

touch しただけじゃ駄目か。こうしてみる。

$ cat up.scm
(define (up lst)
  )
$

で、試験。

$ make
Testing up ...                                                   failed.
discrepancies found.  Errors are:
test (up '((1 2) (3 4))) should return (1 2 3 4): expects (1 2 3 4) => got #<undef>
test (up '((x (y)) z)) should return (x (y) z): expects (x (y) z) => got #<undef>
$

当たり前ですが駄目。こうしてみたりして。

(define (up lst)
  '(1 2 3 4)
  )

で試験。

$ make
Testing up ...                                                   failed.
discrepancies found.  Errors are:
test (up '((x (y)) z)) should return (x (y) z): expects (x (y) z) => got (1 2 3 4)
$

一つは成功してます。当たり前。そろそろ真面目に考える。
ぶっちゃけ down の逆、らしい。とりあえず再起で考えてみると以下?

(define (up lst)
  (if (null? lst)
      '()
      (cons (car lst)
	    (up (cdr lst))))
  )

これだと変わらず。色々ヤッてますが微妙。このハマり方ってツボが分かればさくっとイケるはずなんですが糸口ナシ。それにしても試験があるって良いですね。
で、色々弄くりマワした挙句に以下なナニがひり出てきた。

(define (up lst)
  (define (up-inner rslt lst)
    (if (null? lst)
	(reverse rslt)
	(up-inner (append (if (pair? (car lst))
			      (reverse (car lst))
			      lst)
			  rslt)
		  (cdr lst)))
    )
  (up-inner '() lst)
  )

微妙。reverse ってなんか嫌だ。んーと、これは再帰の方がイメージしやすいはず。

  • car とりだして
    • pair? の場合
    • そうでない場合

と考えてみたんですがどうしたものやら、と言いつつハマッた挙句に以下なソレが出てきました。

(define (up lst)
  (define (up-inner lst)
    (if (null? lst)
	'()
	(append (if (pair? (car lst))
		    (car lst)
		    (list (car lst)))
		(up-inner (cdr lst))))
    )
  (up-inner lst)
  )

微妙。試験にはパスしています。これ、-inner 不要だな。

(define (up lst)
    (if (null? lst)
	'()
	(append (if (pair? (car lst))
		    (car lst)
		    (list (car lst)))
		(up (cdr lst))))
  )

再帰バージョンができたのであれば繰り返しも可能なはず。ってか出てきたの見ると_そりゃそうだよな_という気持ちになります。結構苦労してしまいました。
# あまり何も考えずに手が動くままに任せてるからこうなる

ちなみに

Makefile は以下な形。

SHELL=/bin/sh

TARGET=$(wildcard test-*.scm)

test:
	@rm -f test.log
	@for X in $(TARGET) ; do gosh $$X >> test.log ; done

clean:
	rm -rf *~ test.log

試験なソースは test- がファイル名のアタマに付いています。