binary search

diff --git a/library/collections/sequence-sort.factor b/library/collections/sequence-sort.factor
index a5829f6b89fa92c312b51293a4c273e7836f1ba8..349cdd386e0534f84f678bcf237d5c5e8099658c 100644 (file)
--- a/library/collections/sequence-sort.factor
+++ b/library/collections/sequence-sort.factor
@@ -1,8 +1,6 @@
 IN: sorting-internals
 USING: kernel math sequences ;
 
-: midpoint ( seq -- elt ) dup length 2 /i swap nth ; inline
-
 TUPLE: sorter seq start end mid ;
 
 C: sorter ( seq start end -- sorter )
@@ -49,6 +47,28 @@ DEFER: (nsort)
         2drop
     ] ifte 2drop ; inline
 
+: partition ( seq -1/1 -- seq )
+    >r dup midpoint@ swap r> 1 <
+    [ head-slice ] [ tail-slice ] ifte ; inline
+
+: (binsearch) ( elt quot seq -- i )
+    dup length 1 <= [
+        2nip slice-from
+    ] [
+        3dup midpoint swap call dup 0 = [
+            drop 2nip dup slice-from swap slice-to + 2 /i
+        ] [
+            partition (binsearch)
+        ] ifte
+    ] ifte ; inline
+
+: binsearch-slice ( seq -- slice )
+    #! Binsearch returns an index relative to the sequence
+    #! being sliced, so if we are given a slice as input,
+    #! unexpected behavior will result.
+    dup slice? [ >vector ] when 0 over length rot <slice> ;
+    inline
+
 IN: sequences
 
 : nsort ( seq quot -- | quot: elt elt -- -1/0/1 )
@@ -57,3 +77,11 @@ IN: sequences
 
 : sort ( seq quot -- seq | quot: elt elt -- -1/0/1 )
     swap [ swap nsort ] immutable ; inline
+
+: binsearch ( elt seq quot -- i | quot: elt elt -- -1/0/1 )
+    swap dup empty?
+    [ 3drop -1 ] [ binsearch-slice (binsearch) ] ifte ;
+    inline
+    
+: binsearch-range ( from to seq quot -- from to )
+    [ binsearch ] 2keep rot >r binsearch r> ;

diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor
index 9c6fda8ab886d74b75bca84dfead4dd1466254db..487cc2f44e13a5950aa8ef1b4a7aa6d15d334331 100644 (file)
--- a/library/collections/sequences-epilogue.factor
+++ b/library/collections/sequences-epilogue.factor
@@ -225,6 +225,10 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
     [ tuck nth >r nth r> ] 3keep tuck
     >r >r set-nth r> r> set-nth ;
 
+: midpoint@ length 2 /i ; inline
+
+: midpoint [ midpoint@ ] keep nth ; inline
+
 IN: kernel
 
 : depth ( -- n )

diff --git a/library/test/sequences.factor b/library/test/sequences.factor
index b37ecfb3a3ca7802d8dc1a4665faf8fdba91c3b9..49c08c5c7318e25e4c5e8499f7d03794d8c70c4b 100644 (file)
--- a/library/test/sequences.factor
+++ b/library/test/sequences.factor
@@ -161,3 +161,11 @@ unit-test
         1000 [ drop 0 1000 random-int ] map [ - ] sort [ - ] sorted?
     ] all?
 ] unit-test
+
+[ -1 ] [ 3 { } [ - ] binsearch ] unit-test
+[ 0 ] [ 3 { 3 } [ - ] binsearch ] unit-test
+[ 1 ] [ 2 { 1 2 3 } [ - ] binsearch ] unit-test
+[ 3 ] [ 4 { 1 2 3 4 5 6 } [ - ] binsearch ] unit-test
+[ 1 ] [ 3.5 { 1 2 3 4 5 6 7 8 } [ - ] binsearch ] unit-test
+[ 3 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ - ] binsearch ] unit-test
+[ 10 ] [ 10 20 >vector [ - ] binsearch ] unit-test

diff --git a/library/unix/syscalls.factor b/library/unix/syscalls.factor
index a423357fec8e91cf1a7e25edbfe79528f6ff2ff0..4b7f75141d1d4ca8a15b01242d3c06330113509f 100644 (file)
--- a/library/unix/syscalls.factor
+++ b/library/unix/syscalls.factor
@@ -9,7 +9,7 @@ LIBRARY: factor
 FUNCTION: int err_no ( ) ;
 
 LIBRARY: libc
-FUNCTION: char* strerror ( int ) ;
+FUNCTION: char* strerror ( int errno ) ;
 FUNCTION: int open ( char* path, int flags, int prot ) ;
 FUNCTION: void close ( int fd ) ;
 FUNCTION: int fcntl ( int fd, int cmd, int arg ) ;