From 75a71c0bd96f0a562571dbf3332b0842404118fd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 6 May 2009 12:21:30 -0500 Subject: [PATCH 1/6] fix miller-rabin, safe primes --- basis/math/miller-rabin/miller-rabin.factor | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/basis/math/miller-rabin/miller-rabin.factor b/basis/math/miller-rabin/miller-rabin.factor index 93d7f4c582..8c36dd96fe 100755 --- a/basis/math/miller-rabin/miller-rabin.factor +++ b/basis/math/miller-rabin/miller-rabin.factor @@ -1,7 +1,7 @@ ! 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 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 +85,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 ; @@ -101,5 +102,8 @@ PRIVATE> 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 ; From 2bb7b287f7b07f5dd5ec05054063f86669bc8ecb Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 6 May 2009 12:36:34 -0500 Subject: [PATCH 2/6] make ^n foldable --- basis/math/functions/functions.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 41cb52a396..c8d71b1279 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -23,7 +23,7 @@ M: real sqrt Date: Wed, 6 May 2009 12:38:14 -0500 Subject: [PATCH 3/6] add 2pi constant --- basis/math/constants/constants.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/math/constants/constants.factor b/basis/math/constants/constants.factor index 118a8e8197..a2d3213e78 100644 --- a/basis/math/constants/constants.factor +++ b/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 From 6ea5ccd8811f52fab9b62a407ca7891ab939ab98 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 6 May 2009 13:22:53 -0500 Subject: [PATCH 4/6] uniform and normal distributed random floats. uniform is done the lame way for now --- basis/random/random.factor | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/basis/random/random.factor b/basis/random/random.factor index d972e1e7ac..e3f1ecccb9 100755 --- a/basis/random/random.factor +++ b/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 { From 86120571285246797ecec30d810c10d3230c5425 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 6 May 2009 13:47:35 -0500 Subject: [PATCH 5/6] make noise-map/noise-image take an affine-transform --- extra/perlin-noise/perlin-noise.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/extra/perlin-noise/perlin-noise.factor b/extra/perlin-noise/perlin-noise.factor index e662202ca1..0a12eef12c 100644 --- a/extra/perlin-noise/perlin-noise.factor +++ b/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 ; From 8b4815c01eaa60456feab800135dbefe43e003e9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 6 May 2009 14:10:29 -0500 Subject: [PATCH 6/6] fix miller-rabin --- basis/math/miller-rabin/miller-rabin.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/basis/math/miller-rabin/miller-rabin.factor b/basis/math/miller-rabin/miller-rabin.factor index 8c36dd96fe..5e999aa956 100755 --- a/basis/math/miller-rabin/miller-rabin.factor +++ b/basis/math/miller-rabin/miller-rabin.factor @@ -8,6 +8,8 @@ IN: math.miller-rabin : >odd ( n -- int ) dup even? [ 1 + ] when ; foldable +: >even ( n -- int ) 0 clear-bit ; foldable + TUPLE: positive-even-expected n ; :: (miller-rabin) ( n trials -- ? ) @@ -97,6 +99,7 @@ PRIVATE> } 1&& ; : next-safe-prime ( n -- q ) + 1 - >even 2 / next-safe-prime-candidate dup >safe-prime-form dup miller-rabin