suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Further optimizations to `merge'.

Browse Source 
svn: r17003
This commit is contained in:
Eli Barzilay 2009-11-23 18:48:06 +00:00
parent ebfdbe4bb0
commit c68eeb97ca
1 changed files with 19 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/scheme/private/sort.ss
View File

@ -33,7 +33,7 @@ doing these checks.
(define-syntax foo (syntax-rules () [(_ . pattern) template]))])) (define-syntax foo (syntax-rules () [(_ . pattern) template]))]))
(define-syntax-rule (sort-internal-body v *<? n has-getkey? getkey) (define-syntax-rule (sort-internal-body v *<? n has-getkey? getkey)
(begin (let ([n/2 (ceiling (/ n 2))])
(define-syntax-rule (<? x y) (define-syntax-rule (<? x y)
(if has-getkey? (*<? (getkey x) (getkey y)) (*<? x y))) (if has-getkey? (*<? (getkey x) (getkey y)) (*<? x y)))
(define-syntax-rule (ref n) (vector-ref v n)) (define-syntax-rule (ref n) (vector-ref v n))
@ -42,16 +42,22 @@ doing these checks.
(define-syntax-rule (merge lo? A1 A2 B1 B2 C1 C2) (define-syntax-rule (merge lo? A1 A2 B1 B2 C1 C2)
(let ([b2 B2]) (let ([b2 B2])
(let loop ([a1 A1] [b1 B1] [c1 C1]) (let loop ([a1 A1] [b1 B1] [c1 C1])
(if (<= b2 b1) (let ([x (ref a1)] [y (ref b1)])
(let loop ([a1 a1] [c1 c1]) (if (if lo? (not (<? y x)) (<? x y))
(when (< c1 b1) (set! c1 (ref a1)) (loop (add1 a1) (add1 c1)))) (begin (set! c1 x)
(when (< c1 b1) (let ([a1 (add1 a1)] [c1 (add1 c1)])
(let ([x (ref a1)] [y (ref b1)]) (when (< c1 b1) (loop a1 b1 c1))))
(if (if lo? (not (<? y x)) (<? x y)) (begin (set! c1 y)
(begin (set! c1 x) (loop (add1 a1) b1 (add1 c1))) (let ([b1 (add1 b1)] [c1 (add1 c1)])
(begin (set! c1 y) (loop a1 (add1 b1) (add1 c1)))))))))) (if (<= b2 b1)
(let loop ([a1 a1] [c1 c1])
(when (< c1 b1)
(set! c1 (ref a1))
(loop (add1 a1) (add1 c1))))
(loop a1 b1 c1)))))))))
(define (copying-mergesort Alo Ahi Blo Bhi) (define (copying-mergesort Alo Ahi Blo Bhi)
(unless (= (- Ahi Alo) (- Bhi Blo)) (error "poof!!!"))
(cond [(< Alo (sub1 Ahi)) (cond [(< Alo (sub1 Ahi))
(let ([Amid (/ (+ Alo Ahi) 2)] [Bmid (/ (+ Blo Bhi) 2)]) (let ([Amid (/ (+ Alo Ahi) 2)] [Bmid (/ (+ Blo Bhi) 2)])
(copying-mergesort Amid Ahi Bmid Bhi) (copying-mergesort Amid Ahi Bmid Bhi)
@ -60,13 +66,10 @@ doing these checks.
[(= Alo (sub1 Ahi)) [(= Alo (sub1 Ahi))
(set! Blo (ref Alo))])) (set! Blo (ref Alo))]))
(define-syntax-rule (mergesort Alo Ahi B1lo B1hi) (let ([Alo 0] [Amid n/2] [Ahi n] [B1lo n] [B1hi (+ n n/2)])
(let ([Amid (/ (+ Alo Ahi) 2)]) (copying-mergesort Amid Ahi B1lo B1hi)
(copying-mergesort Amid Ahi B1lo B1hi) (copying-mergesort Alo Amid Amid Ahi)
(copying-mergesort Alo Amid Amid Ahi) (merge #f B1lo B1hi Amid Ahi Alo Ahi))))
(merge #f B1lo B1hi Amid Ahi Alo Ahi)))
(mergesort 0 n n (+ n (/ n 2)))))
(define sort-internals (make-hasheq)) (define sort-internals (make-hasheq))
(define _ (define _