-- We can’t provide a type sig for 'initializeMwc' without adding another explicit
-- dependency, so we disable warnings for this module.
{-# OPTIONS_GHC -Wno-missing-signatures #-}

-- | Functions that vary chaotically based on their input. Useful for introducing
-- deterministic noise in pure code, e.g. for slightly moving points around, in the
-- middle of pure code.
module Geometry.Chaotic (
    -- * MWC-Random chaos
      MwcChaosSource(..)
    , initializeMwc

    -- * STDGen chaos
    , ChaosSource(..)
    , stdGen

    -- ** Utilities
    , normals
    , gaussian
    , normalVecs
    , gaussianVecs
) where

import           Data.Bits
import           Data.Char
import           Data.Foldable
import           Data.Int
import qualified Data.Vector       as V
import           Data.Word
import qualified System.Random     as R
import qualified System.Random.MWC as MWC

import           Geometry
import qualified Geometry.Coordinates.Hexagonal as Hex
import           Util



-- | Create a 'Word32' to initialize an MWC gen with. This is meant for simple and
-- convenient seed creation within pure code. Note that creating a generator to
-- produce a single value is probably much less efficient than using a worse
-- generator that is faster to seed.
class MwcChaosSource a where
    mwcChaos :: a -> Word32

instance MwcChaosSource Integer where
    mwcChaos :: Integer -> Word32
mwcChaos = Word32 -> Integer -> Word32
go Word32
0
      where
        go :: Word32 -> Integer -> Word32
        go :: Word32 -> Integer -> Word32
go !Word32
acc Integer
0 = Word32
acc
        go Word32
acc Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Word32 -> Integer -> Word32
go (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
Data.Bits.rotate Word32
acc Int
17) (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n)
        go Word32
acc Integer
n = let (Integer
d,Integer
m) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
n (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32))
                   in Word32 -> Integer -> Word32
go (Word32
acc Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) Integer
d

mwcChaosIntegral :: Integral a => a -> Word32
mwcChaosIntegral :: forall a. Integral a => a -> Word32
mwcChaosIntegral a
x = Integer -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Integer)

instance MwcChaosSource Int where mwcChaos :: Int -> Word32
mwcChaos = Int -> Word32
forall a. Integral a => a -> Word32
mwcChaosIntegral
instance MwcChaosSource Int8 where mwcChaos :: Int8 -> Word32
mwcChaos = Int8 -> Word32
forall a. Integral a => a -> Word32
mwcChaosIntegral
instance MwcChaosSource Int16 where mwcChaos :: Int16 -> Word32
mwcChaos = Int16 -> Word32
forall a. Integral a => a -> Word32
mwcChaosIntegral
instance MwcChaosSource Int32 where mwcChaos :: Int32 -> Word32
mwcChaos = Int32 -> Word32
forall a. Integral a => a -> Word32
mwcChaosIntegral
instance MwcChaosSource Int64 where mwcChaos :: Int64 -> Word32
mwcChaos = Int64 -> Word32
forall a. Integral a => a -> Word32
mwcChaosIntegral
instance MwcChaosSource Word8 where mwcChaos :: Word8 -> Word32
mwcChaos = Word8 -> Word32
forall a. Integral a => a -> Word32
mwcChaosIntegral
instance MwcChaosSource Word16 where mwcChaos :: Word16 -> Word32
mwcChaos = Word16 -> Word32
forall a. Integral a => a -> Word32
mwcChaosIntegral
instance MwcChaosSource Word32 where mwcChaos :: Word32 -> Word32
mwcChaos = Word32 -> Word32
forall a. a -> a
id
instance MwcChaosSource Word64 where mwcChaos :: Word64 -> Word32
mwcChaos = Word64 -> Word32
forall a. Integral a => a -> Word32
mwcChaosIntegral

instance MwcChaosSource () where
    mwcChaos :: () -> Word32
mwcChaos ()
_ = Word32
0

instance (MwcChaosSource a, MwcChaosSource b) => MwcChaosSource (a, b) where
    mwcChaos :: (a, b) -> Word32
mwcChaos (a
a,b
b) = [Word32] -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos [a -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos a
a, b -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos b
b]

