Question

我们被要求编写一个程序，当给出一个列表时，它将替换给定元素的第一次出现而只替换第一次，但是catch是用CPS样式写的。我们无法将其转换为CPS风格的书面程序，该程序具有成功的连续性和失败的连续性。

如果有人愿意试一试，我们将非常感激：]

我们的程序（由答案here慷慨提供）：

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

Answer 1

<强> EDITED

非常感谢@WillNess指出并修复了一个错误，潜伏在原始代码中。以下是基于他code (with stepwise derivation)的更正实施，评论并使其成为Racket的惯用语：

(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），它接受两个结果值：列表和标志。初始延续只返回最终结果列表，并丢弃最终标志值。我们也可以返回标志，作为是否完全替换的指示。内部使用它来保留尽可能多的原始列表结构，就像常见的持久数据类型一样（如in this answer所示）。

最后，始终测试您的代码：

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

Answer 2

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

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

Testing it与

(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）

将功能更改为CPS样式

2 个答案: