codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; 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)
Private
[
?
]
Run code
Submit