steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

move random-tester2 to apps/, add random-tester2

darcs
erg 2006-12-05 00:08:55 +00:00
parent cce3c52f2e
commit ba78fe8aa1
4 changed files with 27 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
libs/random-tester/load.factor → apps/random-tester/load.factor
View File

@ -1,6 +1,7 @@
PROVIDE: libs/random-tester
PROVIDE: apps/random-tester
{ +files+ {
"utils.factor"
"random.factor"
"random-tester.factor"
"random-tester2.factor"
} } ;

47
libs/random-tester/random-tester.factor → apps/random-tester/random-tester.factor
View File

@ -105,10 +105,6 @@ IN: random-tester
: 2-complex>complex { * + - /f } ;
SYMBOL: last-quot
SYMBOL: first-arg
SYMBOL: second-arg
@ -178,10 +174,10 @@ SYMBOL: second-arg
! RANDOM QUOTATIONS TO TEST
: random-1-integer>x-quot ( -- quot ) 1-integer>x nth-rand unit ;
: random-1-ratio>x-quot ( -- quot ) 1-ratio>x nth-rand unit ;
: random-1-float>x-quot ( -- quot ) 1-float>x nth-rand unit ;
: random-1-complex>x-quot ( -- quot ) 1-complex>x nth-rand unit ;
: random-1-integer>x-quot ( -- quot ) 1-integer>x pick-one unit ;
: random-1-ratio>x-quot ( -- quot ) 1-ratio>x pick-one unit ;
: random-1-float>x-quot ( -- quot ) 1-float>x pick-one unit ;
: random-1-complex>x-quot ( -- quot ) 1-complex>x pick-one unit ;
: test-1-integer>x ( -- )
random-integer random-1-integer>x-quot 1-interpreted-vs-compiled-check ;
@ -193,18 +189,18 @@ SYMBOL: second-arg
random-complex random-1-complex>x-quot 1-interpreted-vs-compiled-check ;
: random-1-float>float-quot ( -- obj ) 1-float>float nth-rand unit ;
: random-2-float>float-quot ( -- obj ) 2-float>float nth-rand unit ;
: random-1-float>float-quot ( -- obj ) 1-float>float pick-one unit ;
: random-2-float>float-quot ( -- obj ) 2-float>float pick-one unit ;
: nrandom-2-float>float-quot ( -- obj )
[
5
[
{
[ 2-float>float nth-rand , random-float , ]
[ 1-float>float nth-rand , ]
[ 2-float>float pick-one , random-float , ]
[ 1-float>float pick-one , ]
} do-one
] times
2-float>float nth-rand ,
2-float>float pick-one ,
] [ ] make ;
: test-1-float>float ( -- )
@ -220,8 +216,8 @@ SYMBOL: second-arg
: test-1-integer>x-runtime ( -- )
random-integer random-1-integer>x-quot 1-runtime-check ;
: random-1-integer>x-throws-quot ( -- obj ) 1-integer>x-throws nth-rand unit ;
: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws nth-rand unit ;
: random-1-integer>x-throws-quot ( -- obj ) 1-integer>x-throws pick-one unit ;
: random-1-ratio>x-throws-quot ( -- obj ) 1-ratio>x-throws pick-one unit ;
: test-1-integer>x-throws ( -- obj )
random-integer random-1-integer>x-throws-quot
1-interpreted-vs-compiled-check-catch ;
@ -234,16 +230,9 @@ SYMBOL: second-arg
: test-2-integer>x-throws ( -- )
[
random-integer , random-integer ,
2-x>y-throws nth-rand ,
2-x>y-throws pick-one ,
] [ ] make 2-interpreted-vs-compiled-check-catch ;
! : test-^-shift ( -- )
! [
! 100 random-int 50 - ,
! 100 random-int 50 - ,
! { ^ shift } nth-rand ,
! ] [ ] make 2-interpreted-vs-compiled-check-catch ;
! : test-^-ratio ( -- )
! [
! random-ratio , random-ratio , \ ^ ,
@ -251,27 +240,27 @@ SYMBOL: second-arg
: test-0-float?-when
[
random-number , \ dup , \ float? , 1-float>x nth-rand unit , \ when ,
random-number , \ dup , \ float? , 1-float>x pick-one unit , \ when ,
] [ ] make 0-runtime-check ;
: test-1-integer?-when
random-integer [
\ dup , \ integer? , 1-integer>x nth-rand unit , \ when ,
\ dup , \ integer? , 1-integer>x pick-one unit , \ when ,
] [ ] make 1-interpreted-vs-compiled-check ;
: test-1-ratio?-when
random-ratio [
\ dup , \ ratio? , 1-ratio>x nth-rand unit , \ when ,
\ dup , \ ratio? , 1-ratio>x pick-one unit , \ when ,
] [ ] make 1-interpreted-vs-compiled-check ;
: test-1-float?-when
random-float [
\ dup , \ float? , 1-float>x nth-rand unit , \ when ,
\ dup , \ float? , 1-float>x pick-one unit , \ when ,
] [ ] make 1-interpreted-vs-compiled-check ;
: test-1-complex?-when
random-complex [
\ dup , \ complex? , 1-complex>x nth-rand unit , \ when ,
\ dup , \ complex? , 1-complex>x pick-one unit , \ when ,
] [ ] make 1-interpreted-vs-compiled-check ;
@ -308,5 +297,5 @@ SYMBOL: second-arg
test-1-complex?-when
! full-gc
! code-gc
} nth-rand dup . execute terpri ;
} pick-one dup . execute terpri ;

6
libs/random-tester/random.factor → apps/random-tester/random.factor
View File

@ -22,7 +22,7 @@ IN: random-tester
random-int 2 swap ^ random-int ;
: random-seq ( -- seq )
{ [ ] { } V{ } "" } nth-rand
{ [ ] { } V{ } "" } pick-one
[ max-length random-int [ max-value random-int , ] times ] swap make ;
: random-string
@ -56,7 +56,7 @@ SYMBOL: special-complexes
coin-flip [
random-fixnum
] [
coin-flip [ random-bignum ] [ special-integers nth-rand ] if
coin-flip [ random-bignum ] [ special-integers pick-one ] if
] if ;
: random-positive-integer ( -- int )
@ -70,7 +70,7 @@ SYMBOL: special-complexes
1000000000 dup [ random-int ] 2apply 1+ / coin-flip [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ;
: random-float ( -- float )
coin-flip [ random-ratio ] [ special-floats nth-rand ] if
coin-flip [ random-ratio ] [ special-floats pick-one ] if
coin-flip
[ .0000000000000000001 /f ] [ coin-flip [ .00000000000000001 * ] when ] if
>float ;

7
libs/random-tester/utils.factor → apps/random-tester/utils.factor
View File

@ -3,11 +3,12 @@ arrays parser compiler syntax io optimizer inference tools
prettyprint ;
IN: random-tester
: nth-rand ( seq -- elem ) [ length random-int ] keep nth ;
: pick-one ( seq -- elt )
[ length random-int ] keep nth ;
! HASHTABLES
: random-hash-entry ( hash -- key value )
hash>alist nth-rand first2 ;
hash>alist pick-one first2 ;
: coin-flip ( -- bool ) 2 random-int zero? ;
: do-one ( seq -- ) nth-rand call ; inline
: do-one ( seq -- ) pick-one call ; inline