extra/sorting/quick/quick.factor

   1 ! Copyright (C) 2014 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: combinators kernel locals math math.order sequences
   5 sequences.private ;
   6
   7 IN: sorting.quick
   8
   9 <PRIVATE
  10
  11 :: quicksort ( seq from to quot -- )
  12     from to < [
  13         from to + 2/ seq nth-unsafe :> pivot
  14
  15         from to [ 2dup <= ] [
  16             [
  17                 over seq nth-unsafe pivot quot call( x x -- x )
  18                 +lt+ eq?
  19             ] [ [ 1 + ] dip ] while
  20
  21             [
  22                 dup seq nth-unsafe pivot quot call( x x -- x )
  23                 +gt+ eq?
  24             ] [ 1 - ] while
  25
  26             2dup <= [
  27                 [ seq exchange-unsafe ]
  28                 [ [ 1 + ] [ 1 - ] bi* ] 2bi
  29             ] when
  30         ] while
  31
  32         [ seq from ] dip quot quicksort
  33         [ seq ] dip to quot quicksort
  34     ] when ; inline recursive
  35
  36 PRIVATE>
  37
  38 : sort! ( seq quot: ( obj1 obj2 -- <=> ) -- )
  39     [ 0 over length 1 - ] dip quicksort ; inline
  40
  41 : sort-with! ( seq quot: ( elt -- key ) -- )
  42     [ compare ] curry sort! ; inline
  43
  44 : inv-sort-with! ( seq quot: ( elt -- key ) -- )
  45     [ compare invert-comparison ] curry sort! ; inline
  46
  47 : natural-sort! ( seq -- )
  48     [ <=> ] sort! ;