instance (MwcChaosSource a, MwcChaosSource b, MwcChaosSource c) => MwcChaosSource (a, b, c) where
    mwcChaos :: (a, b, c) -> Word32
mwcChaos (a
a, b
b, c
c) = [Word32] -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos [a -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos a
a, b -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos b
b, c -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos c
c]

instance (MwcChaosSource a, MwcChaosSource b, MwcChaosSource c, MwcChaosSource d) => MwcChaosSource (a, b, c, d) where
    mwcChaos :: (a, b, c, d) -> Word32
mwcChaos (a
a, b
b, c
c, d
d) = [Word32] -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos [a -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos a
a, b -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos b
b, c -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos c
c, d -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos d
d]

instance (MwcChaosSource a, MwcChaosSource b, MwcChaosSource c, MwcChaosSource d, MwcChaosSource e) => MwcChaosSource (a, b, c, d, e) where
    mwcChaos :: (a, b, c, d, e) -> Word32
mwcChaos (a
a, b
b, c
c, d
d, e
e) = [Word32] -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos [a -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos a
a, b -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos b
b, c -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos c
c, d -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos d
d, e -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos e
e]

instance MwcChaosSource Float where
    mwcChaos :: Float -> Word32
mwcChaos = (Integer, Int) -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos ((Integer, Int) -> Word32)
-> (Float -> (Integer, Int)) -> Float -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat

instance MwcChaosSource Double where
    mwcChaos :: Double -> Word32
mwcChaos = (Integer, Int) -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos ((Integer, Int) -> Word32)
-> (Double -> (Integer, Int)) -> Double -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat

instance MwcChaosSource Char where
    mwcChaos :: Char -> Word32
mwcChaos = Int -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos (Int -> Word32) -> (Char -> Int) -> Char -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

instance MwcChaosSource Vec2 where
    mwcChaos :: Vec2 -> Word32
mwcChaos (Vec2 Double
x Double
y) = (Double, Double) -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos (Double
x,Double
y)

instance MwcChaosSource Line where
    mwcChaos :: Line -> Word32
mwcChaos (Line Vec2
start Vec2
end) = (Vec2, Vec2) -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos (Vec2
start, Vec2
end)

instance MwcChaosSource a => MwcChaosSource [a] where
    mwcChaos :: [a] -> Word32
mwcChaos = (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> Word32
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Word32
acc Word32
x -> Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
Data.Bits.rotate Word32
acc Int
23) Word32
0 ([Word32] -> Word32) -> ([a] -> [Word32]) -> [a] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Word32) -> [a] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map a -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos
    -- 23 is prime so it’ll misalign a lot hence should provide decent mixing. This
    -- is very much not something I have thought about too much, it’s maybe best
    -- not to base anything but wiggly pictures on it.

instance MwcChaosSource Polygon where
    mwcChaos :: Polygon -> Word32
mwcChaos (Polygon [Vec2]
corners) = [Vec2] -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos [Vec2]
corners

instance MwcChaosSource Bezier where
    mwcChaos :: Bezier -> Word32
mwcChaos (Bezier Vec2
a Vec2
b Vec2
c Vec2
d) = (Vec2, Vec2, Vec2, Vec2) -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos (Vec2
a,Vec2
b,Vec2
c,Vec2
d)

instance MwcChaosSource BoundingBox where
    mwcChaos :: BoundingBox -> Word32
mwcChaos (BoundingBox Vec2
a Vec2
b) = (Vec2, Vec2) -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos (Vec2
a, Vec2
b)

instance MwcChaosSource Angle where
    mwcChaos :: Angle -> Word32
mwcChaos = Double -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos (Double -> Word32) -> (Angle -> Double) -> Angle -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Angle -> Double
getRad

instance MwcChaosSource Hex.Hex where
    mwcChaos :: Hex -> Word32
mwcChaos (Hex.Hex Int
q Int
r) = (Int, Int) -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos (Int
q,Int
r)

-- | Initialize an 'MWC.Gen' with anything 'MwcChaosSource'.
--
-- @
-- 'Control.Monad.runST' $ do
--     gen <- 'initializeMwc' ('Vec2' 3 3, 'Geometry.Shapes.regularPolygon' 3)
--     'MWC.randomRM' ('Vec2' 0 0, 'Vec2' 1 1) gen
-- @

