From c8e63057a0029ca51d60703106b7b0fc29257819 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <ehrenbed@carleton.edu>
Date: Sun, 9 Dec 2007 01:35:26 -0500
Subject: [PATCH] Minor random tester cleanup

---
 extra/random-tester/random/random.factor | 27 +++-------
 extra/random-tester/utils/utils.factor   | 67 ++----------------------
 2 files changed, 10 insertions(+), 84 deletions(-)

diff --git a/extra/random-tester/random/random.factor b/extra/random-tester/random/random.factor
index da9a5c26d8..7b7b4dfb6e 100755
--- a/extra/random-tester/random/random.factor
+++ b/extra/random-tester/random/random.factor
@@ -1,22 +1,12 @@
-USING: kernel math sequences namespaces errors hashtables words
-arrays parser compiler syntax io tools prettyprint optimizer
-inference ;
+USING: kernel math sequences namespaces hashtables words math.functions
+arrays parser compiler syntax io random prettyprint optimizer layouts 
+inference math.constants random-tester.utils ;
 IN: random-tester
 
 ! Tweak me
 : max-length 15 ; inline
 : max-value 1000000000 ; inline
 
-: 10% ( -- bool ) 10 random 8 > ;
-: 20% ( -- bool ) 10 random 7 > ;
-: 30% ( -- bool ) 10 random 6 > ;
-: 40% ( -- bool ) 10 random 5 > ;
-: 50% ( -- bool ) 10 random 4 > ;
-: 60% ( -- bool ) 10 random 3 > ;
-: 70% ( -- bool ) 10 random 2 > ;
-: 80% ( -- bool ) 10 random 1 > ;
-: 90% ( -- bool ) 10 random 0 > ;
-
 ! varying bit-length random number
 : random-bits ( n -- int )
     random 2 swap ^ random ;
@@ -28,23 +18,20 @@ IN: random-tester
 : random-string
     [ max-length random [ max-value random , ] times ] "" make ;
 
-SYMBOL: special-integers
+: special-integers ( -- seq ) \ special-integers get ;
 [ { -1 0 1 } % most-negative-fixnum , most-positive-fixnum , first-bignum , ] 
 { } make \ special-integers set-global
-: special-integers ( -- seq ) \ special-integers get ;
-SYMBOL: special-floats
+: special-floats ( -- seq ) \ special-floats get ;
 [ { 0.0 -0.0 } % e , pi , 1./0. , -1./0. , 0./0. , epsilon , epsilon neg , ]
 { } make \ special-floats set-global
-: special-floats ( -- seq ) \ special-floats get ;
-SYMBOL: special-complexes
+: special-complexes ( -- seq ) \ special-complexes get ;
 [ 
-    { -1 0 1 i -i } %
+    { -1 0 1 } % -1 sqrt dup , neg ,
     e , e neg , pi , pi neg ,
     0 pi rect> , 0 pi neg rect> , pi neg 0 rect> , pi pi rect> ,
     pi pi neg rect> , pi neg pi rect> , pi neg pi neg rect> ,
     e neg e neg rect> , e e rect> ,
 ] { } make \ special-complexes set-global
-: special-complexes ( -- seq ) \ special-complexes get ;
 
 : random-fixnum ( -- fixnum )
     most-positive-fixnum random 1+ coin-flip [ neg 1- ] when >fixnum ;
diff --git a/extra/random-tester/utils/utils.factor b/extra/random-tester/utils/utils.factor
index ef3d66ad2d..3bc8184e5e 100644
--- a/extra/random-tester/utils/utils.factor
+++ b/extra/random-tester/utils/utils.factor
@@ -1,7 +1,6 @@
 USING: arrays assocs combinators.lib continuations kernel
 math math.functions namespaces quotations random sequences
 sequences.private shuffle ;
-
 IN: random-tester.utils
 
 : %chance ( n -- ? )
@@ -17,7 +16,7 @@ IN: random-tester.utils
 : 80% ( -- ? ) 80 %chance ;
 : 90% ( -- ? ) 90 %chance ;
 
-: call-if ( quot ? -- ) [ call ] [ drop ] if ; inline
+: call-if ( quot ? -- ) swap when ; inline
 
 : with-10% ( quot -- ) 10% call-if ; inline
 : with-20% ( quot -- ) 20% call-if ; inline
@@ -29,67 +28,7 @@ IN: random-tester.utils
 : with-80% ( quot -- ) 80% call-if ; inline
 : with-90% ( quot -- ) 90% call-if ; inline
 
-: random-hash-key keys random ;
-: random-hash-value [ random-hash-key ] keep at ;
+: random-key keys random ;
+: random-value [ random-key ] keep at ;
 
 : do-one ( seq -- ) random call ; inline
-
-TUPLE: p-list seq max count count-vec ;
-
-: reset-array ( seq -- )
-    [ drop 0 ] over map-into ;
-
-C: <p-list> p-list
-
-: make-p-list ( seq n -- tuple )
-    >r dup length [ 1- ] keep r>
-    [ ^ 0 swap 2array ] keep
-    0 <array> <p-list> ;
-
-: inc-seq ( seq max -- )
-    2dup [ < ] curry find-last over [
-        nipd 1+ 2over swap set-nth
-        1+ over length rot <slice> reset-array
-    ] [
-        3drop reset-array
-    ] if ;
-
-: inc-count ( tuple -- )
-    [ p-list-count first2 >r 1+ r> 2array ] keep
-    set-p-list-count ;
-
-: (get-permutation) ( seq index-seq -- newseq )
-    [ swap nth ] map-with ;
-
-: get-permutation ( tuple -- seq )
-    [ p-list-seq ] keep p-list-count-vec (get-permutation) ;
-
-: p-list-next ( tuple -- seq/f )
-    dup p-list-count first2 < [
-        [
-            [ get-permutation ] keep
-            [ p-list-count-vec ] keep p-list-max
-            inc-seq
-        ] keep inc-count
-    ] [
-        drop f
-    ] if ;
-
-: (permutations) ( tuple -- )
-    dup p-list-next [ , (permutations) ] [ drop ] if* ;
-
-: permutations ( seq n -- seq )
-    make-p-list [ (permutations) ] { } make ;
-
-: (each-permutation) ( tuple quot -- )
-    over p-list-next [
-        [ rot drop swap call ] 3keep
-        drop (each-permutation)
-    ] [
-        2drop
-    ] if* ; inline
-
-: each-permutation ( seq n quot -- )
-    >r make-p-list r> (each-permutation) ;
-
-