; marriage sort
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
(let loop ((x n))
(let ((y (quotient (+ x (quotient n x)) 2)))
(if (< y x) (loop y) x)))))
(define-syntax when
(syntax-rules ()
((when pred? expr ...)
(if pred? (begin expr ...)))))
(define-syntax while
(syntax-rules ()
((while pred? body ...)
(do () ((not pred?)) body ...))))
(define (isort! lt? vec) ; insertion sort
(define (v i) (vector-ref vec i))
(define (v! i x) (vector-set! vec i x))
(define (swap! i j) (let ((t (v i))) (v! i (v j)) (v! j t)))
(let ((n (vector-length vec)))
(do ((i 0 (+ i 1))) ((= i n))
(do ((j i (- j 1)))
((or (<= j 0) (< (v (- j 1)) (v j))))
(swap! (- j 1) j)))))
(define (msort! lt? vec) ; marriage sort
(define (v i) (vector-ref vec i))
(define (v! i x) (vector-set! vec i x))
(define (swap! i j) (let ((t (v i))) (v! i (v j)) (v! j t)))
(let* ((end (- (vector-length vec) 1))
(skip (if (positive? end) (isqrt end) -1)))
(while (<= 0 skip)
(let ((vbest 0) (i 1))
(while (< i skip)
(when (lt? (v vbest) (v i)) (set! vbest i))
(set! i (+ i 1)))
(while (< i end)
(if (lt? (v vbest) (v i))
(begin (swap! i end) (set! end (- end 1)))
(set! i (+ i 1))))
(swap! vbest end)
(set! end (- end 1))
(set! skip (if (positive? end) (isqrt end) -1)))))
(isort! lt? vec))
(define v (vector 5 7 8 10 3 2 9 4 6 1))
(msort! < v)
(display v)