unmaintained/random-tester/random.factor

   1 USING: kernel math sequences namespaces errors hashtables words
   2 arrays parser compiler syntax io tools prettyprint optimizer
   3 inference ;
   4 IN: random-tester
   5
   6 ! Tweak me
   7 : max-length 15 ; inline
   8 : max-value 1000000000 ; inline
   9
  10 : 10% ( -- bool ) 10 random 8 > ;
  11 : 20% ( -- bool ) 10 random 7 > ;
  12 : 30% ( -- bool ) 10 random 6 > ;
  13 : 40% ( -- bool ) 10 random 5 > ;
  14 : 50% ( -- bool ) 10 random 4 > ;
  15 : 60% ( -- bool ) 10 random 3 > ;
  16 : 70% ( -- bool ) 10 random 2 > ;
  17 : 80% ( -- bool ) 10 random 1 > ;
  18 : 90% ( -- bool ) 10 random 0 > ;
  19
  20 ! varying bit-length random number
  21 : random-bits ( n -- int )
  22     random 2 swap ^ random ;
  23
  24 : random-seq ( -- seq )
  25     { [ ] { } V{ } "" } random
  26     [ max-length random [ max-value random , ] times ] swap make ;
  27
  28 : random-string
  29     [ max-length random [ max-value random , ] times ] "" make ;
  30
  31 SYMBOL: special-integers
  32 [ { -1 0 1 } % most-negative-fixnum , most-positive-fixnum , first-bignum , ]
  33 { } make \ special-integers set-global
  34 : special-integers ( -- seq ) \ special-integers get ;
  35 SYMBOL: special-floats
  36 [ { 0.0 -0.0 } % e , pi , 1./0. , -1./0. , 0./0. , epsilon , epsilon neg , ]
  37 { } make \ special-floats set-global
  38 : special-floats ( -- seq ) \ special-floats get ;
  39 SYMBOL: special-complexes
  40 [
  41     { -1 0 1 i -i } %
  42     e , e neg , pi , pi neg ,
  43     0 pi rect> , 0 pi neg rect> , pi neg 0 rect> , pi pi rect> ,
  44     pi pi neg rect> , pi neg pi rect> , pi neg pi neg rect> ,
  45     e neg e neg rect> , e e rect> ,
  46 ] { } make \ special-complexes set-global
  47 : special-complexes ( -- seq ) \ special-complexes get ;
  48
  49 : random-fixnum ( -- fixnum )
  50     most-positive-fixnum random 1+ coin-flip [ neg 1- ] when >fixnum ;
  51
  52 : random-bignum ( -- bignum )
  53      400 random-bits first-bignum + coin-flip [ neg ] when ;
  54
  55 : random-integer ( -- n )
  56     coin-flip [
  57         random-fixnum
  58     ] [
  59         coin-flip [ random-bignum ] [ special-integers random ] if
  60     ] if ;
  61
  62 : random-positive-integer ( -- int )
  63     random-integer dup 0 < [
  64             neg
  65         ] [
  66             dup 0 = [ 1 + ] when
  67     ] if ;
  68
  69 : random-ratio ( -- ratio )
  70     1000000000 dup [ random ] 2apply 1+ / coin-flip [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ;
  71
  72 : random-float ( -- float )
  73     coin-flip [ random-ratio ] [ special-floats random ] if
  74     coin-flip
  75     [ .0000000000000000001 /f ] [ coin-flip [ .00000000000000001 * ] when ] if
  76     >float ;
  77
  78 : random-number ( -- number )
  79     {
  80         [ random-integer ]
  81         [ random-ratio ]
  82         [ random-float ]
  83     } do-one ;
  84
  85 : random-complex ( -- C )
  86     random-number random-number rect> ;
  87