From bc5807b20afa0af4a3329ce389513785b097421f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 30 Sep 2009 02:26:32 -0500 Subject: [PATCH 1/5] add examples to checksums docs --- core/checksums/checksums-docs.factor | 30 +++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) diff --git a/core/checksums/checksums-docs.factor b/core/checksums/checksums-docs.factor index a05bf3a685..4ffd6f4427 100644 --- a/core/checksums/checksums-docs.factor +++ b/core/checksums/checksums-docs.factor @@ -20,15 +20,39 @@ HELP: checksum-stream HELP: checksum-bytes { $values { "bytes" "a sequence of bytes" } { "checksum" "a checksum specifier" } { "value" byte-array } } -{ $contract "Computes the checksum of all data in a sequence." } ; +{ $contract "Computes the checksum of all data in a sequence." } +{ $examples + { $example + "USING: checksums checksums.crc32 prettyprint ;" + "B{ 1 10 100 } crc32 checksum-bytes ." + "B{ 78 179 254 238 }" + } +} ; HELP: checksum-lines { $values { "lines" "a sequence of sequences of bytes" } { "checksum" "a checksum specifier" } { "value" byte-array } } -{ $contract "Computes the checksum of all data in a sequence." } ; +{ $contract "Computes the checksum of all data in a sequence." } +{ $examples + { $example + "USING: checksums checksums.crc32 prettyprint ;" +"""{ + "Take me out to the ball game" + "Take me out with the crowd" +} crc32 checksum-lines .""" + "B{ 111 205 9 27 }" + } +} ; HELP: checksum-file { $values { "path" "a pathname specifier" } { "checksum" "a checksum specifier" } { "value" byte-array } } -{ $contract "Computes the checksum of all data in a file." } ; +{ $contract "Computes the checksum of all data in a file." } +{ $examples + { $example + "USING: checksums checksums.crc32 prettyprint ;" + """"resource:license.txt" crc32 checksum-file .""" + "B{ 100 139 199 92 }" + } +} ; ARTICLE: "checksums" "Checksums" "A " { $emphasis "checksum" } " is a function mapping sequences of bytes to fixed-length strings. While checksums are not one-to-one, a good checksum should have a low probability of collision. Additionally, some checksum algorithms are designed to be hard to reverse, in the sense that finding an input string which hashes to a given checksum string requires a brute-force search." From 61583862fac2ccb14dd91de109fc9ed35928582e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 30 Sep 2009 03:22:11 -0500 Subject: [PATCH 2/5] fix seed-random, random-32* -> random-32 --- basis/random/dummy/dummy.factor | 6 +++--- .../mersenne-twister-tests.factor | 10 ++++++++-- .../mersenne-twister/mersenne-twister.factor | 16 +++++++++++----- basis/random/random-docs.factor | 12 ++++++++---- basis/random/random.factor | 12 ++++++------ .../blum-blum-shub/blum-blum-shub-tests.factor | 6 +++--- .../random/blum-blum-shub/blum-blum-shub.factor | 2 +- 7 files changed, 40 insertions(+), 24 deletions(-) diff --git a/basis/random/dummy/dummy.factor b/basis/random/dummy/dummy.factor index e6661dc078..5763570d75 100644 --- a/basis/random/dummy/dummy.factor +++ b/basis/random/dummy/dummy.factor @@ -4,8 +4,8 @@ IN: random.dummy TUPLE: random-dummy i ; C: random-dummy -M: random-dummy seed-random ( seed obj -- ) - (>>i) ; +M: random-dummy seed-random ( obj seed -- obj ) + >>i ; -M: random-dummy random-32* ( obj -- r ) +M: random-dummy random-32 ( obj -- r ) [ dup 1 + ] change-i drop ; diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor index 651e43ef5b..30caa56059 100644 --- a/basis/random/mersenne-twister/mersenne-twister-tests.factor +++ b/basis/random/mersenne-twister/mersenne-twister-tests.factor @@ -16,14 +16,20 @@ IN: random.mersenne-twister.tests [ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test [ 1333075495 ] [ - 0 [ 1000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng + 0 [ 1000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng ] unit-test [ 1575309035 ] [ - 0 [ 10000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng + 0 [ 10000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng ] unit-test [ 3 ] [ 101 [ 3 random-bytes length ] test-rng ] unit-test [ 33 ] [ 101 [ 33 random-bytes length ] test-rng ] unit-test [ t ] [ 101 [ 100 random-bits log2 90 > ] test-rng ] unit-test + +[ t ] +[ + 1234 + [ random-32 ] [ 1234 seed-random random-32 ] bi = +] unit-test diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor index e29f97ef2e..0e65e195e4 100644 --- a/basis/random/mersenne-twister/mersenne-twister.factor +++ b/basis/random/mersenne-twister/mersenne-twister.factor @@ -62,15 +62,21 @@ PRIVATE> init-mt-seq 0 mersenne-twister boa dup mt-generate ; -M: mersenne-twister seed-random ( mt seed -- ) - init-mt-seq >>seq drop ; +M: mersenne-twister seed-random ( mt seed -- mt' ) + init-mt-seq >>seq + [ mt-generate ] + [ 0 >>i drop ] + [ ] tri ; -M: mersenne-twister random-32* ( mt -- r ) +M: mersenne-twister random-32 ( mt -- r ) [ next-index ] [ seq>> nth-unsafe mt-temper ] [ [ 1 + ] change-i drop ] tri ; -[ +: default-mersenne-twister ( -- mersenne-twister ) [ 32 random-bits ] with-system-random - random-generator set-global + ; + +[ + default-mersenne-twister random-generator set-global ] "bootstrap.random" add-init-hook diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index bb0fc57312..a297df9fd6 100755 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -2,11 +2,15 @@ USING: help.markup help.syntax math kernel sequences ; IN: random HELP: seed-random -{ $values { "tuple" "a random number generator" } { "seed" "an integer between 0 and 2^32-1" } } -{ $description "Seed the random number generator." } +{ $values + { "tuple" "a random number generator" } + { "seed" "a seed specific to the random number generator" } + { "tuple'" "a random number generator" } +} +{ $description "Seed the random number generator. Repeatedly seeding the random number generator should provide the same sequence of random numbers." } { $notes "Not supported on all random number generators." } ; -HELP: random-32* +HELP: random-32 { $values { "tuple" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } } { $description "Generates a random 32-bit unsigned integer." } ; @@ -92,7 +96,7 @@ HELP: delete-random ARTICLE: "random-protocol" "Random protocol" "A random number generator must implement one of these two words:" -{ $subsection random-32* } +{ $subsection random-32 } { $subsection random-bytes* } "Optional, to seed a random number generator:" { $subsection seed-random } ; diff --git a/basis/random/random.factor b/basis/random/random.factor index afdf0b43ba..db15f78ee1 100755 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -10,19 +10,19 @@ SYMBOL: system-random-generator SYMBOL: secure-random-generator SYMBOL: random-generator -GENERIC: seed-random ( tuple seed -- ) -GENERIC: random-32* ( tuple -- r ) +GENERIC# seed-random 1 ( tuple seed -- tuple' ) +GENERIC: random-32 ( tuple -- r ) GENERIC: random-bytes* ( n tuple -- byte-array ) M: object random-bytes* ( n tuple -- byte-array ) [ [ ] keep 4 /mod ] dip - [ pick '[ _ random-32* 4 >le _ push-all ] times ] + [ pick '[ _ random-32 4 >le _ push-all ] times ] [ over zero? - [ 2drop ] [ random-32* 4 >le swap head over push-all ] if + [ 2drop ] [ random-32 4 >le swap head over push-all ] if ] bi-curry bi* ; -M: object random-32* ( tuple -- r ) 4 random-bytes* le> ; +M: object random-32 ( tuple -- r ) 4 random-bytes* le> ; ERROR: no-random-number-generator ; @@ -31,7 +31,7 @@ M: no-random-number-generator summary M: f random-bytes* ( n obj -- * ) no-random-number-generator ; -M: f random-32* ( obj -- * ) no-random-number-generator ; +M: f random-32 ( obj -- * ) no-random-number-generator ; : random-bytes ( n -- byte-array ) random-generator get random-bytes* ; diff --git a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor index 4b0dee642e..5b05b09a4c 100644 --- a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor @@ -4,7 +4,7 @@ grouping ; IN: blum-blum-shub.tests [ 887708070 ] [ - T{ blum-blum-shub f 590695557939 811977232793 } clone random-32* + T{ blum-blum-shub f 590695557939 811977232793 } clone random-32 ] unit-test @@ -23,7 +23,7 @@ IN: blum-blum-shub.tests [ 3716213681 ] [ 100 T{ blum-blum-shub f 200352954495 846054538649 } clone tuck [ - random-32* drop + random-32 drop ] curry times - random-32* + random-32 ] unit-test diff --git a/extra/random/blum-blum-shub/blum-blum-shub.factor b/extra/random/blum-blum-shub/blum-blum-shub.factor index 8229abca69..9f504cefb5 100755 --- a/extra/random/blum-blum-shub/blum-blum-shub.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub.factor @@ -25,6 +25,6 @@ PRIVATE> [ find-relative-prime ] keep blum-blum-shub boa ; -M: blum-blum-shub random-32* ( bbs -- r ) +M: blum-blum-shub random-32 ( bbs -- r ) 0 32 rot [ next-bbs-bit swap 1 shift bitor ] curry times ; From 73d2099faf150f069adb137aa7d60646c85b0f88 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 30 Sep 2009 03:23:01 -0500 Subject: [PATCH 3/5] add tests file for random.dummy --- basis/random/dummy/dummy-tests.factor | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 basis/random/dummy/dummy-tests.factor diff --git a/basis/random/dummy/dummy-tests.factor b/basis/random/dummy/dummy-tests.factor new file mode 100644 index 0000000000..1fa81c4d6e --- /dev/null +++ b/basis/random/dummy/dummy-tests.factor @@ -0,0 +1,7 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: random random.dummy tools.test ; +IN: random.dummy.tests + +[ 10 ] [ 10 random-32 ] unit-test +[ 100 ] [ 10 100 seed-random random-32 ] unit-test From f58e913336f8923786a7067c01ddae2e251db5c1 Mon Sep 17 00:00:00 2001 From: Keith Lazuka Date: Wed, 30 Sep 2009 14:38:53 -0400 Subject: [PATCH 4/5] help.markup: fix layout bug for "N more results" link in apropos content --- basis/help/markup/markup.factor | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index 2377a6753a..678d55df61 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -181,20 +181,22 @@ M: word link-long-text : >topic ( obj -- topic ) dup topic? [ >link ] unless ; +: topic-span ( topic quot -- ) [ >topic ] dip ($span) ; inline + PRIVATE> -: ($link) ( topic -- ) >topic link-text ; +: ($link) ( topic -- ) [ link-text ] topic-span ; : $link ( element -- ) first ($link) ; -: ($long-link) ( topic -- ) >topic link-long-text ; +: ($long-link) ( topic -- ) [ link-long-text ] topic-span ; : $long-link ( element -- ) first ($long-link) ; : ($pretty-link) ( topic -- ) - >topic [ link-icon ] [ drop bl ] [ link-text ] tri ; + [ [ link-icon ] [ drop bl ] [ link-text ] tri ] topic-span ; : $pretty-link ( element -- ) first ($pretty-link) ; : ($long-pretty-link) ( topic -- ) - >topic [ link-icon ] [ drop bl ] [ link-long-text ] tri ; + [ [ link-icon ] [ drop bl ] [ link-long-text ] tri ] topic-span ; : <$pretty-link> ( definition -- element ) 1array \ $pretty-link prefix ; From ef237777c3a84ca7a90fc9ea434f9053d0093faa Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 30 Sep 2009 15:56:02 -0500 Subject: [PATCH 5/5] make random-32* the protocol again, add a random-32 word that doesn't scale the returned bits --- basis/random/dummy/dummy-tests.factor | 4 ++-- basis/random/dummy/dummy.factor | 2 +- .../mersenne-twister/mersenne-twister-tests.factor | 6 +++--- .../random/mersenne-twister/mersenne-twister.factor | 2 +- basis/random/random-docs.factor | 10 ++++++++-- basis/random/random.factor | 12 +++++++----- .../blum-blum-shub/blum-blum-shub-tests.factor | 6 +++--- extra/random/blum-blum-shub/blum-blum-shub.factor | 2 +- 8 files changed, 26 insertions(+), 18 deletions(-) diff --git a/basis/random/dummy/dummy-tests.factor b/basis/random/dummy/dummy-tests.factor index 1fa81c4d6e..5d4b4b5473 100644 --- a/basis/random/dummy/dummy-tests.factor +++ b/basis/random/dummy/dummy-tests.factor @@ -3,5 +3,5 @@ USING: random random.dummy tools.test ; IN: random.dummy.tests -[ 10 ] [ 10 random-32 ] unit-test -[ 100 ] [ 10 100 seed-random random-32 ] unit-test +[ 10 ] [ 10 random-32* ] unit-test +[ 100 ] [ 10 100 seed-random random-32* ] unit-test diff --git a/basis/random/dummy/dummy.factor b/basis/random/dummy/dummy.factor index 5763570d75..988bd015d0 100644 --- a/basis/random/dummy/dummy.factor +++ b/basis/random/dummy/dummy.factor @@ -7,5 +7,5 @@ C: random-dummy M: random-dummy seed-random ( obj seed -- obj ) >>i ; -M: random-dummy random-32 ( obj -- r ) +M: random-dummy random-32* ( obj -- r ) [ dup 1 + ] change-i drop ; diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor index 30caa56059..b877af6f79 100644 --- a/basis/random/mersenne-twister/mersenne-twister-tests.factor +++ b/basis/random/mersenne-twister/mersenne-twister-tests.factor @@ -16,11 +16,11 @@ IN: random.mersenne-twister.tests [ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test [ 1333075495 ] [ - 0 [ 1000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng + 0 [ 1000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng ] unit-test [ 1575309035 ] [ - 0 [ 10000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng + 0 [ 10000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng ] unit-test @@ -31,5 +31,5 @@ IN: random.mersenne-twister.tests [ t ] [ 1234 - [ random-32 ] [ 1234 seed-random random-32 ] bi = + [ random-32* ] [ 1234 seed-random random-32* ] bi = ] unit-test diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor index 0e65e195e4..51112ae980 100644 --- a/basis/random/mersenne-twister/mersenne-twister.factor +++ b/basis/random/mersenne-twister/mersenne-twister.factor @@ -68,7 +68,7 @@ M: mersenne-twister seed-random ( mt seed -- mt' ) [ 0 >>i drop ] [ ] tri ; -M: mersenne-twister random-32 ( mt -- r ) +M: mersenne-twister random-32* ( mt -- r ) [ next-index ] [ seq>> nth-unsafe mt-temper ] [ [ 1 + ] change-i drop ] tri ; diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index a297df9fd6..79e38ec3b6 100755 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -10,7 +10,7 @@ HELP: seed-random { $description "Seed the random number generator. Repeatedly seeding the random number generator should provide the same sequence of random numbers." } { $notes "Not supported on all random number generators." } ; -HELP: random-32 +HELP: random-32* { $values { "tuple" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } } { $description "Generates a random 32-bit unsigned integer." } ; @@ -33,6 +33,10 @@ HELP: random "heads" } } ; +HELP: random-32 +{ $values { "elt" "a 32-bit random integer" } } +{ $description "Outputs 32 random bits. This word is more efficient than calling " { $link random } " because no scaling is done on the output." } ; + HELP: random-bytes { $values { "n" "an integer" } { "byte-array" "a random integer" } } { $description "Outputs an integer with n bytes worth of bits." } @@ -96,7 +100,7 @@ HELP: delete-random ARTICLE: "random-protocol" "Random protocol" "A random number generator must implement one of these two words:" -{ $subsection random-32 } +{ $subsection random-32* } { $subsection random-bytes* } "Optional, to seed a random number generator:" { $subsection seed-random } ; @@ -108,6 +112,8 @@ $nl $nl "Generate a random object:" { $subsection random } +"Efficient 32-bit random numbers:" +{ $subsection random-32 } "Combinators to change the random number generator:" { $subsection with-random } { $subsection with-system-random } diff --git a/basis/random/random.factor b/basis/random/random.factor index db15f78ee1..1f2408556f 100755 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -11,18 +11,18 @@ SYMBOL: secure-random-generator SYMBOL: random-generator GENERIC# seed-random 1 ( tuple seed -- tuple' ) -GENERIC: random-32 ( tuple -- r ) +GENERIC: random-32* ( tuple -- r ) GENERIC: random-bytes* ( n tuple -- byte-array ) M: object random-bytes* ( n tuple -- byte-array ) [ [ ] keep 4 /mod ] dip - [ pick '[ _ random-32 4 >le _ push-all ] times ] + [ pick '[ _ random-32* 4 >le _ push-all ] times ] [ over zero? - [ 2drop ] [ random-32 4 >le swap head over push-all ] if + [ 2drop ] [ random-32* 4 >le swap head over push-all ] if ] bi-curry bi* ; -M: object random-32 ( tuple -- r ) 4 random-bytes* le> ; +M: object random-32* ( tuple -- r ) 4 random-bytes* le> ; ERROR: no-random-number-generator ; @@ -31,7 +31,7 @@ M: no-random-number-generator summary M: f random-bytes* ( n obj -- * ) no-random-number-generator ; -M: f random-32 ( obj -- * ) no-random-number-generator ; +M: f random-32* ( obj -- * ) no-random-number-generator ; : random-bytes ( n -- byte-array ) random-generator get random-bytes* ; @@ -55,6 +55,8 @@ PRIVATE> [ length random-integer ] keep nth ] if-empty ; +: random-32 ( -- n ) random-generator get random-32* ; + : randomize ( seq -- seq ) dup length [ dup 1 > ] [ [ iota random ] [ 1 - ] bi [ pick exchange ] keep ] diff --git a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor index 5b05b09a4c..4b0dee642e 100644 --- a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor @@ -4,7 +4,7 @@ grouping ; IN: blum-blum-shub.tests [ 887708070 ] [ - T{ blum-blum-shub f 590695557939 811977232793 } clone random-32 + T{ blum-blum-shub f 590695557939 811977232793 } clone random-32* ] unit-test @@ -23,7 +23,7 @@ IN: blum-blum-shub.tests [ 3716213681 ] [ 100 T{ blum-blum-shub f 200352954495 846054538649 } clone tuck [ - random-32 drop + random-32* drop ] curry times - random-32 + random-32* ] unit-test diff --git a/extra/random/blum-blum-shub/blum-blum-shub.factor b/extra/random/blum-blum-shub/blum-blum-shub.factor index 9f504cefb5..8229abca69 100755 --- a/extra/random/blum-blum-shub/blum-blum-shub.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub.factor @@ -25,6 +25,6 @@ PRIVATE> [ find-relative-prime ] keep blum-blum-shub boa ; -M: blum-blum-shub random-32 ( bbs -- r ) +M: blum-blum-shub random-32* ( bbs -- r ) 0 32 rot [ next-bbs-bit swap 1 shift bitor ] curry times ;