-USING: kernel tools.test ;
+USING: kernel sequences tools.test ;
IN: sorting.quick
-{ { } } [ { } dup quicksort ] unit-test
-{ { 1 } } [ { 1 } dup quicksort ] unit-test
-{ { 1 2 3 4 5 } } [ { 1 4 2 5 3 } dup quicksort ] unit-test
+{ { } } [ { } dup natural-sort! ] unit-test
+{ { 1 } } [ { 1 } dup natural-sort! ] unit-test
+{ { 1 2 3 4 5 } } [ { 1 4 2 5 3 } dup natural-sort! ] unit-test
+
+{
+ { "dino" "fred" "wilma" "betty" "barney" "pebbles" "bamm-bamm" }
+} [
+ { "fred" "wilma" "pebbles" "dino" "barney" "betty" "bamm-bamm" }
+ dup [ length ] sort-with!
+] unit-test
<PRIVATE
-:: (quicksort) ( seq from to -- )
+:: quicksort ( seq from to quot -- )
from to < [
from to + 2/ seq nth-unsafe :> pivot
from to [ 2dup <= ] [
- [ over seq nth-unsafe pivot before? ] [ [ 1 + ] dip ] while
- [ dup seq nth-unsafe pivot after? ] [ 1 - ] while
+ [
+ over seq nth-unsafe pivot quot call( x x -- x )
+ +lt+ eq?
+ ] [ [ 1 + ] dip ] while
+
+ [
+ dup seq nth-unsafe pivot quot call( x x -- x )
+ +gt+ eq?
+ ] [ 1 - ] while
+
2dup <= [
[ seq exchange-unsafe ]
[ [ 1 + ] [ 1 - ] bi* ] 2bi
] when
] while
- [ seq from ] dip (quicksort)
- [ seq ] dip to (quicksort)
-
+ [ seq from ] dip quot quicksort
+ [ seq ] dip to quot quicksort
] when ; inline recursive
PRIVATE>
-: quicksort ( seq -- )
- 0 over length 1 - (quicksort) ;
+: sort! ( seq quot: ( obj1 obj2 -- <=> ) -- )
+ [ 0 over length 1 - ] dip quicksort ;
+
+: sort-with! ( seq quot: ( elt -- key ) -- )
+ [ compare ] curry sort! ; inline
+
+: inv-sort-with! ( seq quot: ( elt -- key ) -- )
+ [ compare invert-comparison ] curry sort! ; inline
+
+: natural-sort! ( seq -- )
+ [ <=> ] sort! ;