3

We were asked to write a procedure that when given a list it will replace the first occurrence of a given element and only the first, but the catch is to write in CPS style. We are unable to turn it to CPS style written procedure that is given a success-cont and fail-cont..

If anyone is willing to give it a try we will really appreciate it :]

The procedure we have (graciously provided by answers 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)))
Community
  • 1
  • 1
Rachel Bernouli
  • 225
  • 2
  • 9
  • 1
    possible duplicate of [Replace first occurrence of symbol in (possibly nested) list](http://stackoverflow.com/questions/16444290/replace-first-occurrence-of-symbol-in-possibly-nested-list) – Óscar López May 14 '13 at 18:49
  • 3
    That is my code! The very least you could do would be up-vote it in the original post (following link in prior comment). – GoZoner May 14 '13 at 20:37
  • 2
    "The proceudre we wrote". Right. Didn't even remove the comments from the original solution! – Óscar López May 15 '13 at 13:29

2 Answers2

3

EDITED

A big thanks to @WillNess for pointing out and fixing a bug, lurking in the original code. Here's a corrected implementation based on his code (with stepwise derivation), commented and made idiomatic for 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

Notice that a single success continuation is used (called k in the code above) which accepts two resulting values: the list and the flag. The initial continuation just returns the final resulting list, and discards the final flag value. We could also return the flag, as indication of whether the replacement have been made at all or not. It is used internally to preserve as much of original list structure as possible, as usual with persistent data types (as seen in this answer).

Finally, always test your code:

; 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))))))))
Community
  • 1
  • 1
Óscar López
  • 232,561
  • 37
  • 312
  • 386
  • 2
    [appears to be buggy](http://ideone.com/0gndvZ), as [the original](http://stackoverflow.com/a/16449777/849891) as well. `(replace-one '((((11 2) 3 4) a) 6) 'a 'b))` produces `((((11 2) 3 4) a) 6)`. – Will Ness Sep 17 '13 at 14:55
  • @WillNess You're right :( I can't think of a way to fix it using CPS, my attempts turn the solution into a `replace-all`. Any ideas? – Óscar López Sep 17 '13 at 15:45
  • 1
    [OK, here it is](http://ideone.com/AbWKxS), :) passing *two* values up the chain of Cs. – Will Ness Sep 17 '13 at 15:59
  • @WillNess fantastic! you should add that as a solution, so we can upvote it :) – Óscar López Sep 17 '13 at 16:07
  • @WillNess that's too bad, what happened to you on Meta :S with your permission, I'll add your correction here, with full credit of course - and a big thank you! – Óscar López Sep 17 '13 at 16:14
  • 2
    the meta thing [has been resolved](http://meta.stackexchange.com/a/197335/172601), for now at least. – Will Ness Sep 18 '13 at 07:24
1

The OP asks for a transformation with two continuations - success and failure. This is easy enough to do: we start with a CPS version of deep-copy (car-cdr recursion), as usual, and then we just imagine that we have two ways to return a value: when we've just found the old value, so we return the new one instead and will stop looking any further; and if we didn't find it yet - in which case we return what we have and will keep looking for it.

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

this way we're practically forced to preserve the original list structure as much as possible.

Testing it with

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

correctly produces

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

Will Ness
  • 70,110
  • 9
  • 98
  • 181