splitting.monotonic: Don't throw away the last result. Fixes #462.

diff --git a/basis/splitting/monotonic/monotonic-tests.factor b/basis/splitting/monotonic/monotonic-tests.factor
index 2b44f423942ea10babd8c711d273434b0cc7e692..5e1e1ce25e4cbd5447cc2e02d0fc65178309ddc9 100644 (file)
--- a/basis/splitting/monotonic/monotonic-tests.factor
+++ b/basis/splitting/monotonic/monotonic-tests.factor
@@ -53,3 +53,19 @@ USING: tools.test math arrays kernel sequences ;
         }
     }
 ] [ { 1 2 3 3 2 1 } trends ] unit-test
+
+
+[ { { 2 2 } { 3 3 3 3 } { 4 } { 5 } } ]
+[
+    { 2 2 3 3 3 3 4 5 }        
+    [ [ odd? ] bi@ = ] slice monotonic-slice
+    [ >array ] map
+] unit-test
+
+[
+    { { 1 1 1 } { 2 2 2 2 } { 3 3 } }
+] [
+    { 1 1 1 2 2 2 2 3 3 }
+    [ [ odd? ] bi@ = ] slice monotonic-slice
+    [ >array ] map
+] unit-test

diff --git a/basis/splitting/monotonic/monotonic.factor b/basis/splitting/monotonic/monotonic.factor
index e3f08659b7027971e7c9db9f664a9995d247d476..52d5586227f3878bfa8dd16145f2c7097364daf7 100644 (file)
--- a/basis/splitting/monotonic/monotonic.factor
+++ b/basis/splitting/monotonic/monotonic.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2008, 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: make namespaces sequences kernel fry arrays compiler.utilities
-math accessors circular grouping combinators sorting math.order ;
+USING: accessors arrays circular combinators
+combinators.short-circuit compiler.utilities fry grouping
+kernel make math math.order namespaces sequences sorting ;
 IN: splitting.monotonic
 
 <PRIVATE
@@ -27,12 +28,16 @@ PRIVATE>
     [
         dupd '[
             [ length iota ] [ ] [ <circular> 1 over change-circular-start ] tri
-            [ @ not [ , ] [ drop ] if ] 3each
+            [ @ not [ 1 + , ] [ drop ] if ] 3each
         ] { } make
-        dup empty? [ over length 1 - prefix ] when -1 prefix 2 clump
+        2dup {
+            [ nip empty? ]
+            [ [ length ] [ last ] bi* = not ]
+        } 2|| [ over length suffix ] when
+        0 prefix 2 clump
         swap
     ] dip
-    '[ first2 [ 1 + ] bi@ _ _ boa ] map ; inline
+    '[ first2 _ _ boa ] map ; inline
 
 PRIVATE>