Better implementation of sample, fix docs formatting
parent
0d939f731a
commit
f15ec31559
|
@ -86,8 +86,9 @@ HELP: sample
|
|||
}
|
||||
{ $description "Takes " { $snippet "n" } " samples at random without replacement from a sequence. Throws an error if " { $snippet "n" } " is longer than the sequence." }
|
||||
{ $examples
|
||||
{ $unchecked-example "USING: random prettyprint ; { 1 2 3 } 2 sample ."
|
||||
"{ 3 2 }"
|
||||
{ $unchecked-example "USING: random prettyprint ;"
|
||||
"{ 1 2 3 } 2 sample ."
|
||||
"{ 3 2 }"
|
||||
}
|
||||
} ;
|
||||
|
||||
|
|
|
@ -61,29 +61,20 @@ M: sequence random
|
|||
|
||||
: random-32 ( -- n ) random-generator get random-32* ;
|
||||
|
||||
: randomize ( seq -- seq )
|
||||
dup length [ dup 1 > ]
|
||||
: randomize-n-last ( seq n -- seq )
|
||||
[ dup length dup ] dip - 1 max '[ dup _ > ]
|
||||
[ [ random ] [ 1 - ] bi [ pick exchange ] keep ]
|
||||
while drop ;
|
||||
|
||||
: randomize ( seq -- seq )
|
||||
dup length randomize-n-last ;
|
||||
|
||||
ERROR: too-many-samples seq n ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
:: next-sample ( length n seq hashtable -- elt )
|
||||
n hashtable key? [
|
||||
length n 1 + length mod seq hashtable next-sample
|
||||
] [
|
||||
n hashtable conjoin
|
||||
n seq nth
|
||||
] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: sample ( seq n -- seq' )
|
||||
2dup [ length ] dip < [ too-many-samples ] when
|
||||
swap [ length ] [ ] bi H{ } clone
|
||||
'[ _ dup random _ _ next-sample ] replicate ;
|
||||
[ [ length iota >array ] dip [ randomize-n-last ] keep tail-slice* ]
|
||||
[ drop ] 2bi nths ;
|
||||
|
||||
: delete-random ( seq -- elt )
|
||||
[ length random-integer ] keep [ nth ] 2keep remove-nth! drop ;
|
||||
|
|
Loading…
Reference in New Issue