From 6fdf24d5b468adac2e8a942d654eea70773a3f30 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 27 Dec 2011 11:43:32 -0600
Subject: [PATCH] splitting.monotonic: Don't throw away the last result. Fixes
 #462.

---
 basis/splitting/monotonic/monotonic-tests.factor | 16 ++++++++++++++++
 basis/splitting/monotonic/monotonic.factor       | 15 ++++++++++-----
 2 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/basis/splitting/monotonic/monotonic-tests.factor b/basis/splitting/monotonic/monotonic-tests.factor
index 2b44f42394..5e1e1ce25e 100644
--- 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 e3f08659b7..52d5586227 100644
--- 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>