scheme - 替换（可能是嵌套的）列表中第一次出现的符号

Question

我想在可能包含列表的列表中将某个符号（say '-）的第一次出现替换为另一个符号（say ）。'+也就是说，

'(((-)))会变成'(((+)))

'((-) - b)进入'((+) - b)

Answer 1

更新：

正如 Will Ness指出的（谢谢！），我原来的答案是错误的。请参阅下面的更新答案。

原始答案：

似乎延续传递风格在这里会有所帮助。

当此解决方案遍历（可能是嵌套的）列表时，它通过延续函数跟踪位置k，当找到给定符号时，该函数用于“转义”。

#lang racket

(define (replace-first lst old new)
  (let LOOP ([lst lst] [k (λ (x) x)]) ; invariant: (k lst) produces orig list
    (if (null? lst) 
        (k null)
        (let ([fst (car lst)])
          (cond [(pair? fst) (LOOP fst (λ (x) (k (cons x (cdr lst)))))]
                [(eq? fst old) (k (cons new (cdr lst)))]
                [else (LOOP (cdr lst) (λ (x) (k (cons fst x))))])))))

(module+ test
  (require rackunit)
  (check-equal? (replace-first '() '- '+) '())
  (check-equal? (replace-first '(*) '- '+) '(*))
  (check-equal? (replace-first '(-) '- '+) '(+))
  (check-equal? (replace-first '((-)) '- '+) '((+)))
  (check-equal? (replace-first '(((-))) '- '+) '(((+))))
  (check-equal? (replace-first '((-) - b) '- '+) '((+) - b)))

新答案：

我最初的答案只下降到嵌套列表中，但不知道如何回来继续检查列表的其余部分。为了解决这个问题，我添加了一个回溯 thunk，它会记住我们在进入嵌套列表之前所处的位置，以便我们可以在需要时从那里恢复。

#lang racket

(define (replace-first lst old new)
  ; invariant: (k lst) produces orig list
  (let LOOP ([lst lst] [k (λ (x) x)] [back (λ () lst)]) 
    (if (null? lst) 
        (back)
        (let ([fst (car lst)])
          (cond [(pair? fst) 
                 (LOOP fst 
                       (λ (x) (k (cons x (cdr lst))))
                       (λ () (LOOP (cdr lst) (λ (x) (k (cons fst x))) back)))]
                [(eq? fst old) (k (cons new (cdr lst)))]
                [else (LOOP (cdr lst) (λ (x) (k (cons fst x))) back)])))))

(module+ test
  (require rackunit)
  (check-equal? (replace-first '() '- '+) '())
  (check-equal? (replace-first '(*) '- '+) '(*))
  (check-equal? (replace-first '(-) '- '+) '(+))
  (check-equal? (replace-first '((-)) '- '+) '((+)))
  (check-equal? (replace-first '(((-))) '- '+) '(((+))))
  (check-equal? (replace-first '((-) - b) '- '+) '((+) - b))
  (check-equal? (replace-first '((((11 2) 3 4) a) 6) 'a 'b) 
                '((((11 2) 3 4) b) 6))
  (check-equal? (replace-first '((((11 2) 3 4) (c a a)) 6) 'a 'b) 
                '((((11 2) 3 4) (c b a)) 6))
  (check-equal? (replace-first '((((11 2) 3 4) ((c (d e) (f a)))) 6) 'a 'b) 
                '((((11 2) 3 4) ((c (d e) (f b)))) 6))
  (check-equal? (replace-first '((((11 2) a 4) c) 6) 'a 'b) 
                '((((11 2) b 4) c) 6)))

Answer 2

这是一个简短的版本：

(define (replace-one list old new)
  (cond ((pair? list)
         (let ((next (replace-one (car list) old new)))
           (cons next 
                 (if (equal? next (car list))            ; changed?
                     (replace-one (cdr list) old new)    ;   no,  recurse on rest
                     (cdr list)))))                      ;   yes, done
         ((eq? list old) new)
         (else list)))

> (replace-one '(+ 1 2) '+ '-)
(- 1 2)
> (replace-one '((+) 1 2) '+ '-)
((-) 1 2)
> (replace-one '(1 2 ((+)) 3 4) '+ '-)
(1 2 ((-)) 3 4)
> (replace-one '() '+ '-)
()
> (replace-one '(1 2 ((((((+ 3 (+ 4 5)))))))) '+ '-)
(1 2 ((((((- 3 (+ 4 5))))))))

没有人会拥有比这更短的代码！！

Answer 3

这是与先前答案不同的另一种方法。它不使用突变、CPS 或调用equal?递归结果，而是使用第二个返回值来跟踪是否发生了替换。

(define (deep-replace-first lst old new)
  (define (old-car)
    (let-values ([(new-cdr replaced?)
                  (deep-replace-first (cdr lst) old new)])
      (if replaced?
          (values (cons (car lst) new-cdr) #t)
          (values lst #f))))
  (cond [(null? lst) (values '() #f)]
        [(pair? (car lst))
         (let-values ([(new-car replaced?)
                       (deep-replace-first (car lst) old new)])
           (if replaced?
               (values (cons new-car (cdr lst)) #t)
               (old-car)))]
        [(eqv? (car lst) old) (values (cons new (cdr lst)) #t)]
        [else (old-car)]))

Answer 4

这是另一个不同的选择：使用可变状态来找出第一次替换发生的时间：

(define (replace-first)
  (let ((found #f))
    (define (replacer exp old new)
      (cond ((null? exp) '())
            ((not (pair? exp))
             (cond ((and (eq? exp old) (not found))
                    (set! found #t) new)
                   (else exp)))
            (else
             (cons (replacer (car exp) old new)
                   (replacer (cdr exp) old new)))))
    replacer))

((replace-first) '(((-))) '- '+)
=> '(((+)))

((replace-first) '((-) - b) '- '+)
=> '((+) - b)

((replace-first) '(+ 1 2) '+ '-)
=> '(- 1 2)

((replace-first) '((+) 1 2) '+ '-)
=> '((-) 1 2)

((replace-first) '(1 2 ((+)) 3 4) '+ '-)
=> '(1 2 ((-)) 3 4)

((replace-first) '() '+ '-)
=> '()

((replace-first) '(1 2 ((((((+ 3 (+ 4 5)))))))) '+ '-)
=> '(1 2 ((((((- 3 (+ 4 5))))))))