-- No type signature as to not depend explicitly on more packages than necessary…
initializeMwc :: a -> m (Gen (PrimState m))
initializeMwc a
seed = Vector Word32 -> m (Gen (PrimState m))
forall (m :: * -> *) (v :: * -> *).
(PrimMonad m, Vector v Word32) =>
v Word32 -> m (Gen (PrimState m))
MWC.initialize (Word32 -> Vector Word32
forall a. a -> Vector a
V.singleton (a -> Word32
forall a. MwcChaosSource a => a -> Word32
mwcChaos a
seed))

-- | Types that can be turned into a random number generator easily, to yield pure chaotic output.
class ChaosSource a where
    -- | Add a value to the mix the 'R.StdGen' will be created from. Only used
    -- for writing new instances of 'ChaosSource'.
    --
    -- To use instances of this class, use 'stdGen'.
    perturb :: a -> Int

-- | Mix another 'Int' into the chaos source.
stir :: ChaosSource a => a -> Int -> Int
stir :: forall a. ChaosSource a => a -> Int -> Int
stir !a
x !Int
y = a -> Int
forall a. ChaosSource a => a -> Int
perturb a
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int -> Int -> Int
forall a. Bits a => a -> Int -> a
Data.Bits.rotate Int
23 Int
y
    -- 23 is prime so it’ll misalign a lot hence should provide decent mixing.
    -- This is very much not something I have thought about, it’s maybe best not
    -- to base anything but wiggly pictures on it.

-- | Create a 'R.StdGen' which can be used with "System.Random"’s functions,
-- based on a variety of inputs.
stdGen :: ChaosSource a => a -> R.StdGen
stdGen :: forall a. ChaosSource a => a -> StdGen
stdGen = Int -> StdGen
R.mkStdGen (Int -> StdGen) -> (a -> Int) -> a -> StdGen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. ChaosSource a => a -> Int
perturb

instance ChaosSource Integer where
    perturb :: Integer -> Int
perturb = Int -> Integer -> Int
forall {t}. Integral t => Int -> t -> Int
go Int
0
      where
        go :: Int -> t -> Int
go !Int
acc t
0 = Int
acc
        go Int
acc t
i =
            let (t
rest, t
chunk) = t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
quotRem t
i (Word -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
forall a. Bounded a => a
maxBound :: Word))
            in Int -> t -> Int
go (Int
acc Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
chunk) t
rest

perturbIntegral :: Integral a => a -> Int
perturbIntegral :: forall a. Integral a => a -> Int
perturbIntegral a
x = Int -> Int
forall a. ChaosSource a => a -> Int
perturb (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Int)

instance ChaosSource Int where perturb :: Int -> Int
perturb = Int -> Int
forall a. a -> a
id
instance ChaosSource Int8 where perturb :: Int8 -> Int
perturb = Int8 -> Int
forall a. Integral a => a -> Int
perturbIntegral
instance ChaosSource Int16 where perturb :: Int16 -> Int
perturb = Int16 -> Int
forall a. Integral a => a -> Int
perturbIntegral
instance ChaosSource Int32 where perturb :: Int32 -> Int
perturb = Int32 -> Int
forall a. Integral a => a -> Int
perturbIntegral
instance ChaosSource Int64 where perturb :: Int64 -> Int
perturb = Int64 -> Int
forall a. Integral a => a -> Int
perturbIntegral
instance ChaosSource Word8 where perturb :: Word8 -> Int
perturb = Word8 -> Int
forall a. Integral a => a -> Int
perturbIntegral
instance ChaosSource Word16 where perturb :: Word16 -> Int
perturb = Word16 -> Int
forall a. Integral a => a -> Int
perturbIntegral
instance ChaosSource Word32 where perturb :: Word32 -> Int
perturb = Word32 -> Int
forall a. Integral a => a -> Int
perturbIntegral
instance ChaosSource Word64 where perturb :: Word64 -> Int
perturb = Word64 -> Int
forall a. Integral a => a -> Int
perturbIntegral

instance ChaosSource () where
    perturb :: () -> Int
perturb ()
_ = Int
1

instance (ChaosSource a, ChaosSource b) => ChaosSource (a, b) where
    perturb :: (a, b) -> Int
