multi rember, R, L, substr を書いてみた

書いてみました。

multirember

(define multirember
  (lambda (a lat)
    (cond ((null? lat) '())
          ((eq? a (car lat)) (multirember a (cdr lat)))
          (else
           (cons (car lat) (multirember a (cdr lat)))))))
;(multirember 'aaa '(bbb aaa vvv ccc aaa bbb))

multiinsertR

(define multiinsertR
  (lambda (old new lat)
    (cond ((null? lat) '())
          ((eq? old (car lat)) (cons old (cons new (multiinsertR old new (cdr lat)))))
          (else
           (cons (car lat) (multiinsertR old new (cdr lat)))))))

;(multiinsertR 'aaa 'bbb '(aaa ccc dddd eee aaa ccc))

multiinsertL

(define multiinsertL
  (lambda (old new lat)
    (cond ((null? lat) '())
          ((eq? old (car lat)) (cons new (cons old (multiinsertL old new (cdr lat)))))
          (else
           (cons (car lat) (multiinsertL old new (cdr lat)))))))
;(multiinsertL 'bbb 'aaa '(bbb ccc ddd eee bbb ccc))

multisubstr

(define multisubstr
  (lambda (old new lat)
    (cond ((null? lat) '())
          ((eq? old (car lat)) (cons new (multisubstr old new (cdr lat))))
          (else 
           (cons (car lat) (multisubstr old new (cdr lat)))))))

(multisubstr '*** 'aaa '(*** bbb ccc (*** bbb ccc)))

ちょっと書いてて思ったけど
lat? が #f になる場合は きちんとすべてのS式対して評価されないことがわかった。

(multisubstr '*** 'aaa '(*** bbb ccc (*** bbb ccc))) 
;(aaa bbb ccc (*** bbb ccc))

せっかくなのでちょっと改造してみたのがこれ

(define atom?
  (lambda (x) 
    (and (not (pair? x)) (not (null? x)))))

(define (lat? n)
  (cond ((atom? n) true)
        ((null? n) true)
        (else (and (atom? (car n))
                   (lat? (cdr n))))))

(define multisubstrX
  (lambda (old new lat)
    (cond ((null? lat) '())
          ((not (atom? (car lat))) (cons (multisubstrX old new (car lat)) (multisubstrX old new (cdr lat))))
          ((eq? old (car lat)) (cons new (multisubstrX old new (cdr lat))))
          (else 
           (cons (car lat) (multisubstrX old new (cdr lat)))))))

(multisubstrX '*** 'aaa '(*** bbb ccc (*** bbb ccc)))
;(aaa bbb ccc (aaa bbb ccc))

満足。