basis/binary-search/binary-search.factor

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