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

Renaming items->members in sets

db4
Daniel Ehrenberg 2010-02-15 21:08:54 -06:00
parent 8c322a9bf8
commit c36ff9dab8
2 changed files with 23 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
extra/bags/bags-tests.factor
View File

@ -32,14 +32,14 @@ IN: bags.tests
[ f ] [ { 2 3 } { 1 2 3 } set= ] unit-test
[ f ] [ { 1 2 3 } { 2 3 } set= ] unit-test
[ { 1 } ] [ { 1 } items ] unit-test
[ { 1 } ] [ { 1 } members ] unit-test
[ { 1 2 3 } ] [ { 1 1 1 2 2 3 3 3 3 3 } dup set-like natural-sort ] unit-test
[ { 1 2 3 } ] [ HS{ 1 2 3 } { } set-like natural-sort ] unit-test
[ HS{ 1 2 3 } ] [ { 1 2 3 } fast-set ] unit-test
[ { 1 2 3 } ] [ HS{ 1 2 3 } items natural-sort ] unit-test
[ { 1 2 3 } ] [ HS{ 1 2 3 } members natural-sort ] unit-test
[ "HS{ 1 2 3 4 }" ] [ HS{ 1 2 3 4 } unparse ] unit-test
@ -50,7 +50,7 @@ IN: bags.tests
[ HS{ 1 2 3 } ] [ 4 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
[ HS{ 1 2 } ] [ 3 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
[ HS{ 1 2 } ] [ HS{ 1 2 } fast-set ] unit-test
[ { 1 2 } ] [ HS{ 1 2 } items natural-sort ] unit-test
[ { 1 2 } ] [ HS{ 1 2 } members natural-sort ] unit-test
[ HS{ 1 2 3 4 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } union ] unit-test
[ HS{ 2 3 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } intersect ] unit-test
@ -108,20 +108,20 @@ IN: bags.tests
T{ bit-set f ?{ t t t f f f } } subset?
] unit-test
[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } items ] unit-test
[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } members ] unit-test
[ t { 1 2 3 } ] [
{ 1 2 } 5 <bit-set> set-like
[ bit-set? ] keep
3 over adjoin
items >array natural-sort
members >array natural-sort
] unit-test
[ V{ 0 1 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap adjoin ] keep items ] unit-test
[ T{ bit-set f ?{ t f t f f t } } clone [ 9 swap adjoin ] keep items ] must-fail
[ T{ bit-set f ?{ t f t f f t } } clone [ "foo" swap adjoin ] keep items ] must-fail
[ V{ 0 1 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap adjoin ] keep members ] unit-test
[ T{ bit-set f ?{ t f t f f t } } clone [ 9 swap adjoin ] keep members ] must-fail
[ T{ bit-set f ?{ t f t f f t } } clone [ "foo" swap adjoin ] keep members ] must-fail
[ V{ 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 0 swap delete ] keep items ] unit-test
[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap delete ] keep items ] unit-test
[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 9 swap delete ] keep items ] unit-test
[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ "foo" swap delete ] keep items ] unit-test
[ V{ 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 0 swap delete ] keep members ] unit-test
[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap delete ] keep members ] unit-test
[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 9 swap delete ] keep members ] unit-test
[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ "foo" swap delete ] keep members ] unit-test

22
extra/bags/bags.factor
View File

@ -14,7 +14,7 @@ GENERIC: in? ( elt set -- ? )
GENERIC: delete ( elt set -- )
GENERIC: set-like ( set exemplar -- set' )
GENERIC: fast-set ( set -- set' )
GENERIC: items ( set -- sequence )
GENERIC: members ( set -- sequence )
GENERIC: union ( set1 set2 -- set )
GENERIC: intersect ( set1 set2 -- set )
GENERIC: intersects? ( set1 set2 -- ? )
@ -26,12 +26,12 @@ GENERIC: set= ( set1 set2 -- ? )
! Override them for efficiency
M: set union
[ [ items ] bi@ append ] keep set-like ;
[ [ members ] bi@ append ] keep set-like ;
<PRIVATE
: sequence/tester ( set1 set2 -- set1' quot )
[ items ] [ fast-set [ in? ] curry ] bi* ; inline
[ members ] [ fast-set [ in? ] curry ] bi* ; inline
PRIVATE>
@ -56,16 +56,16 @@ M: set fast-set ;
! In a better implementation, less memory would be used
TUPLE: hash-set { table hashtable read-only } ;
: <hash-set> ( items -- hash-set )
: <hash-set> ( members -- hash-set )
sets:unique hash-set boa ;
INSTANCE: hash-set set
M: hash-set in? table>> key? ; inline
M: hash-set adjoin table>> dupd set-at ; inline
M: hash-set delete table>> delete-at ; inline
M: hash-set items table>> keys ; inline
M: hash-set members table>> keys ; inline
M: hash-set set-like
drop dup hash-set? [ items <hash-set> ] unless ;
drop dup hash-set? [ members <hash-set> ] unless ;
M: hash-set clone
table>> clone hash-set boa ;
@ -74,7 +74,7 @@ SYNTAX: HS{
M: hash-set pprint* pprint-object ;
M: hash-set pprint-delims drop \ HS{ \ } ;
M: hash-set >pprint-sequence items ;
M: hash-set >pprint-sequence members ;
! Sequences are sets
INSTANCE: sequence set
@ -82,9 +82,9 @@ M: sequence in? member? ; inline
M: sequence adjoin sets:adjoin ; inline
M: sequence delete remove! drop ; inline
M: sequence set-like
[ dup sequence? [ sets:prune ] [ items ] if ] dip
[ dup sequence? [ sets:prune ] [ members ] if ] dip
like ;
M: sequence items ;
M: sequence members ;
M: sequence fast-set <hash-set> ;
! Bit sets are sets
@ -131,13 +131,13 @@ M: bit-set diff
M: bit-set subset?
(bit-set-op) swap bit-set-subset? ;
M: bit-set items
M: bit-set members
[ table>> length iota ] keep [ in? ] curry filter ;
M: bit-set set-like
! This crashes if there are keys that can't be put in the bit set
over bit-set? [ 2dup [ table>> ] bi@ length = ] [ f ] if
[ drop ] [
[ items ] dip table>> length <bit-set>
[ members ] dip table>> length <bit-set>
[ [ adjoin ] curry each ] keep
] if ;