Serendip

Web Studio

delete-1 の定義を一箇所変更して、一致するものを全て取り除く delete を定義する。

(define (delete elt lis . options)
  (let-optionals* options ((cmp-fn equal?))
                  (define (loop lis)
                    (cond ((null? lis) '())
                          ((cmp-fn elt (car lis)) (loop (cdr lis))) ; 残りのリストを走査する
                          (else (cons (car lis) (loop (cdr lis))))))
                  (loop lis)))

実行結果

(define *inventory* (list 'potion 'potion 'dagger 'cookie 'dagger))
(delete 'cookie *inventory*)
gosh> (potion potion dagger dagger)
(delete 'potion *inventory*)
gosh> (dagger cookie dagger)
(delete 'dagger *inventory*)
gosh> (potion potion cookie)

練習問題

要素が見つからなかった場合にコピーを行わない delete-1 を実装する。

元の delete-1 でテストを行うと、

(let ((data (list 1 2 3 4 5)))
     (test* "non-copy delete-1" data (delete-1 6 data) eq?))
gosh> test non-copy delete-1, expects (1 2 3 4 5) ==> ERROR: GOT (1 2 3 4 5)
#<undef>

ヒントにあるように (delete-1 elt (cdr lis)) と (cdr lis) を eq? で比較してからコピーを行うようにする。

(define (delete-1 elt lis . options)
  (let-optionals* options ((cmp-fn equal?))
                  (define (loop lis)
                    (cond ((null? lis) '())
                          ((cmp-fn elt (car lis)) (cdr lis))
                          ((eq? (loop (cdr lis)) (cdr lis)) lis)
                          (else
                            (if (eq? (loop (cdr lis)) (cdr lis))
                                lis
                                (cons (car lis) (loop (cdr lis)))))))
                  (loop lis)))

実行結果

(let ((data (list 1 2 3 4 5)))
     (test* "non-copy delete-1" data (delete-1 6 data) eq?))
gosh> test non-copy delete-1, expects (1 2 3 4 5) ==> ok
#<undef>

プログラミングGauche

posted with amazlet at 08.11.14

Kahuaプロジェクト
オライリージャパン
売り上げランキング: 22775

Amazon.co.jp で詳細を見る