From 2b4844e75305006201b6a7ebf4b9ecc76101eb6e Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 3 Jun 2014 10:13:51 -0700
Subject: [PATCH] sets.extras: adding mapped-set.

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

diff --git a/extra/sets/extras/extras-tests.factor b/extra/sets/extras/extras-tests.factor
index 5cc06343a6..49fa92decd 100644
--- a/extra/sets/extras/extras-tests.factor
+++ b/extra/sets/extras/extras-tests.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2013 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test sets.extras ;
+USING: math sequences sets.extras tools.test ;
 IN: sets.extras.tests
 
 { { } } [ { } { } setwise-xor ] unit-test
@@ -22,3 +22,5 @@ IN: sets.extras.tests
 { "abc" } [ "abc" non-repeating ] unit-test
 { "abc" } [ "abcddd" non-repeating ] unit-test
 { "" } [ "aabbcc" non-repeating ] unit-test
+
+{ HS{ 0 10 20 30 40 } } [ 5 iota [ 10 * ] mapped-set ] unit-test
diff --git a/extra/sets/extras/extras.factor b/extra/sets/extras/extras.factor
index 2963ad4559..f84958c259 100644
--- 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: assocs kernel locals sequences sequences.extras sets ;
+USING: assocs hash-sets kernel locals sequences
+sequences.extras sets ;
 IN: sets.extras
 
 : setwise-xor ( seq1 seq2 -- set )
@@ -28,3 +29,8 @@ IN: sets.extras
 
 : 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 ] curry compose each
+    ] keep ; inline