perturb (a
a,b
b) = a -> Int
forall a. ChaosSource a => a -> Int
perturb a
a Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` b -> Int
forall a. ChaosSource a => a -> Int
perturb b
b

instance (ChaosSource a, ChaosSource b, ChaosSource c) => ChaosSource (a, b, c) where
    perturb :: (a, b, c) -> Int
perturb (a
a, b
b, c
c) = a -> Int
forall a. ChaosSource a => a -> Int
perturb a
a Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` b -> Int
forall a. ChaosSource a => a -> Int
perturb b
b Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` c -> Int
forall a. ChaosSource a => a -> Int
perturb c
c

instance (ChaosSource a, ChaosSource b, ChaosSource c, ChaosSource d) => ChaosSource (a, b, c, d) where
    perturb :: (a, b, c, d) -> Int
perturb (a
a, b
b, c
c, d
d) = a -> Int
forall a. ChaosSource a => a -> Int
perturb a
a Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` b -> Int
forall a. ChaosSource a => a -> Int
perturb b
b Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` c -> Int
forall a. ChaosSource a => a -> Int
perturb c
c Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` d -> Int
forall a. ChaosSource a => a -> Int
perturb d
d

instance (ChaosSource a, ChaosSource b, ChaosSource c, ChaosSource d, ChaosSource e) => ChaosSource (a, b, c, d, e) where
    perturb :: (a, b, c, d, e) -> Int
perturb (a
a, b
b, c
c, d
d, e
e) = a -> Int
forall a. ChaosSource a => a -> Int
perturb a
a Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` b -> Int
forall a. ChaosSource a => a -> Int
perturb b
b Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` c -> Int
forall a. ChaosSource a => a -> Int
perturb c
c Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` d -> Int
forall a. ChaosSource a => a -> Int
perturb d
d Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` e -> Int
forall a. ChaosSource a => a -> Int
perturb e
e

instance ChaosSource Float where
    perturb :: Float -> Int
perturb = (Integer, Int) -> Int
forall a. ChaosSource a => a -> Int
perturb ((Integer, Int) -> Int)
-> (Float -> (Integer, Int)) -> Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat

instance ChaosSource Double where
    perturb :: Double -> Int
perturb = (Integer, Int) -> Int
forall a. ChaosSource a => a -> Int
perturb ((Integer, Int) -> Int)
-> (Double -> (Integer, Int)) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat

instance ChaosSource Char where
    perturb :: Char -> Int
perturb = Int -> Int
forall a. ChaosSource a => a -> Int
perturb (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

instance ChaosSource Vec2 where
    perturb :: Vec2 -> Int
perturb (Vec2 Double
x Double
y) = (Double, Double) -> Int
forall a. ChaosSource a => a -> Int
perturb (Double
x,Double
y)

instance ChaosSource Line where
    perturb :: Line -> Int
perturb (Line Vec2
start Vec2
end) = (Vec2, Vec2) -> Int
forall a. ChaosSource a => a -> Int
perturb (Vec2
start, Vec2
end)

instance ChaosSource a => ChaosSource [a] where
    perturb :: [a] -> Int
perturb = (Int -> a -> Int) -> Int -> [a] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc a
x -> a -> Int
forall a. ChaosSource a => a -> Int
perturb a
x Int -> Int -> Int
forall a. ChaosSource a => a -> Int -> Int
`stir` Int
acc) Int
0

instance ChaosSource Polygon where
    perturb :: Polygon -> Int
perturb (Polygon [Vec2]
corners) = [Vec2] -> Int
forall a. ChaosSource a => a -> Int
perturb [Vec2]
corners

instance ChaosSource Bezier where
    perturb :: Bezier -> Int
perturb (Bezier Vec2
a Vec2
b Vec2
c Vec2
d) = (Vec2, Vec2, Vec2, Vec2) -> Int
forall a. ChaosSource a => a -> Int
perturb (Vec2
a,Vec2
b,Vec2
c,Vec2
d)

instance ChaosSource BoundingBox where
    perturb :: BoundingBox -> Int
perturb (BoundingBox Vec2
a Vec2
b) = (Vec2, Vec2) -> Int
forall a. ChaosSource a => a -> Int
perturb (Vec2
a, Vec2
b)

