Replace first occurrence of symbol in (possibly ne

问题:

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)]))