From f2169afb899ee1abde4093cb19254157407bf33d Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 29 Oct 2009 16:15:26 +1300 Subject: [PATCH 01/12] Add example of usage to concurrency.distributed help --- .../distributed/distributed-docs.factor | 45 ++++++++++++++++++- 1 file changed, 44 insertions(+), 1 deletion(-) diff --git a/basis/concurrency/distributed/distributed-docs.factor b/basis/concurrency/distributed/distributed-docs.factor index 76c9918cca..4672043b36 100644 --- a/basis/concurrency/distributed/distributed-docs.factor +++ b/basis/concurrency/distributed/distributed-docs.factor @@ -8,11 +8,54 @@ HELP: start-node { $values { "port" "a port number between 0 and 65535" } } { $description "Starts a node server for receiving messages from remote Factor instances." } ; +ARTICLE: "concurrency.distributed.example" "Distributed Concurrency Example" +"For a Factor instance to be able to send and receive distributed " +"concurrency messages it must first have " { $link start-node } " called." +$nl +"In one factor instance call " { $link start-node } " with the port 9000, " +"and in another with the port 9001." +$nl +"In this example the Factor instance associated with port 9000 will run " +"a thread that sits receiving messages and printing the received message " +"in the listener. The code to start the thread is: " +{ $examples + { $unchecked-example + ": log-message ( -- ) receive . flush log-message ;" + "[ log-message ] \"logger\" spawn [ name>> ] keep register-process" + } +} +"This spawns a thread waits for the messages. It registers that thread as a " +"able to be accessed remotely using " { $link register-process } "." +$nl +"The second Factor instance, the one associated with port 9001, can send " +"messages to the 'logger' process by name:" +{ $examples + { $unchecked-example + "USING: io.sockets concurrency.messaging concurrency.distributed ;" + "\"hello\" \"logger\" \"127.0.0.1\" 9000 send" + } +} +"The " { $link send } " word is used to send messages to other threads. If an " +"instance of " { $link remote-process } " is provided instead of a thread then " +"the message is marshalled to the named process on the given machine using the " +{ $vocab-link "serialize" } " vocabulary." +$nl +"Running this code should show the message \"hello\" in the first Factor " +"instance." +$nl +"It is also possible to use " { $link send-synchronous } " to receive a " +"response to a distributed message. When an instance of " { $link thread } " " +"is marshalled it is converted into an instance of " { $link remote-process } +". The receiver of this can use it as the target of a " { $link send } +" or " { $link reply } " call." ; + ARTICLE: "concurrency.distributed" "Distributed message passing" "The " { $vocab-link "concurrency.distributed" } " implements transparent distributed message passing, inspired by Erlang and Termite." { $subsections start-node } "Instances of " { $link thread } " can be sent to remote processes, at which point they are converted to objects holding the thread ID and the current node's host name:" { $subsections remote-process } -"The " { $vocab-link "serialize" } " vocabulary is used to convert Factor objects to byte arrays for transfer over a socket." ; +"The " { $vocab-link "serialize" } " vocabulary is used to convert Factor objects to byte arrays for transfer over a socket." +{ $subsections "concurrency.distributed.example" } ; + ABOUT: "concurrency.distributed" From 2dc8fa646f6c6ee1bae512b15a601da3ce37c7c3 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 29 Oct 2009 18:01:45 +1300 Subject: [PATCH 02/12] Fix channels.remote to/from words --- basis/channels/remote/remote.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/channels/remote/remote.factor b/basis/channels/remote/remote.factor index 6e10b23407..6f63b9bd4a 100644 --- a/basis/channels/remote/remote.factor +++ b/basis/channels/remote/remote.factor @@ -53,12 +53,12 @@ C: remote-channel M: remote-channel to ( value remote-channel -- ) [ [ \ to , id>> , , ] { } make ] keep - node>> "remote-channels" + node>> "remote-channels" swap send-synchronous no-channel = [ no-channel throw ] when ; M: remote-channel from ( remote-channel -- value ) [ [ \ from , id>> , ] { } make ] keep - node>> "remote-channels" + node>> "remote-channels" swap send-synchronous dup no-channel = [ no-channel throw ] when* ; [ From 16be01900ebb5f051bbec09cde21fa08715047ae Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 29 Oct 2009 18:02:07 +1300 Subject: [PATCH 03/12] Move distributed concurrency specific stuff from messaging to distributed --- .../distributed/distributed.factor | 24 ++++++++++++++++++- .../messaging/messaging-docs.factor | 2 +- basis/concurrency/messaging/messaging.factor | 18 -------------- 3 files changed, 24 insertions(+), 20 deletions(-) diff --git a/basis/concurrency/distributed/distributed.factor b/basis/concurrency/distributed/distributed.factor index 52627f2ed9..325e8e3cc9 100644 --- a/basis/concurrency/distributed/distributed.factor +++ b/basis/concurrency/distributed/distributed.factor @@ -1,11 +1,27 @@ ! Copyright (C) 2005 Chris Double. All Rights Reserved. ! See http://factorcode.org/license.txt for BSD license. USING: serialize sequences concurrency.messaging threads io -io.servers.connection io.encodings.binary +io.servers.connection io.encodings.binary assocs init arrays namespaces kernel accessors ; FROM: io.sockets => host-name with-client ; IN: concurrency.distributed + + +: register-process ( name process -- ) + swap registered-processes set-at ; + +: unregister-process ( name -- ) + registered-processes delete-at ; + +: get-process ( name -- process ) + dup registered-processes at [ ] [ thread ] ?if ; + SYMBOL: local-node : handle-node-client ( -- ) @@ -41,3 +57,9 @@ M: thread (serialize) ( obj -- ) : stop-node ( node -- ) f swap send-remote-message ; + +[ + H{ } clone \ registered-processes set-global +] "remote-thread-registry" add-init-hook + + diff --git a/basis/concurrency/messaging/messaging-docs.factor b/basis/concurrency/messaging/messaging-docs.factor index 17f05e20fb..85870db4df 100644 --- a/basis/concurrency/messaging/messaging-docs.factor +++ b/basis/concurrency/messaging/messaging-docs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006 Chris Double. ! See http://factorcode.org/license.txt for BSD license. -USING: help.syntax help.markup concurrency.messaging.private +USING: help.syntax help.markup threads kernel arrays quotations strings ; IN: concurrency.messaging diff --git a/basis/concurrency/messaging/messaging.factor b/basis/concurrency/messaging/messaging.factor index ce7f7d6110..37965309e8 100644 --- a/basis/concurrency/messaging/messaging.factor +++ b/basis/concurrency/messaging/messaging.factor @@ -68,21 +68,3 @@ M: cannot-send-synchronous-to-self summary receive [ data>> swap call ] keep reply-synchronous ; inline - - - -: register-process ( name process -- ) - swap registered-processes set-at ; - -: unregister-process ( name -- ) - registered-processes delete-at ; - -: get-process ( name -- process ) - dup registered-processes at [ ] [ thread ] ?if ; - -\ registered-processes [ H{ } clone ] initialize From 822cf9c2bfec8b93b8d87930152437e5328d6dcf Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 29 Oct 2009 18:39:25 +1300 Subject: [PATCH 04/12] Rename distributed process registry stuff to remote-thread --- basis/channels/remote/remote.factor | 13 ++++----- .../distributed/distributed-docs.factor | 18 ++++++------ .../distributed/distributed-tests.factor | 2 +- .../distributed/distributed.factor | 28 +++++++++---------- 4 files changed, 30 insertions(+), 31 deletions(-) diff --git a/basis/channels/remote/remote.factor b/basis/channels/remote/remote.factor index 6f63b9bd4a..59dec91859 100644 --- a/basis/channels/remote/remote.factor +++ b/basis/channels/remote/remote.factor @@ -28,7 +28,7 @@ MATCH-VARS: ?from ?tag ?id ?value ; SYMBOL: no-channel -: channel-process ( -- ) +: channel-thread ( -- ) [ { { { to ?id ?value } @@ -41,10 +41,9 @@ SYMBOL: no-channel PRIVATE> : start-channel-node ( -- ) - "remote-channels" get-process [ - "remote-channels" - [ channel-process t ] "Remote channels" spawn-server - register-process + "remote-channels" get-remote-thread [ + [ channel-thread t ] "Remote channels" spawn-server + "remote-channels" register-remote-thread ] unless ; TUPLE: remote-channel node id ; @@ -53,12 +52,12 @@ C: remote-channel M: remote-channel to ( value remote-channel -- ) [ [ \ to , id>> , , ] { } make ] keep - node>> "remote-channels" swap + node>> "remote-channels" send-synchronous no-channel = [ no-channel throw ] when ; M: remote-channel from ( remote-channel -- value ) [ [ \ from , id>> , ] { } make ] keep - node>> "remote-channels" swap + node>> "remote-channels" send-synchronous dup no-channel = [ no-channel throw ] when* ; [ diff --git a/basis/concurrency/distributed/distributed-docs.factor b/basis/concurrency/distributed/distributed-docs.factor index 4672043b36..8ea7153b0b 100644 --- a/basis/concurrency/distributed/distributed-docs.factor +++ b/basis/concurrency/distributed/distributed-docs.factor @@ -21,23 +21,23 @@ $nl { $examples { $unchecked-example ": log-message ( -- ) receive . flush log-message ;" - "[ log-message ] \"logger\" spawn [ name>> ] keep register-process" + "[ log-message ] \"logger\" spawn dup name>> register-remote-thread" } } "This spawns a thread waits for the messages. It registers that thread as a " -"able to be accessed remotely using " { $link register-process } "." +"able to be accessed remotely using " { $link register-remote-thread } "." $nl "The second Factor instance, the one associated with port 9001, can send " -"messages to the 'logger' process by name:" +"messages to the 'logger' thread by name:" { $examples { $unchecked-example "USING: io.sockets concurrency.messaging concurrency.distributed ;" - "\"hello\" \"logger\" \"127.0.0.1\" 9000 send" + "\"hello\" \"127.0.0.1\" 9000 \"logger\" send" } } "The " { $link send } " word is used to send messages to other threads. If an " -"instance of " { $link remote-process } " is provided instead of a thread then " -"the message is marshalled to the named process on the given machine using the " +"instance of " { $link remote-thread } " is provided instead of a thread then " +"the message is marshalled to the named thread on the given machine using the " { $vocab-link "serialize" } " vocabulary." $nl "Running this code should show the message \"hello\" in the first Factor " @@ -45,15 +45,15 @@ $nl $nl "It is also possible to use " { $link send-synchronous } " to receive a " "response to a distributed message. When an instance of " { $link thread } " " -"is marshalled it is converted into an instance of " { $link remote-process } +"is marshalled it is converted into an instance of " { $link remote-thread } ". The receiver of this can use it as the target of a " { $link send } " or " { $link reply } " call." ; ARTICLE: "concurrency.distributed" "Distributed message passing" "The " { $vocab-link "concurrency.distributed" } " implements transparent distributed message passing, inspired by Erlang and Termite." { $subsections start-node } -"Instances of " { $link thread } " can be sent to remote processes, at which point they are converted to objects holding the thread ID and the current node's host name:" -{ $subsections remote-process } +"Instances of " { $link thread } " can be sent to remote threads, at which point they are converted to objects holding the thread ID and the current node's host name:" +{ $subsections remote-thread } "The " { $vocab-link "serialize" } " vocabulary is used to convert Factor objects to byte arrays for transfer over a socket." { $subsections "concurrency.distributed.example" } ; diff --git a/basis/concurrency/distributed/distributed-tests.factor b/basis/concurrency/distributed/distributed-tests.factor index b2a2851926..96955ac94b 100644 --- a/basis/concurrency/distributed/distributed-tests.factor +++ b/basis/concurrency/distributed/distributed-tests.factor @@ -25,7 +25,7 @@ IN: concurrency.distributed.tests [ 8 ] [ 5 self 2array - "thread-a" test-node send + test-node "thread-a" send receive ] unit-test diff --git a/basis/concurrency/distributed/distributed.factor b/basis/concurrency/distributed/distributed.factor index 325e8e3cc9..244f1d95a3 100644 --- a/basis/concurrency/distributed/distributed.factor +++ b/basis/concurrency/distributed/distributed.factor @@ -8,25 +8,25 @@ IN: concurrency.distributed -: register-process ( name process -- ) - swap registered-processes set-at ; +: register-remote-thread ( thread name -- ) + registered-remote-threads set-at ; -: unregister-process ( name -- ) - registered-processes delete-at ; +: unregister-remote-thread ( name -- ) + registered-remote-threads delete-at ; -: get-process ( name -- process ) - dup registered-processes at [ ] [ thread ] ?if ; +: get-remote-thread ( name -- thread ) + dup registered-remote-threads at [ ] [ thread ] ?if ; SYMBOL: local-node : handle-node-client ( -- ) deserialize - [ first2 get-process send ] [ stop-this-server ] if* ; + [ first2 get-remote-thread send ] [ stop-this-server ] if* ; : ( addrspec -- threaded-server ) binary @@ -40,26 +40,26 @@ SYMBOL: local-node : start-node ( port -- ) host-name over (start-node) ; -TUPLE: remote-process id node ; +TUPLE: remote-thread node id ; -C: remote-process +C: remote-thread : send-remote-message ( message node -- ) binary [ serialize ] with-client ; -M: remote-process send ( message thread -- ) +M: remote-thread send ( message thread -- ) [ id>> 2array ] [ node>> ] bi send-remote-message ; M: thread (serialize) ( obj -- ) - id>> local-node get-global + id>> [ local-node get-global ] dip (serialize) ; : stop-node ( node -- ) f swap send-remote-message ; [ - H{ } clone \ registered-processes set-global + H{ } clone \ registered-remote-threads set-global ] "remote-thread-registry" add-init-hook From 6d0c823488e8716d2936ef8676efd29f67ab0267 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 30 Oct 2009 14:19:34 +1300 Subject: [PATCH 05/12] Refactor some remote channels code --- basis/channels/remote/remote.factor | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/basis/channels/remote/remote.factor b/basis/channels/remote/remote.factor index 59dec91859..0a88875544 100644 --- a/basis/channels/remote/remote.factor +++ b/basis/channels/remote/remote.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. ! ! Remote Channels -USING: kernel init namespaces make assocs arrays random +USING: kernel init namespaces assocs arrays random sequences channels match concurrency.messaging concurrency.distributed threads accessors ; IN: channels.remote @@ -27,38 +27,44 @@ PRIVATE> MATCH-VARS: ?from ?tag ?id ?value ; SYMBOL: no-channel +TUPLE: to-message id value ; +TUPLE: from-message id ; : channel-thread ( -- ) [ { - { { to ?id ?value } + { T{ to-message f ?id ?value } [ ?value ?id get-channel dup [ to f ] [ 2drop no-channel ] if ] } - { { from ?id } + { T{ from-message f ?id } [ ?id get-channel [ from ] [ no-channel ] if* ] } } match-cond ] handle-synchronous ; -PRIVATE> - : start-channel-node ( -- ) "remote-channels" get-remote-thread [ [ channel-thread t ] "Remote channels" spawn-server "remote-channels" register-remote-thread ] unless ; +PRIVATE> + TUPLE: remote-channel node id ; C: remote-channel -M: remote-channel to ( value remote-channel -- ) - [ [ \ to , id>> , , ] { } make ] keep - node>> "remote-channels" - send-synchronous no-channel = [ no-channel throw ] when ; +> , ] { } make ] keep +: send-message ( message remote-channel -- value ) node>> "remote-channels" send-synchronous dup no-channel = [ no-channel throw ] when* ; + +PRIVATE> + +M: remote-channel to ( value remote-channel -- ) + [ id>> swap to-message boa ] keep send-message drop ; + +M: remote-channel from ( remote-channel -- value ) + [ id>> from-message boa ] keep send-message ; [ H{ } clone \ remote-channels set-global From bdb35920bde1773780c5bef5ca445ddfcb1ec21d Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 30 Oct 2009 14:25:10 +1300 Subject: [PATCH 06/12] Update remote channels help --- basis/channels/remote/remote-docs.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/channels/remote/remote-docs.factor b/basis/channels/remote/remote-docs.factor index 309f764d2d..c612b4256a 100644 --- a/basis/channels/remote/remote-docs.factor +++ b/basis/channels/remote/remote-docs.factor @@ -53,11 +53,11 @@ $nl " to be accessed remotely. " { $link publish } " returns an id which a remote node " "needs to know to access the channel." $nl -{ $snippet "channel [ from . ] spawn drop dup publish" } +{ $snippet " dup [ from . flush ] curry \"test\" spawn drop publish" } $nl -"Given the id from the snippet above, a remote node can put items in the channel." +"Given the id from the snippet above, a remote node can put items in the channel (where 123456 is the id):" $nl -{ $snippet "\"myhost.com\" 9001 \"ID123456\" \n\"hello\" over to" } +{ $snippet "\"myhost.com\" 9001 123456 \n\"hello\" over to" } ; ABOUT: { "remote-channels" "remote-channels" } From 897ef1aa624b14efa60d01e26ab88e296822dd83 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Oct 2009 02:35:51 -0500 Subject: [PATCH 07/12] move nth-root to math.functions, use exchange-unsafe in math.statistics --- basis/math/functions/functions.factor | 3 ++- basis/math/statistics/statistics.factor | 8 ++++---- extra/math/analysis/analysis.factor | 3 --- 3 files changed, 6 insertions(+), 8 deletions(-) diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index a9ad003411..0e0ccd5ecf 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -106,6 +106,8 @@ PRIVATE> [ ^complex ] } cond ; inline +: nth-root ( n x -- y ) swap recip ^ ; inline + : gcd ( x y -- a d ) [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable @@ -304,4 +306,3 @@ M: real atan >float atan ; inline [ [ / floor ] [ * ] bi ] unless-zero ; : lerp ( a b t -- a_t ) [ over - ] dip * + ; inline - diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index 85909bc097..dad0970855 100644 --- a/basis/math/statistics/statistics.factor +++ b/basis/math/statistics/statistics.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman, Michael Judge. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators kernel math math.analysis -math.functions math.order sequences sorting locals -sequences.private assocs fry ; +USING: arrays combinators kernel math math.functions +math.order sequences sorting locals sequences.private +assocs fry ; IN: math.statistics : mean ( seq -- x ) @@ -33,7 +33,7 @@ IN: math.statistics [ i seq nth-unsafe x < ] [ i 1 + i! ] while [ x j seq nth-unsafe < ] [ j 1 - j! ] while i j <= [ - i j seq exchange + i j seq exchange-unsafe i 1 + i! j 1 - j! ] when diff --git a/extra/math/analysis/analysis.factor b/extra/math/analysis/analysis.factor index 39d6450ba0..6d01744290 100755 --- a/extra/math/analysis/analysis.factor +++ b/extra/math/analysis/analysis.factor @@ -56,9 +56,6 @@ PRIVATE> [ abs gammaln-lanczos6 ] keep dup 0 > [ drop ] [ gamma-neg ] if ] if ; -: nth-root ( n x -- y ) - swap recip ^ ; - ! Forth Scientific Library Algorithm #1 ! ! Evaluates the Real Exponential Integral, From a39edf9500901434c95e41dff24e47f7113a2205 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Oct 2009 02:55:54 -0500 Subject: [PATCH 08/12] move histogram to math.statistics, write a main article for math.statistics --- basis/math/statistics/statistics-docs.factor | 104 +++++++++++++++++- basis/math/statistics/statistics-tests.factor | 10 ++ basis/math/statistics/statistics.factor | 33 +++++- extra/histogram/histogram-docs.factor | 87 --------------- extra/histogram/histogram-tests.factor | 12 -- extra/histogram/histogram.factor | 29 ----- 6 files changed, 141 insertions(+), 134 deletions(-) delete mode 100755 extra/histogram/histogram-docs.factor delete mode 100755 extra/histogram/histogram-tests.factor delete mode 100755 extra/histogram/histogram.factor diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor index 1a29d611f9..dc54f4181f 100644 --- a/basis/math/statistics/statistics-docs.factor +++ b/basis/math/statistics/statistics-docs.factor @@ -1,4 +1,5 @@ -USING: help.markup help.syntax debugger ; +USING: assocs debugger hashtables help.markup help.syntax +quotations sequences ; IN: math.statistics HELP: geometric-mean @@ -58,3 +59,104 @@ HELP: var { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } var ." "1" } { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 4 } var ." "1+2/3" } } ; + +HELP: histogram +{ $values + { "seq" sequence } + { "hashtable" hashtable } +} +{ $examples + { $example "! Count the number of times an element appears in a sequence." + "USING: prettyprint histogram ;" + "\"aaabc\" histogram ." + "H{ { 97 3 } { 98 1 } { 99 1 } }" + } +} +{ $description "Returns a hashtable where the keys are the elements of the sequence and the values are the number of times they appeared in that sequence." } ; + +HELP: histogram* +{ $values + { "hashtable" hashtable } { "seq" sequence } + { "hashtable" hashtable } +} +{ $examples + { $example "! Count the number of times the elements of two sequences appear." + "USING: prettyprint histogram ;" + "\"aaabc\" histogram \"aaaaaabc\" histogram* ." + "H{ { 97 9 } { 98 2 } { 99 2 } }" + } +} +{ $description "Takes an existing hashtable and uses " { $link histogram } " to continue counting the number of occurences of each element." } ; + +HELP: sequence>assoc +{ $values + { "seq" sequence } { "quot" quotation } { "exemplar" "an exemplar assoc" } + { "assoc" assoc } +} +{ $examples + { $example "! Iterate over a sequence and increment the count at each element" + "USING: assocs prettyprint histogram ;" + "\"aaabc\" [ inc-at ] H{ } sequence>assoc ." + "H{ { 97 3 } { 98 1 } { 99 1 } }" + } +} +{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a newly created " { $snippet "assoc" } " according to the passed quotation." } ; + +HELP: sequence>assoc* +{ $values + { "assoc" assoc } { "seq" sequence } { "quot" quotation } + { "assoc" assoc } +} +{ $examples + { $example "! Iterate over a sequence and add the counts to an existing assoc" + "USING: assocs prettyprint histogram kernel ;" + "H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ inc-at ] sequence>assoc* ." + "H{ { 97 5 } { 98 2 } { 99 1 } }" + } +} +{ $description "Iterates over a sequence, allowing elements of the sequence to be added to an existing " { $snippet "assoc" } " according to the passed quotation." } ; + +HELP: sequence>hashtable +{ $values + { "seq" sequence } { "quot" quotation } + { "hashtable" hashtable } +} +{ $examples + { $example "! Count the number of times an element occurs in a sequence" + "USING: assocs prettyprint histogram ;" + "\"aaabc\" [ inc-at ] sequence>hashtable ." + "H{ { 97 3 } { 98 1 } { 99 1 } }" + } +} +{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a hashtable according to the passed quotation." } ; + +ARTICLE: "histogram" "Computing histograms" +"Counting elements in a sequence:" +{ $subsections + histogram + histogram* +} +"Combinators for implementing histogram:" +{ $subsections + sequence>assoc + sequence>assoc* + sequence>hashtable +} ; + +ARTICLE: "math.statistics" "Statistics" +"Computing the mean:" +{ $subsections mean geometric-mean harmonic-mean } +"Computing the median:" +{ $subsections median lower-median upper-median medians } +"Computing the mode:" +{ $subsections mode } +"Computing the standard deviation and variance:" +{ $subsections std var } +"Computing the range and minimum and maximum elements:" +{ $subsections range minmax } +"Computing the kth smallest element:" +{ $subsections kth-smallest } +"Counting the frequency of occurrence of elements:" +{ $subsection "histogram" } ; + +ABOUT: "math.statistics" diff --git a/basis/math/statistics/statistics-tests.factor b/basis/math/statistics/statistics-tests.factor index 32ebcbc6a1..0d3172f685 100644 --- a/basis/math/statistics/statistics-tests.factor +++ b/basis/math/statistics/statistics-tests.factor @@ -43,3 +43,13 @@ IN: math.statistics.tests [ 0 ] [ { 1 } var ] unit-test [ 0.0 ] [ { 1 } std ] unit-test [ 0.0 ] [ { 1 } ste ] unit-test + +[ + H{ + { 97 2 } + { 98 2 } + { 99 2 } + } +] [ + "aabbcc" histogram +] unit-test diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index dad0970855..9c72b848ca 100644 --- a/basis/math/statistics/statistics.factor +++ b/basis/math/statistics/statistics.factor @@ -45,7 +45,8 @@ IN: math.statistics k seq nth ; inline : lower-median ( seq -- elt ) - dup dup length odd? [ midpoint@ ] [ midpoint@ 1 - ] if kth-smallest ; + [ ] [ ] [ length odd? ] tri + [ midpoint@ ] [ midpoint@ 1 - ] if kth-smallest ; : upper-median ( seq -- elt ) dup midpoint@ kth-smallest ; @@ -54,13 +55,35 @@ IN: math.statistics [ lower-median ] [ upper-median ] bi ; : median ( seq -- x ) - dup length odd? [ lower-median ] [ medians + 2 / ] if ; + [ ] [ length odd? ] bi [ lower-median ] [ medians + 2 / ] if ; -: frequency ( seq -- hashtable ) - H{ } clone [ '[ _ inc-at ] each ] keep ; +assoc) ( seq quot assoc -- assoc ) + [ swap curry each ] keep ; inline + +PRIVATE> + +: sequence>assoc* ( assoc seq quot: ( obj assoc -- ) -- assoc ) + rot (sequence>assoc) ; inline + +: sequence>assoc ( seq quot: ( obj assoc -- ) exemplar -- assoc ) + clone (sequence>assoc) ; inline + +: sequence>hashtable ( seq quot: ( obj hashtable -- ) -- hashtable ) + H{ } sequence>assoc ; inline + +: histogram* ( hashtable seq -- hashtable ) + [ inc-at ] sequence>assoc* ; + +: histogram ( seq -- hashtable ) + [ inc-at ] sequence>hashtable ; + +: collect-values ( seq quot: ( obj hashtable -- ) -- hash ) + '[ [ dup @ ] dip push-at ] sequence>hashtable ; inline : mode ( seq -- x ) - frequency >alist + histogram >alist [ ] [ [ [ second ] bi@ > ] 2keep ? ] map-reduce first ; : minmax ( seq -- min max ) diff --git a/extra/histogram/histogram-docs.factor b/extra/histogram/histogram-docs.factor deleted file mode 100755 index fc463cabfe..0000000000 --- a/extra/histogram/histogram-docs.factor +++ /dev/null @@ -1,87 +0,0 @@ -IN: histogram -USING: help.markup help.syntax sequences hashtables quotations assocs ; - -HELP: histogram -{ $values - { "seq" sequence } - { "hashtable" hashtable } -} -{ $examples - { $example "! Count the number of times an element appears in a sequence." - "USING: prettyprint histogram ;" - "\"aaabc\" histogram ." - "H{ { 97 3 } { 98 1 } { 99 1 } }" - } -} -{ $description "Returns a hashtable where the keys are the elements of the sequence and the values are the number of times they appeared in that sequence." } ; - -HELP: histogram* -{ $values - { "hashtable" hashtable } { "seq" sequence } - { "hashtable" hashtable } -} -{ $examples - { $example "! Count the number of times the elements of two sequences appear." - "USING: prettyprint histogram ;" - "\"aaabc\" histogram \"aaaaaabc\" histogram* ." - "H{ { 97 9 } { 98 2 } { 99 2 } }" - } -} -{ $description "Takes an existing hashtable and uses " { $link histogram } " to continue counting the number of occurences of each element." } ; - -HELP: sequence>assoc -{ $values - { "seq" sequence } { "quot" quotation } { "exemplar" "an exemplar assoc" } - { "assoc" assoc } -} -{ $examples - { $example "! Iterate over a sequence and increment the count at each element" - "USING: assocs prettyprint histogram ;" - "\"aaabc\" [ inc-at ] H{ } sequence>assoc ." - "H{ { 97 3 } { 98 1 } { 99 1 } }" - } -} -{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a newly created " { $snippet "assoc" } " according to the passed quotation." } ; - -HELP: sequence>assoc* -{ $values - { "assoc" assoc } { "seq" sequence } { "quot" quotation } - { "assoc" assoc } -} -{ $examples - { $example "! Iterate over a sequence and add the counts to an existing assoc" - "USING: assocs prettyprint histogram kernel ;" - "H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ inc-at ] sequence>assoc* ." - "H{ { 97 5 } { 98 2 } { 99 1 } }" - } -} -{ $description "Iterates over a sequence, allowing elements of the sequence to be added to an existing " { $snippet "assoc" } " according to the passed quotation." } ; - -HELP: sequence>hashtable -{ $values - { "seq" sequence } { "quot" quotation } - { "hashtable" hashtable } -} -{ $examples - { $example "! Count the number of times an element occurs in a sequence" - "USING: assocs prettyprint histogram ;" - "\"aaabc\" [ inc-at ] sequence>hashtable ." - "H{ { 97 3 } { 98 1 } { 99 1 } }" - } -} -{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a hashtable according to the passed quotation." } ; - -ARTICLE: "histogram" "Computing histograms" -"Counting elements in a sequence:" -{ $subsections - histogram - histogram* -} -"Combinators for implementing histogram:" -{ $subsections - sequence>assoc - sequence>assoc* - sequence>hashtable -} ; - -ABOUT: "histogram" diff --git a/extra/histogram/histogram-tests.factor b/extra/histogram/histogram-tests.factor deleted file mode 100755 index f0e7b3e80e..0000000000 --- a/extra/histogram/histogram-tests.factor +++ /dev/null @@ -1,12 +0,0 @@ -IN: histogram.tests -USING: help.markup help.syntax tools.test histogram ; - -[ - H{ - { 97 2 } - { 98 2 } - { 99 2 } - } -] [ - "aabbcc" histogram -] unit-test diff --git a/extra/histogram/histogram.factor b/extra/histogram/histogram.factor deleted file mode 100755 index d5c6ab3778..0000000000 --- a/extra/histogram/histogram.factor +++ /dev/null @@ -1,29 +0,0 @@ -! Copyright (C) 2009 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences assocs fry ; -IN: histogram - -assoc) ( seq quot assoc -- assoc ) - [ swap curry each ] keep ; inline - -PRIVATE> - -: sequence>assoc* ( assoc seq quot: ( obj assoc -- ) -- assoc ) - rot (sequence>assoc) ; inline - -: sequence>assoc ( seq quot: ( obj assoc -- ) exemplar -- assoc ) - clone (sequence>assoc) ; inline - -: sequence>hashtable ( seq quot: ( obj hashtable -- ) -- hashtable ) - H{ } sequence>assoc ; inline - -: histogram* ( hashtable seq -- hashtable ) - [ inc-at ] sequence>assoc* ; - -: histogram ( seq -- hashtable ) - [ inc-at ] sequence>hashtable ; - -: collect-values ( seq quot: ( obj hashtable -- ) -- hash ) - '[ [ dup @ ] dip push-at ] sequence>hashtable ; inline From 65ccd89232b10dbb8f6cad83f7882cfe4d681cf2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 30 Oct 2009 02:59:54 -0500 Subject: [PATCH 09/12] concurrency.distributed: fix unit tests --- basis/concurrency/distributed/distributed-tests.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/concurrency/distributed/distributed-tests.factor b/basis/concurrency/distributed/distributed-tests.factor index 96955ac94b..1a46d0e38f 100644 --- a/basis/concurrency/distributed/distributed-tests.factor +++ b/basis/concurrency/distributed/distributed-tests.factor @@ -18,9 +18,9 @@ IN: concurrency.distributed.tests [ ] [ [ receive first2 [ 3 + ] dip send - "thread-a" unregister-process + "thread-a" unregister-remote-thread ] "Thread A" spawn - "thread-a" swap register-process + "thread-a" register-remote-thread ] unit-test [ 8 ] [ From 846d9ba6c498e2a5260ed408ad8224ee17ef3040 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Oct 2009 03:06:03 -0500 Subject: [PATCH 10/12] slightly better math.statistics docs --- basis/math/statistics/statistics-docs.factor | 42 +++++++++++++------- 1 file changed, 28 insertions(+), 14 deletions(-) diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor index dc54f4181f..3ce5a62b9a 100644 --- a/basis/math/statistics/statistics-docs.factor +++ b/basis/math/statistics/statistics-docs.factor @@ -1,57 +1,71 @@ USING: assocs debugger hashtables help.markup help.syntax -quotations sequences ; +quotations sequences math ; IN: math.statistics HELP: geometric-mean -{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } +{ $values { "seq" sequence } { "x" "a non-negative real number"} } { $description "Computes the geometric mean of all elements in " { $snippet "seq" } ". The geometric mean measures the central tendency of a data set that minimizes the effects of extreme values." } { $examples { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } geometric-mean ." "1.81712059283214" } } { $errors "Throws a " { $link signal-error. } " (square-root of 0) if the sequence is empty." } ; HELP: harmonic-mean -{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } +{ $values { "seq" sequence } { "x" "a non-negative real number"} } { $description "Computes the harmonic mean of the elements in " { $snippet "seq" } ". The harmonic mean is appropriate when the average of rates is desired." } { $notes "Positive reals only." } { $examples { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } harmonic-mean ." "6/11" } } { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ; HELP: mean -{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } -{ $description "Computes the arithmetic mean of all elements in " { $snippet "seq" } "." } +{ $values { "seq" sequence } { "x" "a non-negative real number"} } +{ $description "Computes the arithmetic mean of the elements in " { $snippet "seq" } "." } { $examples { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } mean ." "2" } } { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ; HELP: median -{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } -{ $description "Computes the median of " { $snippet "seq" } " by sorting the sequence from lowest value to highest and outputting the middle one. If there is an even number of elements in the sequence, the median is not unique, so the mean of the two middle values is outputted." } +{ $values { "seq" sequence } { "x" "a non-negative real number"} } +{ $description "Computes the median of " { $snippet "seq" } " by finding the middle element of the sequence using " { $link kth-smallest } ". If there is an even number of elements in the sequence, the median is not unique, so the mean of the two middle values is output." } { $examples { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } median ." "2" } { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 4 } median ." "2+1/2" } } { $errors "Throws a " { $link signal-error. } " (divide by zero) if the sequence is empty." } ; HELP: range -{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } -{ $description "Computes the distance of the maximum and minimum values in " { $snippet "seq" } "." } +{ $values { "seq" sequence } { "x" "a non-negative real number"} } +{ $description "Computes the difference of the maximum and minimum values in " { $snippet "seq" } "." } { $examples { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } range ." "2" } { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 4 } range ." "3" } } ; +HELP: minmax +{ $values { "seq" sequence } { "min" real } { "max" real } } +{ $description "Finds the minimum and maximum elements of " { $snippet "seq" } " in one pass." } +{ $examples + { $example "USING: arrays math.statistics prettyprint ;" + "{ 1 2 3 } minmax 2array ." + "{ 1 3 }" + } + { $example "USING: arrays math.statistics prettyprint ;" + "{ 1 2 3 4 } minmax 2array ." + "{ 1 4 }" + } +} ; + HELP: std -{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } +{ $values { "seq" sequence } { "x" "a non-negative real number"} } { $description "Computes the standard deviation of " { $snippet "seq" } ", which is the square root of the variance. It measures how widely spread the values in a sequence are about the mean." } { $examples { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } std ." "1.0" } { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 4 } std ." "1.290994448735806" } } ; HELP: ste - { $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } + { $values { "seq" sequence } { "x" "a non-negative real number"} } { $description "Computes the standard error of the mean for " { $snippet "seq" } ". It's defined as the standard deviation divided by the square root of the length of the sequence, and measures uncertainty associated with the estimate of the mean." } { $examples { $example "USING: math.statistics prettyprint ;" "{ -2 2 } ste ." "2.0" } { $example "USING: math.statistics prettyprint ;" "{ -2 2 2 } ste ." "1.333333333333333" } } ; HELP: var -{ $values { "seq" "a sequence of numbers" } { "x" "a non-negative real number"} } +{ $values { "seq" sequence } { "x" "a non-negative real number"} } { $description "Computes the variance of " { $snippet "seq" } ". It's a measurement of the spread of values in a sequence. The larger the variance, the larger the distance of values from the mean." } { $notes "If the number of elements in " { $snippet "seq" } " is 1 or less, it outputs 0." } { $examples @@ -150,8 +164,8 @@ ARTICLE: "math.statistics" "Statistics" { $subsections median lower-median upper-median medians } "Computing the mode:" { $subsections mode } -"Computing the standard deviation and variance:" -{ $subsections std var } +"Computing the standard deviation, standard error, and variance:" +{ $subsections std ste var } "Computing the range and minimum and maximum elements:" { $subsections range minmax } "Computing the kth smallest element:" From 74d8554ca1b0c41d951cccd659e13c89a98daea5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Oct 2009 06:37:02 -0500 Subject: [PATCH 11/12] move docs for nth-root, fix docs for minmax --- basis/math/functions/functions-docs.factor | 6 ++++++ basis/math/statistics/statistics-docs.factor | 6 +----- extra/math/analysis/analysis-docs.factor | 4 ---- 3 files changed, 7 insertions(+), 9 deletions(-) diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index 1939de4f97..5f7c066efa 100644 --- a/basis/math/functions/functions-docs.factor +++ b/basis/math/functions/functions-docs.factor @@ -54,6 +54,8 @@ ARTICLE: "power-functions" "Powers and logarithms" { $subsections log1+ log10 } "Raising a number to a power:" { $subsections ^ 10^ } +"Finding the root of a number:" +{ $subsections nth-root } "Converting between rectangular and polar form:" { $subsections abs @@ -259,6 +261,10 @@ HELP: ^ { $description "Raises " { $snippet "x" } " to the power of " { $snippet "y" } ". If " { $snippet "y" } " is an integer the answer is computed exactly, otherwise a floating point approximation is used." } { $errors "Throws an error if " { $snippet "x" } " and " { $snippet "y" } " are both integer 0." } ; +HELP: nth-root +{ $values { "n" integer } { "x" number } { "y" number } } +{ $description "Calculates the nth root of a number, such that " { $snippet "y^n=x" } "." } ; + HELP: 10^ { $values { "x" number } { "y" number } } { $description "Raises " { $snippet "x" } " to the power of 10. If " { $snippet "x" } " is an integer the answer is computed exactly, otherwise a floating point approximation is used." } ; diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor index 3ce5a62b9a..9e812d94ca 100644 --- a/basis/math/statistics/statistics-docs.factor +++ b/basis/math/statistics/statistics-docs.factor @@ -4,7 +4,7 @@ IN: math.statistics HELP: geometric-mean { $values { "seq" sequence } { "x" "a non-negative real number"} } -{ $description "Computes the geometric mean of all elements in " { $snippet "seq" } ". The geometric mean measures the central tendency of a data set that minimizes the effects of extreme values." } +{ $description "Computes the geometric mean of all elements in " { $snippet "seq" } ". The geometric mean measures the central tendency of a data set and minimizes the effects of extreme values." } { $examples { $example "USING: math.statistics prettyprint ;" "{ 1 2 3 } geometric-mean ." "1.81712059283214" } } { $errors "Throws a " { $link signal-error. } " (square-root of 0) if the sequence is empty." } ; @@ -44,10 +44,6 @@ HELP: minmax "{ 1 2 3 } minmax 2array ." "{ 1 3 }" } - { $example "USING: arrays math.statistics prettyprint ;" - "{ 1 2 3 4 } minmax 2array ." - "{ 1 4 }" - } } ; HELP: std diff --git a/extra/math/analysis/analysis-docs.factor b/extra/math/analysis/analysis-docs.factor index a810ffc1bd..586a6d4971 100644 --- a/extra/math/analysis/analysis-docs.factor +++ b/extra/math/analysis/analysis-docs.factor @@ -9,10 +9,6 @@ HELP: gammaln { $values { "x" number } { "gamma[x]" number } } { $description "An alternative to " { $link gamma } " when gamma(x)'s range varies too widely." } ; -HELP: nth-root -{ $values { "n" integer } { "x" number } { "y" number } } -{ $description "Calculates the nth root of a number, such that " { $snippet "y^n=x" } "." } ; - HELP: exp-int { $values { "x" number } { "y" number } } { $description "Exponential integral function." } From c20a5166adb04267c335e7f1c627e192e73bee1a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 30 Oct 2009 13:35:20 -0500 Subject: [PATCH 12/12] fix help lint --- basis/help/lint/checks/checks.factor | 1 + basis/math/statistics/statistics-docs.factor | 10 +++++----- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index dac3900cc9..340f9b16d3 100644 --- a/basis/help/lint/checks/checks.factor +++ b/basis/help/lint/checks/checks.factor @@ -44,6 +44,7 @@ SYMBOL: vocab-articles : contains-funky-elements? ( element -- ? ) { $shuffle + $complex-shuffle $values-x/y $predicate $class-description diff --git a/basis/math/statistics/statistics-docs.factor b/basis/math/statistics/statistics-docs.factor index 9e812d94ca..3b6e7d62ba 100644 --- a/basis/math/statistics/statistics-docs.factor +++ b/basis/math/statistics/statistics-docs.factor @@ -77,7 +77,7 @@ HELP: histogram } { $examples { $example "! Count the number of times an element appears in a sequence." - "USING: prettyprint histogram ;" + "USING: prettyprint math.statistics ;" "\"aaabc\" histogram ." "H{ { 97 3 } { 98 1 } { 99 1 } }" } @@ -91,7 +91,7 @@ HELP: histogram* } { $examples { $example "! Count the number of times the elements of two sequences appear." - "USING: prettyprint histogram ;" + "USING: prettyprint math.statistics ;" "\"aaabc\" histogram \"aaaaaabc\" histogram* ." "H{ { 97 9 } { 98 2 } { 99 2 } }" } @@ -105,7 +105,7 @@ HELP: sequence>assoc } { $examples { $example "! Iterate over a sequence and increment the count at each element" - "USING: assocs prettyprint histogram ;" + "USING: assocs prettyprint math.statistics ;" "\"aaabc\" [ inc-at ] H{ } sequence>assoc ." "H{ { 97 3 } { 98 1 } { 99 1 } }" } @@ -119,7 +119,7 @@ HELP: sequence>assoc* } { $examples { $example "! Iterate over a sequence and add the counts to an existing assoc" - "USING: assocs prettyprint histogram kernel ;" + "USING: assocs prettyprint math.statistics kernel ;" "H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ inc-at ] sequence>assoc* ." "H{ { 97 5 } { 98 2 } { 99 1 } }" } @@ -133,7 +133,7 @@ HELP: sequence>hashtable } { $examples { $example "! Count the number of times an element occurs in a sequence" - "USING: assocs prettyprint histogram ;" + "USING: assocs prettyprint math.statistics ;" "\"aaabc\" [ inc-at ] sequence>hashtable ." "H{ { 97 3 } { 98 1 } { 99 1 } }" }