如何通过索引获取子树?

在没有毛茸茸的控制结构的情况下实现这一点的方法是制定议程。

但在你这么做之前, 定义抽象概念 .每次我看代码时,它称之为“树”,并充满了显式的 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 在上面的函数中?

我已经修复了我的实现。如果你知道如何改进,或者知道如何实施 subtree 如果不使用连续传球方式(CPS),请发布答案。我对非CPS(和非call/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

一种方法是递归遍历树,使用一个计数器跟踪当前访问的节点数。以前每次 loop 与节点的子节点一起调用时,计数器递增 环 遍历子树返回计数器反映到目前为止访问的树节点数(这就是逻辑失败的地方)。当找到所需的节点时,它使用一个“exit”延续来缩短调用堆栈的展开,直接从递归的深处返回它。

(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)

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

(看起来像是更换了 fold 具有 foldl (足够了)

好吧,让我看看。。。这种深度优先枚举的一般结构是使用显式维护的堆栈(或者对于宽度优先顺序,使用队列):

(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)))