方案：是否可以將 S 表達式列表轉換為原子列表？

Question

我正在嘗試將 S 表達式列表轉換為簡單的原子列表，類似於The Little Schemer書中的問題。

我的代碼是（在 Dr.Racket 中輸入）：

> (define lat '((coffee) cup ((tea) cup) (and (hick)) cup))
> (define f
    (lambda (lat)
      (cond
        ((null? lat) (quote ()))
        ((atom? (car lat)) (cons (car lat) (f (cdr lat))))
        (else (cons (f (car lat)) (f (cdr lat)))))))
> (f lat)
'((coffee) cup ((tea) cup) (and (hick)) cup)

上面的代碼返回與輸入列表相同的列表。 我盡了最大努力，但得到了不同的答案，例如：

(coffee)
(cup . cup)
( () (()) (()) )

用於程序中的各種修改。

我想知道，我們能不能得到答案：

'(coffee cup tea cup and hick cup)

給定

'((coffee) cup ((tea) cup) (and (hick)) cup)

僅使用cond cons car和cdr 。

Answer 1

調整它：

(define f
    (lambda (lat)
      (cond
        ((null? lat) (quote ()))
        ;; add this clause
        ((null? (car lat)) (f (cdr lat)))
        ((atom? (car lat)) (cons (car lat) (f (cdr lat))))
        (else ;; (cons (f (car lat)) (f (cdr lat)))
             (f (cons (car (car lat))       ; rotate the tree to the right
                      (cons (cdr (car lat)) (cdr lat))))))))  ; and repeat

使用 John McCarthy 的“地鼠”技巧，將樹向右旋轉，直到最左邊的原子暴露在左上角 position 中，然后將其拆分並繼續。

Answer 2

您只需將最后一個cons替換為append ，以展平子列表：

(define f
  (lambda (lat)
    (cond
      ((null? lat) (quote ()))
      ((atom? (car lat)) (cons (car lat) (f (cdr lat))))
      (else (append (f (car lat)) (f (cdr lat)))))))

append已經是一個內置的原語，但是如果你願意的話，按照你提到的原語程序來說它很容易實現（不推薦，當然：只使用內置的。）。

(define (append l1 l2)
  (cond ((null? l1) l2)
        ((null? l2) l1)
        (else (cons (car l1) (append (cdr l1) l2)))))

現在它按預期工作：

(f '((coffee) cup ((tea) cup) (and (hick)) cup))
=> '(coffee cup tea cup and hick cup)

僅供參考，您嘗試實現的過程稱為flatten並且非常常見，並且某些 Scheme 風格（例如 Racket）已經包含它。 在現實生活中，你要做的是：

(flatten '((coffee) cup ((tea) cup) (and (hick)) cup))
=> '(coffee cup tea cup and hick cup)

Answer 3

這似乎接近每個人在某個時候都想寫的標准flatten function。 我總是想看看如何通過使用append使用具有議程的好技巧（我認為）來編寫這些內容而無需逃避。 以下是這樣做的：注意這可能是特定於 Racket 的。

(define (tree->atoms tree)
  (define atom?
    ;; Something is an atom if it is not a cons
    (compose not cons?))
  (define (rev thing)
    ;; this is just reverse
    (let rev-loop ([rt thing] [rrt '()])
      (if (null? rt)
          rrt
          (rev-loop (rest rt) (cons (first rt) rrt)))))
  (let tree->atoms-loop ([it tree]
                         [agenda '()]
                         [results '()])
    (cond [(null? it)
           ;; no more left
           (if (null? agenda)
               ;; no more agenda: we're done, so reverse
               ;; the results and return that
               (rev results)
               ;; more agenda, so carry on
               (tree->atoms-loop (first agenda)
                                 (rest agenda)
                                 results))]
          [(atom? it)
           ;; we've found an atom which is not ()
           (if (null? agenda)
               ;; we're done
               (rev (cons it results))
               ;; there is more
               (tree->atoms-loop (first agenda)
                                 (rest agenda)
                                 (cons it results)))]
          [else
           ;; cons: look at the car, and stuff the cdr onto the agenda
           (tree->atoms-loop (car it)
                             (cons (cdr it) agenda)
                             results)])))