steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

sets: adding union! and intersection.

db4
John Benediktsson 2013-03-08 07:57:45 -08:00
parent b015af4f33
commit ffd03ec922
3 changed files with 25 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
core/sets/sets-docs.factor
View File

@ -25,6 +25,7 @@ ARTICLE: "set-operations" "Operations on sets"
adjoin
delete
clear-set
union!
}
"To test if a set is the empty set:"
{ $subsections null? }
@ -148,6 +149,10 @@ HELP: intersect
{ $example "USING: sets prettyprint ;" "{ 1 2 3 } { 2 3 4 } intersect ." "{ 2 3 }" }
} ;
HELP: intersection
{ $values { "sets" sequence } { "set/f" "a " { $link set } " or " { $link f } } }
{ $description "Outputs the intersection of all the sets of the sequence " { $snippet "sets" } ", or " { $link f } " if " { $snippet "sets" } " is empty." } ;
HELP: union
{ $values { "set1" set } { "set2" set } { "set" set } }
{ $description "Outputs a set consisting of elements present in either " { $snippet "set1" } " or " { $snippet "set2" } " which does not contain duplicate values."
@ -158,6 +163,11 @@ HELP: union
{ diff intersect union } related-words
HELP: union!
{ $values { "set1" set } { "set2" set } }
{ $description "Adds all members from " { $snippet "set2" } " to " { $snippet "set1" } "." }
{ $side-effects "set1" } ;
HELP: intersects?
{ $values { "set1" set } { "set2" set } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "set1" } " and " { $snippet "set2" } " have any elements in common." }

9
core/sets/sets-tests.factor
View File

@ -126,3 +126,12 @@ M: null-set members drop f ;
[ HS{ } ] [ HS{ } [ clear-set ] keep ] unit-test
[ HS{ } ] [ HS{ 1 2 3 } [ clear-set ] keep ] unit-test
[ HS{ } ] [ HS{ } HS{ } union! ] unit-test
[ HS{ 1 } ] [ HS{ 1 } HS{ } union! ] unit-test
[ HS{ 1 } ] [ HS{ } HS{ 1 } union! ] unit-test
[ HS{ 1 2 3 } ] [ HS{ 1 } HS{ 1 2 3 } union! ] unit-test
[ f ] [ { } intersection ] unit-test
[ HS{ } ] [ { HS{ } } intersection ] unit-test
[ HS{ 1 } ] [ { HS{ 1 2 3 } HS{ 1 } } intersection ] unit-test

6
core/sets/sets.factor
View File

@ -138,6 +138,9 @@ M: sequence clear-set
[ [ [ ?members ] map concat ] [ first ] bi set-like ]
if-empty ;
: intersection ( sets -- set/f )
[ f ] [ [ ] [ intersect ] map-reduce ] if-empty ;
: gather ( ... seq quot: ( ... elt -- ... elt' ) -- ... newseq )
map concat members ; inline
@ -153,6 +156,9 @@ M: sequence clear-set
: ?adjoin ( elt set -- ? )
2dup in? [ 2drop f ] [ adjoin t ] if ; inline
: union! ( set1 set2 -- set1 )
?members over [ adjoin ] curry each ;
! Temporarily for compatibility
: unique ( seq -- assoc )