Merge branch 'master' of git://factorcode.org/git/factor

basis/math/constants/constants.factor

@@ -7,6 +7,7 @@ IN: math.constants
 : euler ( -- gamma ) 0.57721566490153286060 ; inline
 : phi ( -- phi ) 1.61803398874989484820 ; inline
 : pi ( -- pi ) 3.14159265358979323846 ; inline
+: 2pi ( -- pi ) 2 pi * ; inline
 : epsilon ( -- epsilon ) 2.2204460492503131e-16 ; inline
 : smallest-float ( -- x ) HEX: 1 bits>double ; foldable
 : largest-float ( -- x ) HEX: 7fefffffffffffff bits>double ; foldable

basis/math/functions/functions.factor

@@ -23,7 +23,7 @@ M: real sqrt
 
 <PRIVATE
 
-GENERIC# ^n 1 ( z w -- z^w )
+GENERIC# ^n 1 ( z w -- z^w ) foldable
 
 : (^n) ( z w -- z^w )
     make-bits 1 [ [ dupd * ] when [ sq ] dip ] reduce nip ; inline

basis/math/miller-rabin/miller-rabin.factor

@@ -1,28 +1,32 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators kernel locals math math.functions math.ranges
-random sequences sets combinators.short-circuit ;
+random sequences sets combinators.short-circuit math.bitwise ;
 IN: math.miller-rabin
 
 <PRIVATE
 
 : >odd ( n -- int ) dup even? [ 1 + ] when ; foldable
 
+: >even ( n -- int ) 0 clear-bit ; foldable
+
 TUPLE: positive-even-expected n ;
 
 :: (miller-rabin) ( n trials -- ? )
     n 1 - :> n-1
     n-1 factor-2s :> s :> r
     0 :> a!
-    t :> prime?!
     trials [
+        drop
         n 1 - [1,b] random a!
         a s n ^mod 1 = [
+            f
+        ] [
             r iota [
                 2^ s * a swap n ^mod n - -1 =
-            ] any? not [ f prime?! trials + ] when
-        ] unless drop
-    ] each prime? ;
+            ] any? not 
+        ] if
+    ] any? not ;
 
 PRIVATE>
 
@@ -83,7 +87,6 @@ ERROR: too-few-primes ;
     1 + 6 divisor? ;
 
 : next-safe-prime-candidate ( n -- candidate )
-    1 - 2/
     next-prime dup safe-prime-candidate?
     [ next-safe-prime-candidate ] unless ;
 
@@ -96,10 +99,14 @@ PRIVATE>
     } 1&& ;
 
 : next-safe-prime ( n -- q )
+    1 - >even 2 /
     next-safe-prime-candidate
     dup >safe-prime-form
     dup miller-rabin
     [ nip ] [ drop next-safe-prime ] if ;
 
+: random-bits* ( numbits -- n )
+    [ random-bits ] keep set-bit ;
+
 : random-safe-prime ( numbits -- p )
-    random-bits next-safe-prime ;
+    1- random-bits* next-safe-prime ;

basis/random/random.factor

@@ -3,7 +3,7 @@
 USING: alien.c-types kernel math namespaces sequences
 io.backend io.binary combinators system vocabs.loader
 summary math.bitwise byte-vectors fry byte-arrays
-math.ranges ;
+math.ranges math.constants math.functions ;
 IN: random
 
 SYMBOL: system-random-generator
@@ -69,6 +69,17 @@ PRIVATE>
 : with-secure-random ( quot -- )
     secure-random-generator get swap with-random ; inline
 
+: uniform-random-float ( min max -- n )
+    64 random-bits >float [ over - 2.0 -64 ^ * ] dip
+    * + ;
+
+: normal-random-float ( mean sigma -- n )
+    0.0 1.0 uniform-random-float
+    0.0 1.0 uniform-random-float
+    [ 2 pi * * cos ]
+    [ 1.0 swap - log -2.0 * sqrt ]
+    bi* * * + ;
+
 USE: vocabs.loader
 
 {

extra/perlin-noise/perlin-noise.factor

@@ -1,4 +1,4 @@
-USING: byte-arrays combinators images kernel locals math
+USING: byte-arrays combinators images kernel locals math math.affine-transforms
 math.functions math.polynomials math.vectors random sequences
 sequences.product ;
 IN: perlin-noise
@@ -70,14 +70,14 @@ IN: perlin-noise
     [ faded second lerp ] 2bi@
     faded third lerp ;
 
-: noise-map ( table scale dim -- map ) 
-    [ iota ] map [ v* 0.0 suffix noise ] with with product-map ;
+: noise-map ( table transform dim -- map ) 
+    [ iota ] map [ a.v 0.0 suffix noise ] with with product-map ;
 
-: normalize ( sequence -- sequence' )
+: normalize-0-1 ( sequence -- sequence' )
     [ supremum ] [ infimum [ - ] keep ] [ ] tri
     [ swap - ] with map [ swap / ] with map ;
 
-: noise-image ( table scale dim -- image )
-    [ noise-map normalize [ 255.0 * >fixnum ] B{ } map-as ]
+: noise-image ( table transform dim -- image )
+    [ noise-map normalize-0-1 [ 255.0 * >fixnum ] B{ } map-as ]
     [ swap [ L f ] dip image boa ] bi ;