extra/sorting/bubble/bubble.factor

   1 ! Copyright (C) 2014 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: kernel math math.order ranges sequences
   5 sequences.private ;
   6
   7 IN: sorting.bubble
   8
   9 <PRIVATE
  10
  11 :: (bubble-sort!) ( seq quot: ( obj1 obj2 -- <=> ) -- )
  12     seq length 1 - [
  13         f over [0..b) [| i |
  14             i i 1 + [ seq nth-unsafe ] bi@ 2dup quot call +gt+ =
  15             [ i 1 + i [ seq set-nth-unsafe ] bi-curry@ bi* 2drop i t ]
  16             [ 2drop ] if
  17         ] each
  18     ] loop drop ; inline
  19
  20 PRIVATE>
  21
  22 : bubble-sort! ( seq quot: ( obj1 obj2 -- <=> ) -- )
  23     over length 2 < [ 2drop ] [ (bubble-sort!) ] if ; inline
  24
  25 : natural-bubble-sort! ( seq -- )
  26     [ <=> ] bubble-sort! ;