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 16:28:01 +09:00
parent 2f6e007702
commit f18a6ab379
1 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -26,8 +26,9 @@
;;; (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.
;;FIXME ;; FIXME
;; use lets for vectorrefs etc. ;; use lets for vectorrefs etc.
;; copy vector nodes into n-ary vectors (from median splitted vecs)
(define (make-b-tree-node l r) (define (make-b-tree-node l r)
(let ((numitems 0) (let ((numitems 0)
@ -109,25 +110,28 @@
)))) ))))
(define (search-rec str tree) ;; root param in b-treenode ;; FIXME right vecs (define (search-rec str tree side-string) ;; root param in b-treenode
(let ((len (vector-length ((tree 'get-left)))) (let* ((side-tree ((tree side-string)))
(len (vector-length lefttree)))
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
((cond ((>= i len 1);;last node ((let* ((side-tree-el-first ((vector-ref side-tree i))))
(do ((j 0 (+ j 1))) (cond ((>= i len 1);;last node
((= j len) 0) (do ((j 0 (+ j 1)))
(search-rec str (vector-ref j ((tree 'get-left)))))) ((= j len) 0)
((and (string<? str (search-rec str (vector-ref j side-tree))))
(((vector-ref ((tree 'get-left)) i)'get-data))) ((let ((side-tree-el-second ((vector-ref side-tree (+ i 1)))))
(string>? str (and (string<? str
(((vector-ref ((tree 'get-left)) (+ i 1))'get-data)))) ((side-tree-el-first 'get-data)))
(display "node not found in tree.") 0) (string>? str
((string=? str (((vector-ref ((tree 'get-left)) i)'get-data))) ((side-tree-el-second 'get-data))))
(display "string found in tree.") str) (display "node not found in tree.") 0))
(else (display "never reached.")))) ((string=? str ((side-tree-el-first 'get-data)))
)))) (display "string found in tree.") str)
(else (display "never reached."))))))))
(define (search str) (define (search str)
(search-rec str *tree)) (search-rec str *tree 'get-left)
(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,7 +154,7 @@
(dump-rec *tree)) (dump-rec *tree))
(define (add-rec str tree) ;; root param in b-treenode ;; refactor call-with-values (define (add-rec str tree) ;; root param in b-treenode ;; refactor call-with-values
(let ((lefttree (tree 'get-left));;FIXME (let ((lefttree (tree 'get-left));;FIXME ()
(righttree (tree 'get-right))) (righttree (tree 'get-right)))
;;len (vector-length ((tree 'get-left))))) ;;len (vector-length ((tree 'get-left)))))
(call-with-values (call-with-values