sorting.quick: a bit faster for standard data types.
parent
43aa46384c
commit
7711c2720f
|
@ -1,25 +1,25 @@
|
||||||
! Copyright (C) 2014 John Benediktsson
|
! Copyright (C) 2014 John Benediktsson
|
||||||
! See http://factorcode.org/license.txt for BSD license
|
! See http://factorcode.org/license.txt for BSD license
|
||||||
|
|
||||||
USING: combinators kernel locals math math.order sequences
|
USING: arrays combinators kernel locals math math.order
|
||||||
sequences.private ;
|
sequences sequences.private strings vectors ;
|
||||||
|
|
||||||
IN: sorting.quick
|
IN: sorting.quick
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
:: quicksort ( seq from to quot -- )
|
:: quicksort ( seq from to quot: ( obj1 obj2 -- <=> ) -- )
|
||||||
from to < [
|
from to < [
|
||||||
from to + 2/ seq nth-unsafe :> pivot
|
from to + 2/ seq nth-unsafe :> pivot
|
||||||
|
|
||||||
from to [ 2dup <= ] [
|
from to [ 2dup <= ] [
|
||||||
[
|
[
|
||||||
over seq nth-unsafe pivot quot call( x x -- x )
|
over seq nth-unsafe pivot quot call
|
||||||
+lt+ eq?
|
+lt+ eq?
|
||||||
] [ [ 1 + ] dip ] while
|
] [ [ 1 + ] dip ] while
|
||||||
|
|
||||||
[
|
[
|
||||||
dup seq nth-unsafe pivot quot call( x x -- x )
|
dup seq nth-unsafe pivot quot call
|
||||||
+gt+ eq?
|
+gt+ eq?
|
||||||
] [ 1 - ] while
|
] [ 1 - ] while
|
||||||
|
|
||||||
|
@ -44,5 +44,9 @@ PRIVATE>
|
||||||
: inv-sort-with! ( seq quot: ( elt -- key ) -- )
|
: inv-sort-with! ( seq quot: ( elt -- key ) -- )
|
||||||
[ compare invert-comparison ] curry sort! ; inline
|
[ compare invert-comparison ] curry sort! ; inline
|
||||||
|
|
||||||
: natural-sort! ( seq -- )
|
GENERIC: natural-sort! ( seq -- )
|
||||||
[ <=> ] sort! ;
|
|
||||||
|
M: object natural-sort! [ <=> ] sort! ;
|
||||||
|
M: array natural-sort! [ <=> ] sort! ;
|
||||||
|
M: vector natural-sort! [ <=> ] sort! ;
|
||||||
|
M: string natural-sort! [ <=> ] sort! ;
|
||||||
|
|
Loading…
Reference in New Issue