diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor
index 7a71bae69d..2819c965d9 100644
--- a/extra/math/extras/extras-tests.factor
+++ b/extra/math/extras/extras-tests.factor
@@ -129,3 +129,6 @@ IN: math.extras.test
 { 5 } [ 3 5 round-to-step ] unit-test
 { 10 } [ 12 5 round-to-step ] unit-test
 { 15 } [ 13 5 round-to-step ] unit-test
+
+{ { 0 1 2 3 0 0 1 } } [ { 1 2 3 3 2 1 2 } [ <= ] monotonic-count ] unit-test
+{ 4 } [ { 1 2 3 1 2 3 4 5 } [ < ] max-monotonic-count ] unit-test
diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
index b78e06464a..f0a35e7ee4 100644
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@@ -264,3 +264,17 @@ M: float round-to-even
 
 : round-to-step ( x step -- y )
     [ [ / round ] [ * ] bi ] unless-zero ;
+
+: monotonic-count ( seq quot: ( elt1 elt2 -- ? ) -- newseq )
+    over empty? [ 2drop { } ] [
+        [ 0 swap unclip-slice swap ] dip '[
+            [ @ [ 1 + ] [ drop 0 ] if ] keep over
+        ] { } map-as 2nip 0 prefix
+    ] if ; inline
+
+: max-monotonic-count ( seq quot: ( elt1 elt2 -- ? ) -- n )
+    over empty? [ 2drop 0 ] [
+        [ 0 swap unclip-slice swap 0 ] dip '[
+            [ swapd @ [ 1 + ] [ max 0 ] if ] keep swap
+        ] reduce nip max
+    ] if ; inline