Squashed commit of the following:
commit fbec7374aa3f99d8f76499183920e537dc7f38b1
Author: Doug Coleman <doug.coleman@gmail.com>
Date: Sun Sep 19 13:28:47 2010 -0500
Remove random.combinators vocab
commit 74f91aca4a961879ec57ef56114eadd5e9f6dcee
Author: Doug Coleman <doug.coleman@gmail.com>
Date: Sun Sep 19 13:28:22 2010 -0500
Rename random.combinators to combinators.random. Add random.data vocabulary
commit f616c3f4ceac48ac6f48836040130ba4f090c47f
Author: Doug Coleman <doug.coleman@gmail.com>
Date: Sun Sep 19 13:14:01 2010 -0500
Add execute-random combinator, docs, and respace a few things..
commit 1ce17507e3767c78e14ecf5e27e542168a47b2a2
Merge: db359d6
b53fc83
Author: Doug Coleman <doug.coleman@gmail.com>
Date: Sun Sep 19 12:55:53 2010 -0500
Merge branch 'random-combinators' of git://github.com/jonenst/factor into random-combinators
commit b53fc830f3319e9bdfce02674ea480f69e1453db
Author: Jon Harper <jon.harper87@gmail.com>
Date: Mon Aug 23 17:16:21 2010 +0200
Random combinators vocabulary
db4
parent
d29625850f
commit
4a018ebdfc
|
@ -0,0 +1 @@
|
||||||
|
Jon Harper
|
|
@ -0,0 +1,112 @@
|
||||||
|
! Copyright (C) 2010 Jon Harper.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: assocs help.markup help.syntax kernel quotations
|
||||||
|
combinators.random.private sequences ;
|
||||||
|
IN: combinators.random
|
||||||
|
|
||||||
|
HELP: call-random
|
||||||
|
{ $values { "seq" "a sequence of quotations" } }
|
||||||
|
{ $description "Calls a random quotation from the given sequence of quotations." } ;
|
||||||
|
|
||||||
|
HELP: execute-random
|
||||||
|
{ $values { "seq" "a sequence of words" } }
|
||||||
|
{ $description "Executes a random word from the given sequence of quotations." } ;
|
||||||
|
|
||||||
|
HELP: ifp
|
||||||
|
{ $values
|
||||||
|
{ "p" "a number between 0 and 1" } { "true" quotation } { "false" quotation }
|
||||||
|
}
|
||||||
|
{ $description "Calls the " { $snippet "true" } " quotation with probability " { $snippet "p" }
|
||||||
|
" and the " { $snippet "false" } " quotation with probability (1-" { $snippet "p" } ")." } ;
|
||||||
|
|
||||||
|
HELP: casep
|
||||||
|
{ $values
|
||||||
|
{ "assoc" "a sequence of probability/quotations pairs with an optional quotation at the end" }
|
||||||
|
}
|
||||||
|
{ $description "Calls the different quotations randomly with the given probability. The optional quotation at the end "
|
||||||
|
"will be given a probability so that the sum of the probabilities is one. Therefore, the sum of the probabilities "
|
||||||
|
"must be exactly one when no default quotation is given, or between zero and one when it is given. "
|
||||||
|
"Additionally, all probabilities must be numbers between 0 and 1. "
|
||||||
|
"These rules are enforced during the macro expansion by throwing " { $link bad-probabilities } " "
|
||||||
|
"if they are not respected." }
|
||||||
|
{ $examples
|
||||||
|
"The following two forms will output 1 with 0.2 probability, 2 with 0.3 probability and 3 with 0.5 probability"
|
||||||
|
{ $code
|
||||||
|
"USING: combinators.random ;"
|
||||||
|
"{ { 0.2 [ 1 ] }"
|
||||||
|
" { 0.3 [ 2 ] }"
|
||||||
|
" { 0.5 [ 3 ] } } casep ."
|
||||||
|
}
|
||||||
|
$nl
|
||||||
|
{ $code
|
||||||
|
"USING: combinators.random ;"
|
||||||
|
"{ { 0.2 [ 1 ] }"
|
||||||
|
" { 0.3 [ 2 ] }"
|
||||||
|
" { [ 3 ] } } casep ."
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
{ $see-also casep* } ;
|
||||||
|
|
||||||
|
HELP: casep*
|
||||||
|
{ $values
|
||||||
|
{ "assoc" "a sequence of probability/word pairs with an optional quotation at the end" }
|
||||||
|
}
|
||||||
|
{ $description "Calls the different quotations randomly with the given probability. Unlike " { $link casep } ", "
|
||||||
|
"the probabilities are interpreted as conditional probabilities. "
|
||||||
|
"All probabilities must be numbers between 0 and 1. "
|
||||||
|
"The sequence must end with a pair whose probability is one, or a quotation."
|
||||||
|
"These rules are enforced during the macro expansion by throwing " { $link bad-probabilities } " "
|
||||||
|
"if they are not respected." }
|
||||||
|
{ $examples
|
||||||
|
"The following two forms will output 1 with 0.5 probability, 2 with 0.25 probability and 3 with 0.25 probability"
|
||||||
|
{ $code
|
||||||
|
"USING: combinators.random ;"
|
||||||
|
"{ { 0.5 [ 1 ] }"
|
||||||
|
" { 0.5 [ 2 ] }"
|
||||||
|
" { 1 [ 3 ] } } casep* ."
|
||||||
|
}
|
||||||
|
$nl
|
||||||
|
{ $code
|
||||||
|
"USING: combinators.random ;"
|
||||||
|
"{ { 0.5 [ 1 ] }"
|
||||||
|
" { 0.5 [ 2 ] }"
|
||||||
|
" { [ 3 ] } } casep* ."
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
{ $see-also casep } ;
|
||||||
|
|
||||||
|
HELP: unlessp
|
||||||
|
{ $values
|
||||||
|
{ "p" "a number between 0 and 1" } { "false" quotation }
|
||||||
|
}
|
||||||
|
{ $description "Variant of " { $link ifp } " with no " { $snippet "true" } " quotation." } ;
|
||||||
|
|
||||||
|
HELP: whenp
|
||||||
|
{ $values
|
||||||
|
{ "p" "a number between 0 and 1" } { "true" quotation }
|
||||||
|
}
|
||||||
|
{ $description "Variant of " { $link ifp } " with no " { $snippet "false" } " quotation." } ;
|
||||||
|
|
||||||
|
ARTICLE: "combinators.random" "Random combinators"
|
||||||
|
"The " { $vocab-link "combinators.random" } " vocabulary implements simple combinators to easily express random choices"
|
||||||
|
" between multiple code paths."
|
||||||
|
$nl
|
||||||
|
"For all these combinators, the stack effect of the different given quotations or words must be the same."
|
||||||
|
$nl
|
||||||
|
"Variants of if, when and unless:"
|
||||||
|
{ $subsections
|
||||||
|
ifp
|
||||||
|
whenp
|
||||||
|
unlessp }
|
||||||
|
"Variants of case:"
|
||||||
|
{ $subsections
|
||||||
|
casep
|
||||||
|
casep*
|
||||||
|
call-random
|
||||||
|
execute-random
|
||||||
|
} ;
|
||||||
|
|
||||||
|
ABOUT: "combinators.random"
|
|
@ -0,0 +1,72 @@
|
||||||
|
! Copyright (C) 2010 Jon Harper.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: tools.test combinators.random combinators.random.private ;
|
||||||
|
IN: combinators.random.tests
|
||||||
|
|
||||||
|
[ 1 ] [ 1 [ 1 ] [ 2 ] ifp ] unit-test
|
||||||
|
[ 2 ] [ 0 [ 1 ] [ 2 ] ifp ] unit-test
|
||||||
|
|
||||||
|
[ 3 ]
|
||||||
|
[ { { 0 [ 1 ] }
|
||||||
|
{ 0 [ 2 ] }
|
||||||
|
{ 1 [ 3 ] }
|
||||||
|
[ 4 ]
|
||||||
|
} casep ] unit-test
|
||||||
|
|
||||||
|
[ 4 ]
|
||||||
|
[ { { 0 [ 1 ] }
|
||||||
|
{ 0 [ 2 ] }
|
||||||
|
{ 0 [ 3 ] }
|
||||||
|
[ 4 ]
|
||||||
|
} casep ] unit-test
|
||||||
|
|
||||||
|
[ 1 1 ] [ 1 {
|
||||||
|
{ 1 [ 1 ] }
|
||||||
|
{ 0 [ 2 ] }
|
||||||
|
{ 0 [ 3 ] }
|
||||||
|
[ 4 ]
|
||||||
|
} casep ] unit-test
|
||||||
|
|
||||||
|
[ 1 4 ] [ 1 {
|
||||||
|
{ 0 [ 1 ] }
|
||||||
|
{ 0 [ 2 ] }
|
||||||
|
{ 0 [ 3 ] }
|
||||||
|
[ 4 ]
|
||||||
|
} casep ] unit-test
|
||||||
|
|
||||||
|
[ 2 ] [ 0.7 {
|
||||||
|
{ 0.3 [ 1 ] }
|
||||||
|
{ 0.5 [ 2 ] }
|
||||||
|
[ 2 ] } (casep) ] unit-test
|
||||||
|
|
||||||
|
[ { { 1/3 [ 1 ] }
|
||||||
|
{ 1/3 [ 2 ] }
|
||||||
|
{ 1/3 [ 3 ] } } ]
|
||||||
|
[ { [ 1 ] [ 2 ] [ 3 ] } call-random>casep ] unit-test
|
||||||
|
|
||||||
|
[ { { 1/2 [ 1 ] }
|
||||||
|
{ 1/4 [ 2 ] }
|
||||||
|
{ 1/4 [ 3 ] } } ]
|
||||||
|
[ { { 1/2 [ 1 ] }
|
||||||
|
{ 1/2 [ 2 ] }
|
||||||
|
{ 1 [ 3 ] } } direct>conditional ] unit-test
|
||||||
|
|
||||||
|
[ { { 1/2 [ 1 ] }
|
||||||
|
{ 1/4 [ 2 ] }
|
||||||
|
{ [ 3 ] } } ]
|
||||||
|
[ { { 1/2 [ 1 ] }
|
||||||
|
{ 1/2 [ 2 ] }
|
||||||
|
{ [ 3 ] } } direct>conditional ] unit-test
|
||||||
|
|
||||||
|
[ f ] [ { { 0.6 [ 1 ] }
|
||||||
|
{ 0.6 [ 2 ] } } good-probabilities? ] unit-test
|
||||||
|
[ f ] [ { { 0.3 [ 1 ] }
|
||||||
|
{ 0.6 [ 2 ] } } good-probabilities? ] unit-test
|
||||||
|
[ f ] [ { { -0.6 [ 1 ] }
|
||||||
|
{ 1.4 [ 2 ] } } good-probabilities? ] unit-test
|
||||||
|
[ f ] [ { { -0.6 [ 1 ] }
|
||||||
|
[ 2 ] } good-probabilities? ] unit-test
|
||||||
|
[ t ] [ { { 0.6 [ 1 ] }
|
||||||
|
[ 2 ] } good-probabilities? ] unit-test
|
||||||
|
[ t ] [ { { 0.6 [ 1 ] }
|
||||||
|
{ 0.4 [ 2 ] } } good-probabilities? ] unit-test
|
|
@ -0,0 +1,69 @@
|
||||||
|
! Copyright (C) 2010 Jon Harper.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: arrays assocs combinators combinators.short-circuit
|
||||||
|
kernel macros math math.order quotations random sequences
|
||||||
|
summary ;
|
||||||
|
IN: combinators.random
|
||||||
|
|
||||||
|
: ifp ( p true false -- ) [ 0 1 uniform-random-float > ] 2dip if ; inline
|
||||||
|
: whenp ( p true -- ) [ ] ifp ; inline
|
||||||
|
: unlessp ( p false -- ) [ [ ] ] dip ifp ; inline
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: with-drop ( quot -- quot' ) [ drop ] prepend ; inline
|
||||||
|
|
||||||
|
: prepare-pair ( pair -- pair' )
|
||||||
|
first2 [ [ [ - ] [ < ] 2bi ] curry ] [ with-drop ] bi* 2array ;
|
||||||
|
|
||||||
|
ERROR: bad-probabilities assoc ;
|
||||||
|
|
||||||
|
M: bad-probabilities summary
|
||||||
|
drop "The probabilities do not satisfy the rules stated in the docs." ;
|
||||||
|
|
||||||
|
: good-probabilities? ( assoc -- ? )
|
||||||
|
dup last pair? [
|
||||||
|
keys { [ sum 1 number= ] [ [ 0 1 between? ] all? ] } 1&&
|
||||||
|
] [
|
||||||
|
but-last keys { [ sum 0 1 between? ] [ [ 0 1 between? ] all? ] } 1&&
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
! Useful for unit-tests (no random part)
|
||||||
|
: (casep>quot) ( assoc -- quot )
|
||||||
|
dup good-probabilities? [
|
||||||
|
[ dup pair? [ prepare-pair ] [ with-drop ] if ] map
|
||||||
|
cond>quot
|
||||||
|
] [ bad-probabilities ] if ;
|
||||||
|
|
||||||
|
MACRO: (casep) ( assoc -- ) (casep>quot) ;
|
||||||
|
|
||||||
|
: casep>quot ( assoc -- quot )
|
||||||
|
(casep>quot) [ 0 1 uniform-random-float ] prepend ;
|
||||||
|
|
||||||
|
: (conditional-probabilities) ( seq i -- p )
|
||||||
|
[ dup 0 > [ head [ 1 swap - ] [ * ] map-reduce ] [ 2drop 1 ] if ] [ swap nth ] 2bi * ;
|
||||||
|
|
||||||
|
: conditional-probabilities ( seq -- seq' )
|
||||||
|
dup length iota [ (conditional-probabilities) ] with map ;
|
||||||
|
|
||||||
|
: (direct>conditional) ( assoc -- assoc' )
|
||||||
|
[ keys conditional-probabilities ] [ values ] bi zip ;
|
||||||
|
|
||||||
|
: direct>conditional ( assoc -- assoc' )
|
||||||
|
dup last pair? [ (direct>conditional) ] [
|
||||||
|
unclip-last [ (direct>conditional) ] [ suffix ] bi*
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: call-random>casep ( seq -- assoc )
|
||||||
|
[ length recip ] keep [ 2array ] with map ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
MACRO: casep ( assoc -- ) casep>quot ;
|
||||||
|
|
||||||
|
MACRO: casep* ( assoc -- ) direct>conditional casep>quot ;
|
||||||
|
|
||||||
|
MACRO: call-random ( seq -- ) call-random>casep casep>quot ;
|
||||||
|
|
||||||
|
MACRO: execute-random ( seq -- )
|
||||||
|
[ 1quotation ] map call-random>casep casep>quot ;
|
|
@ -3,7 +3,7 @@
|
||||||
USING: arrays combinators continuations fry io io.backend
|
USING: arrays combinators continuations fry io io.backend
|
||||||
io.directories io.directories.hierarchy io.files io.pathnames
|
io.directories io.directories.hierarchy io.files io.pathnames
|
||||||
kernel locals math math.bitwise math.parser namespaces random
|
kernel locals math math.bitwise math.parser namespaces random
|
||||||
sequences system vocabs.loader ;
|
sequences system vocabs.loader random.data ;
|
||||||
IN: io.files.unique
|
IN: io.files.unique
|
||||||
|
|
||||||
HOOK: (touch-unique-file) io-backend ( path -- )
|
HOOK: (touch-unique-file) io-backend ( path -- )
|
||||||
|
@ -25,22 +25,15 @@ SYMBOL: unique-retries
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: random-letter ( -- ch )
|
: random-file-name ( -- string )
|
||||||
26 random { CHAR: a CHAR: A } random + ;
|
unique-length get random-string ;
|
||||||
|
|
||||||
: random-ch ( -- ch )
|
|
||||||
{ t f } random
|
|
||||||
[ 10 random CHAR: 0 + ] [ random-letter ] if ;
|
|
||||||
|
|
||||||
: random-name ( -- string )
|
|
||||||
unique-length get [ random-ch ] "" replicate-as ;
|
|
||||||
|
|
||||||
: retry ( quot: ( -- ? ) n -- )
|
: retry ( quot: ( -- ? ) n -- )
|
||||||
iota swap [ drop ] prepose attempt-all ; inline
|
iota swap [ drop ] prepose attempt-all ; inline
|
||||||
|
|
||||||
: (make-unique-file) ( path prefix suffix -- path )
|
: (make-unique-file) ( path prefix suffix -- path )
|
||||||
'[
|
'[
|
||||||
_ _ _ random-name glue append-path
|
_ _ _ random-file-name glue append-path
|
||||||
dup touch-unique-file
|
dup touch-unique-file
|
||||||
] unique-retries get retry ;
|
] unique-retries get retry ;
|
||||||
|
|
||||||
|
@ -55,7 +48,7 @@ PRIVATE>
|
||||||
: unique-directory ( -- path )
|
: unique-directory ( -- path )
|
||||||
[
|
[
|
||||||
current-temporary-directory get
|
current-temporary-directory get
|
||||||
random-name append-path
|
random-file-name append-path
|
||||||
dup make-directory
|
dup make-directory
|
||||||
] unique-retries get retry ;
|
] unique-retries get retry ;
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Doug Coleman
|
|
@ -0,0 +1,20 @@
|
||||||
|
! Copyright (C) 2010 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: combinators effects.parser kernel math random
|
||||||
|
combinators.random sequences ;
|
||||||
|
IN: random.data
|
||||||
|
|
||||||
|
: random-digit ( -- ch )
|
||||||
|
10 random CHAR: 0 + ;
|
||||||
|
|
||||||
|
: random-LETTER ( -- ch ) 26 random CHAR: A + ;
|
||||||
|
|
||||||
|
: random-letter ( -- ch ) 26 random CHAR: a + ;
|
||||||
|
|
||||||
|
: random-Letter ( -- ch )
|
||||||
|
{ random-LETTER random-letter } execute-random ;
|
||||||
|
|
||||||
|
: random-ch ( -- ch )
|
||||||
|
{ random-digit random-Letter } execute-random ;
|
||||||
|
|
||||||
|
: random-string ( n -- string ) [ random-ch ] "" replicate-as ;
|
Loading…
Reference in New Issue