sequences.extras: add more words from the bqn language

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index c116a51aeac3cb15cee0703ad4796a2d3c98c600..2a8668ad32fae645e38ba2701be8bdc393566bbd 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -304,6 +304,21 @@ strings tools.test ;
 { { } } [ { } [ + ] 0accumulate ] unit-test
 { { 100 101 103 107 } } [ { 100 1 2 4 } [ + ] 0accumulate ] unit-test
 
+{ { "y" "o" "y" "p" "o" "y" } }
+[ { "y" "o" "y" "p" "o" "y" } [ classify ] [ deduplicate ] bi nths ] unit-test
+
+{ { "take" "drop" "pick" } }
+[ { "take" "drop" "drop" "pick" "take" "take" } deduplicate ] unit-test
+
+{ { "drop" "pick" "take" } }
+[ { "take" "drop" "drop" "pick" "take" "take" } deduplicate-last ] unit-test
+
+{ { } }
+[ "" mark-firsts ] unit-test
+
+{ { 1 1 0 0 1 0 } }
+[ "abaacb" mark-firsts ] unit-test
+
 {
     H{ { t 6 } { f 5 } }
     { 0 0 1 1 2 3 4 2 3 4 5 }
@@ -325,7 +340,7 @@ strings tools.test ;
         { 109 1 } { 110 1 } { 111 1 } { 112 1 }
     }
     { 1 2 0 3 3 3 3 3 3 3 3 3 3 3 3 3 }
- } [
+} [
     "cab" "abcdefghijklmnop" progressive-index
 ] unit-test
 

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 389718aea668d630e76a38385d3109484d73c460..3dd39de67ecae0c4b9a0f06eb3cae28ece96fbb8 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -1,7 +1,7 @@
-
-USING: accessors arrays assocs combinators generalizations
-grouping growable heaps kernel math math.order ranges sequences
-sequences.private shuffle sorting splitting vectors ;
+USING: accessors arrays assocs assocs.extras combinators
+generalizations grouping growable hash-sets heaps kernel math
+math.order ranges sequences sequences.private sets shuffle
+sorting splitting vectors ;
 IN: sequences.extras
 
 : find-all ( ... seq quot: ( ... elt -- ... ? ) -- ... elts )
@@ -309,6 +309,28 @@ PRIVATE>
 
 : inc-at* ( key assoc -- old new ) [ 1 ] 2dip at+* ; inline
 
+: mark-firsts ( seq -- seq' )
+    dup length <hash-set> '[ _ ?adjoin 1 0 ? ] { } map-as ;
+
+: deduplicate ( seq -- seq' )
+    dup length <hash-set> '[ _ ?adjoin ] { } filter-as ;
+
+: deduplicate-last ( seq -- seq' )
+    <reversed> deduplicate reverse ;
+
+: classify-from ( next hash seq -- next' hash seq' )
+    '[
+        swap '[
+            dupd _ ?set-once-at
+            [ [ 1 + ] dip ] when
+        ] { } map-as
+    ] keepd swap ;
+
+: classify* ( seq -- next hash seq' )
+    [ 0 H{ } clone ] dip classify-from ;
+
+: classify ( seq -- seq' ) classify* 2nip ; inline
+
 : occurrence-count-by ( seq quot: ( elt -- elt' ) -- hash seq' )
     '[ nip @ over inc-at* drop ] [ H{ } clone ] 2dip 0accumulate ; inline