use while to implement randomize (thanks joe!), document it
parent
a0491606bc
commit
99122a8fb1
|
@ -57,6 +57,13 @@ HELP: with-system-random
|
|||
|
||||
{ with-random with-secure-random with-system-random } related-words
|
||||
|
||||
HELP: randomize
|
||||
{ $values
|
||||
{ "seq" sequence }
|
||||
{ "seq" sequence }
|
||||
}
|
||||
{ $description "Randomizes a sequence in-place with the Fisher-Yates algorithm and returns the sequence." } ;
|
||||
|
||||
HELP: delete-random
|
||||
{ $values
|
||||
{ "seq" sequence }
|
||||
|
@ -83,6 +90,8 @@ $nl
|
|||
{ $subsection with-secure-random }
|
||||
"Implementation:"
|
||||
{ $subsection "random-protocol" }
|
||||
"Randomizing a sequence:"
|
||||
{ $subsection randomize }
|
||||
"Deleting a random element from a sequence:"
|
||||
{ $subsection delete-random } ;
|
||||
|
||||
|
|
|
@ -18,14 +18,8 @@ IN: random.tests
|
|||
|
||||
[ f ] [ 0 random ] unit-test
|
||||
|
||||
[ 0 ] [ { } >randomize-range length ] unit-test
|
||||
[ 0 ] [ { 1 } >randomize-range length ] unit-test
|
||||
|
||||
[ { } ] [ { } randomize ] unit-test
|
||||
[ { 1 } ] [ { 1 } randomize ] unit-test
|
||||
|
||||
[ f ]
|
||||
[ 100 [ { 0 1 } random ] replicate all-equal? ] unit-test
|
||||
|
||||
[ t ]
|
||||
[ { 1 2 } [ length ] [ >randomize-range length ] bi - 1 = ] unit-test
|
||||
|
|
|
@ -43,9 +43,6 @@ M: f random-32* ( obj -- * ) no-random-number-generator ;
|
|||
[ random-bytes >byte-array byte-array>bignum ]
|
||||
[ 3 shift 2^ ] bi / * >integer ;
|
||||
|
||||
: >randomize-range ( seq -- range/iota )
|
||||
length dup 2 < [ drop 0 iota ] [ 1+ 2 (a,b] ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: random-bits ( n -- r ) 2^ random-integer ;
|
||||
|
@ -55,9 +52,10 @@ PRIVATE>
|
|||
[ length random-integer ] keep nth
|
||||
] if-empty ;
|
||||
|
||||
: randomize ( seq -- seq' )
|
||||
[ ] [ >randomize-range ] [ ] tri
|
||||
'[ [ random ] [ 1- ] bi _ exchange ] each ;
|
||||
: randomize ( seq -- seq )
|
||||
dup length [ dup 1 > ]
|
||||
[ [ random ] [ 1- ] bi [ pick exchange ] keep ]
|
||||
[ ] while drop ;
|
||||
|
||||
: delete-random ( seq -- elt )
|
||||
[ length random-integer ] keep [ nth ] 2keep delete-nth ;
|
||||
|
|
Loading…
Reference in New Issue