如何按索引获取子树？

Question

假设我有以下树：

在我的程序中，这棵树用一个列表表示：'(+ (* 5 6) (sqrt 3))。

如何通过索引获取子树？

索引应该从 0 开始并且是深度优先的。在上图中，我用索引标记了所有节点以显示这一点。

例如：

(define tree '(+ (* 5 6) (sqrt 3)))

(subtree tree 0)  ; Returns: '(+ (* 5 6) (sqrt 3)))
(subtree tree 1)  ; Returns: '(* 5 6)
(subtree tree 2)  ; Returns: 5
(subtree tree 3)  ; Returns: 6
(subtree tree 4)  ; Returns: '(sqrt 3)
(subtree tree 5)  ; Returns: 3

我尝试像这样实现subtree：

(define (subtree tree index)
  (cond [(= index 0) tree]
        [else
         (subtree (cdr tree)
                  (- index 1))]))

但是，这不会遍历子列表。这是不正确的。

编辑：

我尝试使用延续传递样式实现subtree：

(define (subtree& exp index counter f)
  (cond [(= counter index) exp]
        [(null? exp) (f counter)]
        [(list? exp)
         (let ((children (cdr exp)))
           (subtree& (car children)
                     index
                     (+ counter 1)
                     (lambda (counter2)
                       (if (null? (cdr children))
                           (f counter)
                           (subtree& (cadr children)
                                     index
                                     (+ counter2 1)
                                     f)))))]
        [else (f counter)]))

(define (subtree tree index)
  (subtree& tree
            index
            0
            (lambda (_)
              (error "Index out of bounds" index))))

这适用于以下树：

• '(+ 1 2)
• '(+ (* 5 6) (sqrt 3))

但是，对于像这样的树，它会失败：

• '(+ 1 2 3)

我的实现有什么问题？

Answer 1

好的，让我们看看...这种深度优先枚举的一般结构是使用明确维护的堆栈（或者对于广度优先排序，队列）：

(define (subtree t i)
  (let loop ((t t) (k 0) (s (list)))  ; s for stack
    (cond
      ((= k i)     t)             ; or:  (append s (cdr t))  for a kind of
      ((pair? t)   (loop (car t) (+ k 1) (append (cdr t) s))) ; bfs ordering
      ((null? s)   (list 'NOT-FOUND))
      (else        (loop  (car s) (+ k 1) (cdr s))))))

这做了类似的事情，但不完全是你想要的：

> (map (lambda (i) (list i ': (subtree tree i))) (range 10))
'((0 : (+ (* 5 6) (sqrt 3)))
  (1 : +)
  (2 : (* 5 6))
  (3 : *)
  (4 : 5)
  (5 : 6)
  (6 : (sqrt 3))
  (7 : sqrt)
  (8 : 3)
  (9 : (NOT-FOUND)))

根据您的示例，您希望跳过应用程序中的第一个元素：

(define (subtree-1 t i)   ; skips the head elt
  (let loop ((t t) (k 0) (s (list)))  ; s for stack
     (cond
        ((= k i)     t)
        ((and (pair? t)
           (pair? (cdr t)));____                     ____         ; the
                     (loop (cadr t) (+ k 1) (append (cddr t) s))) ;  changes
        ((null? s)   (list 'NOT-FOUND))
        (else        (loop  (car s) (+ k 1) (cdr s))))))

所以现在，如你所愿，

> (map (lambda (i) (list i ': (subtree-1 tree i))) (range 7))
'((0 : (+ (* 5 6) (sqrt 3)))
  (1 : (* 5 6))
  (2 : 5)
  (3 : 6)
  (4 : (sqrt 3))
  (5 : 3)
  (6 : (NOT-FOUND)))

Answer 2

一种方法是递归地遍历树，并使用一个计数器来跟踪当前访问的节点数。每次在使用节点的子节点调用 loop 之前，计数器都会递增，因此当 loop 从遍历子树返回时，计数器会反映到目前为止访问的树节点的数量（这是您的逻辑失败的地方）。当找到所需节点时，它使用“退出”延续来短路展开调用堆栈，直接从递归内部返回。

(require-extension (srfi 1))
(require-extension (chicken format))

(define (subtree tree idx)
  (call/cc
   (lambda (return-result)
     (let loop ((node tree)
                (n 0))    ; the counter
       (cond
        ((= idx n)    ; We're at the desired node
         (return-result node))
        ((list? node) ; Node is itself a tree; recursively walk its children.
         (fold (lambda (elem k) (loop elem (+ k 1))) n (cdr node)))
        (else n)))    ; Leaf node; return the count of nodes so far
     ;; return-result hasn't been called, so raise an error
     (error "No such index"))))

(define (test tree depth)
  (printf "(subtree tree ~A) -> ~A~%" depth (subtree tree depth)))

(define tree '(+ (* 5 6) (sqrt 3)))
(test tree 0)
(test tree 1)
(test tree 2)
(test tree 3)
(test tree 4)
(test tree 5)

---

鸡计划方言；我没有安装球拍。任何需要的转换都留给读者练习。

（看起来用foldl替换fold就足够了）

Answer 3

没有复杂的控制结构的方法是使用议程。

但在此之前，定义抽象。每次我看到正在行走的代码，它称之为“树”并且充满了明确的car、cdr 和c，我必须阻止自己简单地冷启动宇宙，希望我们能得到一个更好的宇宙。如果教你的人没有告诉你这一点对他们有强烈的言辞。

这里是树结构的一些抽象。这些特别重要，因为树结构非常不规则：我希望能够在任何节点上说“给我这个节点的子节点”：叶子只是没有子节点的节点，而不是某种特殊的东西。

(define (make-node value . children)
  ;; make a tree node with value and children
  (if (null? children)
      value
      (cons value children)))

(define (node-value node)
  ;; the value of a node
  (if (cons? node)
      (car node)
      node))

(define (node-children node)
  ;; the children of a node as a list.
  (if (cons? node)
      (cdr node)
      '()))

现在对议程进行一些抽象。议程以列表的形式表示，但当然没有其他人知道这一点，更工业化的实现可能不希望这样表示。

(define empty-agenda
  ;; an empty agenda
  '())

(define agenda-empty?
  ;; is an agenda empty?
  empty?)

(define (agenda-next agenda)
  ;; return the next element of an agenda if it is not empty
  ;; error if it is
  (if (not (null? agenda))
      (car agenda)
      (error 'agenda-next "empty agenda")))

(define (agenda-rest agenda)
  ;; Return an agenda without the next element, or error if the
  ;; agenda is empty
  (if (not (null? agenda))
      (cdr agenda)
      (error 'agenda-rest "empty agenda")))

(define (agenda-prepend agenda things)
  ;; Prepend things to agenda: the first element of things will be
  ;; the next element of the new agenda
  (append things agenda))

(define (agenda-append agenda things)
  ;; append things to agenda: the elements of things will be after
  ;; all elements of agenda in the new agenda
  (append agenda things))

现在很容易编写函数的纯迭代版本（议程是维护堆栈），而无需各种复杂的控制结构。

(define (node-indexed root index)
  ;; find the node with index index in root.
  (let ni-loop ([idx 0]
                [agenda (agenda-prepend empty-agenda (list root))])
    (cond [(agenda-empty? agenda)
           ;; we're out of agenda: raise an exception
           (error 'node-indexed "no node with index ~A" index)]
          [(= idx index)
           ;; we've found it: it's whatever is next on the agenda
           (agenda-next agenda)]
          [else
           ;; carry on after adding all the children of this node
           ;; to the agenda
           (ni-loop (+ idx 1)
                    (agenda-prepend (agenda-rest agenda)
                                    (node-children
                                     (agenda-next agenda))))])))

---

需要考虑的一件事：如果在上述函数中将agenda-prepend 替换为agenda-append 会发生什么？

Answer 4

我已经修复了我的实现。如果您知道如何改进这一点，或者知道如何在不使用延续传递样式 (CPS) 的情况下实现 subtree，请发布答案。我对看到非 CPS（和非调用/cc）实现特别感兴趣。

使用延续传递风格：

(define (subtree& exp index counter f)
  (cond [(= counter index) exp]
        [(null? exp) (f counter)]
        [(list? exp)
         (define children (cdr exp))
         (define (sibling-continuation siblings)
           (lambda (counter2)
             (if (null? siblings)
                 (f counter2)
                 (subtree& (car siblings)
                           index
                           (+ counter2 1)
                           (sibling-continuation (cdr siblings))))))
         (subtree& (car children)
                   index
                   (+ counter 1)
                   (sibling-continuation (cdr children)))]
        [else (f counter)]))

(define (subtree tree index)
  (subtree& tree
            index
            0
            (lambda (max-index)
              (error "Index out of bounds" index))))

用法：

(define t1 '(+ (* 5 6) (sqrt 3)))

(subtree t1 0)  ; Returns: '(+ (* 5 6) (sqrt 3)))
(subtree t1 1)  ; Returns: '(* 5 6)
(subtree t1 2)  ; Returns: 5
(subtree t1 3)  ; Returns: 6
(subtree t1 4)  ; Returns: '(sqrt 3)
(subtree t1 5)  ; Returns: 3

(define t2 '(+ 0 (* (/ 1 2) (- 3 4)) (sqrt 5) 6))

(subtree t2 0)   ; Returns: '(+ 0 (* (/ 1 2) (- 3 4)) (sqrt 5) 6)
(subtree t2 1)   ; Returns: 0
(subtree t2 2)   ; Returns: '(* (/ 1 2) (- 3 4))
(subtree t2 3)   ; Returns: '(/ 1 2)
(subtree t2 4)   ; Returns: 1
(subtree t2 5)   ; Returns: 2
(subtree t2 6)   ; Returns: '(- 3 4)
(subtree t2 7)   ; Returns: 3
(subtree t2 8)   ; Returns: 4
(subtree t2 9)   ; Returns: '(sqrt 5)
(subtree t2 10)  ; Returns: 5
(subtree t2 11)  ; Returns: 6