factor: trim using lists

[factor.git] / extra / sets / extras / extras.factor

diff --git a/extra/sets/extras/extras.factor b/extra/sets/extras/extras.factor
index 0a5132b3790be689d15fd366f4afa8d5101aab05..a6ca1f974004b210670e3f1cf39939c8dc016911 100644 (file)
--- a/extra/sets/extras/extras.factor
+++ b/extra/sets/extras/extras.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2013 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences sets ;
+USING: assocs hash-sets kernel sequences sequences.extras
+sets ;
 IN: sets.extras
 
 : setwise-xor ( seq1 seq2 -- set )
@@ -11,3 +12,28 @@ IN: sets.extras
 
 : proper-subset? ( set1 set2 -- ? )
     2dup subset? [ swap subset? not ] [ 2drop f ] if ;
+
+: superset? ( set1 set2 -- ? )
+    swap subset? ;
+
+: disjoint? ( set1 set2 -- ? )
+    intersects? not ;
+
+:: non-repeating ( seq -- seq' )
+    HS{ } clone :> visited
+    0 seq new-resizable :> accum
+    seq [
+        accum over visited ?adjoin
+        [ push ] [ remove-first! drop ] if
+    ] each accum seq like ;
+
+: adjoin-at* ( value key assoc -- set )
+    [ [ HS{ } clone ] unless* [ adjoin ] keep dup ] change-at ;
+
+: mapped-set ( ... seq quot: ( ... elt -- ... newelt ) -- ... set )
+    over length <hash-set> [
+        '[ @ _ adjoin ] each
+    ] keep ; inline
+
+: unique-by ( seq quot: ( elt -- key ) -- seq' )
+    over length <hash-set> '[ @ _ ?adjoin ] filter ; inline