instance ChaosSource Angle where
    perturb :: Angle -> Int
perturb = Double -> Int
forall a. ChaosSource a => a -> Int
perturb (Double -> Int) -> (Angle -> Double) -> Angle -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Angle -> Double
getRad

instance ChaosSource Hex.Hex where
    perturb :: Hex -> Int
perturb (Hex.Hex Int
q Int
r) = (Int, Int) -> Int
forall a. ChaosSource a => a -> Int
perturb (Int
q,Int
r)

-- | Infinite list of normally distributed values.
normals :: ChaosSource seed => seed -> [Double]
normals :: forall seed. ChaosSource seed => seed -> [Double]
normals seed
seed
  = let go :: [a] -> [a]
go (a
u1:[a]
rest)
            | a
u1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 = [a] -> [a]
go [a]
rest -- to avoid diverging on log(0)
        go (a
u1:a
u2:[a]
rest)
            = let root1 :: a
root1 = a -> a
forall a. Floating a => a -> a
sqrt (-a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
log a
u1)
                  pi2u2 :: a
pi2u2 = a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Floating a => a
pi a -> a -> a
forall a. Num a => a -> a -> a
* a
u2
                  x :: a
x = a
root1 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
cos a
pi2u2
                  y :: a
y = a
root1 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
sin a
pi2u2
              in a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
rest
        go [a]
_ = String -> String -> [a]
forall a. String -> String -> a
bugError String
"Chaotic.normals" String
"Can’t happen, input is infinite"
    in [Double] -> [Double]
forall {a}. (Ord a, Floating a) => [a] -> [a]
go ((Double, Double) -> StdGen -> [Double]
forall g. RandomGen g => (Double, Double) -> g -> [Double]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
R.randomRs (Double
0, Double
1) (seed -> StdGen
forall a. ChaosSource a => a -> StdGen
stdGen seed
seed))

-- | Infinite list of Gaussian distributed values.
gaussian
    :: ChaosSource seed
    => Double -- ^ Mean
    -> Double -- ^ Standard deviation
    -> seed
    -> [Double]
gaussian :: forall seed.
ChaosSource seed =>
Double -> Double -> seed -> [Double]
gaussian Double
mu Double
sigma seed
seed = [Double
sigmaDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
mu | Double
x <- seed -> [Double]
forall seed. ChaosSource seed => seed -> [Double]
normals seed
seed]

vecPair :: ChaosSource seed => (seed -> [Double]) -> seed -> [Vec2]
vecPair :: forall seed.
ChaosSource seed =>
(seed -> [Double]) -> seed -> [Vec2]
vecPair seed -> [Double]
f seed
seed = [Double] -> [Vec2]
go (seed -> [Double]
f seed
seed)
  where
    go :: [Double] -> [Vec2]
go (Double
x:Double
y:[Double]
rest) = Double -> Double -> Vec2
Vec2 Double
x Double
y Vec2 -> [Vec2] -> [Vec2]
forall a. a -> [a] -> [a]
: [Double] -> [Vec2]
go [Double]
rest
    go [Double]
_ = String -> String -> [Vec2]
forall a. String -> String -> a
bugError String
"Chaotic.vecPair" String
"Can’t happen, input is infinite"

normalVecs :: ChaosSource seed => seed -> [Vec2]
normalVecs :: forall seed. ChaosSource seed => seed -> [Vec2]
normalVecs = (seed -> [Double]) -> seed -> [Vec2]
forall seed.
ChaosSource seed =>
(seed -> [Double]) -> seed -> [Vec2]
vecPair seed -> [Double]
forall seed. ChaosSource seed => seed -> [Double]
normals

gaussianVecs :: ChaosSource seed => Double -> Double -> seed -> [Vec2]
gaussianVecs :: forall seed. ChaosSource seed => Double -> Double -> seed -> [Vec2]
gaussianVecs Double
mu Double
sigma = (seed -> [Double]) -> seed -> [Vec2]
forall seed.
ChaosSource seed =>
(seed -> [Double]) -> seed -> [Vec2]
vecPair (Double -> Double -> seed -> [Double]
forall seed.
ChaosSource seed =>
Double -> Double -> seed -> [Double]
gaussian Double
mu Double
sigma)