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:02:04 +09:00
parent bfe29465a8
commit d0249be4d4
1 changed files with 27 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -26,41 +26,43 @@
;;; (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 (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) (define (make-b-tree)
(let ((*tree (make-vector 0))) (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) (define (goto-left-node str i tree)
(cond ((= (vector-length tree) i) (display "null node") (vector-set! tree i str)) (cond ((= (vector-length tree) i) (display "null node") (vector-set! tree i str))
(else #f))) (else #f)))
(define (grow-up upper-node) (define (grow-up upper-node)
(cond ((eq? node *tree) (cond ((eq? node *tree)
(set! *tree (vector-median *tree (
(define (add-rec str tree upper-node) (define (add-rec str tree upper-node)
(do ((i 0 (+ i 1))) (let ((len (vector-length tree)))
((eq? i (vector-length tree)) (do ((i 0 (+ i 1)))
(grow-up upper-node) ((cond ((>= i (- len 1));;last node
(let ((vi (vector-ref tree i))) (grow-up upper-node))
(cond ((string<=? str vi) ((and (string<=? str (vector-ref tree i))
0) (string>=? str (vector-ref tree (+ i 1))))
((string>=? str vi) (add-rec str (vector-ref tree i)))
(grow-down)) ((string>=? str (vector-ref tree i))
((string=? str vi) (grow-down))
(set! i (vector-length tree))) ((string=? str (vector-ref tree i))
(else (display "never reached.")))) (set! i (vector-length tree)))
)) (else (display "never reached."))))
)))
(define (add str) (define (add str)
(add-rec *tree *tree)) (add-rec *tree *tree))