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

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

@ -26,12 +26,18 @@
;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(define (make-b-tree-node left right) (define (make-b-tree-node l r)
(let ((numitems 0) (let ((numitems 0)
(numnodes 0) (numnodes 0)
(root 'foo) (root 'foo)
(left left) (left l)
(right right)) (right r))
(define (get-left)
left)
(define (get-right)
right)
(define (get-root) (define (get-root)
root) root)
@ -57,8 +63,8 @@
(else (display "b-tree-node : message not understood"))))) (else (display "b-tree-node : message not understood")))))
dispatch)) dispatch))
(define (make-b-tree n-ary) (define (make-b-tree n-ary);;NOTE FIXME n-ary and vector-length
(let ((*tree (make-vector n-ary))) (let ((*tree (make-vector n-ary (make-b-tree-node (make-vector n-ary) (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))))
@ -89,8 +95,6 @@
(vector-set! tree i new-node) (vector-set! tree i new-node)
;;(grow-down (vector-ref tree i) ;;(grow-down (vector-ref tree i)
))) )))
((string>=? str (vector-ref tree i))
(grow-down))
((string=? str (vector-ref tree i)) ((string=? str (vector-ref tree i))
(set! i (vector-length tree))) (set! i (vector-length tree)))
(else (display "never reached.")))) (else (display "never reached."))))