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

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
Doug Coleman 2010-09-19 13:29:43 -05:00
parent d29625850f
commit 4a018ebdfc
7 changed files with 280 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
basis/combinators/random/authors.txt Normal file
View File

@ -0,0 +1 @@
Jon Harper

112
basis/combinators/random/random-docs.factor Normal file
View File

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

72
basis/combinators/random/random-tests.factor Normal file
View File

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

69
basis/combinators/random/random.factor Normal file
View File

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

17
basis/io/files/unique/unique.factor
View File

@ -3,7 +3,7 @@
USING: arrays combinators continuations fry io io.backend
io.directories io.directories.hierarchy io.files io.pathnames
kernel locals math math.bitwise math.parser namespaces random
sequences system vocabs.loader ;
sequences system vocabs.loader random.data ;
IN: io.files.unique
HOOK: (touch-unique-file) io-backend ( path -- )
@ -25,22 +25,15 @@ SYMBOL: unique-retries
<PRIVATE
: random-letter ( -- ch )
26 random { CHAR: a CHAR: A } random + ;
: random-ch ( -- ch )
{ t f } random
[ 10 random CHAR: 0 + ] [ random-letter ] if ;
: random-name ( -- string )
unique-length get [ random-ch ] "" replicate-as ;
: random-file-name ( -- string )
unique-length get random-string ;
: retry ( quot: ( -- ? ) n -- )
iota swap [ drop ] prepose attempt-all ; inline
: (make-unique-file) ( path prefix suffix -- path )
'[
_ _ _ random-name glue append-path
_ _ _ random-file-name glue append-path
dup touch-unique-file
] unique-retries get retry ;
@ -55,7 +48,7 @@ PRIVATE>
: unique-directory ( -- path )
[
current-temporary-directory get
random-name append-path
random-file-name append-path
dup make-directory
] unique-retries get retry ;

1
basis/random/data/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

20
basis/random/data/data.factor Normal file
View File

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