Como obtenho uma subárvore por índice?
Suponha que eu tenha a seguinte árvore:
No meu programa, esta árvore é representado usando uma lista: '(+ (* 5 6) (sqrt 3)).
Como faço para obter uma subárvore por seu índice?
O índice deve começar em 0 e ser o primeiro em profundidade. Na imagem acima, rotulei todos os nós com seus índices para mostrar isso.
Por exemplo:
(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
Tentei implementar subtreeassim:
(define (subtree tree index)
(cond [(= index 0) tree]
[else
(subtree (cdr tree)
(- index 1))]))
No entanto, isso não atravessa as sublistas. Isso está incorreto.
EDITAR:
Tentei implementar subtreeusando o estilo de passagem de continuação:
(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))))
Isso funciona corretamente para árvores como:
'(+ 1 2)'(+ (* 5 6) (sqrt 3))
No entanto, falha para árvores como:
'(+ 1 2 3)
O que há de errado com minha implementação?
Respostas
A maneira de fazer isso sem construções de controle cabeludas é com uma agenda.
Mas antes de fazer isso, defina abstrações . Cada vez que vejo um código que está andando em algo, ele chama de 'árvore' e está cheio de explícito car, cdretc., tenho que parar de simplesmente inicializar o universo a frio na esperança de obter um melhor. Se quem está ensinando você não está dizendo isso, tenha palavras fortes com eles .
Aqui estão algumas abstrações para a estrutura da árvore. Eles são particularmente importantes porque a estrutura da árvore é realmente irregular: eu quero ser capaz de dizer 'dê-me os filhos deste nó' em qualquer nó: as folhas são apenas nós sem filhos, não algum tipo especial de coisa.
(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)
'()))
Agora, algumas abstrações para a agenda. As agendas são representadas como listas, mas nada mais sabe disso, é claro, e uma implementação de força industrial pode muito bem não querer representá-las dessa forma.
(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))
Agora é fácil escrever uma versão puramente iterativa da função (a agenda é manter a pilha), sem todos os tipos de construções de controle complicadas.
(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))))])))
Uma coisa para se pensar: o que acontece se você substituir agenda-prependpor agenda-appendna função acima?
Eu consertei minha implementação. Se você sabe como melhorar isso, ou sabe como implementar subtreesem usar o estilo de passagem de continuação (CPS), poste uma resposta. Estou particularmente interessado em ver uma implementação não-CPS (e não-call / cc).
Usando o estilo de passagem de continuação:
(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))))
Uso:
(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
Uma abordagem que percorre a árvore recursivamente, com um contador que rastreia o número atual de nós visitados. Cada vez que antes loopé chamado com um filho de um nó, o contador é incrementado, então quando loopretorna de uma subárvore o contador reflete o número de nós da árvore visitados até agora (que é onde sua lógica está falhando). Ele usa uma continuação de "saída" para desfazer um curto-circuito na pilha de chamadas quando o nó desejado é encontrado, retornando-o diretamente de dentro da recursão.
(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)
Dialeto do esquema da galinha; Não tenho o Racket instalado. Qualquer conversão necessária é deixada como um exercício para o leitor.
(parece que substituir foldpor foldlé suficiente)
OK, vamos ver ... A estrutura geral de tais enumerações em profundidade é com uma pilha mantida explicitamente (ou para a ordem em largura, uma fila):
(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))))))
Isso faz algo semelhante, mas não exatamente o que você queria:
> (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)))
Conforme seu exemplo, você deseja pular o primeiro elemento nos aplicativos:
(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))))))
de modo que agora, como você queria,
> (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)))