scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

xanadu - btree

This commit is contained in:
erana 2012-01-21 16:30:33 +09:00
parent f18a6ab379
commit af119e61eb
1 changed files with 29 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
scsh/xanadu/b-tree.scm
View File

@ -160,32 +160,36 @@
(call-with-values (call-with-values
(lambda () (values lefttree righttree)) (lambda () (values lefttree righttree))
(lambda (lefttree righttree) (lambda (lefttree righttree)
(add-rec-side-tree str lefttree)
(add-rec-side-tree str righttree)
))))
(define (add-rec-side-tree str side-tree)
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
((cond ((or lefttree ((cond ((or side-tree
(not (((vector-ref lefttree i) 'get-data))) (not (((vector-ref side-tree i) 'get-data)))
(string=? (((vector-ref lefttree i) 'get-data)) "")) (string=? (((vector-ref side-tree i) 'get-data)) ""))
(let ((lr (vector-median ((lefttree 'get-left)))));;FIXME right also descend (let ((lr (vector-median ((side-tree 'get-left)))));;FIXME right also descend
(let ((new-node (make-b-tree-node (car lr) (cadr lr))));;FIXME lenght mustbe n-ary (let ((new-node (make-b-tree-node (car lr) (cadr lr))));;FIXME lenght mustbe n-ary
((new-node 'set-data!) str) ((new-node 'set-data!) str)
((lefttree 'set-left-with-index!) i new-node) ((side-tree 'set-left-with-index!) i new-node)
))) )))
((and (string<? str (((vector-ref lefttree i) 'get-data))) ((and (string<? str (((vector-ref side-tree i) 'get-data)))
(string>? str (((vector-ref lefttree (+ i 1)) 'get-data)))) (string>? str (((vector-ref side-tree (+ i 1)) 'get-data))))
(let ((lr (vector-median ((lefttree 'get-left))))) (let ((lr (vector-median ((side-tree 'get-left)))))
(let ((new-node (make-b-tree-node (car lr) (cadr lr)))) (let ((new-node (make-b-tree-node (car lr) (cadr lr))))
((new-node 'set-data!) str) ((new-node 'set-data!) str)
(vector-set! lefttree i new-node) (vector-set! side-tree i new-node)
))) )))
;;((string=? str (((vector-ref lefttree i)'get-data))) ;;((string=? str (((vector-ref side-tree i)'get-data)))
;; (set! i (vector-length tree))) ;; (set! i (vector-length tree)))
((>= i (- len 1));;last node ((>= i (- len 1));;last node
(do ((j 0 (+ j 1))) (do ((j 0 (+ j 1)))
((= j len) (display "node not added.") 0) ((= j len) (display "node not added.") 0)
(add-rec str (vector-ref lefttree i))) (add-rec str (vector-ref side-tree i)))
) )
(else (display "never reached."))))) (else (display "never reached."))))))
))))
(define (add str) (define (add str)
(add-rec str *tree) (add-rec str *tree)