2011/07/31

Gaucheでbubble sort

その他のソート

ソース

準備
(use math.mt-random)
(use srfi-1)

(define data
  '(1 0 9 2 8 4 3 6 7 8 9 5 0 1 2 3))

(define rand
  (let1 m (make <mersenne-twister> :seed (sys-time))
    (^n (mt-random-integer m n))))

(define (make-rand-list n)
  (list-tabulate n (^_ (rand n))))

汚いけど末尾再帰で
(define (bubble-sort ls)
  (define (pass1 ls)
    (let rec ((ls ls)(acc '()))
      (cond ((null? (cdr ls))(reverse (cons (car ls) acc)))
            ((< (cadr ls)(car ls))
             (rec (cons (car ls)(cddr ls))(cons (cadr ls) acc)))
            (else (rec (cdr ls)(cons (car ls) acc))))))
  (let rec ((ls ls)(i (- (length ls) 1)))
    (if (or (null? ls)(zero? i))
        ls
        (rec (pass1 ls) (- i 1)))))

(bubble-sort data)
;; -> (0 0 1 1 2 2 3 3 4 5 6 7 8 8 9 9)

(time (bubble-sort (make-rand-list 1000)))
;(time (bubble-sort (make-rand-list 1000)))
; real   0.698
; user   0.687
; sys    0.015


(time (bubble-sort (make-rand-list 10000))
      (undefined))
;(time (bubble-sort (make-rand-list 10000)) (undefined))
; real  68.651
; user  68.250
; sys    0.203

vector + 副作用で
(define (bubble-sort! v)
  (let ((len (vector-length v)))
    (dotimes (_ len)
      (dotimes (i len)
        (when (< (+ i 1) len)
          (let ((cur (vector-ref v i))
                (next (vector-ref v (+ i 1))))
            (when (< next cur)
              (vector-set! v (+ i 1) cur)
              (vector-set! v i next)))))))
  v)

(let ((v (list->vector data)))
  (bubble-sort! v))
;; -> #(0 0 1 1 2 2 3 3 4 5 6 7 8 8 9 9)

(time
 (let ((v (list->vector (make-rand-list 1000))))
   (vector->list (bubble-sort! v))))
;(time (let ((v (list->vector (make-rand-list 1000)))) (bubble-sort! v)))
; real   0.698
; user   0.703
; sys    0.000


(time
 (let ((v (list->vector (make-rand-list 10000))))
   (vector->list (bubble-sort! v))
   (undefined)))
;(time (let ((v (list->vector (make-rand-list 10000)))) (vector->list (b ...
; real  67.471
; user  66.531
; sys    0.016

vector + 副作用版が速いだろうと思ったけど、末尾再帰版とほとんど変わらなかった。

参考

記号と再帰―記号論の形式・プログラムの必然

0 件のコメント:

コメントを投稿