2010-04-17 01:58:12 -04:00
|
|
|
! Copyright (C) 2008, 2010 Slava Pestov.
|
2008-07-15 18:16:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2013-04-19 14:35:14 -04:00
|
|
|
USING: accessors arrays combinators kernel locals math
|
|
|
|
math.order sequences sequences.private vectors ;
|
2008-07-15 18:16:08 -04:00
|
|
|
IN: binary-search
|
|
|
|
|
|
|
|
<PRIVATE
|
|
|
|
|
2010-04-17 01:58:12 -04:00
|
|
|
:: (search) ( seq from to quot: ( elt -- <=> ) -- i elt )
|
|
|
|
from to + 2/ :> midpoint@
|
2010-04-18 15:24:17 -04:00
|
|
|
midpoint@ seq nth-unsafe :> midpoint
|
2008-07-15 18:16:08 -04:00
|
|
|
|
2010-04-17 01:58:12 -04:00
|
|
|
to from - 1 <= [
|
|
|
|
midpoint@ midpoint
|
2008-07-15 18:16:08 -04:00
|
|
|
] [
|
2010-04-17 01:58:12 -04:00
|
|
|
midpoint quot call {
|
|
|
|
{ +lt+ [ seq from midpoint@ quot (search) ] }
|
|
|
|
{ +gt+ [ seq midpoint@ to quot (search) ] }
|
2012-07-13 19:21:18 -04:00
|
|
|
{ +eq+ [ midpoint@ midpoint ] }
|
2008-07-15 18:16:08 -04:00
|
|
|
} case
|
2008-07-18 20:22:59 -04:00
|
|
|
] if ; inline recursive
|
2008-07-15 18:16:08 -04:00
|
|
|
|
|
|
|
PRIVATE>
|
|
|
|
|
2010-04-17 01:58:12 -04:00
|
|
|
: search ( seq quot: ( elt -- <=> ) -- i elt )
|
2015-08-10 13:55:27 -04:00
|
|
|
over empty? [ 2drop f f ] [ [ 0 over length ] dip (search) ] if ; inline
|
2008-07-15 18:16:08 -04:00
|
|
|
|
2013-04-19 14:35:14 -04:00
|
|
|
GENERIC: natural-search ( obj seq -- i elt )
|
|
|
|
M: object natural-search [ <=> ] with search ;
|
|
|
|
M: array natural-search [ <=> ] with search ;
|
|
|
|
M: vector natural-search [ <=> ] with search ;
|
2008-08-24 04:59:37 -04:00
|
|
|
|
2008-07-15 18:16:08 -04:00
|
|
|
: sorted-index ( obj seq -- i )
|
|
|
|
natural-search drop ;
|
|
|
|
|
|
|
|
: sorted-member? ( obj seq -- ? )
|
|
|
|
dupd natural-search nip = ;
|
|
|
|
|
2009-10-28 16:02:00 -04:00
|
|
|
: sorted-member-eq? ( obj seq -- ? )
|
2008-07-15 18:16:08 -04:00
|
|
|
dupd natural-search nip eq? ;
|