steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

Joe Groff 2009-10-30 14:53:56 -05:00
parent ad47fde94b c20a5166ad
commit 1b8c9f757d
18 changed files with 278 additions and 208 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/channels/remote/remote-docs.factor
View File

@ -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 "<channel> 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 <node> \"ID123456\" <remote-channel>\n\"hello\" over to" }
{ $snippet "\"myhost.com\" 9001 <node> 123456 <remote-channel>\n\"hello\" over to" }
;
ABOUT: { "remote-channels" "remote-channels" }

37
basis/channels/remote/remote.factor
View File

@ -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,39 +27,44 @@ PRIVATE>
MATCH-VARS: ?from ?tag ?id ?value ;
SYMBOL: no-channel
TUPLE: to-message id value ;
TUPLE: from-message id ;
: channel-process ( -- )
: 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-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 ;
PRIVATE>
TUPLE: remote-channel node id ;
C: <remote-channel> remote-channel
<PRIVATE
: send-message ( message remote-channel -- value )
node>> "remote-channels" <remote-thread>
send-synchronous dup no-channel = [ no-channel throw ] when* ;
PRIVATE>
M: remote-channel to ( value remote-channel -- )
[ [ \ to , id>> , , ] { } make ] keep
node>> "remote-channels" <remote-process>
send-synchronous no-channel = [ no-channel throw ] when ;
[ id>> swap to-message boa ] keep send-message drop ;
M: remote-channel from ( remote-channel -- value )
[ [ \ from , id>> , ] { } make ] keep
node>> "remote-channels" <remote-process>
send-synchronous dup no-channel = [ no-channel throw ] when* ;
[ id>> from-message boa ] keep send-message ;
[
H{ } clone \ remote-channels set-global

49
basis/concurrency/distributed/distributed-docs.factor
View File

@ -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 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-remote-thread } "."
$nl
"The second Factor instance, the one associated with port 9001, can send "
"messages to the 'logger' thread by name:"
{ $examples
{ $unchecked-example
"USING: io.sockets concurrency.messaging concurrency.distributed ;"
"\"hello\" \"127.0.0.1\" 9000 <inet4> \"logger\" <remote-thread> send"
}
}
"The " { $link send } " word is used to send messages to other threads. If an "
"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 "
"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-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 }
"The " { $vocab-link "serialize" } " vocabulary is used to convert Factor objects to byte arrays for transfer over a socket." ;
"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" } ;
ABOUT: "concurrency.distributed"

6
basis/concurrency/distributed/distributed-tests.factor
View File

@ -18,14 +18,14 @@ 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 ] [
5 self 2array
"thread-a" test-node <remote-process> send
test-node "thread-a" <remote-thread> send
receive
] unit-test

34
basis/concurrency/distributed/distributed.factor
View File

@ -1,16 +1,32 @@
! 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 <inet> with-client ;
IN: concurrency.distributed
<PRIVATE
: registered-remote-threads ( -- hash )
\ registered-remote-threads get-global ;
PRIVATE>
: register-remote-thread ( thread name -- )
registered-remote-threads set-at ;
: unregister-remote-thread ( name -- )
registered-remote-threads delete-at ;
: 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* ;
: <node-server> ( addrspec -- threaded-server )
binary <threaded-server>
@ -24,20 +40,26 @@ SYMBOL: local-node
: start-node ( port -- )
host-name over <inet> (start-node) ;
TUPLE: remote-process id node ;
TUPLE: remote-thread node id ;
C: <remote-process> remote-process
C: <remote-thread> 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 <remote-process>
id>> [ local-node get-global ] dip <remote-thread>
(serialize) ;
: stop-node ( node -- )
f swap send-remote-message ;
[
H{ } clone \ registered-remote-threads set-global
] "remote-thread-registry" add-init-hook

2
basis/concurrency/messaging/messaging-docs.factor
View File

@ -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

18
basis/concurrency/messaging/messaging.factor
View File

@ -68,21 +68,3 @@ M: cannot-send-synchronous-to-self summary
receive [
data>> swap call
] keep reply-synchronous ; inline
<PRIVATE
: registered-processes ( -- hash )
\ registered-processes get-global ;
PRIVATE>
: 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

1
basis/help/lint/checks/checks.factor
View File

@ -44,6 +44,7 @@ SYMBOL: vocab-articles
: contains-funky-elements? ( element -- ? )
{
$shuffle
$complex-shuffle
$values-x/y
$predicate
$class-description

6
basis/math/functions/functions-docs.factor
View File

@ -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." } ;

3
basis/math/functions/functions.factor
View File

@ -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

138
basis/math/statistics/statistics-docs.factor
View File

@ -1,56 +1,67 @@
USING: help.markup help.syntax debugger ;
USING: assocs debugger hashtables help.markup help.syntax
quotations sequences math ;
IN: math.statistics
HELP: geometric-mean
{ $values { "seq" "a sequence of numbers" } { "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." }
{ $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 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." } ;
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 }"
}
} ;
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
@ -58,3 +69,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 math.statistics ;"
"\"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 math.statistics ;"
"\"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 math.statistics ;"
"\"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 math.statistics 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 math.statistics ;"
"\"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, standard error, and variance:"
{ $subsections std ste 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"

10
basis/math/statistics/statistics-tests.factor
View File

@ -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

41
basis/math/statistics/statistics.factor
View File

@ -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
@ -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 ;
<PRIVATE
: (sequence>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 )

87
extra/histogram/histogram-docs.factor
View File

@ -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"

12
extra/histogram/histogram-tests.factor
View File

@ -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

29
extra/histogram/histogram.factor
View File

@ -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
<PRIVATE
: (sequence>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

4
extra/math/analysis/analysis-docs.factor
View File

@ -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." }

3
extra/math/analysis/analysis.factor
View File

@ -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,