sum 10 mod 0 = ;
: v-credit-card ( str -- n )
- "- " diff
+ "- " without
dup CHAR: 0 CHAR: 9 [a,b] diff empty? [
13 v-min-length
16 v-max-length
M: f fast-set drop H{ } clone hash-set boa ;
M: sequence duplicates
- HS{ } clone [ [ in? ] [ adjoin ] 2bi ] curry filter ;
+ f fast-set [ [ in? ] [ adjoin ] 2bi ] curry filter ;
IN: sets
ARTICLE: "sets" "Sets"
-"A set is an unordered list of elements. Words for working with sets are in the " { $vocab-link "sets" } " vocabulary."
+"A set is an unordered list of elements. Words for working with sets are in the " { $vocab-link "sets" } " vocabulary." $nl
"All sets are instances of a mixin class:"
{ $subsections
set
{ $subsections
all-unique?
duplicates
+}
+"Utilities for sets and sequences:"
+{ $subsections
+ within
+ without
} ;
ARTICLE: "set-implementations" "Set implementations"
{ $description "Destructively adds " { $snippet "elt" } " to " { $snippet "set" } ". For sequences, this guarantees that this element is not duplicated, and that it is at the end of the sequence." $nl "Each mutable set type is expected to implement a method on this generic word." }
{ $examples
{ $example
- "USING: namespaces prettyprint sets ;"
- "V{ \"beans\" \"salsa\" \"cheese\" } \"v\" set"
- "\"nachos\" \"v\" get adjoin"
- "\"salsa\" \"v\" get adjoin"
- "\"v\" get ."
+ "USING: prettyprint sets kernel ;"
+ "V{ \"beans\" \"salsa\" \"cheese\" } clone"
+ "\"nachos\" over adjoin"
+ "\"salsa\" over adjoin"
+ "."
"V{ \"beans\" \"cheese\" \"nachos\" \"salsa\" }"
}
}
{ $values { "set" set } { "seq" sequence } }
{ $description "Outputs a sequence consisting of elements which occur more than once in " { $snippet "set" } "." }
{ $examples
- { $example "USING: sets prettyprint ;" "{ 1 2 3 1 2 1 } duplicates ." "{ 2 1 2 1 }" }
+ { $example "USING: sets prettyprint ;" "{ 1 2 3 1 2 1 } duplicates ." "{ 1 2 1 }" }
} ;
HELP: all-unique?
{ $examples
{ $example "USING: sets prettyprint ;" "{ 1 2 3 } HS{ } set-like ." "HS{ 1 2 3 }" }
} ;
+
+HELP: within
+{ $values { "seq" sequence } { "set" set } { "subseq" sequence } }
+{ $description "Returns the subsequence of the given sequence consisting of members of the set. This may contain duplicates, if the sequence has duplicates." } ;
+
+HELP: without
+{ $values { "seq" sequence } { "set" set } { "subseq" sequence } }
+{ $description "Returns the subsequence of the given sequence consisting of things that are not members of the set. This may contain duplicates, if the sequence has duplicates." } ;
[ { } ] [ { } { } 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
[ { } ] [ { } { } 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
+
+[ { } ] [ { } { } 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
+
+[ { } ] [ { } { } without ] unit-test
+[ { 1 } ] [ { 1 2 3 } { 2 3 4 } without ] unit-test
+[ { 1 1 } ] [ { 1 1 2 3 3 } { 2 3 4 4 } without ] unit-test
[ { } ] [ { } { } union ] unit-test
[ { 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs hashtables kernel vectors
math sequences ;
+FROM: assocs => change-at ;
IN: sets
! Set protocol
GENERIC: delete ( elt set -- )
GENERIC: set-like ( set exemplar -- set' )
GENERIC: fast-set ( set -- set' )
-GENERIC: members ( set -- sequence )
+GENERIC: members ( set -- seq )
GENERIC: union ( set1 set2 -- set )
GENERIC: intersect ( set1 set2 -- set )
GENERIC: intersects? ( set1 set2 -- ? )
dup pruned sequence= ;
: combine ( sets -- set )
- f [ union ] reduce ;
+ [ f ]
+ [ [ [ members ] map concat ] [ first ] bi set-like ]
+ if-empty ;
: gather ( seq quot -- newseq )
map concat members ; inline
: adjoin-at ( value key assoc -- )
[ [ f fast-set ] unless* [ adjoin ] keep ] change-at ;
+: within ( seq set -- subseq )
+ fast-set [ in? ] curry filter ;
+
+: without ( seq set -- subseq )
+ fast-set [ in? not ] curry filter ;
+
! Temporarily for compatibility
: unique ( seq -- assoc )
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.combinatorics math.parser math.primes
- project-euler.common sequences sets ;
+ project-euler.common sequences ;
IN: project-euler.035
! http://projecteuler.net/index.php?section=problems&id=35
: possible? ( seq -- ? )
dup length 1 > [
- dup { 0 2 4 5 6 8 } diff =
+ [ even? ] any? not
] [
drop t
] if ;