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 12:43:00 +09:00
parent 62b26ba20b
commit 7c689a82e7
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -55,10 +55,10 @@
((eq? msg 'get-right) ((eq? msg 'get-right)
get-right) get-right)
(else (display "b-tree-node : message not understood"))))) (else (display "b-tree-node : message not understood")))))
dispatch)) dispatch))
(define (make-b-tree) (define (make-b-tree n-ary)
(let ((*tree (make-vector 0))) (let ((*tree (make-vector n-ary)))
(define (vector-median v) (define (vector-median v)
(let ((len (ceiling (/ (vector-length v) 2)))) (let ((len (ceiling (/ (vector-length v) 2))))
@ -75,7 +75,7 @@
(else #f))) (else #f)))
(define (grow-up upper-node) (define (grow-up upper-node)
) #t)
(define (add-rec str tree upper-node) (define (add-rec str tree upper-node)
(let ((len (vector-length tree))) (let ((len (vector-length tree)))
@ -84,11 +84,11 @@
(grow-up upper-node)) (grow-up upper-node))
((and (string<? str (vector-ref tree i)) ((and (string<? str (vector-ref tree i))
(string>? str (vector-ref tree (+ i 1)))) (string>? str (vector-ref tree (+ i 1))))
(let ((new-node (make-b-tree-node l r)) (let ((lr (vector-median tree)))
(lr (vector-median tree))) (let ((new-node (make-b-tree-node (car lr) (cadr lr))))
(vector-set! tree i new-node (car lr)(cadr lr))) (vector-set! tree i new-node)
;;(grow-down (vector-ref tree i) ;;(grow-down (vector-ref tree i)
) )))
((string>=? str (vector-ref tree i)) ((string>=? str (vector-ref tree i))
(grow-down)) (grow-down))
((string=? str (vector-ref tree i)) ((string=? str (vector-ref tree i))