<commit_before>! Copyright (C) 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.data arrays assocs byte-arrays
byte-vectors combinators combinators.short-circuit fry
hashtables hashtables.private hash-sets hints io.backend
io.binary kernel locals math math.bitwise math.constants
math.functions math.order math.ranges namespaces sequences
sequences.private sets summary system typed vocabs ;
QUALIFIED-WITH: alien.c-types c
QUALIFIED-WITH: sets sets
IN: random

SYMBOL: system-random-generator
SYMBOL: secure-random-generator
SYMBOL: random-generator

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 )
    [ [ <byte-vector> ] keep 4 /mod ] dip
    [ pick '[ _ random-32* c:int <ref> _ push-all ] times ]
    [
        over zero?
        [ 2drop ] [ random-32* c:int <ref> swap head append! ] if
    ] bi-curry bi* B{ } like ;

HINTS: M\ object random-bytes* { fixnum object } ;

M: object random-32* ( tuple -- r ) 4 swap random-bytes* be> ;

ERROR: no-random-number-generator ;

M: no-random-number-generator summary
    drop "Random number generator is not defined." ;

M: f random-bytes* ( n obj -- * ) no-random-number-generator ;

M: f random-32* ( obj -- * ) no-random-number-generator ;

: random-32 ( -- n ) random-generator get random-32* ;

TYPED: random-bytes ( n: fixnum -- byte-array: byte-array )
    random-generator get random-bytes* ; inline

<PRIVATE

: #bits ( n -- bits )
    dup 2 <= [ drop 1 ] [ 1 - log2 1 + ] if ; inline

:: (random-bits) ( n bits obj -- n' )
    obj random-32* 32 bits 32 - [ dup 0 > ] [
        [ 32 shift obj random-32* + ] [ 32 + ] [ 32 - ] tri*
    ] while drop [ n * ] [ 2^ /i ] bi* ; inline

: (random-integer) ( n obj -- n' )
    [ dup #bits ] dip (random-bits) ;

: random-integer ( n -- n' )
    random-generator get (random-integer) ;

PRIVATE>

: random-bits ( numbits -- r )
    [ 2^ ] keep random-generator get (random-bits) ;

: random-bits* ( numbits -- n )
    1 - [ random-bits ] keep set-bit ;

GENERIC: random ( obj -- elt )

M: integer random [ f ] [ random-integer ] if-zero ;

M: sequence random
    [ f ] [
        [ length random-integer ] keep nth
    ] if-empty ;

M: assoc random >alist random ;

M: hashtable random
    dup assoc-size [ drop f ] [
        [ 0 ] [ array>> ] [ random ] tri* 1 + [
            [ 2dup array-nth tombstone? [ 2 + ] 2dip ] loop
        ] times [ 2 - ] dip
        [ array-nth ] [ [ 1 + ] dip array-nth ] 2bi 2array
    ] if-zero ;

M: sets:set random members random ;

M: hash-set random table>> random first ;

: randomize-n-last ( seq n -- seq )
    [ dup length dup ] dip - 1 max '[ dup _ > ]
    [ [ random ] [ 1 - ] bi [ pick exchange-unsafe ] keep ]
    while drop ;

: randomize ( seq -- randomized )
    dup length randomize-n-last ;

ERROR: too-many-samples seq n ;

: sample ( seq n -- seq' )
    2dup [ length ] dip < [ too-many-samples ] when
    [ [ 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 ;

: with-random ( tuple quot -- )
    random-generator swap with-variable ; inline

: with-system-random ( quot -- )
    system-random-generator get swap with-random ; inline

: with-secure-random ( quot -- )
    secure-random-generator get swap with-random ; inline

<PRIVATE

: (uniform-random-float) ( min max obj -- n )
    [ 4 4 ] dip [ random-bytes* c:uint deref >float ] curry bi@
    2.0 32 ^ * +
    [ over - 2.0 -64 ^ * ] dip
    * + ; inline

PRIVATE>

: uniform-random-float ( min max -- n )
    random-generator get (uniform-random-float) ; inline

M: float random [ f ] [ 0.0 swap uniform-random-float ] if-zero ;

: random-unit ( -- n )
    0.0 1.0 uniform-random-float ; inline

: random-units ( length -- sequence )
    random-generator get '[ 0.0 1.0 _ (uniform-random-float) ] replicate ;

: random-integers ( length n -- sequence )
    random-generator get '[ _ _ (random-integer) ] replicate ;

: (cos-random-float) ( -- n )
    0. 2pi uniform-random-float cos ;

: (log-sqrt-random-float) ( -- n )
    random-unit log -2. * sqrt ;
<commit_msg>random: speed up uniform-random-float.<commit_after>! Copyright (C) 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.data arrays assocs byte-arrays
byte-vectors combinators combinators.short-circuit fry
hashtables hashtables.private hash-sets hints io.backend
io.binary kernel locals math math.bitwise math.constants
math.functions math.order math.ranges namespaces sequences
sequences.private sets summary system typed vocabs ;
QUALIFIED-WITH: alien.c-types c
QUALIFIED-WITH: sets sets
IN: random

SYMBOL: system-random-generator
SYMBOL: secure-random-generator
SYMBOL: random-generator

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 )
    [ [ <byte-vector> ] keep 4 /mod ] dip
    [ pick '[ _ random-32* c:int <ref> _ push-all ] times ]
    [
        over zero?
        [ 2drop ] [ random-32* c:int <ref> swap head append! ] if
    ] bi-curry bi* B{ } like ;

HINTS: M\ object random-bytes* { fixnum object } ;

M: object random-32* ( tuple -- r )
    4 swap random-bytes* c:uint deref ;

ERROR: no-random-number-generator ;

M: no-random-number-generator summary
    drop "Random number generator is not defined." ;

M: f random-bytes* ( n obj -- * ) no-random-number-generator ;

M: f random-32* ( obj -- * ) no-random-number-generator ;

: random-32 ( -- n ) random-generator get random-32* ;

TYPED: random-bytes ( n: fixnum -- byte-array: byte-array )
    random-generator get random-bytes* ; inline

<PRIVATE

: #bits ( n -- bits )
    dup 2 <= [ drop 1 ] [ 1 - log2 1 + ] if ; inline

:: (random-bits) ( n bits obj -- n' )
    obj random-32* 32 bits 32 - [ dup 0 > ] [
        [ 32 shift obj random-32* + ] [ 32 + ] [ 32 - ] tri*
    ] while drop [ n * ] [ 2^ /i ] bi* ; inline

: (random-integer) ( n obj -- n' )
    [ dup #bits ] dip (random-bits) ;

: random-integer ( n -- n' )
    random-generator get (random-integer) ;

PRIVATE>

: random-bits ( numbits -- r )
    [ 2^ ] keep random-generator get (random-bits) ;

: random-bits* ( numbits -- n )
    1 - [ random-bits ] keep set-bit ;

GENERIC: random ( obj -- elt )

M: integer random [ f ] [ random-integer ] if-zero ;

M: sequence random
    [ f ] [
        [ length random-integer ] keep nth
    ] if-empty ;

M: assoc random >alist random ;

M: hashtable random
    dup assoc-size [ drop f ] [
        [ 0 ] [ array>> ] [ random ] tri* 1 + [
            [ 2dup array-nth tombstone? [ 2 + ] 2dip ] loop
        ] times [ 2 - ] dip
        [ array-nth ] [ [ 1 + ] dip array-nth ] 2bi 2array
    ] if-zero ;

M: sets:set random members random ;

M: hash-set random table>> random first ;

: randomize-n-last ( seq n -- seq )
    [ dup length dup ] dip - 1 max '[ dup _ > ]
    [ [ random ] [ 1 - ] bi [ pick exchange-unsafe ] keep ]
    while drop ;

: randomize ( seq -- randomized )
    dup length randomize-n-last ;

ERROR: too-many-samples seq n ;

: sample ( seq n -- seq' )
    2dup [ length ] dip < [ too-many-samples ] when
    [ [ 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 ;

: with-random ( tuple quot -- )
    random-generator swap with-variable ; inline

: with-system-random ( quot -- )
    system-random-generator get swap with-random ; inline

: with-secure-random ( quot -- )
    secure-random-generator get swap with-random ; inline

<PRIVATE

: (uniform-random-float) ( min max obj -- n )
    [ random-32* ] keep random-32* [ >float ] bi@
    2.0 32 ^ * +
    [ over - 2.0 -64 ^ * ] dip
    * + ; inline

PRIVATE>

: uniform-random-float ( min max -- n )
    random-generator get (uniform-random-float) ; inline

M: float random [ f ] [ 0.0 swap uniform-random-float ] if-zero ;

: random-unit ( -- n )
    0.0 1.0 uniform-random-float ; inline

: random-units ( length -- sequence )
    random-generator get '[ 0.0 1.0 _ (uniform-random-float) ] replicate ;

: random-integers ( length n -- sequence )
    random-generator get '[ _ _ (random-integer) ] replicate ;

: (cos-random-float) ( -- n )
    0. 2pi uniform-random-float cos ;

: (log-sqrt-random-float) ( -- n )
    random-unit log -2. * sqrt ;

{'fraction_non_alphanumeric': 0.14350453172205438, 'fraction_numerical': 0.01928886823146642, 'mean_word_length': 2.4663713250100683, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 34, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5364595', 'n_tokens_mistral': 3042, 'n_tokens_neox': 2893, 'n_words': 880}