move some words to sets

write docs for sets
started on usings..
db4
Doug Coleman 2008-04-14 02:20:37 -05:00
parent 83aad018ca
commit 4597cab824
19 changed files with 119 additions and 84 deletions

View File

@ -5,7 +5,7 @@ kernel.private math memory continuations kernel io.files
io.backend system parser vocabs sequences prettyprint io.backend system parser vocabs sequences prettyprint
vocabs.loader combinators splitting source-files strings vocabs.loader combinators splitting source-files strings
definitions assocs compiler.errors compiler.units definitions assocs compiler.errors compiler.units
math.parser generic ; math.parser generic sets ;
IN: bootstrap.stage2 IN: bootstrap.stage2
SYMBOL: bootstrap-time SYMBOL: bootstrap-time

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel classes classes.builtin combinators accessors USING: kernel classes classes.builtin combinators accessors
sequences arrays vectors assocs namespaces words sorting layouts sequences arrays vectors assocs namespaces words sorting layouts
math hashtables kernel.private ; math hashtables kernel.private sets ;
IN: classes.algebra IN: classes.algebra
: 2cache ( key1 key2 assoc quot -- value ) : 2cache ( key1 key2 assoc quot -- value )

View File

@ -3,7 +3,7 @@
IN: combinators IN: combinators
USING: arrays sequences sequences.private math.private USING: arrays sequences sequences.private math.private
kernel kernel.private math assocs quotations vectors kernel kernel.private math assocs quotations vectors
hashtables sorting words ; hashtables sorting words sets ;
: cleave ( x seq -- ) : cleave ( x seq -- )
[ call ] with each ; [ call ] with each ;

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic kernel kernel.private math memory USING: arrays generic kernel kernel.private math memory
namespaces sequences layouts system hashtables classes alien namespaces sequences layouts system hashtables classes alien
byte-arrays bit-arrays float-arrays combinators words ; byte-arrays bit-arrays float-arrays combinators words sets ;
IN: cpu.architecture IN: cpu.architecture
! A pseudo-register class for parameters spilled on the stack ! A pseudo-register class for parameters spilled on the stack

View File

@ -4,7 +4,7 @@ USING: arrays assocs classes classes.private classes.algebra
combinators cpu.architecture generator.fixup hashtables kernel combinators cpu.architecture generator.fixup hashtables kernel
layouts math namespaces quotations sequences system vectors layouts math namespaces quotations sequences system vectors
words effects alien byte-arrays bit-arrays float-arrays words effects alien byte-arrays bit-arrays float-arrays
accessors ; accessors sets ;
IN: generator.registers IN: generator.registers
SYMBOL: +input+ SYMBOL: +input+

View File

@ -49,11 +49,7 @@ $nl
ARTICLE: "hashtables.utilities" "Hashtable utilities" ARTICLE: "hashtables.utilities" "Hashtable utilities"
"Utility words to create a new hashtable from a single key/value pair:" "Utility words to create a new hashtable from a single key/value pair:"
{ $subsection associate } { $subsection associate }
{ $subsection ?set-at } { $subsection ?set-at } ;
"The final two words pertain to sequences but use a hashtable internally. Removing duplicate elements from a sequence in linear time, using a hashtable:"
{ $subsection prune }
"Test if a sequence contains duplicates in linear time:"
{ $subsection all-unique? } ;
ABOUT: "hashtables" ABOUT: "hashtables"
@ -138,15 +134,6 @@ HELP: >hashtable
{ $values { "assoc" "an assoc" } { "hashtable" "a hashtable" } } { $values { "assoc" "an assoc" } { "hashtable" "a hashtable" } }
{ $description "Constructs a hashtable from any assoc." } ; { $description "Constructs a hashtable from any assoc." } ;
HELP: all-unique?
{ $values { "seq" sequence } { "?" "a boolean" } }
{ $description "Tests whether a sequence contains any repeated elements." }
{ $example
"USING: hashtables prettyprint ;"
"{ 0 1 1 2 3 5 } all-unique? ."
"f"
} ;
HELP: rehash HELP: rehash
{ $values { "hash" hashtable } } { $values { "hash" hashtable } }
{ $description "Rebuild the hashtable. This word should be called if the hashcodes of the hashtable's keys have changed, or if the hashing algorithms themselves have changed, neither of which should occur during normal operation." } ; { $description "Rebuild the hashtable. This word should be called if the hashcodes of the hashtable's keys have changed, or if the hashing algorithms themselves have changed, neither of which should occur during normal operation." } ;

