3

我们被要求编写一个程序,当给定一个列表时,它将替换给定元素的第一次出现,并且只替换第一次出现,但要注意的是要以 CPS 样式编写。我们无法将其转换为 CPS 风格的书面程序,该程序给出了成功-连续和失败-连续..

如果有人愿意试一试,我们将不胜感激:]

我们拥有的程序(由此处的答案慷慨地提供):

(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)))
4

2 回答 2

3

已编辑

非常感谢@WillNess 指出并修复了隐藏在原始代码中的错误。这是基于他的代码(逐步推导)的更正实现,评论并为球拍惯用:

(define (replace-one lst a b)
  (let loop ([lst lst]                ; input list
             [f #f]                   ; have we made the first replacement?
             [k (lambda (ls f) ls)])  ; continue with results: list and flag
    (cond 
      (f                              ; replaced already: 
        (k lst f))                    ; continue without changing anything
      ((empty? lst)                   ; empty list case
        (k lst f))                    ; go on with empty lst and flag as is
      ((not (pair? lst))              ; - none replaced yet - is this an atom?
        (if (eq? lst a)               ; is this the atom being searched?
            (k b #t)                  ; replace, continue with updated flag
            (k lst f)))               ; no match, continue
      (else                           ; is this a list?
        (loop (first lst)             ; process the `car` of `lst`
          f                           ; according to flag's value, and then
          (lambda (x f)               ; accept resulting list and flag, and
            (loop (rest lst)          ; process the `cdr` of `lst`
              f                       ; according to new value of flag, 
              (lambda (y f)           ; getting the results from that, and then
                (if f                 ; - if replacement was made -
                  (k                  ; continuing with new list, built from
                    (cons x y)        ; results of processing the two branches,
                    f)                ; and with new flag, or with 
                  (k lst f))))))))))  ; the old list if nothing was changed

请注意,使用了一个成功延续(k在上面的代码中调用),它接受两个结果值:列表和标志。初始延续只返回最终结果列表,并丢弃最终标志值。我们还可以返回标志,以表明是否已经进行了替换。它在内部用于尽可能多地保留原始列表结构,与持久数据类型一样(如本答案所示)。

最后,始终测试您的代码:

; fixed, this wasn't working correctly
(replace-one '((((1 2) 3 4) a) 6) 'a 'b)
=> '((((1 2) 3 4) b) 6)

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

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

(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))))))))
于 2013-05-14T18:45:55.577 回答
1

OP 要求进行具有两个延续的转换 - 成功和失败。这很容易做到:像往常一样,我们从 CPS 版本的深拷贝 ( car-cdr recursion ) 开始,然后我们只是想象我们有两种返回值的方法:当我们刚刚找到旧的值,所以我们返回新的值,不再继续查找;如果我们还没有找到它 - 在这种情况下,我们会返回我们拥有的东西并将继续寻找它。

;; replace first occurence of a inside xs with b,
;;      using two continuations - success and failure 
(define (rplac1_2 xs a b)
  (let g ((xs xs)
          (s (lambda (x) x))    ; s is "what to do on success"
          (f (lambda () xs)))   ; f is "what to do on failure"
    (cond
      ((null? xs) 
            (f))                ; nowhere to look for `a` anymore
      ((not (pair? xs))
        (if (eq? xs a) 
            (s b)               ; success: `a` found: "return" `b` instead
            (f)))               ; nowhere to look for `a` anymore
      (else
        (g (car xs)
           (lambda (x)          ; if succeded on (car xs), with `x` the result
             (s (cons x (cdr xs))))
           (lambda ()           ; if failed (nothing replaced yet, keep trying)
             (g (cdr xs)
                (lambda (y)     ; if succeeded on (cdr xs), with `y` the result
                  (s (cons (car xs) y)))
                f)))))))        ; if none replaced

这样,我们实际上被迫尽可能地保留原始列表结构。

测试

(display (rplac1_2 '((((a 2) 3 4) a) 6) 'a 'b)) 
(display (rplac1_2 '((((c 2) 3 4) a) 6) 'a 'b)) 
(display (rplac1_2 '((((c 2) 3 a) a) 6) 'a 'b)) 

正确产生

((((b 2) 3 4) a) 6)
((((c 2) 3 4) b) 6)
((((c 2) 3 b) a) 6)

于 2013-10-03T09:09:56.090 回答