How do I get a subtree by index?

Question

Suppose I have the following tree:

In my program, this tree is represented using a list: '(+ (* 5 6) (sqrt 3)).

How do I get a subtree by its index?

The index should start from 0 and be depth-first. In the picture above, I have labelled all the nodes with their index to show this.

For example:

(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

I tried to implement subtree like this:

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

However, this does not traverse into sublists. It is incorrect.

EDIT:

I tried to implement subtree using continuation-passing style:

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

This works correctly for trees like:

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

However, it fails for trees like:

• '(+ 1 2 3)

What is wrong with my implementation?

Answer 1

I've fixed my implementation. If you know how to improve upon this, or know how to implement subtree without using continuation-passing style (CPS), please post an answer. I'm particularly interested in seeing a non-CPS (and non-call/cc) implementation.

Using continuation-passing style:

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

Usage:

(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

Answer 2

The way to do this without hairy control constructs is with an agenda.

But before you do that, define abstractions. Every time I look at code which is walking something it calls a 'tree' and is full of explicit car, cdr &c I have to stop myself from simply cold-booting the universe in the hope we get a better one. If whoever is teaching you is not telling you this have strong words with them.

Here are some abstractions for the tree structure. These are particularly important because the tree structure is really irregular: I want to be able to say 'give me the children of this node' on any node: leaves are just nodes with no children, not some special kind of thing.

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

Now some abstractions for the agenda. Agendas are represented as lists, but nothing else knows this of course, and a more industrial-strength implementation might well not want to represent them like that.

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

Now it's easy to write a purely iterative version of the function (the agenda is maintaining the stack), without all sorts of hairy control constructs.

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

---

A thing to think about: what happens if you replace agenda-prepend by agenda-append in the above function?

Answer 3

One approach, that recursively walks the tree, with a counter that tracks the current number of nodes visited. Every time before loop is called with a node's child, the counter is incremented, so when loop returns from walking a subtree the counter reflects the number of the tree nodes visited so far (Which is where your logic is failing). It uses an "exit" continuation to short-circuit unwinding the call stack when the desired node is found, directly returning it from deep inside the recursion.

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

---

Chicken scheme dialect; I don't have Racket installed. Any needed conversion is left as an exercise for the reader.

(looks like replacing fold with foldl is enough)

Answer 4

OK, let's see... The general structure of such depth-first enumerations is with an explicitly maintained stack (or for the breadth-first ordering, a queue):

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

This does something similar but not exactly what you wanted:

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

As per your example you want to skip the first element in applications:

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

so that now, as you wanted,

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