1

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

4

3 回答 3

5

调整它：

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

于 2020-07-17T17:30:00.847 回答
3

您只需将最后一个替换为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)
于 2020-07-17T06:50:46.043 回答
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)])))
于 2020-07-17T11:19:44.257 回答