EoPL reading (13) 1.2.4 Exercises

Exercise 1.17-2

こんどは並べ替えか。って簡単に考えてたんですがそうでもないのか。最初にこんなのがでっち上がったのですが

(define (sort lon)
  (cond ((null? (cdr lon)) lon)
	((<= (car lon) (cadr lon))
	 (cons (car lon) (sort (cdr lon))))
	(else
	 (cons (cadr lon) (sort (append (list (car lon)) (cddr lon))))))
  )

以下な試験にパスしない。

(test* "(sort '(8 2 5 2 3)) should return (2 2 3 5 8)"
       '(2 2 3 5 8)
       (sort '(8 2 5 2 3)))

戻ってきてるのが (2 5 2 3 8) との事。むむ。
これって挿入法をイメージしてたんですが、そうなってはいないな。残りが単純に cdr ではない、というのがナニ。あるいは挿入法であれば_挿入_をどうヤルか、がポイントと言えば良い?
で、以下の微妙な手続きができたんですが、動作が微妙。

(define (sort lst)
  (define (ins rslt l x)
    (cond ((null? l) (append rslt (list x)))
	  ((< (car l) x)
	   (ins (append rslt (list (car l))) (cdr l) x))
	  (else
	   (append (append rslt (list x)) (cdr l))))
    )
  (define (sort-inner rslt lst)
    (cond ((null? lst) rslt)
	  ((< (car lst) (car rslt))
	   (sort-inner (cons (car lst) rslt) (cdr lst)))
	  (else
	   (sort-inner (ins (list (car rslt)) (cdr rslt) (car lst)) (cdr lst))))
    )
  (sort-inner (list (car lst)) (cdr lst))
  )

REPL で確認してたら以下なカンジ。

gosh> (sort '(8 2 5 2))
(2 2)
gosh>

何故にヌケが出るのか、と言いつつ ins な手続きを以下に修正して試験はパス。

  (define (ins rslt l x)
    (cond ((null? l) (append rslt (list x)))
	  ((< (car l) x)
	   (ins (append rslt (list (car l))) (cdr l) x))
	  (else
	   (append (append rslt (list x)) l)))
    )

しかしこれ、ぱっと見読みづらい。ちなみに問題 3 は以下で OK

(define (sort pred lst)
  (define (ins rslt l x)
    (cond ((null? l) (append rslt (list x)))
	  ((pred (car l) x)
	   (ins (append rslt (list (car l))) (cdr l) x))
	  (else
	   (append (append rslt (list x)) l)))
    )
  (define (sort-inner rslt lst)
    (cond ((null? lst) rslt)
	  ((pred (car lst) (car rslt))
	   (sort-inner (cons (car lst) rslt) (cdr lst)))
	  (else
	   (sort-inner (ins (list (car rslt)) (cdr rslt) (car lst)) (cdr lst))))
    )
  (sort-inner (list (car lst)) (cdr lst))
  )

以下な試験にもパス。

(use gauche.test)

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

(test-start "sort")
(test-section "sort")
(test* "(sort < '(8 2 5 2 3)) should return (2 2 3 5 8)"
       '(2 2 3 5 8)
       (sort < '(8 2 5 2 3)))
(test* "(sort > '(8 2 5 2 3)) should return (8 5 3 2 2)"
       '(8 5 3 2 2)
       (sort > '(8 2 5 2 3)))
(test-end)