View File

@ -164,6 +164,3 @@ H{ } "x" set
[ { "one" "two" 3 } ] [ [ { "one" "two" 3 } ] [
{ 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute { 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute
] unit-test ] unit-test
[ f ] [ { 0 1 1 2 3 5 } all-unique? ] unit-test
[ t ] [ { 0 1 2 3 4 5 } all-unique? ] unit-test

View File

@ -174,18 +174,4 @@ M: hashtable assoc-like
: ?set-at ( value key assoc/f -- assoc ) : ?set-at ( value key assoc/f -- assoc )
[ [ set-at ] keep ] [ associate ] if* ; [ [ set-at ] keep ] [ associate ] if* ;
: (prune) ( hash vec elt -- )
rot 2dup key?
[ 3drop ] [ dupd dupd set-at swap push ] if ; inline
M: sequence prune ( seq -- newseq )
[ length <hashtable> ]
[ length <vector> ]
[ ] tri
[ >r 2dup r> (prune) ] each nip ;
: all-unique? ( seq -- ? )
[ length ]
[ prune length ] bi = ;
INSTANCE: hashtable assoc INSTANCE: hashtable assoc

View File

@ -3,7 +3,7 @@
USING: arrays kernel words sequences generic math namespaces USING: arrays kernel words sequences generic math namespaces
quotations assocs combinators math.bitfields inference.backend quotations assocs combinators math.bitfields inference.backend
inference.dataflow inference.state classes.tuple.private effects inference.dataflow inference.state classes.tuple.private effects
inspector hashtables classes generic ; inspector hashtables classes generic sets ;
IN: inference.transforms IN: inference.transforms
: pop-literals ( n -- rstate seq ) : pop-literals ( n -- rstate seq )

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic hashtables io kernel assocs math USING: arrays generic hashtables io kernel assocs math
namespaces prettyprint sequences strings io.styles vectors words namespaces prettyprint sequences strings io.styles vectors words
quotations mirrors splitting math.parser classes vocabs refs ; quotations mirrors splitting math.parser classes vocabs refs
sets ;
IN: inspector IN: inspector
GENERIC: summary ( object -- string ) GENERIC: summary ( object -- string )

View File

@ -5,7 +5,7 @@ prettyprint sequences strings vectors words quotations inspector
io.styles io combinators sorting splitting math.parser effects io.styles io combinators sorting splitting math.parser effects
continuations debugger io.files io.streams.string vocabs continuations debugger io.files io.streams.string vocabs
io.encodings.utf8 source-files classes classes.tuple hashtables io.encodings.utf8 source-files classes classes.tuple hashtables
compiler.errors compiler.units accessors ; compiler.errors compiler.units accessors sets ;
IN: parser IN: parser
TUPLE: lexer text line line-text line-length column ; TUPLE: lexer text line line-text line-length column ;

View File

@ -7,7 +7,8 @@ vectors words prettyprint.backend prettyprint.sections
prettyprint.config sorting splitting math.parser vocabs prettyprint.config sorting splitting math.parser vocabs
definitions effects classes.builtin classes.tuple io.files definitions effects classes.builtin classes.tuple io.files
classes continuations hashtables classes.mixin classes.union classes continuations hashtables classes.mixin classes.union
classes.predicate classes.singleton combinators quotations ; classes.predicate classes.singleton combinators quotations
sets ;
: make-pprint ( obj quot -- block in use ) : make-pprint ( obj quot -- block in use )
[ [

View File

@ -234,6 +234,7 @@ $nl
{ $subsection "sequences-destructive" } { $subsection "sequences-destructive" }
{ $subsection "sequences-stacks" } { $subsection "sequences-stacks" }
{ $subsection "sequences-sorting" } { $subsection "sequences-sorting" }
{ $subsection "sets" }
"For inner loops:" "For inner loops:"
{ $subsection "sequences-unsafe" } ; { $subsection "sequences-unsafe" } ;
@ -660,34 +661,6 @@ HELP: prefix
{ $example "USING: prettyprint sequences ;" "{ 1 2 3 } 0 prefix ." "{ 0 1 2 3 }" } { $example "USING: prettyprint sequences ;" "{ 1 2 3 } 0 prefix ." "{ 0 1 2 3 }" }
} ; } ;
HELP: prune
{ $values { "seq" "a sequence" } { "newseq" "a sequence" } }
{ $description "Outputs a new sequence with each distinct element of " { $snippet "seq" } " appearing only once. Elements are compared for equality using " { $link = } " and elements are ordered according to their position in " { $snippet "seq" } "." }
{ $examples
{ $example "USING: sequences prettyprint ;" "{ 1 1 t 3 t } prune ." "V{ 1 t 3 }" }
} ;
HELP: diff
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq2" } " but not " { $snippet "seq1" } ", comparing elements for equality." }
{ $examples
{ $example "USING: sequences prettyprint ;" "{ 1 2 3 } { 2 3 4 } diff ." "{ 4 }" }
} ;
HELP: intersect
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
{ $description "Outputs a sequence consisting of elements present in both " { $snippet "seq1" } " and " { $snippet "seq2" } "." }
{ $examples
{ $example "USING: sequences prettyprint ;" "{ 1 2 3 } { 2 3 4 } union ." "{ 1 2 3 4 }" }
} ;
HELP: union
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq1" } " and " { $snippet "seq2" } " which does not contain duplicate values." }
{ $examples
{ $example "USING: sequences prettyprint ;" "{ 1 2 3 } { 2 3 4 } union ." "{ 1 2 3 4 }" }
} ;
HELP: sum-lengths HELP: sum-lengths
{ $values { "seq" "a sequence of sequences" } { "n" integer } } { $values { "seq" "a sequence of sequences" } { "n" integer } }
{ $description "Outputs the sum of the lengths of all sequences in " { $snippet "seq" } "." } ; { $description "Outputs the sum of the lengths of all sequences in " { $snippet "seq" } "." } ;

View File

@ -260,9 +260,5 @@ unit-test
[ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test [ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test
[ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test [ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test
[ { 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test
[ { 4 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
! Hardcore ! Hardcore
[ ] [ "sequences" reload ] unit-test [ ] [ "sequences" reload ] unit-test

View File

@ -444,17 +444,6 @@ PRIVATE>
: memq? ( obj seq -- ? ) : memq? ( obj seq -- ? )
[ eq? ] with contains? ; [ eq? ] with contains? ;
: diff ( seq1 seq2 -- newseq )
swap [ member? not ] curry subset ;
: intersect ( seq1 seq2 -- newseq )
swap [ member? ] curry subset ;
GENERIC: prune ( obj -- obj' )
: union ( seq1 seq2 -- newseq )
append prune ;
: remove ( obj seq -- newseq ) : remove ( obj seq -- newseq )
[ = not ] with subset ; [ = not ] with subset ;

View File

@ -0,0 +1,56 @@
USING: kernel help.markup help.syntax sequences ;
IN: sets
ARTICLE: "sets" "Set theoretic operations"
"Remove duplicates:"
{ $subsection prune }
"Test for duplicates:"
{ $subsection all-unique? }
"Set operations on sequences:"
{ $subsection diff }
{ $subsection intersect }
{ $subsection union } ;
HELP: unique
{ $values { "seq" "a sequence" } { "assoc" "an assoc" } }
{ $description "Outputs a new assoc where the keys and values are equal." }
{ $examples
{ $example "USING: sets prettyprint ;" "{ 1 1 2 2 3 3 } unique ." "H{ { 1 1 } { 2 2 } { 3 3 } }" }
} ;
HELP: prune
{ $values { "seq" "a sequence" } { "newseq" "a sequence" } }
{ $description "Outputs a new sequence with each distinct element of " { $snippet "seq" } " appearing only once. Elements are compared for equality using " { $link = } " and elements are ordered according to their position in " { $snippet "seq" } "." }
{ $examples
{ $example "USING: sequences prettyprint ;" "{ 1 1 t 3 t } prune ." "V{ 1 t 3 }" }
} ;
HELP: all-unique?
{ $values { "seq" sequence } { "?" "a boolean" } }
{ $description "Tests whether a sequence contains any repeated elements." }
{ $example
"USING: hashtables prettyprint ;"
"{ 0 1 1 2 3 5 } all-unique? ."
"f"
} ;
HELP: diff
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq2" } " but not " { $snippet "seq1" } ", comparing elements for equality."
} { $examples
{ $example "USING: sequences prettyprint ;" "{ 1 2 3 } { 2 3 4 } diff ." "{ 4 }" }
} ;
HELP: intersect
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
{ $description "Outputs a sequence consisting of elements present in both " { $snippet "seq1" } " and " { $snippet "seq2" } "." }
{ $examples
{ $example "USING: sequences prettyprint ;" "{ 1 2 3 } { 2 3 4 } intersect ." "{ 2 3 }" }
} ;
HELP: union
{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq1" } " and " { $snippet "seq2" } " which does not contain duplicate values." }
{ $examples
{ $example "USING: sequences prettyprint ;" "{ 1 2 3 } { 2 3 4 } union ." "{ 1 2 3 4 }" }
} ;

View File

@ -0,0 +1,17 @@
USING: kernel sets tools.test ;
IN: sets.tests
[ f ] [ { 0 1 1 2 3 5 } all-unique? ] unit-test
[ t ] [ { 0 1 2 3 4 5 } all-unique? ] unit-test
[ V{ 1 2 3 } ] [ { 1 2 2 3 3 } prune ] unit-test
[ V{ 3 2 1 } ] [ { 3 3 2 2 1 } prune ] unit-test
[ { } ] [ { } { } intersect ] unit-test
[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
[ { } ] [ { } { } diff ] unit-test
[ { 4 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
[ V{ } ] [ { } { } union ] unit-test
[ V{ 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test

31
core/sets/sets.factor Normal file
View File

@ -0,0 +1,31 @@
! Copyright (C) 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs hashtables kernel sequences vectors ;
IN: sets
: (prune) ( elt hash vec -- )
3dup drop key?
[ [ drop dupd set-at ] [ nip push ] [ ] 3tri ] unless
3drop ; inline
: prune ( seq -- newseq )
[ ] [ length <hashtable> ] [ length <vector> ] tri
[ [ (prune) ] 2curry each ] keep ;
: unique ( seq -- assoc )
[ dup ] H{ } map>assoc ;
: (all-unique?) ( elt hash -- ? )
2dup key? [ 2drop f ] [ dupd set-at t ] if ;
: all-unique? ( seq -- ? )
dup length <hashtable> [ (all-unique?) ] curry all? ;
: intersect ( seq1 seq2 -- newseq )
unique [ key? ] curry subset ;
: diff ( seq1 seq2 -- newseq )
swap unique [ key? not ] curry subset ;
: union ( seq1 seq2 -- newseq )
append prune ;

View File

@ -1,6 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov. ! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math namespaces strings arrays vectors sequences ; USING: kernel math namespaces strings arrays vectors sequences
sets ;
IN: splitting IN: splitting
TUPLE: groups seq n sliced? ; TUPLE: groups seq n sliced? ;