]> gitweb.factorcode.org Git - factor.git/commitdiff
_finally_ cleaned up miller-rabin. it's passable now
authorDoug Coleman <erg@jobim.local>
Wed, 6 May 2009 04:25:26 +0000 (23:25 -0500)
committerDoug Coleman <erg@jobim.local>
Wed, 6 May 2009 04:25:26 +0000 (23:25 -0500)
basis/math/miller-rabin/miller-rabin.factor

index 8c237d0dc3656ee0f7fdc20f78872302985f9059..62d8ee4432cfe08353c6d0ae65bd23eacb4a5780 100755 (executable)
@@ -6,31 +6,28 @@ IN: math.miller-rabin
 
 <PRIVATE
 
-: >odd ( n -- int ) dup even? [ 1+ ] when ; foldable
+: >odd ( n -- int ) dup even? [ 1 + ] when ; foldable
 
 TUPLE: positive-even-expected n ;
 
 :: (miller-rabin) ( n trials -- ? )
-    [let | r [ n 1- factor-2s drop ]
-           s [ n 1- factor-2s nip ]
-           prime?! [ t ]
-           a! [ 0 ]
-           count! [ 0 ] |
-        trials [
-            n 1- [1,b] random a!
-            a s n ^mod 1 = [
-                0 count!
-                r [
-                    2^ s * a swap n ^mod n - -1 =
-                    [ count 1+ count! r + ] when
-                ] each
-                count zero? [ f prime?! trials + ] when
-            ] unless drop
-        ] each prime? ] ;
-
+    n 1 - :> n-1
+    n-1 factor-2s :> s :> r
+    0 :> a!
+
+    trials [
+        drop
+        n-1 [1,b] random a!
+        a s n ^mod 1 = [
+            f
+        ] [
+            r [ 2^ s * a swap n ^mod n - -1 = ] any?
+        ] if
+    ] any? ;
+    
 PRIVATE>
 
-: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ;
+: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ;
 
 : miller-rabin* ( n numtrials -- ? )
     over {