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 15:36:48 +09:00
parent c0f2b15d89
commit f6ce2b3875
1 changed files with 16 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -40,6 +40,16 @@
(define (set-data! value) (define (set-data! value)
(set! data value)) (set! data value))
(define (set-left-with-index! i value)
(cond ((not left)
(display "not left"))
(else (vector-set! left i value))))
(define (set-right-with-index! i value)
(cond ((not right)
(display "not right"))
(else (vector-set! right i value))))
(define (get-left) (define (get-left)
(display "get-left") (display "get-left")
left) left)
@ -66,6 +76,10 @@
get-numnodes) get-numnodes)
((eq? msg 'get-left) ((eq? msg 'get-left)
get-left) get-left)
((eq? msg 'set-left-with-index!)
set-left-with-index!)
((eq? msg 'set-right-with-index!)
set-right-with-index!)
((eq? msg 'get-data) ((eq? msg 'get-data)
get-data) get-data)
((eq? msg 'set-data!) ((eq? msg 'set-data!)
@ -139,11 +153,11 @@
((cond ((or lefttree ((cond ((or lefttree
(not (((vector-ref lefttree i) 'get-data))) (not (((vector-ref lefttree i) 'get-data)))
(string=? (((vector-ref lefttree i) 'get-data)) "")) (string=? (((vector-ref lefttree i) 'get-data)) ""))
(display 'FOO1) (display "FOO1")
(let ((lr (vector-median ((lefttree 'get-left)))));;FIXME right also descend (let ((lr (vector-median ((lefttree '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)
(vector-set! lefttree i new-node) ((lefttree 'set-left-with-index!) i new-node)
))) )))
((and (string<? str (((vector-ref lefttree i) 'get-data))) ((and (string<? str (((vector-ref lefttree i) 'get-data)))
(string>? str (((vector-ref lefttree (+ i 1)) 'get-data)))) (string>? str (((vector-ref lefttree (+ i 1)) 'get-data))))