assocs: Add harvest-keys, harvest-values to core/. Remove assoc-sift because it's sift-keys, sift-values in core/.

db4
Doug Coleman 2015-08-08 11:58:40 -05:00
parent 21013d4571
commit 434f08a303
4 changed files with 63 additions and 8 deletions

View File

@ -161,6 +161,8 @@ $nl
{ $subsections
sift-keys
sift-values
harvest-keys
harvest-values
}
"Mapping between assocs and sequences:"
{ $subsections
@ -343,11 +345,42 @@ HELP: assoc-subset?
HELP: sift-keys
{ $values { "assoc" assoc } { "assoc'" "a new assoc" } }
{ $description "Outputs an assoc removing keys that are " { $link f } "." } ;
{ $description "Outputs an assoc removing keys that are " { $link f } "." }
{ $examples
{ $example "USING: prettyprint assocs hashtables ;"
"H{ { 1 2 } { f 3 } } sift-keys ."
"H{ { 1 2 } }" }
} ;
HELP: sift-values
{ $values { "assoc" assoc } { "assoc'" "a new assoc" } }
{ $description "Outputs an assoc removing values that are " { $link f } "." } ;
{ $description "Outputs an assoc removing values that are " { $link f } "." }
{ $examples
{ $example "USING: prettyprint assocs hashtables ;"
"H{ { 1 f } { 3 4 } } sift-values ."
"H{ { 3 4 } }" }
} ;
{ sift-keys sift-values harvest-keys harvest-values } related-words
HELP: harvest-keys
{ $values { "assoc" assoc } { "assoc'" "a new assoc" } }
{ $description "Outputs an assoc removing keys that are empty sequences." }
{ $examples
{ $example "USING: prettyprint assocs hashtables ;"
"H{ { { 2 } 1 } { { } 3 } } harvest-keys ."
"H{ { { 2 } 1 } }" }
} ;
HELP: harvest-values
{ $values { "assoc" assoc } { "assoc'" "a new assoc" } }
{ $description "Outputs an assoc removing values that are empty sequences." }
{ $examples
{ $example "USING: prettyprint assocs hashtables ;"
"H{ { 1 { } } { 3 { 4 } } } harvest-values ."
"H{ { 3 { 4 } } }" }
} ;
HELP: assoc=
{ $values { "assoc1" assoc } { "assoc2" assoc } { "?" boolean } }

View File

@ -217,6 +217,28 @@ unit-test
{ { 1 f } { f 2 } } sift-keys
] unit-test
{
{
{ { 2 } 1 }
}
} [
{
{ { 2 } 1 }
{ { } 3 }
} harvest-keys
] unit-test
{
{
{ 1 { 2 } }
}
} [
{
{ 1 { 2 } }
{ 3 { } }
} harvest-values
] unit-test
{
{ { f 2 } }
} [

View File

@ -95,6 +95,12 @@ PRIVATE>
: sift-values ( assoc -- assoc' )
[ nip ] assoc-filter ; inline
: harvest-keys ( assoc -- assoc' )
[ drop empty? ] assoc-reject ; inline
: harvest-values ( assoc -- assoc' )
[ nip empty? ] assoc-reject ; inline
: assoc-partition ( ... assoc quot: ( ... key value -- ... ? ) -- ... true-assoc false-assoc )
[ (assoc-each) partition ] [ drop ] 2bi
[ assoc-like ] curry bi@ ; inline

View File

@ -5,12 +5,6 @@ USING: arrays assocs assocs.private kernel math sequences ;
IN: assocs.extras
: assoc-sift ( assoc -- assoc' )
[ nip ] assoc-filter ; inline
: assoc-harvest ( assoc -- assoc' )
[ nip empty? ] assoc-reject ; inline
: deep-at ( assoc seq -- value/f )
[ of ] each ; inline