}
} ;
-HELP: sequence>assoc
-{ $values
- { "seq" sequence } { "map-quot" quotation } { "insert-quot" quotation } { "exemplar" "an exemplar assoc" }
- { "assoc" assoc }
-}
-{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a newly created " { $snippet "assoc" } ". The " { $snippet "map-quot" } " gets passed each element from the sequence. Its outputs are passed along with the assoc being constructed to the " { $snippet "insert-quot" } ", which can modify the assoc in response." }
-{ $examples
- { $example "! Iterate over a sequence and increment the count at each element"
- "! The first quotation has stack effect ( key -- key ), a no-op"
- "USING: assocs prettyprint kernel math.statistics ;"
- "\"aaabc\" [ ] [ inc-at ] H{ } sequence>assoc ."
- "H{ { 97 3 } { 98 1 } { 99 1 } }"
- }
-} ;
-
-HELP: sequence>assoc!
-{ $values
- { "assoc" assoc } { "seq" sequence } { "map-quot" quotation } { "insert-quot" quotation } }
-{ $description "Iterates over a sequence, allowing elements of the sequence to be added to an existing " { $snippet "assoc" } ". The " { $snippet "map-quot" } " gets passed each element from the sequence. Its outputs are passed along with the assoc being constructed to the " { $snippet "insert-quot" } ", which can modify the assoc in response." }
-{ $examples
- { $example "! Iterate over a sequence and add the counts to an existing assoc"
- "USING: assocs prettyprint math.statistics kernel ;"
- "H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ ] [ inc-at ] sequence>assoc! ."
- "H{ { 97 5 } { 98 2 } { 99 1 } }"
- }
-} ;
-
-HELP: sequence>hashtable
-{ $values
- { "seq" sequence } { "map-quot" quotation } { "insert-quot" quotation }
- { "hashtable" hashtable }
-}
-{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a newly created hashtable. The " { $snippet "map-quot" } " gets passed each element from the sequence. Its outputs are passed along with the assoc being constructed to the " { $snippet "insert-quot" } ", which can modify the assoc in response." }
-{ $examples
- { $example "! Count the number of times an element occurs in a sequence"
- "USING: assocs kernel prettyprint math.statistics ;"
- "\"aaabc\" [ ] [ inc-at ] sequence>hashtable ."
- "H{ { 97 3 } { 98 1 } { 99 1 } }"
- }
-} ;
-
HELP: cum-sum
{ $values { "seq" sequence } { "seq'" sequence } }
{ $description "Returns the cumulative sum of " { $snippet "seq" } "." }
} ;
HELP: cum-count
-{ $values { "seq" sequence } { "quot" quotation } { "seq'" sequence } }
+{ $values { "seq" sequence } { "quot" { $quotation ( elt -- ? ) } } { "seq'" sequence } }
{ $description "Returns the cumulative count of how many times " { $snippet "quot" } " returns true." }
{ $examples
{ $example "USING: math math.statistics prettyprint ;"
{ $values { "u" sequence } { "v" sequence } }
{ $description "Returns " { $snippet "u" } " rescaled to run from 0 to 1 over the range min to max." } ;
-HELP: collect-by
-{ $values
- { "seq" sequence } { "quot" { $quotation ( ... obj -- ... key ) } }
- { "hashtable" hashtable }
-}
-{ $description "Applies a quotation to each element in the input sequence and returns a " { $snippet "hashtable" } " of like elements. The keys of this " { $snippet "hashtable" } " are the output of " { $snippet "quot" } " and the values at each key are the elements that transformed to that key." }
-{ $examples
- "Collect even and odd elements:"
- { $example
- "USING: math math.statistics prettyprint ;"
- "{ 11 12 13 14 14 13 12 11 } [ odd? ] collect-by ."
- "H{ { t V{ 11 13 13 11 } } { f V{ 12 14 14 12 } } }"
- }
-}
-{ $notes "May be named " { $snippet "group-by" } " in other languages." } ;
-
-HELP: collect-index-by
-{ $values
- { "seq" sequence } { "quot" { $quotation ( ... obj -- ... key ) } }
- { "hashtable" hashtable }
-}
-{ $description "Applies a quotation to each element in the input sequence and returns a " { $snippet "hashtable" } " of like elements. The keys of this " { $snippet "hashtable" } " are the output of " { $snippet "quot" } " and the values at each key are the indices for the elements that transformed to that key." }
-{ $examples
- "Collect even and odd elements:"
- { $example
- "USING: math math.statistics prettyprint ;"
- "{ 11 12 13 14 14 13 12 11 } [ odd? ] collect-index-by ."
- "H{ { t V{ 0 2 5 7 } } { f V{ 1 3 4 6 } } }"
- }
-} ;
-
HELP: z-score
{ $values { "seq" sequence } { "n" number } }
{ $description "Calculates the Z-Score for " { $snippet "seq" } "." } ;
histogram-by
histogram!
sorted-histogram
-}
-"Combinators for implementing histogram:"
-{ $subsections
- sequence>assoc
- sequence>assoc!
- sequence>hashtable
} ;
ARTICLE: "cumulative" "Computing cumulative sequences"
{ $subsections kth-smallest }
"Counting the frequency of occurrence of elements:"
{ $subsections "histogram" }
-"Collecting related items:"
-{ $subsections collect-by collect-index-by }
"Computing cumulative sequences:"
{ $subsections "cumulative" } ;
{ H{ { 1 1/2 } { 2 1/6 } { 3 1/3 } } }
[ { 1 1 1 1 1 1 2 2 3 3 3 3 } normalized-histogram ] unit-test
-{
- V{ 0 3 6 9 }
- V{ 1 4 7 }
- V{ 2 5 8 }
-} [
- 10 iota [ 3 mod ] collect-by
- [ 0 of ] [ 1 of ] [ 2 of ] tri
-] unit-test
-
{ 0 } [ { 1 } { 1 } sample-cov ] unit-test
{ 2/3 } [ { 1 2 3 } { 4 5 6 } population-cov ] unit-test
{ { 1 2 6 } }
[ { 2 3 4 } cum-product1 ] unit-test
-{
- H{
- { 0 V{ 600 603 606 609 } }
- { 1 V{ 601 604 607 610 } }
- { 2 V{ 602 605 608 } }
- }
-}
-[ 600 610 [a,b] [ 3 mod ] collect-by ] unit-test
-
-
-{
- H{ { 0 V{ 0 3 6 9 } } { 1 V{ 1 4 7 10 } } { 2 V{ 2 5 8 } } }
-}
-[ 600 610 [a,b] [ 3 mod ] collect-index-by ] unit-test
-
-
{ { 1 } } [
{ 1 2 3 4 5 10 21 12 12 12 12203 3403 030 3022 2 2 }
{ 1/1000 } quantile5
! Copyright (C) 2008 Doug Coleman, Michael Judge, Loryn Jenkins.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs combinators generalizations kernel locals math
-math.functions math.order math.vectors math.ranges sequences
-sequences.private sorting fry arrays grouping sets
-splitting.monotonic ;
+USING: arrays assocs combinators fry generalizations grouping
+kernel locals math math.functions math.order math.vectors
+sequences sequences.private sorting ;
IN: math.statistics
: power-mean ( seq p -- x )
: trimean ( seq -- x )
quartile first3 [ 2 * ] dip + + 4 / ;
-<PRIVATE
-
-: (sequence>assoc) ( seq map-quot insert-quot assoc -- assoc )
- [ swap curry compose each ] keep ; inline
-
-: (sequence-index>assoc) ( seq map-quot insert-quot assoc -- assoc )
- [ swap curry compose each-index ] keep ; inline
-
-PRIVATE>
-
-: sequence>assoc! ( assoc seq map-quot: ( x -- ..y ) insert-quot: ( ..y assoc -- ) -- assoc )
- 4 nrot (sequence>assoc) ; inline
-
-: sequence>assoc ( seq map-quot insert-quot exemplar -- assoc )
- clone (sequence>assoc) ; inline
-
-: sequence-index>assoc ( seq map-quot insert-quot exemplar -- assoc )
- clone (sequence-index>assoc) ; inline
-
-: sequence-index>hashtable ( seq map-quot insert-quot -- hashtable )
- H{ } sequence-index>assoc ; inline
-
-: sequence>hashtable ( seq map-quot insert-quot -- hashtable )
- H{ } sequence>assoc ; inline
-
: histogram! ( hashtable seq -- hashtable )
- [ ] [ inc-at ] sequence>assoc! ;
+ over '[ _ inc-at ] each ;
: histogram-by ( seq quot: ( x -- bin ) -- hashtable )
- [ inc-at ] sequence>hashtable ; inline
+ H{ } clone [ '[ @ _ inc-at ] each ] keep ; inline
: histogram ( seq -- hashtable )
[ ] histogram-by ;
: normalized-histogram ( seq -- alist )
[ histogram ] [ length ] bi '[ _ / ] assoc-map ;
-: collect-index-by ( ... seq quot: ( ... obj -- ... key ) -- ... hashtable )
- [ dip swap ] curry [ push-at ] sequence-index>hashtable ; inline
-
-: collect-by ( ... seq quot: ( ... obj -- ... key ) -- ... hashtable )
- [ keep swap ] curry [ push-at ] sequence>hashtable ; inline
-
: equal-probabilities ( n -- array )
dup recip <array> ; inline
: cum-mean ( seq -- seq' )
0 swap [ [ + dup ] dip 1 + / ] map-index nip ;
-: cum-count ( seq quot -- seq' )
- [ 0 ] dip '[ _ call [ 1 + ] when ] accumulate* ; inline
+: cum-count ( seq quot: ( elt -- ? ) -- seq' )
+ [ 0 ] dip '[ @ [ 1 + ] when ] accumulate* ; inline
: cum-min ( seq -- seq' )
dup ?first [ min ] accumulate* ;
{ $description "Zip a sequence with its index and return an associative list of type " { $snippet "exemplar" } " where the input sequence is the keys and the indices are the values." } ;
{ unzip zip zip-as zip-index zip-index-as } related-words
+
+HELP: collect-by
+{ $values
+ { "seq" sequence } { "quot" { $quotation ( ... obj -- ... key ) } }
+ { "assoc" assoc }
+}
+{ $description "Applies a quotation to each element in the input sequence and returns a " { $snippet "hashtable" } " of like elements. The keys of this " { $snippet "hashtable" } " are the output of " { $snippet "quot" } " and the values at each key are the elements that transformed to that key." }
+{ $examples
+ "Collect even and odd elements:"
+ { $example
+ "USING: assocs math prettyprint ;"
+ "{ 11 12 13 14 14 13 12 11 } [ odd? ] collect-by ."
+ "H{ { t V{ 11 13 13 11 } } { f V{ 12 14 14 12 } } }"
+ }
+ "Collect strings by length:"
+ { $example
+ "USING: assocs prettyprint sequences ;"
+ "{ \"one\" \"two\" \"three\" \"four\" \"five\" } [ length ] collect-by ."
+ "H{\n { 3 V{ \"one\" \"two\" } }\n { 4 V{ \"four\" \"five\" } }\n { 5 V{ \"three\" } }\n}"
+ }
+} ;
-USING: alien.c-types assocs kernel make math namespaces
+USING: alien.c-types ascii assocs kernel make math namespaces
sequences specialized-arrays tools.test ;
IN: assocs.tests
SPECIALIZED-ARRAY: double
{
V{ { 11 0 } { 22 1 } { 33 2 } }
} [ { 11 22 33 } V{ } zip-index-as ] unit-test
+
+{
+ H{
+ { 0 V{ 0 3 6 9 } }
+ { 1 V{ 1 4 7 } }
+ { 2 V{ 2 5 8 } }
+ }
+} [
+ 10 iota [ 3 mod ] collect-by
+] unit-test
: unzip ( assoc -- keys values )
dup assoc-empty? [ drop { } { } ] [ >alist flip first2 ] if ;
+: collect-by ( ... seq quot: ( ... obj -- ... key ) -- ... assoc )
+ [ keep swap ] curry H{ } clone [
+ [ push-at ] curry compose each
+ ] keep ; inline
+
M: sequence at*
search-alist [ second t ] [ f ] if ;
[ [ line#>> 0 or ] sort-with ] { } assoc-map-as sort-keys ;
: group-by-source-file ( errors -- assoc )
- H{ } clone [ [ push-at ] curry [ dup path>> ] prepose each ] keep ;
+ [ path>> ] collect-by ;
TUPLE: error-type-holder type word plural icon quot forget-quot { fatal? initial: t } ;
! See http://factorcode.org/license.txt for BSD license
USING: ascii assocs fry io.encodings.ascii io.files kernel math
-math.statistics memoize sequences sequences.extras sorting sets ;
+memoize sequences sequences.extras sorting sets ;
IN: anagrams
: make-anagram-hash ( strings -- assoc )
! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs definitions help.topics io.pathnames
-kernel math math.order math.statistics memoize namespaces sequences sets
-sorting tools.completion tools.crossref vocabs vocabs.parser
-vocabs.hierarchy words ;
+USING: accessors arrays assocs definitions help.topics
+io.pathnames kernel memoize namespaces sequences sets sorting
+tools.completion tools.crossref vocabs vocabs.hierarchy
+vocabs.parser words ;
IN: fuel.xref
: equal-stratified-sample ( stratified-sequences -- elt )
random random ; inline
+: collect-indices ( seq -- indices )
+ H{ } clone [ '[ swap _ push-at ] each-index ] keep ;
+
: balance-labels ( X y n -- X' y' )
[
- dup [ ] collect-index-by
+ dup collect-indices
values '[
_ _ _ equal-stratified-sample
'[ _ swap nth ] bi@ 2array
: skew-labels ( X y probs n -- X' y' )
[
- [ dup [ ] collect-index-by sort-keys values ] dip
+ [ dup collect-indices sort-keys values ] dip
'[
_ _ _ _ stratified-sample
'[ _ swap nth ] bi@ 2array
USING: accessors assocs calendar calendar.elapsed
colors.constants colors.hex combinators formatting fry
http.client io io.styles json json.reader kernel make math
-math.statistics sequences urls ;
+sequences urls ;
IN: reddit
! Copyright (c) 2012 Anonymous
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs fry io kernel math.parser sequences
-sorting math.statistics ;
+USING: accessors assocs io kernel math.parser sequences
+sorting ;
IN: rosetta-code.top-rank
! http://rosettacode.org/wiki/Top_rank_per_group
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators combinators.short-circuit
-combinators.smart fry io.encodings.utf8 io.files kernel
-math.parser math.statistics memoize namespaces sequences
-splitting unicode calendar arrays ;
+USING: accessors arrays assocs calendar combinators
+combinators.smart io.encodings.utf8 io.files kernel math.parser
+memoize namespaces sequences splitting unicode ;
IN: zoneinfo
CONSTANT: zoneinfo-paths
projects / factor.git / commitdiff