From 4a018ebdfca03943bb25f90147e667fe8513d6db Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 19 Sep 2010 13:29:43 -0500 Subject: [PATCH] Squashed commit of the following: commit fbec7374aa3f99d8f76499183920e537dc7f38b1 Author: Doug Coleman Date: Sun Sep 19 13:28:47 2010 -0500 Remove random.combinators vocab commit 74f91aca4a961879ec57ef56114eadd5e9f6dcee Author: Doug Coleman Date: Sun Sep 19 13:28:22 2010 -0500 Rename random.combinators to combinators.random. Add random.data vocabulary commit f616c3f4ceac48ac6f48836040130ba4f090c47f Author: Doug Coleman 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 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 Date: Mon Aug 23 17:16:21 2010 +0200 Random combinators vocabulary --- basis/combinators/random/authors.txt | 1 + basis/combinators/random/random-docs.factor | 112 +++++++++++++++++++ basis/combinators/random/random-tests.factor | 72 ++++++++++++ basis/combinators/random/random.factor | 69 ++++++++++++ basis/io/files/unique/unique.factor | 17 +-- basis/random/data/authors.txt | 1 + basis/random/data/data.factor | 20 ++++ 7 files changed, 280 insertions(+), 12 deletions(-) create mode 100644 basis/combinators/random/authors.txt create mode 100644 basis/combinators/random/random-docs.factor create mode 100644 basis/combinators/random/random-tests.factor create mode 100644 basis/combinators/random/random.factor create mode 100644 basis/random/data/authors.txt create mode 100644 basis/random/data/data.factor diff --git a/basis/combinators/random/authors.txt b/basis/combinators/random/authors.txt new file mode 100644 index 0000000000..2c5e05bdac --- /dev/null +++ b/basis/combinators/random/authors.txt @@ -0,0 +1 @@ +Jon Harper diff --git a/basis/combinators/random/random-docs.factor b/basis/combinators/random/random-docs.factor new file mode 100644 index 0000000000..2fc0b8c00e --- /dev/null +++ b/basis/combinators/random/random-docs.factor @@ -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" diff --git a/basis/combinators/random/random-tests.factor b/basis/combinators/random/random-tests.factor new file mode 100644 index 0000000000..32f2874538 --- /dev/null +++ b/basis/combinators/random/random-tests.factor @@ -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 diff --git a/basis/combinators/random/random.factor b/basis/combinators/random/random.factor new file mode 100644 index 0000000000..9e6fde9a16 --- /dev/null +++ b/basis/combinators/random/random.factor @@ -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 + +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 ; \ No newline at end of file diff --git a/basis/io/files/unique/unique.factor b/basis/io/files/unique/unique.factor index 7652bfcfd0..79dddba4ec 100644 --- a/basis/io/files/unique/unique.factor +++ b/basis/io/files/unique/unique.factor @@ -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 : unique-directory ( -- path ) [ current-temporary-directory get - random-name append-path + random-file-name append-path dup make-directory ] unique-retries get retry ; diff --git a/basis/random/data/authors.txt b/basis/random/data/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/random/data/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/random/data/data.factor b/basis/random/data/data.factor new file mode 100644 index 0000000000..f153065527 --- /dev/null +++ b/basis/random/data/data.factor @@ -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 ;