sets.extras: adding duplicates-by.

diff --git a/extra/sets/extras/extras-tests.factor b/extra/sets/extras/extras-tests.factor
index 49fa92decdf56cb36df664bd51ab752b183e9091..9458f4aecd28a7c2391781f33cb18b87d954632c 100644 (file)
--- a/extra/sets/extras/extras-tests.factor
+++ b/extra/sets/extras/extras-tests.factor
@@ -24,3 +24,5 @@ IN: sets.extras.tests
 { "" } [ "aabbcc" non-repeating ] unit-test
 
 { HS{ 0 10 20 30 40 } } [ 5 iota [ 10 * ] mapped-set ] unit-test
+
+{ { 1 2 4 } } [ { 1 2 3 4 5 } [ 2/ ] duplicates-by ] unit-test

diff --git a/extra/sets/extras/extras.factor b/extra/sets/extras/extras.factor
index f84958c2596924f1963365aaedaed8ad35b36984..5810cd3b17c7c9ef7ae5f0d96ed23a76a8c31b5b 100644 (file)
--- a/extra/sets/extras/extras.factor
+++ b/extra/sets/extras/extras.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2013 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs hash-sets kernel locals sequences
+USING: assocs fry hash-sets kernel locals sequences
 sequences.extras sets ;
 IN: sets.extras
 
@@ -32,5 +32,8 @@ IN: sets.extras
 
 : mapped-set ( ... seq quot: ( ... elt -- ... newelt ) -- ... set )
     over length <hash-set> [
-        [ adjoin ] curry compose each
+        '[ @ _ adjoin ] each
     ] keep ; inline
+
+: duplicates-by ( seq quot: ( elt -- key ) -- seq' )
+    over length <hash-set> '[ @ _ ?adjoin ] filter ; inline