H{ } clone compiled set
[ queue-compile ] each
compile-queue get compile-loop
- compiled get >alist
+ compiled get >alist >array
] with-scope ;
: enable-compiler ( -- )
--- /dev/null
+Slava Pestov
--- /dev/null
+USING: help.markup help.syntax sequences strings ;
+IN: grouping
+
+ARTICLE: "grouping" "Groups and clumps"
+"Splitting a sequence into disjoint, fixed-length subsequences:"
+{ $subsection group }
+"A virtual sequence for splitting a sequence into disjoint, fixed-length subsequences:"
+{ $subsection groups }
+{ $subsection <groups> }
+{ $subsection <sliced-groups> }
+"Splitting a sequence into overlapping, fixed-length subsequences:"
+{ $subsection clump }
+"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:"
+{ $subsection clumps }
+{ $subsection <clumps> }
+{ $subsection <sliced-clumps> }
+"The difference can be summarized as the following:"
+{ $list
+ { "With groups, the subsequences form the original sequence when concatenated:"
+ { $unchecked-example "dup n groups concat sequence= ." "t" }
+ }
+ { "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:"
+ { $unchecked-example "dup n clumps unclip-last >r [ first ] map r> append sequence= ." "t" }
+ }
+} ;
+
+ABOUT: "grouping"
+
+HELP: groups
+{ $class-description "Instances are virtual sequences whose elements are disjoint fixed-length subsequences of an underlying sequence. Groups are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
+$nl
+"New groups are created by calling " { $link <groups> } " and " { $link <sliced-groups> } "." }
+{ $see-also group } ;
+
+HELP: group
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
+{ $description "Splits the sequence into disjoint groups of " { $snippet "n" } " elements and collects the groups into a new array." }
+{ $notes "If the sequence length is not a multiple of " { $snippet "n" } ", the final subsequence in the list will be shorter than " { $snippet "n" } " elements." }
+{ $examples
+ { $example "USING: grouping prettyprint ;" "{ 3 1 3 3 7 } 2 group ." "{ { 3 1 } { 3 3 } { 7 } }" }
+} ;
+
+HELP: <groups>
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
+{ $description "Outputs a virtual sequence whose elements are disjoint subsequences of " { $snippet "n" } " elements from the underlying sequence." }
+{ $examples
+ { $example
+ "USING: arrays kernel prettyprint sequences grouping ;"
+ "9 >array 3 <groups> dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }"
+ }
+} ;
+
+HELP: <sliced-groups>
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
+{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
+{ $examples
+ { $example
+ "USING: arrays kernel prettyprint sequences grouping ;"
+ "9 >array 3 <sliced-groups>"
+ "dup [ reverse-here ] each concat >array ."
+ "{ 2 1 0 5 4 3 8 7 6 }"
+ }
+} ;
+
+HELP: clumps
+{ $class-description "Instances are virtual sequences whose elements are overlapping fixed-length subsequences o an underlying sequence. Clumps are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
+$nl
+"New clumps are created by calling " { $link <clumps> } " and " { $link <sliced-clumps> } "." } ;
+
+HELP: clump
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
+{ $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements and collects the clumps into a new array." }
+{ $errors "Throws an error if " { $snippet "n" } " is smaller than the length of the sequence." }
+{ $examples
+ { $example "USING: grouping prettyprint ;" "{ 3 1 3 3 7 } 2 clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } }" }
+} ;
+
+HELP: <clumps>
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
+{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
+{ $examples
+ "Running averages:"
+ { $example
+ "USING: grouping sequences math prettyprint kernel ;"
+ "IN: scratchpad"
+ ": share-price"
+ " { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 } ;"
+ ""
+ "share-price 4 <clumps> [ [ sum ] [ length ] bi / ] map ."
+ "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }"
+ }
+} ;
+
+HELP: <sliced-clumps>
+{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
+{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." } ;
+
+{ clumps groups } related-words
+
+{ clump group } related-words
+
+{ <clumps> <groups> } related-words
+
+{ <sliced-clumps> <sliced-groups> } related-words
--- /dev/null
+USING: grouping tools.test kernel sequences arrays ;
+IN: grouping.tests
+
+[ { 1 2 3 } 0 group ] must-fail
+
+[ { "hell" "o wo" "rld" } ] [ "hello world" 4 group ] unit-test
+
+[ { V{ "a" "b" } V{ f f } } ] [
+ V{ "a" "b" } clone 2 <groups>
+ 2 over set-length
+ >array
+] unit-test
+
+[ { { 1 2 } { 2 3 } } ] [ { 1 2 3 } 2 <sliced-clumps> [ >array ] map ] unit-test
--- /dev/null
+! Copyright (C) 2005, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.order strings arrays vectors sequences
+sequences.private accessors ;
+IN: grouping
+
+<PRIVATE
+
+TUPLE: chunking-seq { seq read-only } { n read-only } ;
+
+: check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline
+
+: new-groups ( seq n class -- groups )
+ >r check-groups r> boa ; inline
+
+GENERIC: group@ ( n groups -- from to seq )
+
+M: chunking-seq set-nth group@ <slice> 0 swap copy ;
+
+M: chunking-seq like drop { } like ;
+
+INSTANCE: chunking-seq sequence
+
+MIXIN: subseq-chunking
+
+M: subseq-chunking nth group@ subseq ;
+
+MIXIN: slice-chunking
+
+M: slice-chunking nth group@ <slice> ;
+
+M: slice-chunking nth-unsafe group@ slice boa ;
+
+TUPLE: abstract-groups < chunking-seq ;
+
+M: abstract-groups length
+ [ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
+
+M: abstract-groups set-length
+ [ n>> * ] [ seq>> ] bi set-length ;
+
+M: abstract-groups group@
+ [ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ;
+
+TUPLE: abstract-clumps < chunking-seq ;
+
+M: abstract-clumps length
+ [ seq>> length ] [ n>> ] bi - 1+ ;
+
+M: abstract-clumps set-length
+ [ n>> + 1- ] [ seq>> ] bi set-length ;
+
+M: abstract-clumps group@
+ [ n>> over + ] [ seq>> ] bi ;
+
+PRIVATE>
+
+TUPLE: groups < abstract-groups ;
+
+: <groups> ( seq n -- groups )
+ groups new-groups ; inline
+
+INSTANCE: groups subseq-chunking
+
+TUPLE: sliced-groups < abstract-groups ;
+
+: <sliced-groups> ( seq n -- groups )
+ sliced-groups new-groups ; inline
+
+INSTANCE: sliced-groups slice-chunking
+
+TUPLE: clumps < abstract-clumps ;
+
+: <clumps> ( seq n -- clumps )
+ clumps new-groups ; inline
+
+INSTANCE: clumps subseq-chunking
+
+TUPLE: sliced-clumps < abstract-clumps ;
+
+: <sliced-clumps> ( seq n -- clumps )
+ sliced-clumps new-groups ; inline
+
+INSTANCE: sliced-clumps slice-chunking
+
+: group ( seq n -- array ) <groups> { } like ;
+
+: clump ( seq n -- array ) <clumps> { } like ;
--- /dev/null
+Grouping sequence elements into subsequences
--- /dev/null
+collections
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: help.markup help.syntax sequences strings ;
-IN: grouping
-
-ARTICLE: "grouping" "Groups and clumps"
-"Splitting a sequence into disjoint, fixed-length subsequences:"
-{ $subsection group }
-"A virtual sequence for splitting a sequence into disjoint, fixed-length subsequences:"
-{ $subsection groups }
-{ $subsection <groups> }
-{ $subsection <sliced-groups> }
-"Splitting a sequence into overlapping, fixed-length subsequences:"
-{ $subsection clump }
-"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:"
-{ $subsection clumps }
-{ $subsection <clumps> }
-{ $subsection <sliced-clumps> }
-"The difference can be summarized as the following:"
-{ $list
- { "With groups, the subsequences form the original sequence when concatenated:"
- { $unchecked-example "dup n groups concat sequence= ." "t" }
- }
- { "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:"
- { $unchecked-example "dup n clumps unclip-last >r [ first ] map r> append sequence= ." "t" }
- }
-} ;
-
-ABOUT: "grouping"
-
-HELP: groups
-{ $class-description "Instances are virtual sequences whose elements are disjoint fixed-length subsequences of an underlying sequence. Groups are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
-$nl
-"New groups are created by calling " { $link <groups> } " and " { $link <sliced-groups> } "." }
-{ $see-also group } ;
-
-HELP: group
-{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
-{ $description "Splits the sequence into disjoint groups of " { $snippet "n" } " elements and collects the groups into a new array." }
-{ $notes "If the sequence length is not a multiple of " { $snippet "n" } ", the final subsequence in the list will be shorter than " { $snippet "n" } " elements." }
-{ $examples
- { $example "USING: grouping prettyprint ;" "{ 3 1 3 3 7 } 2 group ." "{ { 3 1 } { 3 3 } { 7 } }" }
-} ;
-
-HELP: <groups>
-{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
-{ $description "Outputs a virtual sequence whose elements are disjoint subsequences of " { $snippet "n" } " elements from the underlying sequence." }
-{ $examples
- { $example
- "USING: arrays kernel prettyprint sequences grouping ;"
- "9 >array 3 <groups> dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }"
- }
-} ;
-
-HELP: <sliced-groups>
-{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
-{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
-{ $examples
- { $example
- "USING: arrays kernel prettyprint sequences grouping ;"
- "9 >array 3 <sliced-groups>"
- "dup [ reverse-here ] each concat >array ."
- "{ 2 1 0 5 4 3 8 7 6 }"
- }
-} ;
-
-HELP: clumps
-{ $class-description "Instances are virtual sequences whose elements are overlapping fixed-length subsequences o an underlying sequence. Clumps are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
-$nl
-"New clumps are created by calling " { $link <clumps> } " and " { $link <sliced-clumps> } "." } ;
-
-HELP: clump
-{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
-{ $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements and collects the clumps into a new array." }
-{ $errors "Throws an error if " { $snippet "n" } " is smaller than the length of the sequence." }
-{ $examples
- { $example "USING: grouping prettyprint ;" "{ 3 1 3 3 7 } 2 clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } }" }
-} ;
-
-HELP: <clumps>
-{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
-{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
-{ $examples
- "Running averages:"
- { $example
- "USING: grouping sequences math prettyprint kernel ;"
- "IN: scratchpad"
- ": share-price"
- " { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 } ;"
- ""
- "share-price 4 <clumps> [ [ sum ] [ length ] bi / ] map ."
- "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }"
- }
-} ;
-
-HELP: <sliced-clumps>
-{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
-{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." } ;
-
-{ clumps groups } related-words
-
-{ clump group } related-words
-
-{ <clumps> <groups> } related-words
-
-{ <sliced-clumps> <sliced-groups> } related-words
+++ /dev/null
-USING: grouping tools.test kernel sequences arrays ;
-IN: grouping.tests
-
-[ { 1 2 3 } 0 group ] must-fail
-
-[ { "hell" "o wo" "rld" } ] [ "hello world" 4 group ] unit-test
-
-[ { V{ "a" "b" } V{ f f } } ] [
- V{ "a" "b" } clone 2 <groups>
- 2 over set-length
- >array
-] unit-test
-
-[ { { 1 2 } { 2 3 } } ] [ { 1 2 3 } 2 <sliced-clumps> [ >array ] map ] unit-test
+++ /dev/null
-! Copyright (C) 2005, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.order strings arrays vectors sequences
-sequences.private accessors ;
-IN: grouping
-
-<PRIVATE
-
-TUPLE: chunking-seq { seq read-only } { n read-only } ;
-
-: check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline
-
-: new-groups ( seq n class -- groups )
- >r check-groups r> boa ; inline
-
-GENERIC: group@ ( n groups -- from to seq )
-
-M: chunking-seq set-nth group@ <slice> 0 swap copy ;
-
-M: chunking-seq like drop { } like ;
-
-INSTANCE: chunking-seq sequence
-
-MIXIN: subseq-chunking
-
-M: subseq-chunking nth group@ subseq ;
-
-MIXIN: slice-chunking
-
-M: slice-chunking nth group@ <slice> ;
-
-M: slice-chunking nth-unsafe group@ slice boa ;
-
-TUPLE: abstract-groups < chunking-seq ;
-
-M: abstract-groups length
- [ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
-
-M: abstract-groups set-length
- [ n>> * ] [ seq>> ] bi set-length ;
-
-M: abstract-groups group@
- [ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ;
-
-TUPLE: abstract-clumps < chunking-seq ;
-
-M: abstract-clumps length
- [ seq>> length ] [ n>> ] bi - 1+ ;
-
-M: abstract-clumps set-length
- [ n>> + 1- ] [ seq>> ] bi set-length ;
-
-M: abstract-clumps group@
- [ n>> over + ] [ seq>> ] bi ;
-
-PRIVATE>
-
-TUPLE: groups < abstract-groups ;
-
-: <groups> ( seq n -- groups )
- groups new-groups ; inline
-
-INSTANCE: groups subseq-chunking
-
-TUPLE: sliced-groups < abstract-groups ;
-
-: <sliced-groups> ( seq n -- groups )
- sliced-groups new-groups ; inline
-
-INSTANCE: sliced-groups slice-chunking
-
-TUPLE: clumps < abstract-clumps ;
-
-: <clumps> ( seq n -- clumps )
- clumps new-groups ; inline
-
-INSTANCE: clumps subseq-chunking
-
-TUPLE: sliced-clumps < abstract-clumps ;
-
-: <sliced-clumps> ( seq n -- clumps )
- sliced-clumps new-groups ; inline
-
-INSTANCE: sliced-clumps slice-chunking
-
-: group ( seq n -- array ) <groups> { } like ;
-
-: clump ( seq n -- array ) <clumps> { } like ;
+++ /dev/null
-Grouping sequence elements into subsequences
+++ /dev/null
-collections
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel kernel.private slots.private math
-assocs math.private sequences sequences.private vectors grouping ;
+assocs math.private sequences sequences.private vectors ;
IN: hashtables
TUPLE: hashtable
2 <hashtable> [ set-at ] keep ;
M: hashtable >alist
- array>> 2 <groups> [ first tombstone? not ] filter ;
+ array>> [ length 2/ ] keep V{ } clone [
+ [
+ >r
+ >r 1 fixnum-shift-fast r>
+ [ array-nth ] [ >r 1 fixnum+fast r> array-nth ] 2bi r>
+ pick tombstone? [ 3drop ] [ [ 2array ] dip push ] if
+ ] 2curry each
+ ] keep ;
M: hashtable clone
(clone) [ clone ] change-array ;
M: hashtable equal?
over hashtable? [
- 2dup [ assoc-size ] bi@ number=
+ 2dup [ assoc-size ] bi@ eq?
[ assoc= ] [ 2drop f ] if
] [ 2drop f ] if ;
projects / factor.git / commitdiff