codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; binary tree traversal (define (split-while pred? xs) (let loop ((xs xs) (ys '())) (if (or (null? xs) (not (pred? (car xs)))) (values (reverse ys) xs) (loop (cdr xs) (cons (car xs) ys))))) (define (preorder t) (if (null? t) (list) (append (list (car t)) (if (pair? (cdr t)) (preorder (cadr t)) (list)) (if (and (pair? (cdr t)) (pair? (cddr t))) (preorder (caddr t)) (list))))) (define (postorder t) (if (null? t) (list) (append (if (pair? (cdr t)) (postorder (cadr t)) (list)) (if (and (pair? (cdr t)) (pair? (cddr t))) (postorder (caddr t)) (list)) (list (car t))))) (define (last xs) (car (reverse xs))) (define (but-last xs) (reverse (cdr (reverse xs)))) (define (prebuild xs) (cond ((null? xs) (list)) ((null? (cdr xs)) (list (car xs))) (else (call-with-values (lambda () (split-while (lambda (x) (< x (car xs))) (cdr xs))) (lambda (lo hi) (list (car xs) (prebuild lo) (prebuild hi))))))) (define (postbuild xs) (cond ((null? xs) (list)) ((null? (cdr xs)) (list (car xs))) (else (call-with-values (lambda () (split-while (lambda (x) (< x (last xs))) (but-last xs))) (lambda (lo hi) (list (last xs) (postbuild lo) (postbuild hi))))))) (define t '(8 (3 (1) (6 (4) (7))) (10 () (14 (13) ())))) (display (preorder t)) (newline) (display (postorder t)) (newline) (display (prebuild (preorder t))) (newline) (display (postbuild (postorder t))) (newline)
Private
[
?
]
Run code
Submit