From 1da6ea957aa00bfd11ff2343b287be72ba3cf50e Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 16 Mar 2010 20:17:26 -0400 Subject: [PATCH] Fixing bugs with sets, including adding new within and without words --- basis/validators/validators.factor | 2 +- core/hash-sets/hash-sets.factor | 2 +- core/sets/sets-docs.factor | 27 ++++++++++++++++++++------- core/sets/sets-tests.factor | 10 ++++++++++ core/sets/sets.factor | 13 +++++++++++-- extra/project-euler/035/035.factor | 4 ++-- 6 files changed, 45 insertions(+), 13 deletions(-) diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor index f2c5691452..cf45e7b13f 100644 --- a/basis/validators/validators.factor +++ b/basis/validators/validators.factor @@ -97,7 +97,7 @@ IN: validators 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 diff --git a/core/hash-sets/hash-sets.factor b/core/hash-sets/hash-sets.factor index bdef9a6ff9..248b4af4c6 100644 --- a/core/hash-sets/hash-sets.factor +++ b/core/hash-sets/hash-sets.factor @@ -25,4 +25,4 @@ M: sequence fast-set ; 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 ; diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index ac296f949c..5cb0096d0b 100644 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -3,7 +3,7 @@ quotations sequences vectors ; 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 @@ -43,6 +43,11 @@ ARTICLE: "set-operations" "Operations on sets" { $subsections all-unique? duplicates +} +"Utilities for sets and sequences:" +{ $subsections + within + without } ; ARTICLE: "set-implementations" "Set implementations" @@ -68,11 +73,11 @@ HELP: adjoin { $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\" }" } } @@ -100,7 +105,7 @@ HELP: duplicates { $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? @@ -165,3 +170,11 @@ HELP: set-like { $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." } ; diff --git a/core/sets/sets-tests.factor b/core/sets/sets-tests.factor index aa76a4f02e..e4bc762512 100644 --- a/core/sets/sets-tests.factor +++ b/core/sets/sets-tests.factor @@ -5,9 +5,19 @@ IN: sets.tests [ { } ] [ { } { } 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 diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 5274c07d37..3f441f9239 100644 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -2,6 +2,7 @@ ! 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 @@ -11,7 +12,7 @@ GENERIC: in? ( elt set -- ? ) 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 -- ? ) @@ -95,7 +96,9 @@ M: sequence all-unique? 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 @@ -103,6 +106,12 @@ M: sequence all-unique? : 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 ) diff --git a/extra/project-euler/035/035.factor b/extra/project-euler/035/035.factor index 7d98de62b1..ee4af81720 100644 --- a/extra/project-euler/035/035.factor +++ b/extra/project-euler/035/035.factor @@ -1,7 +1,7 @@ ! 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 @@ -28,7 +28,7 @@ IN: project-euler.035 : possible? ( seq -- ? ) dup length 1 > [ - dup { 0 2 4 5 6 8 } diff = + [ even? ] any? not ] [ drop t ] if ;