sets, bit-sets: cleanups

db4
Slava Pestov 2010-12-27 20:10:37 -08:00
parent 47faf5f6ae
commit 3c73e53db3
4 changed files with 21 additions and 9 deletions

View File

@ -64,3 +64,8 @@ IN: bit-sets.tests
[ T{ bit-set f ?{ f } } T{ bit-set f ?{ t } } ] [ T{ bit-set f ?{ f } } T{ bit-set f ?{ t } } ]
[ 1 <bit-set> dup clone 0 over adjoin ] unit-test [ 1 <bit-set> dup clone 0 over adjoin ] unit-test
[ 0 ] [ T{ bit-set f ?{ } } cardinality ] unit-test
[ 0 ] [ T{ bit-set f ?{ f f f f } } cardinality ] unit-test
[ 1 ] [ T{ bit-set f ?{ f t f f } } cardinality ] unit-test
[ 2 ] [ T{ bit-set f ?{ f t f t } } cardinality ] unit-test

View File

@ -15,19 +15,21 @@ M: bit-set in?
over integer? [ table>> ?nth ] [ 2drop f ] if ; inline over integer? [ table>> ?nth ] [ 2drop f ] if ; inline
M: bit-set adjoin M: bit-set adjoin
! This is allowed to crash when the elt couldn't go in the set ! This is allowed to throw an error when the elt couldn't
! go in the set
[ t ] 2dip table>> set-nth ; [ t ] 2dip table>> set-nth ;
M: bit-set delete M: bit-set delete
! This isn't allowed to crash if the elt wasn't in the set ! This isn't allowed to throw an error if the elt wasn't
! in the set
over integer? [ over integer? [
table>> 2dup bounds-check? [ table>> 2dup bounds-check? [
[ f ] 2dip set-nth [ f ] 2dip set-nth
] [ 2drop ] if ] [ 2drop ] if
] [ 2drop ] if ; ] [ 2drop ] if ;
! If you do binary set operations with a bitset, it's expected ! If you do binary set operations with a bit-set, it's expected
! that the other thing can also be represented as a bitset ! that the other thing can also be represented as a bit-set
! of the same length. ! of the same length.
<PRIVATE <PRIVATE
@ -71,7 +73,8 @@ M: bit-set members
<PRIVATE <PRIVATE
: bit-set-like ( set bit-set -- bit-set' ) : bit-set-like ( set bit-set -- bit-set' )
! This crashes if there are keys that can't be put in the bit set ! Throws an error if there are keys that can't be put
! in the bit set
over bit-set? [ 2dup [ table>> length ] bi@ = ] [ f ] if over bit-set? [ 2dup [ table>> length ] bi@ = ] [ f ] if
[ drop ] [ [ drop ] [
[ members ] dip table>> length <bit-set> [ members ] dip table>> length <bit-set>
@ -87,4 +90,4 @@ M: bit-set clone
table>> clone bit-set boa ; table>> clone bit-set boa ;
M: bit-set cardinality M: bit-set cardinality
table>> bit-array>integer bit-count ; table>> bit-count ;

View File

@ -18,6 +18,8 @@ ARTICLE: "set-operations" "Operations on sets"
{ $subsections in? } { $subsections in? }
"All sets can be represented as a sequence, without duplicates, of their members:" "All sets can be represented as a sequence, without duplicates, of their members:"
{ $subsections members } { $subsections members }
"To get the number of elements in a set:"
{ $subsections cardinality }
"Sets can have members added or removed destructively:" "Sets can have members added or removed destructively:"
{ $subsections { $subsections
adjoin adjoin
@ -187,4 +189,4 @@ HELP: null?
HELP: cardinality HELP: cardinality
{ $values { "set" set } { "n" "a non-negative integer" } } { $values { "set" set } { "n" "a non-negative integer" } }
{ $description "Returns the number of elements in the set. All sets support this operation." } ; { $description "Returns the number of elements in the set. All sets support this operation." } ;

View File

@ -3,7 +3,7 @@
USING: sets tools.test kernel prettyprint hash-sets sorting ; USING: sets tools.test kernel prettyprint hash-sets sorting ;
IN: sets.tests IN: sets.tests
[ { } ] [ { } { } intersect ] unit-test [ { } ] [ { } { } intersect ] unit-test
[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test [ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
[ { 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } intersect ] unit-test [ { 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } intersect ] unit-test
@ -11,7 +11,7 @@ IN: sets.tests
[ { 1 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test [ { 1 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
[ { 1 } ] [ { 1 1 2 3 } { 2 3 4 4 } diff ] unit-test [ { 1 } ] [ { 1 1 2 3 } { 2 3 4 4 } diff ] unit-test
[ { } ] [ { } { } within ] unit-test [ { } ] [ { } { } within ] unit-test
[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } within ] unit-test [ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } within ] unit-test
[ { 2 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } within ] unit-test [ { 2 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } within ] unit-test
@ -67,4 +67,6 @@ IN: sets.tests
[ 0 ] [ f cardinality ] unit-test [ 0 ] [ f cardinality ] unit-test
[ 0 ] [ { } cardinality ] unit-test [ 0 ] [ { } cardinality ] unit-test
[ 1 ] [ { 1 } cardinality ] unit-test
[ 1 ] [ HS{ 1 } cardinality ] unit-test [ 1 ] [ HS{ 1 } cardinality ] unit-test
[ 3 ] [ HS{ 1 2 3 } cardinality ] unit-test