Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / grouping / grouping.factor

diff --git a/basis/grouping/grouping.factor b/basis/grouping/grouping.factor
index b4d4c08d42dbb00c4e5bcae887f23aa073ed0dc7..f68760a4e18e881d08d80507edd2223a90a7d99d 100644 (file)
--- a/basis/grouping/grouping.factor
+++ b/basis/grouping/grouping.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.order strings arrays vectors sequences
-sequences.private accessors ;
+sequences.private accessors fry ;
 IN: grouping
 
 <PRIVATE
@@ -35,7 +35,7 @@ M: slice-chunking nth-unsafe group@ slice boa ;
 TUPLE: abstract-groups < chunking-seq ;
 
 M: abstract-groups length
-    [ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
+    [ seq>> length ] [ n>> ] bi [ + 1 - ] keep /i ;
 
 M: abstract-groups set-length
     [ n>> * ] [ seq>> ] bi set-length ;
@@ -46,10 +46,10 @@ M: abstract-groups group@
 TUPLE: abstract-clumps < chunking-seq ;
 
 M: abstract-clumps length
-    [ seq>> length ] [ n>> ] bi - 1+ ;
+    [ seq>> length ] [ n>> ] bi - 1 + ;
 
 M: abstract-clumps set-length
-    [ n>> + 1- ] [ seq>> ] bi set-length ;
+    [ n>> + 1 - ] [ seq>> ] bi set-length ;
 
 M: abstract-clumps group@
     [ n>> over + ] [ seq>> ] bi ;
@@ -87,3 +87,17 @@ INSTANCE: sliced-clumps slice-chunking
 : group ( seq n -- array ) <groups> { } like ;
 
 : clump ( seq n -- array ) <clumps> { } like ;
+
+: monotonic? ( seq quot -- ? )
+    over length 2 < [ 2drop t ] [
+        over length 2 = [
+            [ first2-unsafe ] dip call
+        ] [
+            [ 2 <sliced-clumps> ] dip
+            '[ first2-unsafe @ ] all?
+        ] if
+    ] if ; inline
+
+: all-equal? ( seq -- ? ) [ = ] monotonic? ;
+
+: all-eq? ( seq -- ? ) [ eq? ] monotonic? ;