mergsort


Our old friend mergesort.

 $ cat ms.scm 
 (include-from-path "utils.scm") 
 (include-from-path "srfi-78/srfi-78.scm") 
 (check-set-mode! 'summary) 
  
 (define (mergesort! v) 
  
   (define n (vector-length v)) 
  
   (define (merge! from i to step) 
     (let* 
       ((left-end (min (+ i step) n)) 
        (right-end (min (+ left-end step) n))) 
  
       (let loop ((left-start i) (right-start left-end) (to-start i)) 
  
         (let 
             ((left-nonempty (< left-start left-end)) 
              (right-nonempty  (< right-start right-end))) 
  
           (cond 
            ((and left-nonempty right-nonempty) 
             (let  
                 ((l (vector-ref from left-start)) 
                  (r (vector-ref from right-start)) 
                  (to-start' (+ to-start 1))) 
  
               (if (< l r) 
                   (begin 
                     (vector-set! to to-start l) 
                     (loop (+ left-start 1) right-start to-start')) 
                   (begin 
                     (vector-set! to to-start r) 
                     (loop left-start (+ right-start 1) to-start'))))) 
  
            (left-nonempty 
             (vector-move-left! from left-start left-end to to-start)) 
  
            (right-nonempty 
             (vector-move-left! from right-start right-end to to-start))))))) 
  
   (let loop ((step 1) (from v) (to (make-vector n)) (swap #f)) 
     (if (>= step n) 
       (begin 
         (when swap (vector-move-left! from 0 n v 0)) 
         v) 
       (begin  
         (do ((i 0 (+ i (* step 2)))) ((>= i n)) 
           (merge! from i to step)) 
         (loop (* step 2) to from (not swap)))))) 
  
  
 (define (check-it n) 
  
   (define sorted-v (make-identity-vector n)) 
  
   (call-with-permuted-vector (vector-copy sorted-v)  
     (lambda (v) 
       (check (mergesort! (vector-copy v)) => sorted-v)))) 
  
  
 (do ((i 0 (+ i 1))) ((>= i 10)) 
   (check-it i)) 
  
 (check-report) 
  
 $ guile ms.scm 
  
 ; *** checks *** : 409114 correct, 0 failed. 
  
 $