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

xanadu - xml b-tree - 3

This commit is contained in:
erana 2012-01-21 00:52:58 +09:00
parent 0e25720779
commit ec6815345e
1 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,11 +27,14 @@
;;; 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) (define (vector-median v)
(let ((retv (make-vector (inexact->exact (/ (vector-length v) 2))))) (let ((len (ceiling (/ (vector-length v) 2))))
(do ((i 0 (+ i 1))) (let ((retl (make-vector len))
((= i (/ (vector-length v) 2)) retv) (retr (make-vector len)))
(vector-set! retv i (vector-ref v i)) (do ((i 0 (+ i 1)))
))) ((= i len) (list retl retr))
(vector-set! retl i (vector-ref v i))
(vector-set! retr i (vector-ref v (- len (+ i 1))))
)))
(define (make-b-tree) (define (make-b-tree)
(let ((*tree (make-vector 0))) (let ((*tree (make-vector 0)))