basis/binary-search/binary-search.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays combinators hints kernel locals math
   4 math.order sequences sequences.private ;
   5 IN: binary-search
   6
   7 <PRIVATE
   8
   9 :: (search) ( seq from to quot: ( elt -- <=> ) -- i elt )
  10     from to + 2/ :> midpoint@
  11     midpoint@ seq nth-unsafe :> midpoint
  12
  13     to from - 1 <= [
  14         midpoint@ midpoint
  15     ] [
  16         midpoint quot call {
  17             { +eq+ [ midpoint@ midpoint ] }
  18             { +lt+ [ seq from midpoint@ quot (search) ] }
  19             { +gt+ [ seq midpoint@ to quot (search) ] }
  20         } case
  21     ] if ; inline recursive
  22
  23 PRIVATE>
  24
  25 : search ( seq quot: ( elt -- <=> ) -- i elt )
  26     over empty? [ 2drop f f ] [ [ 0 over length ] dip (search) ] if ;
  27     inline
  28
  29 : natural-search ( obj seq -- i elt )
  30     [ <=> ] with search ;
  31
  32 HINTS: natural-search array ;
  33
  34 : sorted-index ( obj seq -- i )
  35     natural-search drop ;
  36
  37 : sorted-member? ( obj seq -- ? )
  38     dupd natural-search nip = ;
  39
  40 : sorted-member-eq? ( obj seq -- ? )
  41     dupd natural-search nip eq? ;