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

xanadu - xml-tree

This commit is contained in:
erana 2012-01-21 20:11:48 +09:00
parent 2e10d78084
commit bbf29a40f2
1 changed files with 24 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -115,7 +115,7 @@
(define (search str) (define (search str)
(search-rec str *tree 'get-left) (search-rec str *tree 'get-left)
(search-rec str *tree 'get-right))) (search-rec str *tree 'get-right))
(define (dump-rec tree) ;; root param in b-treenode (define (dump-rec tree) ;; root param in b-treenode
(if (not (tree 'get-left)) (if (not (tree 'get-left))
@ -150,30 +150,32 @@
(define (add-rec-side-tree str side-tree) (define (add-rec-side-tree str side-tree)
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
((cond ((or side-tree ((cond ((not side-tree)
(not (((vector-ref side-tree i) 'get-data))) (vector-set! side-tree i new-node))
(string=? (((vector-ref side-tree i) 'get-data)) "")) ((let ((data (((vector-ref side-tree i) 'get-data))))
(let ((lr (vector-median ((side-tree 'get-left)))));;FIXME right also descend (or data (and (string? data)(string=? data "")))
(let ((new-node (make-b-tree-node (car lr) (cadr lr))));;FIXME lenght mustbe n-ary (let* ((lr (vector-median side-tree));;FIXME right also descend
((new-node 'set-data!) str) ((new-node (make-b-tree-node (car lr) (cadr lr)))));;FIXME lenght mustbe n-ary
((side-tree 'set-left-with-index!) i new-node)
)))
((and (string<? str (((vector-ref side-tree i) 'get-data)))
(string>? str (((vector-ref side-tree (+ i 1)) 'get-data))))
(let ((lr (vector-median ((side-tree 'get-left)))))
(let ((new-node (make-b-tree-node (car lr) (cadr lr))))
((new-node 'set-data!) str) ((new-node 'set-data!) str)
;;((side-tree 'set-left-with-index!) i new-node)
(vector-set! side-tree i new-node) (vector-set! side-tree i new-node)
))) )))
;;((string=? str (((vector-ref side-tree i)'get-data))) ((let ((data (((vector-ref side-tree i) 'get-data))))
;; (set! i (vector-length tree))) (or ;;(and (string=?)
((>= i (- len 1));;last node ;; (string>? str data))
(do ((j 0 (+ j 1))) (and (string? data)
((= j len) (display "node not added.") 0) (string=? data ""))
(add-rec str (vector-ref side-tree i))) (and (string=? data)
) (string<? str data)
(string>? str data)))
(else (display "never reached.")))))) (let ((left-and-right (vector-median side-tree)))
(let ((new-node (make-b-tree-node (car left-and-right) (cadr left-and-right))))
((new-node 'set-data!) str)
(vector-set! side-tree i new-node)
))))
((= j len)
(display "node not added.") 0)
(else (display "b-tree add - never reached."))))))
(define (add str) (define (add str)
(add-rec str *tree) (add-rec str *tree)