问题
I would like to replace just the first occurrence of a certain symbol (say '-) with another symbol (say '+) inside a list that may contain lists. That is to say,
'(((-))) would turn into '(((+)))
'((-) - b) into '((+) - b)
回答1:
Here's another, different option: using mutable state to find out when the first replace has happened:
(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))))))))
回答2:
UPDATE:
As Will Ness pointed out (thanks!), my original answer is wrong. See below for an updated answer.
ORIGINAL ANSWER:
Seems like continuation-passing style would be helpful here.
As this solution traverses the (possibly nested) list, it keeps track of the position via a continuation function k, which is used to "escape" when the given symbol is found.
#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)))
NEW ANSWER:
My original answer only descended into nested lists but did not know how to come back up to keep checking the rest of the list(s). To fix this, I added a backtracking thunk that remembers where we were before diving into a nested list so we can resume from there if needed.
#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)))
回答3:
Here is a short-and-sweet version:
(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))))))))
Nobody is going to have code shorter than this!!
回答4:
Here's another approach than those of the previous answers. Instead of mutation, CPS, or calling equal? on the results of recursion, it uses a second return value to keep track whether a replacement happend.
(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)]))
来源：https://stackoverflow.com/questions/16444290/replace-first-occurrence-of-symbol-in-possibly-nested-list