From fd5aa1d4f292227ddf70b20fbfe1672e4f959553 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 18 Nov 2016 06:59:07 -0800
Subject: [PATCH] sets.extras: adding duplicates-by.

---
 extra/sets/extras/extras-tests.factor | 2 ++
 extra/sets/extras/extras.factor       | 7 +++++--
 2 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/extra/sets/extras/extras-tests.factor b/extra/sets/extras/extras-tests.factor
index 49fa92decd..9458f4aecd 100644
--- 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 f84958c259..5810cd3b17 100644
--- 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