我想在可能包含列表的列表中替换第一次出现的某个符号(比如说'-
)和另一个符号(比如'+
)。也就是说,
'(((-)))
会变成'(((+)))
'((-) - b)
加入'((+) - b)
答案 0 :(得分:3)
更新:
Will Will Ness pointed out(谢谢!),我原来的回答是错误的。请参阅下面的更新答案。
原始回答:
似乎延续传递风格在这里会有所帮助。
当此解决方案遍历(可能是嵌套的)列表时,它通过延续函数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)))
答案 1 :(得分:1)
这是一个简短的甜蜜版本:
(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))))))))
没有人会比这更短的代码!!
答案 2 :(得分:1)
这是另一个不同的选择:使用可变状态来找出第一次替换发生的时间:
(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))))))))
答案 3 :(得分:1)
这是另一种方法,而不是之前的答案。它不使用变异,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)]))