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

Combined the two merge functions into one macro, and improved it a little.

Browse Source 
svn: r17002
This commit is contained in:
Eli Barzilay 2009-11-23 18:47:32 +00:00
parent a272c479a6
commit ebfdbe4bb0
1 changed files with 14 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -39,41 +39,32 @@ doing these checks.
(define-syntax-rule (ref n) (vector-ref v n))
(define-syntax-rule (set! n x) (vector-set! v n x))
(define (merge1 A1 A2 B1 B2 C1 C2)
(when (< C1 B1)
(if (< B1 B2)
(if (<? (ref B1) (ref A1))
(begin (set! C1 (ref B1))
(merge1 A1 A2 (add1 B1) B2 (add1 C1) C2))
(begin (set! C1 (ref A1))
(merge1 (add1 A1) A2 B1 B2 (add1 C1) C2)))
(begin (set! C1 (ref A1))
(merge1 (add1 A1) A2 B1 B2 (add1 C1) C2)))))
(define (merge2 A1 A2 B1 B2 C1 C2)
(when (< C1 B1)
(if (< B1 B2)
(if (<? (ref A1) (ref B1))
(begin (set! C1 (ref A1))
(merge2 (add1 A1) A2 B1 B2 (add1 C1) C2))
(begin (set! C1 (ref B1))
(merge2 A1 A2 (add1 B1) B2 (add1 C1) C2)))
(begin (set! C1 (ref A1))
(merge2 (add1 A1) A2 B1 B2 (add1 C1) C2)))))
(define-syntax-rule (merge lo? A1 A2 B1 B2 C1 C2)
(let ([b2 B2])
(let loop ([a1 A1] [b1 B1] [c1 C1])
(if (<= b2 b1)
(let loop ([a1 a1] [c1 c1])
(when (< c1 b1) (set! c1 (ref a1)) (loop (add1 a1) (add1 c1))))
(when (< c1 b1)
(let ([x (ref a1)] [y (ref b1)])
(if (if lo? (not (<? y x)) (<? x y))
(begin (set! c1 x) (loop (add1 a1) b1 (add1 c1)))
(begin (set! c1 y) (loop a1 (add1 b1) (add1 c1))))))))))
(define (copying-mergesort Alo Ahi Blo Bhi)
(cond [(< Alo (sub1 Ahi))
(let ([Amid (/ (+ Alo Ahi) 2)] [Bmid (/ (+ Blo Bhi) 2)])
(copying-mergesort Amid Ahi Bmid Bhi)
(copying-mergesort Alo Amid Amid Ahi)
(merge1 Amid Ahi Bmid Bhi Blo Bhi))]
(merge #t Amid Ahi Bmid Bhi Blo Bhi))]
[(= Alo (sub1 Ahi))
(set! Blo (ref Alo))]))
(define (mergesort Alo Ahi B1lo B1hi)
(define-syntax-rule (mergesort Alo Ahi B1lo B1hi)
(let ([Amid (/ (+ Alo Ahi) 2)])
(copying-mergesort Amid Ahi B1lo B1hi)
(copying-mergesort Alo Amid Amid Ahi)
(merge2 B1lo B1hi Amid Ahi Alo Ahi)))
(merge #f B1lo B1hi Amid Ahi Alo Ahi)))
(mergesort 0 n n (+ n (/ n 2)))))