# Paste: Quicksort

Author: Rich factor Sun, 23 Aug 2009 23:58:13
Plain Text |
```! Copyright (C) 2009 Richard Osborn.
USING:  kernel combinators combinators.short-circuit generalizations
sequences arrays math ;
IN: qsort

: choose-pivot ( seq -- pivot ) 0 swap nth ;

: partition ( pivot seq -- <lowslice> <highslice> )
dup length 1 - 0 0 rot
[ 2dup <= ] [
{
{ [ over 5 npick nth 6 npick < ] [
2over 6 npick exchange
[ [ 1 + ] bi@ ] dip ] }
{ [ over 5 npick nth 6 npick > ] [
2dup 6 npick exchange
1 - ] }
[ [ 1 + ] dip ]
} cond
] while
drop
[ drop 0 spin <slice> ]
[ nip over length rot <slice> ] 3bi rot drop
;

: insertion-sort ( seq -- )
1                                               ! seq i
over length 1 -                                 ! seq i len-
[                                               ! seq i
2dup swap nth 2over                         ! seq i key seq j
[   3dup
{   [ 2nip 0 > ]                        ! j > 0 ?
[ 1 - swap nth < ]                  ! key < seq[j-1] ?
} 3&& ]
[
dup 1 - pick nth 2over swap set-nth     ! seq[j-1] =
1 -                                     ! j-1
] while
swap set-nth                                ! seq[j] = key
1 +                                         ! seq i+
] times                                         ! seq i
2drop                                           !
;

: qsort ( seq -- )
dup length 8 < [
insertion-sort
] [
dup choose-pivot swap partition
[ qsort ] bi@
] if
; recursive

```

## Annotation: New qsort

Author: Rich factor Mon, 24 Aug 2009 00:14:32
Plain Text |
```! Copyright (C) 2009 Richard Osborn.
USING:  kernel combinators combinators.short-circuit generalizations
sequences arrays math fry ;
IN: qsort

: choose-pivot ( seq -- pivot ) 0 swap nth ;

: insertion-sort ( seq -- )
1                                               ! seq i
over length 1 -                                 ! seq i len-
[                                               ! seq i
2dup swap nth 2over                         ! seq i key seq j
[   3dup
{   [ 2nip 0 > ]                        ! j > 0 ?
[ 1 - swap nth < ]                  ! key < seq[j-1] ?
} 3&& ]
[
dup 1 - pick nth 2over swap set-nth     ! seq[j-1] =
1 -                                     ! j-1
] while
swap set-nth                                ! seq[j] = key
1 +                                         ! seq i+
] times                                         ! seq i
2drop                                           !
;

: qsort ( seq -- )
dup length 8 < [
insertion-sort
] [
dup choose-pivot '[ _ < ] partition
[ qsort ] bi@
] if
; recursive```