方案：是否可以将 S 表达式列表转换为原子列表？答案

【问题标题】：Scheme: Is it possible to convert a list of S-expressions into a list of atoms?方案：是否可以将 S 表达式列表转换为原子列表？
【发布时间】：2020-11-06 20:06:35
【问题描述】：

我正在尝试将 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。

【问题讨论】：

标签： recursion scheme lisp flatten the-little-schemer

【解决方案1】：

您只需将最后一个 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)

【讨论】：

append 是方案的原语吗？我有个疑问。请说清楚。或者它是racket 的一部分。
append 是 Scheme 规范的标准部分，它是一个基本原语。如果你不能使用它，用null?、cons、car、cdr、cond等其他原语很容易实现。

【解决方案2】：

这似乎接近每个人都想在某个时候编写的标准flatten 函数。我总是喜欢看看如何通过使用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)])))

【讨论】：

太棒了！但对于一个大人物来说很复杂。
@SreekumarR：是的，对不起，它有点毛！我不认为这是对你的最佳答案，只是一个答案。
我想我在这里看到它在某处说 Racket 的堆栈在堆上，所以除非整个内存耗尽，否则没有堆栈溢出，所以没有真正需要 tail-rec-accumulate-and-再倒过来。我只能看到tail-rec积累的价值，如果它是自上而下的建筑结构，但禁止手术操作，所以它不适用......所以在这里我们可以摆脱reverse和results完全可变，并简化代码。然后它变得与我的答案中的代码非常相似，其中(cdr lat) 充当agenda，(car lat) 充当it。
比如this。
@exnihilo：关于atom? 的好点：是的，它应该是顶级的。对于reverse，我试图在没有任何“列表->列表”（aka 非恒定时间，或多或少）函数的情况下逃脱，因此定义了本地函数。

【解决方案3】：

调整它：

(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 的 "gopher" 技巧，将树向右旋转直到最左边的原子暴露在左上角，然后将其拆分并继续。

【讨论】：