フラッシュソート
http://www.neubert.net/FSOIntro.html
オーダーNのソーティングアルゴリズム。抽象的な理論ばっか勉強してたので、リハビリ代わりにSchemeで書いてみようと思ったけど、原理がよく分からない･･･。論文(?)読みづらいし。
まず、全体を大雑把な大きさ(=key value)でグループに分けてグループをソートして(partial-sort)、更に、そうやって、分けた各グループを再帰的にソートして(要素数が十分小さいときは、挿入ソートを使うのは定石通り)、最後にくっつけるという感じなのかな、多分。発想的には、基数ソート(だっけ?)に近いものがある。イントロで、"sorting algorithms based on the classification of elements"とか書いてるのは、このへんのことなんでしょう。きちんと理解しないまま、とりあえず、無理やり書いてみる
(eval (cons 'min L) (interaction-environment))とかやってるのは、(apply min L)だと、大きいリストを与えると、Gaucheに、要素数が大きすぎるって怒られるので。あと、roundもfloorもtruncateも返すのは、整数値じゃなく、あくまで実数値なので、vector-refの引数に使えなくて困ったり、vector-set!とか使ってるし、ださいとか。一応、これで正しく動く模様
(define (fsort L)
(letrec
((partial-sort
(lambda (L m)
(let ((vmin (eval (cons 'min L) (interaction-environment)))
(vmax (eval (cons 'max L) (interaction-environment))))
(if (= vmax vmin) #f
(let loop ((rest L) (v (make-vector m '())) (c (/ (- m 1) (- vmax vmin))))
(if (null? rest) v
(let ((k (x->integer (* c (- (car rest) vmin)))))
(begin
(vector-set! v k (cons (car rest) (vector-ref v k)))
(loop (cdr rest) v c))))))))))
(cond
( (< (length L) 50) (sort L) )
( (partial-sort L 50) => (lambda (x) (apply append (map fsort (vector->list x)))) )
( else L ))))
一応ベンチマークを取ってみた
list?とかやってるのは、ソート結果がずらずら表示されるのを抑止するためで、もっとましなやり方はいくらでもあるでしょう。結果。
(use math.mt-random)
(use gauche.time)(define (qsort L) ;比較用のクイックソート
(letrec
((separate
(lambda (v L L1 L2)
(cond
( (null? L) (append (qsort L1) (cons v (qsort L2))) )
( (< v (car L)) (separate v (cdr L) L1 (cons (car L) L2)) )
( else (separate v (cdr L) (cons (car L) L1) L2) )))))
(if (< (length L) 50) (sort L) (separate (car L) (cdr L) '() '()))))(define (gen-random-list len range)
(let ((m (make:seed (sys-time))))
(let loop ( (ret '()) (i len) )
(if (= i 0) ret
(loop (cons (mt-random-integer m range) ret) (- i 1))))))(define test-list (gen-random-list 10000 1000))
(time (list? (fsort test-list)))
(time (list? (qsort test-list)))
(time (list? (sort test-list)))
組み込みのsort>>(超えられない壁)>>qsort>fsort
;(time (list? (fsort test-list)))
; real 0.094
; user 0.094
; sys 0.000
#t
;(time (list? (qsort test-list)))
; real 0.063
; user 0.063
; sys 0.000
#t
;(time (list? (sort test-list)))
; real 0.000
; user 0.000
; sys 0.000
#t
という結果に。あと、でかいリストをfsortに与えると、何故かGaucheが落ちる。
みたいなエラーメッセージが。とりあえず、vm.cの該当部分見ても、パッと見ではよく分かんないので、まあいいや
"vm.c", line 716: Assertion failed: SCM_IDENTIFIERP(val0)
VM 0x101dce58 -----------------------------------------------------------
pc: Segmentation fault (core dumped)
