How to construct a tree of particular shape with e

问题:

Given an s-expression '((a . b) . (c . d)) and a list '(e f g h), how can I traverse the s-expression create an s-expression with the same shape, but with elements taken from the list? E.g., for the s-expression and list above, the result would be '((e . f) g . h)?

回答1:

Traversing a tree of pairs in left to right order isn't particularly difficult, as car and cdr let you get to both sides, and cons can put things back together. The tricky part in a problem like this is that to "replace" elements in the right hand side of a tree, you need to know how many of the available inputs you used when processing the left hand side of the tree. So, here's a procedure reshape that takes a template (a tree with the shape that you want) and a list of elements to use in the new tree. It returns as multiple values the new tree and any remaining elements from the list. This means that in the recursive calls for a pair, you can easily obtain both the new left and right subtrees, along with the remaining elements.

(define (reshape template list)
  ;; Creates a tree shaped like TEMPLATE, but with 
  ;; elements taken from LIST.  Returns two values: 
  ;; the new tree, and a list of any remaining
  ;; elements from LIST.
  (if (not (pair? template))
      (values (first list) (rest list))
      (let-values (((left list) (reshape (car template) list)))
        (let-values (((right list) (reshape (cdr template) list)))
          (values (cons left right) list)))))

(reshape '((a . b) . (c . d)) '(e f g h))
;=> ((e . f) g . h)
;=> ()

(reshape '((a . b) . (c . d)) '(e f g h i j k))
;=> ((e . f) g . h)
;=> (i j k)          ; leftovers

回答2:

I'll assume that you want to create a new s-expression with the same shape of the s-expression given as the first parameter, but with the elements of the list from the second parameter.

If that's right, here's one possible solution using a list to save the point where we are in the replacement list and Racket's begin0 to keep the list updated (if that's not available in you interpreter use a let, as suggested by Chris and Joshua in the comments):

(define (transform sexp lst)
  (let loop ((sexp sexp))     ; the s-expression list to be traversed
    (cond ((null? sexp) '())  ; if it's empty, we're finished
          ((not (pair? sexp)) ; if it's an atom
           (begin0            ; then (alternatively: use a `let`)
             (car lst)        ; return first element in replacements list
             (set! lst (cdr lst)))) ; and update replacements to next element
          (else                         ; otherwise advance recursion
           (cons (loop (car sexp))      ; over both the `car` part of input
                 (loop (cdr sexp))))))) ; and the `cdr` part

For example:

(transform '((a . b) . (c . d)) '(e f g h))
=> '((e . f) g . h)

(transform '((a . b) (c d (x y) . z) . t) '(e f g h i j k m))
=> '((e . f) (g h (i j) . k) . m)

回答3:

The solution is similar to my previous answer:

(define (transform sxp lst)
  (let loop ((sxp sxp))
    (cond ((null? sxp) sxp)
          ((pair? sxp) (cons (loop (car sxp)) (loop (cdr sxp))))
          (else (begin0 (car lst) (set! lst (cdr lst)))))))

then

> (transform '((a . b) . (c . d)) '(e f g h))
'((e . f) g . h)