EoPL reading (6) 1.2.4 Exercises

とりあえず昨晩でっちあげたナニから。

Exercise 1.15-10

以下な手続きをでっちあげている。

(define (vector-append-list v l)
  (define (vector-append-list-inner init vec lst)
    (define (add-v1 init v c)
      (if (= c (vector-length v))
	  init
	  (begin
	    (vector-set! init c (vector-ref v c))
	    (add-v1 init
		    v
		    (+ c 1))))
      )
    (define (add-v2 init l cnt)
      (if (null? l)
	  init
	  (begin
	    (vector-set! init cnt (car l))
	    (add-v2 init (cdr l) (+ cnt 1))))
      )
    (add-v2 (add-v1 init vec 0) lst (vector-length v))
    )
  (vector-append-list-inner (make-vector (+ (vector-length v)
					    (length l)))
			    v
			    l)
  )

これ、無理矢理ひとマトメにできそげなんですが。

(define (add-vec init obj cnt end-proc set-proc next-proc)
  (if (end-proc obj)
      init
      (begin
	(vector-set! init cnt (set-proc obj cnt))
	(add-vec init (next-proc obj) (+ cnt 1)))))

うーん、微妙。こんなの出ました。これは酷い。

(define (vector-append-list v l)
  (define (vector-append-list-inner init vec lst)
    (define (add-vec init obj cnt end-proc set-proc next-proc)
      (if (end-proc obj cnt)
	  init
	  (begin
	    (vector-set! init cnt (set-proc obj cnt))
	    (add-vec init (next-proc obj) (+ cnt 1) end-proc set-proc next-proc))))

    (add-vec (add-vec init vec 0 
		      (lambda (obj cnt) (= cnt (vector-length obj)))
		      (lambda (obj cnt) (vector-ref obj cnt))
		      (lambda (obj) obj))
	     lst
	     (vector-length v)
	     (lambda (obj cnt) (null? obj))
	     (lambda (obj cnt) (car obj))
	     (lambda (obj) (cdr obj)))
    )

  (vector-append-list-inner (make-vector (+ (vector-length v)
					    (length l)))
			    v
			    l)
  )

一応試験にはパスしてますが。。
なんか品に欠けるカンジ。もっとなんつーかエレガントな書き方ができるような気がするんだけどなぁ。
こんなのもありなのか。

  (vector-append-list-inner (make-vector (+ (vector-length v)
					    (length l)))
			    v
			    (list2vec l)

これだと make-vector は中に入れても大丈夫か。こんどはこんなのがでっち上がりました。

(define (vector-append-list v l)
  (define (list2vec list)
    (let ((v (make-vector (length list))))
      (let list2vec-inner ((v v) (l list) (c 0))
	(if (null? l)
	    v
	    (begin
	      (vector-set! v c (car l))
	      (list2vec-inner v (cdr l) (+ c 1))))
	)
      )
    )
  (define (vector-append-list-inner v1 v2)
    (let ((v (make-vector (+ (vector-length v1) (vector-length v2)))))
      (let f ((v v) (v1 v1) (v2 v2) (c 0))
	(if (= (vector-length v) c)
	    v
	    (begin
	      (if (< c (vector-length v1))
		  (vector-set! v c (vector-ref v1 c))
		  (vector-set! v c (vector-ref v2 (- c (vector-length v1)))))
	      (f v v1 v2 (+ c 1))))
	)
      )
    )

  (vector-append-list-inner v (list2vec l))
  )

これって良く考えたら -inner で v1 とか v2 は f に渡す必要は無い?

(define (vector-append-list v l)
  (define (list2vec list)
    (let ((v (make-vector (length list))))
      (let list2vec-inner ((v v) (l list) (c 0))
	(if (null? l)
	    v
	    (begin
	      (vector-set! v c (car l))
	      (list2vec-inner v (cdr l) (+ c 1))))
	)
      )
    )
  (define (vector-append-list-inner v1 v2)
    (let ((v (make-vector (+ (vector-length v1) (vector-length v2)))))
      (let f ((c 0))
	(if (= (vector-length v) c)
	    v
	    (begin
	      (if (< c (vector-length v1))
		  (vector-set! v c (vector-ref v1 c))
		  (vector-set! v c (vector-ref v2 (- c (vector-length v1)))))
	      (f (+ c 1))))
	)
      )
    )

  (vector-append-list-inner v (list2vec l))
  )

これでも動きましたな。凄く変態的な書き方してる気がします。可読性低そう。