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

db4
John Benediktsson 2009-05-06 19:11:30 +00:00
commit e530198446
5 changed files with 23 additions and 8 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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
{

View File

@ -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 ;