9章1節の練習問題：delete-1

srfi-1のdeleteは等価述語を満たす要素を全部削除してしまうけど、見つけた1つ目だけ消す手続きdelete-1を定義してみると

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

ってなるけど、第1引数で指定した要素が見つからなかった場合に、一切コピーしないようにdelete-1を書き換えてみよう、と。
ヒントを読まないと取っ掛かりが分からんかった ＞＜

ヒントみて、初めて書けたやつ。

(define delete-1
  (lambda (elt lis . optionals)
    (let-optionals* optionals ((cmp-fn equal?))
      (cond
       ((null? lis) lis)
       ((member elt (cdr lis) cmp-fn)
        (if (cmp-fn elt (car lis))
            (cdr lis)
            (cons (car lis) (delete-1 elt (cdr lis) cmp-fn))))
       (else
        (if (cmp-fn elt (car lis))
            (cdr lis)
            lis))))))

null?のチェック要らなくね？ということで、condでnull?のチェック削除した。

(define delete-1
  (lambda (elt lis . optionals)
    (let-optionals* optionals ((cmp-fn equal?))
      (cond
       ((member elt (cdr lis) cmp-fn)
        (if (cmp-fn elt (car lis))
            (cdr lis)
            (cons (car lis) (delete-1 elt (cdr lis) cmp-fn))))
       (else
        (if (cmp-fn elt (car lis))
            (cdr lis)
            lis))))))

2個あるif式の

• 条件式
• それが真の場合の値

同じで、違うのは条件式が#fになった時の値だけなので、まとめて外に出してみた。

(define delete-1
  (lambda (elt lis . optionals)
    (let-optionals* optionals ((cmp-fn equal?))
      (cond
       ((cmp-fn elt (car lis)) (cdr lis))
       ((member elt (cdr lis) cmp-fn)
        (cons (car lis) (delete-1 elt (cdr lis) cmp-fn)))
       (else lis)))))

本に倣って、ローカル手続きにしてみた。

(define delete-1
  (lambda (elt lis . optionals)
    (let-optionals* optionals ((cmp-fn equal?))
      (define loop
        (lambda (lis)
          (cond
           ((cmp-fn elt (car lis)) (cdr lis))
           ((member elt (cdr lis) cmp-fn)
            (cons (car lis) (loop (cdr lis))))
           (else lis))))
      (loop lis))))

できた！（*´▽｀）ﾊﾟｧｧ
...と思ったけど、このdelete-1は

(delete-1 'foo '())

を評価するとエラーになる。
null?のチェックを削除してから

(cmp-fn elt (car lis))

をmemberの前に出してしまったからだな。ってことでnull?のチェックを復活。

(define delete-1
  (lambda (elt lis . optionals)
    (let-optionals* optionals ((cmp-fn equal?))
      (define loop
        (lambda (lis)
          (cond
           ((null? lis) lis)
           ((cmp-fn elt (car lis)) (cdr lis))
           ((member elt (cdr lis) cmp-fn)
            (cons (car lis) (loop (cdr lis))))
           (else lis))))
      (loop lis))))

多分、これでOKじゃないかなー。

gosh> (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>

非効率かも？（2009/03/08追記）

delete-1で毎回member手続きを実行しているけど、非効率な気がしてきた。
何か良い方法があるのかも知れないなぁ。