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: arrays combinators kernel math math.order sequences
   4 sequences.private vectors ;
   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             { +lt+ [ seq from midpoint@ quot (search) ] }
  18             { +gt+ [ seq midpoint@ to quot (search) ] }
  19             { +eq+ [ midpoint@ midpoint ] }
  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 ; inline
  27
  28 GENERIC: natural-search ( obj seq -- i elt )
  29 M: object natural-search [ <=> ] with search ;
  30 M: array natural-search [ <=> ] with search ;
  31 M: vector natural-search [ <=> ] with search ;
  32
  33 : sorted-index ( obj seq -- i )
  34     natural-search drop ;
  35
  36 : sorted-member? ( obj seq -- ? )
  37     dupd natural-search nip = ;
  38
  39 : sorted-member-eq? ( obj seq -- ? )
  40     dupd natural-search nip eq? ;