diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,25 @@ ## Unreleased +## 0.2.0.0 - 2025-10-21 + +### Added + +- Comprehensive haddock documentation for main `Numeric.Noise` module with usage examples + +### Changed + +- Migrated internal implementation from `vector` to `primitive` (PrimArray) +- Removed `vector` dependency from library (still used in benchmarks) +- Require GHC 9.2+ (base >= 4.16) +- Hide internal modules from public API (`Numeric.Noise.Internal`, `Numeric.Noise.Internal.Math`) +- Improved cellular noise performance by 20-30% through specialized computation paths for different result types + +### Fixed + +- Fixed intermediate list allocation in fractal functions on GHC 9.6+ +- Improved division performance for `Noise3` instances + ## 0.1.0.1 - 2024-10-15 - Add bounds for vector diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -42,35 +42,35 @@ | name | values / second | | ------------- | --------------- | -| value2 | 157_347_680 | -| perlin2 | 129_541_747 | -| openSimplex2 | 64_758_006 | -| superSimplex2 | 64_072_639 | -| valueCubic2 | 52_110_819 | -| cellular2 | 15_743_434 | +| value2 | 156_797_694 | +| perlin2 | 138_048_921 | +| superSimplex2 | 65_204_214 | +| openSimplex2 | 64_483_692 | +| valueCubic2 | 50_666_467 | +| cellular2 | 20_819_883 | #### 3D | name | values / second | | ----------- | --------------- | -| value3 | 85_438_023 | -| perlin3 | 56_830_482 | -| valueCubic3 | 15_559_523 | +| value3 | 83_034_432 | +| perlin3 | 60_233_650 | +| valueCubic3 | 15_220_433 | ## Examples -There's an interactive [demo app](demo/README.md) in the `demo` directory. +There's an interactive [demo app](https://github.com/jtnuttall/pure-noise/tree/main/demo) in the `demo` directory. _OpenSimplex2_ -![OpenSimplex2](demo/images/opensimplex.png) -![OpenSimplex2 ridged](demo/images/opensimplex-ridged.png) +![OpenSimplex2](https://raw.githubusercontent.com/jtnuttall/pure-noise/main/demo/images/opensimplex.png) +![OpenSimplex2 ridged](https://raw.githubusercontent.com/jtnuttall/pure-noise/main/demo/images/opensimplex-ridged.png) _Perlin_ -![Perlin fBm](demo/images/perlin-fbm.png) +![Perlin fBm](https://raw.githubusercontent.com/jtnuttall/pure-noise/main/demo/images/perlin-fbm.png) _Cellular_ -![value](demo/images/cell-value.png) -![distance2add](demo/images/cell-d2.png) +![value](https://raw.githubusercontent.com/jtnuttall/pure-noise/main/demo/images/cell-value.png) +![distance2add](https://raw.githubusercontent.com/jtnuttall/pure-noise/main/demo/images/cell-d2.png) diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -2,7 +2,6 @@ import Data.Typeable import Data.Vector.Unboxed qualified as U import Numeric.Noise -import Numeric.Noise.Internal (const2, const3) import System.Random.MWC qualified as MWC main :: IO () diff --git a/bench/BenchLib.hs b/bench/BenchLib.hs --- a/bench/BenchLib.hs +++ b/bench/BenchLib.hs diff --git a/pure-noise.cabal b/pure-noise.cabal --- a/pure-noise.cabal +++ b/pure-noise.cabal @@ -1,13 +1,17 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.37.0. +-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack name: pure-noise -version: 0.1.0.1 -synopsis: Performant, modern noise generation for Haskell with minimal dependencies. Based on FastNoiseLite. -description: Please see the README on GitHub at +version: 0.2.0.0 +synopsis: High-performance composable noise generation (Perlin, Simplex, Cellular) +description: A high-performance noise generation library ported from FastNoiseLite. + Provides N-dimensional noise functions (Perlin, OpenSimplex, SuperSimplex, + Value, Cellular) that can be composed using Num or Fractional methods with + minimal performance overhead. Noise values are generally clamped to [-1, 1]. + Benefits significantly from LLVM backend compilation (~50-80% performance improvement). category: Math, Numeric, Noise homepage: https://github.com/jtnuttall/pure-noise#readme bug-reports: https://github.com/jtnuttall/pure-noise/issues @@ -19,6 +23,7 @@ build-type: Simple extra-source-files: README.md +extra-doc-files: CHANGELOG.md source-repository head @@ -30,14 +35,14 @@ Numeric.Noise Numeric.Noise.Cellular Numeric.Noise.Fractal - Numeric.Noise.Internal - Numeric.Noise.Internal.Math Numeric.Noise.OpenSimplex Numeric.Noise.Perlin Numeric.Noise.SuperSimplex Numeric.Noise.Value Numeric.Noise.ValueCubic other-modules: + Numeric.Noise.Internal + Numeric.Noise.Internal.Math Paths_pure_noise autogen-modules: Paths_pure_noise @@ -45,8 +50,8 @@ src ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: - base >=4.7 && <5 - , vector <=0.14 + base >=4.16 && <5 + , primitive >=0.8 && <0.10 default-language: GHC2021 test-suite pure-noise-test @@ -63,13 +68,13 @@ test ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wno-missing-export-lists -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 + base >=4.16 && <5 + , primitive >=0.8 && <0.10 , pure-noise , tasty , tasty-discover , tasty-hunit , tasty-quickcheck - , vector <=0.14 default-language: GHC2021 benchmark pure-noise-bench @@ -82,11 +87,12 @@ Paths_pure_noise hs-source-dirs: bench - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N +RTS -A32m --nonmoving-gc -T -RTS -O2 -optc-O3 -fproc-alignment=64 -fsimpl-tick-factor=1000 + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N +RTS -A32m --nonmoving-gc -T -RTS -O2 -optc-O3 -fsimpl-tick-factor=1000 build-depends: - base >=4.7 && <5 + base >=4.16 && <5 , deepseq , mwc-random + , primitive >=0.8 && <0.10 , pure-noise , tasty , tasty-bench diff --git a/src/Numeric/Noise.hs b/src/Numeric/Noise.hs --- a/src/Numeric/Noise.hs +++ b/src/Numeric/Noise.hs @@ -3,15 +3,60 @@ -- | -- Maintainer: Jeremy Nuttall -- Stability : experimental +-- +-- Performant noise generation with composable noise functions. +-- +-- Noise functions are wrapped in 'Noise2' and 'Noise3' newtypes that abstract over +-- the seed and coordinate parameters. These can be composed using 'Num' or 'Fractional' +-- methods with minimal performance overhead. +-- +-- Noise values are generally clamped to @[-1, 1]@, though some functions may +-- occasionally produce values slightly outside this range. +-- +-- == Basic Usage +-- +-- Generate 2D Perlin noise: +-- +-- @ +-- import Numeric.Noise qualified as Noise +-- +-- myNoise :: Noise.Seed -> Float -> Float -> Float +-- myNoise = Noise.noise2At Noise.perlin2 +-- @ +-- +-- Compose multiple noise functions: +-- +-- @ +-- combined :: (RealFrac a) => Noise.Noise2 a +-- combined = (Noise.perlin2 + Noise.superSimplex2) / 2 +-- +-- myNoise2 :: Noise.Seed -> Float -> Float -> Float +-- myNoise2 = Noise.noise2At combined +-- @ +-- +-- Apply fractal Brownian motion: +-- +-- @ +-- fbm :: (RealFrac a) => Noise.Noise2 a +-- fbm = Noise.fractal2 Noise.defaultFractalConfig Noise.perlin2 +-- @ module Numeric.Noise ( - -- * Noise functions + -- * Core Types - -- ** Noise functions + -- + + -- | 'Noise2' and 'Noise3' are newtypes wrapping noise functions. They can be + -- unwrapped with 'noise2At' and 'noise3At' respectively. + -- + -- 'Seed' is a 'Word64' value used for deterministic noise generation. module NoiseTypes, + + -- * Noise evaluation noise2At, noise3At, -- ** 2D Noise + const2, cellular2, openSimplex2, superSimplex2, @@ -20,6 +65,7 @@ valueCubic2, -- ** 3D Noise + const3, perlin3, value3, valueCubic3, @@ -29,21 +75,51 @@ -- ** Math utility functions module NoiseUtility, - -- ** Fractal Brownian Motion - module Fractal, + -- ** Fractal noise composition + -- + + -- | Fractal noise combines multiple octaves at different frequencies and + -- amplitudes to create natural-looking, multi-scale patterns. + -- + -- For custom fractal implementations using modifier functions, see + -- "Numeric.Noise.Fractal". + + -- *** Configuration + FractalConfig (..), + defaultFractalConfig, + PingPongStrength (..), + defaultPingPongStrength, + + -- *** Fractal Brownian Motion (FBM) + fractal2, + fractal3, + + -- *** Fractal variants + billow2, + billow3, + ridged2, + ridged3, + pingPong2, + pingPong3, + -- ** Cellular noise configuration - module Cellular, -) where -import Numeric.Noise.Cellular as Cellular ( + -- + + -- | Cellular (Worley) noise creates patterns based on distances to + -- randomly distributed cell points. + + -- *** Configuration CellularConfig (..), + defaultCellularConfig, CellularDistanceFn (..), CellularResult (..), - defaultCellularConfig, - ) +) where + +import Numeric.Noise.Cellular (CellularConfig, CellularDistanceFn (..), CellularResult (..), defaultCellularConfig) import Numeric.Noise.Cellular qualified as Cellular -import Numeric.Noise.Fractal as Fractal +import Numeric.Noise.Fractal import Numeric.Noise.Internal import Numeric.Noise.Internal as NoiseTypes ( Noise2, @@ -67,46 +143,78 @@ import Numeric.Noise.Value qualified as Value import Numeric.Noise.ValueCubic qualified as ValueCubic -noise2At :: Noise2 a -> Seed -> a -> a -> a +-- | Evaluate a 2D noise function at the given coordinates with the given seed. +noise2At + :: Noise2 a + -> Seed + -- ^ deterministic seed + -> a + -- ^ x coordinate + -> a + -- ^ y coordinate + -> a noise2At = unNoise2 {-# INLINE noise2At #-} +-- | 2D Cellular (Worley) noise. Configure with 'CellularConfig' to control +-- distance functions and return values. cellular2 :: (RealFrac a, Floating a) => CellularConfig a -> Noise2 a cellular2 = Cellular.noise2 {-# INLINE cellular2 #-} +-- | 2D OpenSimplex noise. Smooth gradient noise similar to Perlin but without +-- directional artifacts. openSimplex2 :: (RealFrac a) => Noise2 a openSimplex2 = OpenSimplex.noise2 {-# INLINE openSimplex2 #-} +-- | 2D SuperSimplex noise. Improved OpenSimplex variant with better visual +-- characteristics. superSimplex2 :: (RealFrac a) => Noise2 a superSimplex2 = SuperSimplex.noise2 {-# INLINE superSimplex2 #-} +-- | 2D Perlin noise. Classic gradient noise algorithm. perlin2 :: (RealFrac a) => Noise2 a perlin2 = Perlin.noise2 {-# INLINE perlin2 #-} -noise3At :: Noise3 a -> Seed -> a -> a -> a -> a +-- | Evaluate a 3D noise function at the given coordinates with the given seed. +noise3At + :: Noise3 a + -> Seed + -- ^ deterministic seed + -> a + -- ^ x coordinate + -> a + -- ^ y coordinate + -> a + -- ^ z coordinate + -> a noise3At = unNoise3 {-# INLINE noise3At #-} +-- | 3D Perlin noise. Classic gradient noise algorithm. perlin3 :: (RealFrac a) => Noise3 a perlin3 = Perlin.noise3 {-# INLINE perlin3 #-} +-- | 2D Value noise. Simple noise based on interpolated random values at grid points. value2 :: (RealFrac a) => Noise2 a value2 = Value.noise2 {-# INLINE value2 #-} +-- | 3D Value noise. Simple noise based on interpolated random values at grid points. value3 :: (RealFrac a) => Noise3 a value3 = Value.noise3 {-# INLINE value3 #-} +-- | 2D Value noise with cubic interpolation for smoother results. valueCubic2 :: (RealFrac a) => Noise2 a valueCubic2 = ValueCubic.noise2 {-# INLINE valueCubic2 #-} +-- | 3D Value noise with cubic interpolation for smoother results. valueCubic3 :: (RealFrac a) => Noise3 a valueCubic3 = ValueCubic.noise3 {-# INLINE valueCubic3 #-} diff --git a/src/Numeric/Noise/Cellular.hs b/src/Numeric/Noise/Cellular.hs --- a/src/Numeric/Noise/Cellular.hs +++ b/src/Numeric/Noise/Cellular.hs @@ -14,23 +14,32 @@ -- * 2D Noise noise2, - noise2BaseWith, ) where import Data.Bits -import Data.Foldable -import Data.Vector.Unboxed qualified as U +import Data.Foldable -- redundant since GHC 9.10.1, here for compat +import Data.Primitive.PrimArray import GHC.Generics (Generic) import Numeric.Noise.Internal import Numeric.Noise.Internal.Math +-- | Configuration for cellular (Worley) noise generation. +-- +-- Cellular noise is based on distances to randomly distributed cell points, +-- creating a distinctive cellular or organic pattern. data CellularConfig a = CellularConfig { cellularDistanceFn :: !CellularDistanceFn + -- ^ Distance metric to use when computing distance to cell points. , cellularJitter :: !a + -- ^ Amount of randomness in cell point positions. + -- 0 creates a regular grid, 1 creates fully random positions. + -- Values outside [0, 1] are valid but may produce unusual results. , cellularResult :: !CellularResult + -- ^ What value to return from the noise function. } deriving (Generic, Show) +-- | Default configuration for cellular noise generation. defaultCellularConfig :: (RealFrac a) => CellularConfig a defaultCellularConfig = CellularConfig @@ -39,21 +48,51 @@ , cellularResult = CellValue } +-- | Distance function for cellular noise calculations. +-- +-- Different distance metrics produce different visual characteristics +-- in the cellular pattern. data CellularDistanceFn - = DistEuclidean - | DistEuclideanSq - | DistManhattan - | DistHybrid + = -- | Standard Euclidean distance (sqrt(dx² + dy²)). + -- Creates circular cells with smooth edges. + DistEuclidean + | -- | Squared Euclidean distance (dx² + dy²), no square root. + -- Faster than 'DistEuclidean' with similar appearance. + DistEuclideanSq + | -- | Manhattan/taxicab distance (|dx| + |dy|). + -- Creates diamond-shaped cells with sharp edges. + DistManhattan + | -- | Hybrid of Euclidean and Manhattan distances. + -- Combines characteristics of both metrics. + DistHybrid deriving (Generic, Read, Show, Eq, Ord, Enum, Bounded) +-- | What value to return from cellular noise evaluation. +-- +-- These options allow for different visual effects by returning different +-- properties of the cell structure. data CellularResult - = CellValue - | Distance - | Distance2 - | Distance2Add - | Distance2Sub - | Distance2Mul - | Distance2Div + = -- | Return the hash value of the nearest cell point. + -- Creates discrete regions with constant values. + CellValue + | -- | Return the distance to the nearest cell point. + -- Creates a classic Worley noise pattern with cell boundaries. + Distance + | -- | Return the distance to the second-nearest cell point. + -- Creates larger, more organic-looking cells. + Distance2 + | -- | Return the sum of distances to the two nearest cell points. + -- Creates smooth, rounded cells. + Distance2Add + | -- | Return the difference between distances to the two nearest cell points. + -- Emphasizes cell boundaries and creates sharp edges. + Distance2Sub + | -- | Return the product of distances to the two nearest cell points. + -- Creates cells with varying contrast. + Distance2Mul + | -- | Return the ratio of nearest to second-nearest distance. + -- Creates normalized cell patterns. + Distance2Div deriving (Generic, Read, Show, Eq, Ord, Enum, Bounded) distance :: (RealFrac a) => CellularDistanceFn -> a -> a -> a @@ -71,68 +110,80 @@ {-# INLINE normDist #-} noise2 :: (RealFrac a, Floating a) => CellularConfig a -> Noise2 a -noise2 CellularConfig{..} = +noise2 CellularConfig{..} = Noise2 $ \ !seed !x !y -> let !jitter = cellularJitter * 0.43701595 - !dist = distance cellularDistanceFn - !norm = normDist cellularDistanceFn + !rx = round x + !ry = round y + + dist = distance cellularDistanceFn + norm = normDist cellularDistanceFn coeff = 1 / (fromIntegral (maxBound @Hash) + 1) - in Noise2 $ \seed x y -> - let (!hash, !d0u, !d1u) = noise2BaseWith jitter dist seed x y - !d0 = norm d0u - !d1 = norm d1u - in case cellularResult of - CellValue -> fromIntegral hash * coeff - Distance -> d0 - 1 - Distance2 -> d1 - 1 - Distance2Add -> (d1 + d0) * 0.5 - 1 - Distance2Sub -> d1 - d0 - 1 - Distance2Mul -> d1 * d0 * 0.5 - 1 - Distance2Div -> d0 / d1 - 1 -{-# INLINE noise2 #-} --- | Calculate 2D cellular noise values at a given point using the given distance function -noise2BaseWith - :: (RealFrac a) - => a - -- ^ cellular jitter - -> (a -> a -> a) - -- ^ distance function - -> Seed - -> a - -- ^ x - -> a - -- ^ y - -> (Hash, a, a) -noise2BaseWith !jitter !dist !seed !x !y = - foldl' @[] - minmax - (0, infinity, infinity) - [pointDist (rx + xi) (ry + yi) | !xi <- [-1 .. 1], !yi <- [-1 .. 1]] - where - !rx = round x - !ry = round y + {-# INLINE pointDist #-} + pointDist !xi !yi = + let !px = fromIntegral xi - x + !py = fromIntegral yi - y + !h = hash2 seed (primeX * xi) (primeY * yi) + !i = h .&. 0x1FE + !rvx = randVecs2d `indexPrimArray` fromIntegral i + !rvy = randVecs2d `indexPrimArray` (fromIntegral i .|. 1) + !d = dist (px + realToFrac rvx * jitter) (py + realToFrac rvy * jitter) + in (h, d) - minmax (!c, !d0, !d1) (!h, !d) - | d < d0 = (h, d, d1') - | otherwise = (c, d0, d1') - where - !d1' = max (min d1 d) d0 + {-# INLINE points #-} + points = [pointDist (rx + xi) (ry + yi) | !xi <- [-1 .. 1], !yi <- [-1 .. 1]] - pointDist !xi !yi = - let !px = fromIntegral xi - x - !py = fromIntegral yi - y - !h = hash2 seed (primeX * xi) (primeY * yi) - !i = h .&. 510 - !rvx = randVecs2d `U.unsafeIndex` fromIntegral i - !rvy = randVecs2d `U.unsafeIndex` (fromIntegral i .|. 1) - !d = dist (px + realToFrac rvx * jitter) (py + realToFrac rvy * jitter) - in (h, d) -{-# INLINE noise2BaseWith #-} + {-# INLINE selectMinHash #-} + selectMinHash = + let minHash (!hMin, !dMin) (!h, !d) + | d < dMin = (h, d) + | otherwise = (hMin, dMin) + in foldl' minHash (0, infinity) points --- >>> U.length randVecs2d == 512 + {-# INLINE selectMinDist #-} + selectMinDist = + let minDist !dMin (_, !d) + | d < dMin = d + | otherwise = dMin + in foldl' minDist infinity points + + {-# INLINE selectSmallestTwo #-} + selectSmallestTwo = + let smallestTwo (!c, !d0, !d1) (!h, !d) + | d < d0 = (h, d, d0) + | d < d1 = (c, d0, d) + | otherwise = (c, d0, d1) + in foldl' smallestTwo (0, infinity, infinity) points + in case cellularResult of + CellValue -> + let (!hash, !_) = selectMinHash + in fromIntegral hash * coeff + Distance -> + let !d0 = selectMinDist + in norm d0 - 1 + Distance2 -> + let (!_, !_, !d1) = selectSmallestTwo + in norm d1 - 1 + Distance2Add -> + let (!_, !d0, !d1) = selectSmallestTwo + in (norm d1 + norm d0) * 0.5 - 1 + Distance2Sub -> + let (!_, !d0, !d1) = selectSmallestTwo + in norm d1 - norm d0 - 1 + Distance2Mul -> + let (!_, !d0, !d1) = selectSmallestTwo + in norm d1 * norm d0 * 0.5 - 1 + Distance2Div -> + let (!_, !d0, !d1) = selectSmallestTwo + in norm d0 / norm d1 - 1 + where + +{-# INLINE noise2 #-} + +-- >>> sizeofPrimArray randVecs2d == 512 -- True {- ORMOLU_DISABLE -} -randVecs2d :: U.Vector Float +randVecs2d :: PrimArray Float randVecs2d = [-0.2700222198,-0.9628540911,0.3863092627,-0.9223693152,0.04444859006,-0.999011673,-0.5992523158,-0.8005602176 ,-0.7819280288,0.6233687174,0.9464672271,0.3227999196,-0.6514146797,-0.7587218957,0.9378472289,0.347048376 diff --git a/src/Numeric/Noise/Fractal.hs b/src/Numeric/Noise/Fractal.hs --- a/src/Numeric/Noise/Fractal.hs +++ b/src/Numeric/Noise/Fractal.hs @@ -37,14 +37,30 @@ import GHC.Generics import Numeric.Noise.Internal +-- | Configuration for fractal noise generation. +-- +-- Fractal noise combines multiple octaves (layers) of noise at different +-- frequencies and amplitudes to create more complex, natural-looking patterns. data FractalConfig a = FractalConfig { octaves :: Int + -- ^ Number of noise layers to combine. More octaves create more detail + -- but are more expensive to compute. Must be >= 1. , lacunarity :: a + -- ^ Frequency multiplier between octaves. Each octave's frequency is + -- the previous octave's frequency multiplied by lacunarity. , gain :: a + -- ^ Amplitude multiplier between octaves. Each octave's amplitude is + -- the previous octave's amplitude multiplied by gain. + -- Values < 1 create smoother noise, values > 1 create rougher noise. , weightedStrength :: a + -- ^ Controls how much each octave's amplitude is influenced by the + -- previous octave's value. At 0, octaves have independent amplitudes. + -- At 1, lower-valued areas in previous octaves reduce the amplitude + -- of subsequent octaves. Range: [0, 1]. } deriving (Generic, Read, Show, Eq) +-- | Default configuration for fractal noise generation. defaultFractalConfig :: (RealFrac a) => FractalConfig a defaultFractalConfig = FractalConfig @@ -54,18 +70,58 @@ , weightedStrength = 0 } +-- | Apply Fractal Brownian Motion (FBM) to a 2D noise function. +-- +-- FBM combines multiple octaves of noise at increasing frequencies and +-- decreasing amplitudes to create natural-looking, multi-scale patterns. +-- This is the standard fractal noise implementation. +-- +-- @ +-- fbm :: Noise2 Float +-- fbm = fractal2 defaultFractalConfig perlin2 +-- @ fractal2 :: (RealFrac a) => FractalConfig a -> Noise2 a -> Noise2 a fractal2 config = Noise2 . fractal2With fractalNoiseMod (fractalAmpMod config) config . unNoise2 {-# INLINE fractal2 #-} +-- | Apply billow fractal to a 2D noise function. +-- +-- Billow creates a cloud-like or billowy appearance by taking the absolute +-- value of each octave. This produces sharp ridges in the negative regions +-- of the noise, creating a distinct puffy or cloudy look. +-- +-- @ +-- clouds :: Noise2 Float +-- clouds = billow2 defaultFractalConfig perlin2 +-- @ billow2 :: (RealFrac a) => FractalConfig a -> Noise2 a -> Noise2 a billow2 config = Noise2 . fractal2With billowNoiseMod (billowAmpMod config) config . unNoise2 {-# INLINE billow2 #-} +-- | Apply ridged fractal to a 2D noise function. +-- +-- Ridged creates sharp ridges by inverting and taking the absolute value +-- of each octave. This is particularly useful for terrain generation, +-- creating mountain ridges and valleys. +-- +-- @ +-- mountains :: Noise2 Float +-- mountains = ridged2 defaultFractalConfig perlin2 +-- @ ridged2 :: (RealFrac a) => FractalConfig a -> Noise2 a -> Noise2 a ridged2 config = Noise2 . fractal2With ridgedNoiseMod (ridgedAmpMod config) config . unNoise2 {-# INLINE ridged2 #-} +-- | Apply ping-pong fractal to a 2D noise function. +-- +-- Ping-pong creates a wave-like pattern by folding the noise values back +-- and forth within a range, creating a distinctive undulating appearance. +-- The strength parameter controls the intensity of the ping-pong effect. +-- +-- @ +-- waves :: Noise2 Float +-- waves = pingPong2 defaultFractalConfig defaultPingPongStrength perlin2 +-- @ pingPong2 :: (RealFrac a) => FractalConfig a -> PingPongStrength a -> Noise2 a -> Noise2 a pingPong2 config strength = Noise2 . fractal2With (pingPongNoiseMod strength) (pingPongAmpMod config) config . unNoise2 @@ -96,18 +152,30 @@ in go (o - 1) (acc + noise) (s + 1) (freq * lacunarity) amp' {-# INLINE fractal2With #-} +-- | Apply Fractal Brownian Motion (FBM) to a 3D noise function. +-- +-- 3D version of 'fractal2'. See 'fractal2' for details. fractal3 :: (RealFrac a) => FractalConfig a -> Noise3 a -> Noise3 a fractal3 config = Noise3 . fractal3With fractalNoiseMod (fractalAmpMod config) config . unNoise3 {-# INLINE fractal3 #-} +-- | Apply billow fractal to a 3D noise function. +-- +-- 3D version of 'billow2'. See 'billow2' for details. billow3 :: (RealFrac a) => FractalConfig a -> Noise3 a -> Noise3 a billow3 config = Noise3 . fractal3With billowNoiseMod (billowAmpMod config) config . unNoise3 {-# INLINE billow3 #-} +-- | Apply ridged fractal to a 3D noise function. +-- +-- 3D version of 'ridged2'. See 'ridged2' for details. ridged3 :: (RealFrac a) => FractalConfig a -> Noise3 a -> Noise3 a ridged3 config = Noise3 . fractal3With ridgedNoiseMod (ridgedAmpMod config) config . unNoise3 {-# INLINE ridged3 #-} +-- | Apply ping-pong fractal to a 3D noise function. +-- +-- 3D version of 'pingPong2'. See 'pingPong2' for details. pingPong3 :: (RealFrac a) => FractalConfig a -> PingPongStrength a -> Noise3 a -> Noise3 a pingPong3 config strength = Noise3 . fractal3With (pingPongNoiseMod strength) (pingPongAmpMod config) config . unNoise3 @@ -128,10 +196,10 @@ -> a fractal3With modNoise modAmps FractalConfig{..} noise3 seed x y z | octaves < 1 = error "octaves must be a positive integer" - | otherwise = - let bounding = fractalBounding FractalConfig{..} - in go octaves 0 seed 1 bounding + | otherwise = go octaves 0 seed 1 bounding where + bounding = fractalBounding FractalConfig{..} + go 0 acc _ _ _ = acc go o acc s freq amp = let noise = amp * modNoise (noise3 s (freq * x) (freq * y) (freq * z)) @@ -140,41 +208,75 @@ {-# INLINE fractal3With #-} fractalBounding :: (RealFrac a) => FractalConfig a -> a -fractalBounding FractalConfig{..} = - let amps = take octaves $ iterate (* gain) gain - in 1 / (sum amps + 1) +fractalBounding FractalConfig{..} = recip (sum amps + 1) + where + ~amps = take octaves $ iterate (* gain) gain {-# INLINE fractalBounding #-} +-- | Identity noise modifier for standard FBM. +-- +-- This is used internally by 'fractal2' and 'fractal3'. +-- Exposed for users creating custom fractal implementations. fractalNoiseMod :: a -> a fractalNoiseMod = id {-# INLINE fractalNoiseMod #-} + +-- | Amplitude modifier for standard FBM. +-- +-- Uses the 'weightedStrength' parameter to influence amplitude based on +-- the previous octave's value. Exposed for custom fractal implementations. fractalAmpMod :: (Num a) => FractalConfig a -> a -> a fractalAmpMod FractalConfig{..} n = lerp 1 n weightedStrength {-# INLINE fractalAmpMod #-} +-- | Noise modifier for billow fractal. +-- +-- Transforms noise value to @abs(n) * 2 - 1@, creating the billow effect. +-- Exposed for custom fractal implementations. billowNoiseMod :: (Num a) => a -> a billowNoiseMod n = abs n * 2 - 1 {-# INLINE billowNoiseMod #-} +-- | Amplitude modifier for billow fractal. +-- +-- Uses the 'weightedStrength' parameter. Exposed for custom fractal implementations. billowAmpMod :: (Num a) => FractalConfig a -> a -> a billowAmpMod FractalConfig{..} n = lerp 1 n weightedStrength {-# INLINE billowAmpMod #-} +-- | Noise modifier for ridged fractal. +-- +-- Transforms noise value to @abs(n) * (-2) + 1@, creating the ridge effect. +-- Exposed for custom fractal implementations. ridgedNoiseMod :: (Num a) => a -> a ridgedNoiseMod n = abs n * (-2) + 1 {-# INLINE ridgedNoiseMod #-} +-- | Amplitude modifier for ridged fractal. +-- +-- Uses the 'weightedStrength' parameter with inverted noise value. +-- Exposed for custom fractal implementations. ridgedAmpMod :: (Num a) => FractalConfig a -> a -> a ridgedAmpMod FractalConfig{..} n = lerp 1 (1 - n) weightedStrength {-# INLINE ridgedAmpMod #-} +-- | Strength parameter for ping-pong fractal noise. +-- +-- Controls the intensity of the ping-pong folding effect. +-- Higher values create more frequent oscillations. newtype PingPongStrength a = PingPongStrength a deriving (Generic) +-- | Default ping-pong strength value. defaultPingPongStrength :: (RealFrac a) => PingPongStrength a defaultPingPongStrength = PingPongStrength 2 {-# INLINE defaultPingPongStrength #-} +-- | Noise modifier for ping-pong fractal. +-- +-- Folds noise values back and forth within a range, creating a wave-like +-- pattern. The strength parameter controls the folding intensity. +-- Exposed for custom fractal implementations. pingPongNoiseMod :: (RealFrac a) => PingPongStrength a -> a -> a pingPongNoiseMod (PingPongStrength s) n = let n' = (n + 1) * s @@ -182,6 +284,9 @@ in if t < 1 then t else 2 - t {-# INLINE pingPongNoiseMod #-} +-- | Amplitude modifier for ping-pong fractal. +-- +-- Uses the 'weightedStrength' parameter. Exposed for custom fractal implementations. pingPongAmpMod :: (Num a) => FractalConfig a -> a -> a pingPongAmpMod FractalConfig{..} n = lerp 1 n weightedStrength {-# INLINE pingPongAmpMod #-} diff --git a/src/Numeric/Noise/Internal.hs b/src/Numeric/Noise/Internal.hs --- a/src/Numeric/Noise/Internal.hs +++ b/src/Numeric/Noise/Internal.hs @@ -25,9 +25,32 @@ quinticInterp, ) +-- | A 2D noise function parameterized by a seed and two coordinates. +-- +-- 'Noise2' wraps a function @Seed -> a -> a -> a@ that takes a seed value +-- and x, y coordinates to produce a noise value. +-- +-- This type supports 'Num', 'Fractional', and 'Floating' instances, allowing +-- noise functions to be combined algebraically: +-- +-- @ +-- combined :: Noise2 Float +-- combined = (perlin2 + superSimplex2) / 2 +-- @ +-- +-- To evaluate a 'Noise2', use 'noise2At' from "Numeric.Noise". newtype Noise2 a = Noise2 {unNoise2 :: Seed -> a -> a -> a} +-- | Increment the seed for a 2D noise function. +-- +-- This is useful for generating independent noise layers: +-- +-- @ +-- layer1 = perlin2 +-- layer2 = next2 perlin2 +-- layer3 = next2 (next2 perlin2) +-- @ next2 :: Noise2 a -> Noise2 a next2 (Noise2 f) = Noise2 (\s x y -> f (s + 1) x y) {-# INLINE next2 #-} @@ -36,6 +59,12 @@ map2 f (Noise2 g) = Noise2 (\s x y -> f (g s x y)) {-# INLINE map2 #-} +-- | Clamp the output of a 2D noise function to the range @[lower, upper]@. +-- +-- @ +-- clamped :: Noise2 Float +-- clamped = clamp2 0 1 perlin2 -- clamp to [0, 1] +-- @ clamp2 :: (Ord a) => a -> a -> Noise2 a -> Noise2 a clamp2 l u (Noise2 f) = Noise2 $ \s x y -> clamp l u (f s x y) {-# INLINE clamp2 #-} @@ -44,6 +73,10 @@ const2 a = Noise2 (\_ _ _ -> a) {-# INLINE const2 #-} +-- | Arithmetic operations on 'Noise2' are performed point-wise. +-- +-- For example, @n1 + n2@ creates a new noise function that adds the +-- results of @n1@ and @n2@ at each coordinate. instance (Num a) => Num (Noise2 a) where Noise2 f + Noise2 g = Noise2 $ \s x y -> f s x y + g s x y {-# INLINE (+) #-} @@ -94,9 +127,21 @@ atanh (Noise2 f) = Noise2 $ \s x y -> atanh (f s x y) {-# INLINE atanh #-} +-- | A 3D noise function parameterized by a seed and three coordinates. +-- +-- 'Noise3' wraps a function @Seed -> a -> a -> a -> a@ that takes a seed value +-- and x, y, z coordinates to produce a noise value. +-- +-- Like 'Noise2', this type supports 'Num', 'Fractional', and 'Floating' instances +-- for algebraic composition. +-- +-- To evaluate a 'Noise3', use 'noise3At' from "Numeric.Noise". newtype Noise3 a = Noise3 {unNoise3 :: Seed -> a -> a -> a -> a} +-- | Increment the seed for a 3D noise function. +-- +-- Analogous to 'next2', this is useful for generating independent 3D noise layers. next3 :: Noise3 a -> Noise3 a next3 (Noise3 f) = Noise3 (\s x y z -> f (s + 1) x y z) {-# INLINE next3 #-} @@ -109,10 +154,20 @@ const3 a = Noise3 (\_ _ _ _ -> a) {-# INLINE const3 #-} +-- | Clamp the output of a 3D noise function to the range @[lower, upper]@. +-- +-- @ +-- clamped :: Noise3 Float +-- clamped = clamp3 (-0.5) 0.5 perlin3 -- clamp to [-0.5, 0.5] +-- @ clamp3 :: (Ord a) => a -> a -> Noise3 a -> Noise3 a clamp3 l u (Noise3 f) = Noise3 $ \s x y z -> clamp l u (f s x y z) {-# INLINE clamp3 #-} +-- | Arithmetic operations on 'Noise3' are performed point-wise. +-- +-- For example, @n1 * n2@ creates a new noise function that multiplies the +-- results of @n1@ and @n2@ at each coordinate. instance (Num a) => Num (Noise3 a) where Noise3 f + Noise3 g = Noise3 $ \s x y z -> f s x y z + g s x y z {-# INLINE (+) #-} @@ -132,6 +187,8 @@ {-# INLINE fromRational #-} recip (Noise3 f) = Noise3 $ \s x y z -> recip (f s x y z) {-# INLINE recip #-} + Noise3 f / Noise3 g = Noise3 $ \s x y z -> f s x y z / g s x y z + {-# INLINE (/) #-} instance (Floating a) => Floating (Noise3 a) where pi = const3 pi diff --git a/src/Numeric/Noise/Internal/Math.hs b/src/Numeric/Noise/Internal/Math.hs --- a/src/Numeric/Noise/Internal/Math.hs +++ b/src/Numeric/Noise/Internal/Math.hs @@ -29,13 +29,22 @@ import Data.Bits import Data.Int -import Data.Vector.Unboxed qualified as U +import Data.Primitive.PrimArray import Data.Word +-- | Seed value for deterministic noise generation. +-- +-- Using the same 'Seed' value will produce the same noise pattern, +-- allowing for reproducible results. Different seed values produce +-- different, independent noise patterns. type Seed = Word64 + +-- | Internal hash value type used in noise calculations. type Hash = Int32 --- | monotonic lerp +-- | Linear interpolation between two values. +-- +-- Monotonic lerp lerp :: (Num a) => a @@ -65,6 +74,10 @@ quinticInterp t = t * t * t * (t * (t * 6 - 15) + 10) {-# INLINE quinticInterp #-} +-- | Clamp a value to a specified range. +-- +-- Returns the value if it's within bounds, otherwise returns +-- the nearest boundary. clamp :: (Ord a) => a @@ -130,8 +143,8 @@ gradCoord2 seed xPrimed yPrimed xd yd = let !hash = hash2 seed xPrimed yPrimed !ix = (hash `xor` (hash `shiftR` 15)) .&. 0xFE - !xg = grad2d `U.unsafeIndex` fromIntegral ix - !yg = grad2d `U.unsafeIndex` fromIntegral (ix .|. 1) + !xg = grad2d `indexPrimArray` fromIntegral ix + !yg = grad2d `indexPrimArray` fromIntegral (ix .|. 1) in xd * realToFrac xg + yd * realToFrac yg {-# INLINE gradCoord2 #-} @@ -139,9 +152,9 @@ gradCoord3 seed xPrimed yPrimed zPrimed xd yd zd = let !hash = hash3 seed xPrimed yPrimed zPrimed !ix = (hash `xor` (hash `shiftR` 15)) .&. 0xFC - !xg = grad3d `U.unsafeIndex` fromIntegral ix - !yg = grad3d `U.unsafeIndex` fromIntegral (ix .|. 1) - !zg = grad3d `U.unsafeIndex` fromIntegral (ix .|. 2) + !xg = grad3d `indexPrimArray` fromIntegral ix + !yg = grad3d `indexPrimArray` fromIntegral (ix .|. 1) + !zg = grad3d `indexPrimArray` fromIntegral (ix .|. 2) in xd * fromIntegral xg + yd * fromIntegral yg + zd * fromIntegral zg {-# INLINE gradCoord3 #-} @@ -150,9 +163,9 @@ {-# INLINE maxHash #-} {- ORMOLU_DISABLE -} --- >>> U.length grad2d == 256 +-- >>> sizeofPrimArray grad2d == 256 -- True -grad2d :: U.Vector Float +grad2d :: PrimArray Float grad2d = [ 0.130526192220052, 0.99144486137381 , 0.38268343236509 , 0.923879532511287, 0.608761429008721, 0.793353340291235, 0.793353340291235, 0.608761429008721, 0.923879532511287, 0.38268343236509 , 0.99144486137381 , 0.130526192220051, 0.99144486137381 , -0.130526192220051, 0.923879532511287, -0.38268343236509, @@ -187,10 +200,11 @@ 0.38268343236509 , 0.923879532511287, 0.923879532511287, 0.38268343236509 , 0.923879532511287, -0.38268343236509 , 0.38268343236509 , -0.923879532511287, -0.38268343236509 , -0.923879532511287, -0.923879532511287, -0.38268343236509 , -0.923879532511287, 0.38268343236509 , -0.38268343236509 , 0.923879532511287 ] +{-# INLINABLE grad2d #-} --- >>> U.length grad3d == 256 +-- >>> sizeofPrimArray grad3d == 256 -- True -grad3d :: U.Vector Int +grad3d :: PrimArray Int grad3d = [ 0, 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0 , 1, 0, 1, 0, -1, 0, 1, 0, 1, 0, -1, 0, -1, 0, -1, 0 @@ -209,3 +223,4 @@ , 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0, 0 , 1, 1, 0, 0, 0, -1, 1, 0, -1, 1, 0, 0, 0, -1, -1, 0 ] +{-# INLINABLE grad3d #-} diff --git a/src/Numeric/Noise/OpenSimplex.hs b/src/Numeric/Noise/OpenSimplex.hs --- a/src/Numeric/Noise/OpenSimplex.hs +++ b/src/Numeric/Noise/OpenSimplex.hs diff --git a/src/Numeric/Noise/Perlin.hs b/src/Numeric/Noise/Perlin.hs --- a/src/Numeric/Noise/Perlin.hs +++ b/src/Numeric/Noise/Perlin.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE Strict #-} - -- | -- Maintainer: Jeremy Nuttall -- Stability : experimental diff --git a/src/Numeric/Noise/SuperSimplex.hs b/src/Numeric/Noise/SuperSimplex.hs --- a/src/Numeric/Noise/SuperSimplex.hs +++ b/src/Numeric/Noise/SuperSimplex.hs diff --git a/src/Numeric/Noise/Value.hs b/src/Numeric/Noise/Value.hs --- a/src/Numeric/Noise/Value.hs +++ b/src/Numeric/Noise/Value.hs diff --git a/src/Numeric/Noise/ValueCubic.hs b/src/Numeric/Noise/ValueCubic.hs --- a/src/Numeric/Noise/ValueCubic.hs +++ b/src/Numeric/Noise/ValueCubic.hs diff --git a/test/Noise2Spec.hs b/test/Noise2Spec.hs --- a/test/Noise2Spec.hs +++ b/test/Noise2Spec.hs @@ -1,7 +1,6 @@ module Noise2Spec where import Numeric.Noise -import Numeric.Noise.Internal seed :: Seed seed = 55 diff --git a/test/Noise3Spec.hs b/test/Noise3Spec.hs --- a/test/Noise3Spec.hs +++ b/test/Noise3Spec.hs @@ -1,7 +1,6 @@ module Noise3Spec where import Numeric.Noise -import Numeric.Noise.Internal seed :: Seed seed = 2381 diff --git a/test/PerlinSpec.hs b/test/PerlinSpec.hs --- a/test/PerlinSpec.hs +++ b/test/PerlinSpec.hs @@ -1,5 +1,6 @@ module PerlinSpec where +import GHC.Exts (noinline) import Numeric.Noise seed :: Seed @@ -12,8 +13,10 @@ prop_noise2_addition_associative :: Rational -> Rational -> Bool prop_noise2_addition_associative x y = - noise2At ((perlin2 + perlin2) + perlin2) seed x y == noise2At (perlin2 + (perlin2 + perlin2)) seed x y + noise2At ((noinline perlin2 + noinline superSimplex2) + noinline openSimplex2) seed x y + == noise2At (perlin2 + (noinline superSimplex2 + noinline openSimplex2)) seed x y prop_noise2_addition_commutative :: Rational -> Rational -> Bool prop_noise2_addition_commutative x y = - noise2At (perlin2 + perlin2) seed x y == noise2At (perlin2 + perlin2) seed x y + noise2At (noinline perlin2 + noinline superSimplex2) seed x y + == noise2At (noinline superSimplex2 + noinline perlin2) seed x y