sets.extras: adding symmetric-diff and proper-subset?.

diff --git a/extra/sets/extras/extras-docs.factor b/extra/sets/extras/extras-docs.factor
index cfde0569b6a711cba79b6a7a5aa9775a9c3921fc..174f91f44bd6496acf5be30e8303fdb66399c664 100644 (file)
--- a/extra/sets/extras/extras-docs.factor
+++ b/extra/sets/extras/extras-docs.factor
@@ -5,7 +5,7 @@ IN: sets.extras
 
 HELP: setwise-xor
 { $values
-    { "seq0" sequence } { "seq1" sequence }
+    { "seq1" sequence } { "seq2" sequence }
     { "set" set }
 }
 { $description "Converts the sequences to sets and takes the element-wise " { $link xor } ". Outputs elements that are in either set but not in both." }
@@ -16,6 +16,14 @@ HELP: setwise-xor
 }
 { $notes "Known as setxor1d in numpy." } ;
 
+HELP: symmetric-diff
+{ $values { "set1" set } { "set2" set } { "set" set } }
+{ $description "Find the symmetric difference of two sets.  Outputs a set containing elements that in either set but not in both." } ;
+
+HELP: proper-subset?
+{ $values { "set1" set } { "set2" set } { "?" boolean } }
+{ $description "Find whether " { $snippet "set1" } " is a proper subset of " { $snippet "set2" } ".  Returns true if " { $snippet "set1" } " is a subset of " { $snippet "set2" } " but " { $snippet "set2" } " is not a subset of " { $snippet "set1" } "." } ;
+
 ARTICLE: "sets.extras" "Extra sets words"
 "The " { $vocab-link "sets.extras" } " vocabulary is a collection of words related to sets."
 $nl

diff --git a/extra/sets/extras/extras-tests.factor b/extra/sets/extras/extras-tests.factor
index 858945f651a84c6d91f638705a06ee630e8f109f..c6ce2adf253cc8b545d38c2b58172a89e7289d7e 100644 (file)
--- a/extra/sets/extras/extras-tests.factor
+++ b/extra/sets/extras/extras-tests.factor
@@ -3,17 +3,18 @@
 USING: tools.test sets.extras ;
 IN: sets.extras.tests
 
-{ { } }
-[ { } { } setwise-xor ] unit-test
+{ { } } [ { } { } setwise-xor ] unit-test
+{ { 1 } } [ { 1 } { } setwise-xor ] unit-test
+{ { 1 } } [ { } { 1 } setwise-xor ] unit-test
+{ { } } [ { 1 } { 1 } setwise-xor ] unit-test
+{ { 1 4 5 7 } } [ { 1 2 3 2 4 } { 2 3 5 7 5 } setwise-xor ] unit-test
 
-{ { 1 } }
-[ { 1 } { } setwise-xor ] unit-test
+{ { } } [ { } { } symmetric-diff ] unit-test
+{ { 1 2 3 } } [ { 1 2 3 } { } symmetric-diff ] unit-test
+{ { 1 2 3 } } [ { } { 1 2 3 } symmetric-diff ] unit-test
+{ { 1 2 4 5 } } [ { 1 2 3 } { 3 4 5 } symmetric-diff ] unit-test
 
-{ { 1 } }
-[ { } { 1 } setwise-xor ] unit-test
-
-{ { } }
-[ { 1 } { 1 } setwise-xor ] unit-test
-
-{ { 1 4 5 7 } }
-[ { 1 2 3 2 4 } { 2 3 5 7 5 } setwise-xor ] unit-test
+{ f } [ { } { } proper-subset? ] unit-test
+{ f } [ { 1 2 } { 1 2 } proper-subset? ] unit-test
+{ f } [ { 1 2 3 } { 1 2 } proper-subset? ] unit-test
+{ t } [ { 1 2 } { 1 2 3 } proper-subset? ] unit-test

diff --git a/extra/sets/extras/extras.factor b/extra/sets/extras/extras.factor
index 7b98c65745d91a54ea9503c354494bbf40256ef8..0a5132b3790be689d15fd366f4afa8d5101aab05 100644 (file)
--- a/extra/sets/extras/extras.factor
+++ b/extra/sets/extras/extras.factor
@@ -3,5 +3,11 @@
 USING: kernel sequences sets ;
 IN: sets.extras
 
-: setwise-xor ( seq0 seq1 -- set )
+: setwise-xor ( seq1 seq2 -- set )
     [ append members ] [ intersect ] 2bi diff ;
+
+: symmetric-diff ( set1 set2 -- set )
+    [ union ] [ intersect ] 2bi diff ;
+
+: proper-subset? ( set1 set2 -- ? )
+    2dup subset? [ swap subset? not ] [ 2drop f ] if ;