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 13:38:01 +09:00
parent c85b80f333
commit e69708fefd
1 changed files with 14 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -30,9 +30,16 @@
(let ((numitems 0) (let ((numitems 0)
(numnodes 0) (numnodes 0)
(root 'foo) (root 'foo)
(data #f)
(left l) (left l)
(right r)) (right r))
(define (get-data)
data)
(define (set-data! value)
(set! data value))
(define (get-left) (define (get-left)
left) left)
@ -58,6 +65,10 @@
get-numnodes) get-numnodes)
((eq? msg 'get-left) ((eq? msg 'get-left)
get-left) get-left)
((eq? msg 'get-data)
get-data)
((eq? msg 'set-data!)
set-data!)
((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")))))
@ -103,10 +114,11 @@
((= j len) (display "node not added.") 0) ((= j len) (display "node not added.") 0)
(add-rec str (vector-ref j tree))) (add-rec str (vector-ref j tree)))
))) )))
((and (string<? str (vector-ref tree i)) ((and (string<? str (((vector-ref tree i) 'get-data)))
(string>? str (vector-ref tree (+ i 1)))) (string>? str (((vector-ref tree (+ i 1)) 'get-data))))
(let ((lr (vector-median tree))) (let ((lr (vector-median tree)))
(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)
(vector-set! tree i new-node) (vector-set! tree i new-node)
))) )))
((string=? str (vector-ref tree i)) ((string=? str (vector-ref tree i))