From d0249be4d4488c9be1da0676720c7d31165bf575 Mon Sep 17 00:00:00 2001 From: erana Date: Sat, 21 Jan 2012 12:02:04 +0900 Subject: [PATCH] xanadu - -btree --- scsh/xanadu/b-tree.scm | 52 ++++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 25 deletions(-) diff --git a/scsh/xanadu/b-tree.scm b/scsh/xanadu/b-tree.scm index e73f925..0b191a6 100644 --- a/scsh/xanadu/b-tree.scm +++ b/scsh/xanadu/b-tree.scm @@ -26,41 +26,43 @@ ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -(define (vector-median v) - (let ((len (ceiling (/ (vector-length v) 2)))) - (let ((retl (make-vector len)) - (retr (make-vector len))) - (do ((i 0 (+ i 1))) - ((= i len) (list retl retr)) - (vector-set! retl i (vector-ref v i)) - (vector-set! retr (- len (- i 1)) (vector-ref v (- len (- i 1)))) - )))) - (define (make-b-tree) (let ((*tree (make-vector 0))) + (define (vector-median v) + (let ((len (ceiling (/ (vector-length v) 2)))) + (let ((retl (make-vector len)) + (retr (if (odd? len) (make-vector (- len 1)) (make-vector len)))) + (do ((i 0 (+ i 1))) + ((= i len) (list retl retr)) + (vector-set! retl i (vector-ref v i)) + (vector-set! retr (- len (- i 1)) (vector-ref v (- len (- i 1)))) + )))) + (define (goto-left-node str i tree) (cond ((= (vector-length tree) i) (display "null node") (vector-set! tree i str)) - (else #f))) + (else #f))) (define (grow-up upper-node) (cond ((eq? node *tree) - (set! *tree (vector-median *tree + ( (define (add-rec str tree upper-node) - (do ((i 0 (+ i 1))) - ((eq? i (vector-length tree)) - (grow-up upper-node) - (let ((vi (vector-ref tree i))) - (cond ((string<=? str vi) - 0) - ((string>=? str vi) - (grow-down)) - ((string=? str vi) - (set! i (vector-length tree))) - (else (display "never reached.")))) - )) - + (let ((len (vector-length tree))) + (do ((i 0 (+ i 1))) + ((cond ((>= i (- len 1));;last node + (grow-up upper-node)) + ((and (string<=? str (vector-ref tree i)) + (string>=? str (vector-ref tree (+ i 1)))) + (add-rec str (vector-ref tree i))) + ((string>=? str (vector-ref tree i)) + (grow-down)) + ((string=? str (vector-ref tree i)) + (set! i (vector-length tree))) + (else (display "never reached.")))) + ))) + + (define (add str) (add-rec *tree *tree))